28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78 use gtool_historyauto_internal, only: initialized, version, sub_sname, &
79 & zero_time, numdims, &
80 & title_save, source_save, institution_save, conventions_save, &
81 & gt_version_save, rank_save, save_mpi_split, save_mpi_gather, &
82 & time_unit_bycreate, time_unit_suffix, gthst_axes, data_axes, &
83 & all_output_save, gthstnml, cal_save
84 use gtool_history,
only: historyaxiscreate, historyaxisaddattr
88 use dc_trace, only: beginsub, endsub
91 use netcdf, only: nf90_emaxdims, nf90_max_dims
92 use dc_string, only: putline, printf, split, strinclude, stoa, joinchar
93 use dc_present, only: present_and_not_empty, present_and_true, &
94 & present_select
96 & dccaldateinquire, dccalinquire, dccaldefault
97 use dc_date,
only: dcdifftimecreate, evalbyunit, tochar, tocharcal, eval
99 use dc_message, only: messagenotify
102 implicit none
103 character(*), intent(in):: title
104
105
106 character(*), intent(in):: source
107
108
109 character(*), intent(in):: institution
110
111
112 character(*), intent(in):: dims(:)
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131 integer, intent(in):: dimsizes (:)
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159 character(*), intent(in):: longnames (:)
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179 character(*), intent(in):: units(:)
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199 type(DC_DIFFTIME), intent(in):: origin
200
201
202
203
204 type(DC_DIFFTIME), intent(in):: terminus
205
206
207
208
209 character(*), intent(in), optional:: xtypes(:)
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239 character(*), intent(in), optional:: conventions
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258 character(*), intent(in), optional:: gt_version
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280 logical, intent(in), optional:: all_output
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316 character(*), intent(in), optional:: file_prefix
317
318
319 character(*), intent(in), optional:: namelist_filename
320
321
322
323
324
325
326
327
328
329
330
331 type(DC_DIFFTIME), intent(in), optional:: interval
332
333
334
335
336
337
338
339
340
341
342
343 integer, intent(in), optional:: slice_start(:)
344
345
346
347
348
349
350
351
352
353 integer, intent(in), optional:: slice_end(:)
354
355
356
357
358
359
360
361
362
363
364
365 integer, intent(in), optional:: slice_stride(:)
366
367
368
369
370
371
372
373
374
375 logical, intent(in), optional:: space_average(:)
376
377
378
379
380
381
382
383
384
385
386
387
388 logical, intent(in), optional:: time_average
389
390
391
392
393 integer, intent(in), optional:: newfile_interval
394
395
396
397
398
399
400
401
402
403
404 character(*), intent(in), optional:: rank
405
406
407
408
409 type(DC_DATETIME), intent(in), optional:: origin_date
410
411
412
413
414
415
416 logical, intent(in), optional:: origin_date_invalid
417
418
419
420 type(DC_CAL_DATE), intent(in), optional:: start_date
421
422
423
424
425 type(DC_CAL), intent(in), optional:: cal
426
427
428
429
430
431
432
433
434 logical, intent(in), optional:: flag_mpi_gather
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451 logical, intent(in), optional:: flag_mpi_split
452
453
454
455
456
457
458
459
460
461
462
463
464
465 character(STRING):: Name
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482 character(STRING):: File
483
484
485
486
487
488
489
490
491
492 real(DP):: IntValue
493
494
495
496
497 character(TOKEN):: IntUnit
498
499
500 character(TOKEN):: Precision
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516 character(STRING):: FilePrefix
517
518
519 logical:: TimeAverage
520
521
522
523
524
525
526
527
528
529 logical:: AllOutput
530
531
532 real(DP):: OriginValue
533
534
535 character(TOKEN):: OriginUnit
536
537
538 real(DP):: TerminusValue
539
540
541 character(TOKEN):: TerminusUnit
542
543
544 integer:: SliceStart(1:NF90_MAX_DIMS)
545
546
547 integer:: SliceEnd(1:NF90_MAX_DIMS)
548
549
550
551
552
553
554
555
556
557
558
559 integer:: SliceStride(1:NF90_MAX_DIMS)
560
561
562 logical:: SpaceAverage(1:NF90_MAX_DIMS)
563
564
565 integer:: NewFileIntValue
566
567
568 character(TOKEN):: NewFileIntUnit
569
570
571
572 namelist /gtool_historyauto_nml/ &
573 & name, file, &
574 & intvalue, intunit, &
575 & precision, &
576 & fileprefix, &
577 & timeaverage, alloutput, &
578 & originvalue, originunit, &
579 & terminusvalue, terminusunit, &
580 & slicestart, sliceend, slicestride, spaceaverage, &
581 & newfileintvalue, newfileintunit
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602 integer:: blank_index
603 integer:: stat
604 character(STRING):: cause_c
605 integer:: unit_nml
606
607 integer:: iostat_nml
608
609 character(TOKEN):: pos_nml
610
611
612 integer:: i, j
613 character(TOKEN):: my_xtype
614
615 real(DP):: interval_work, origin_work, terminus_work
616 integer:: date_day
617 real(DP):: date_sec
618 integer:: msnot_rank
619 character(STRING):: date_str
620 character(TOKEN):: cal_str, cal_type
621 integer:: origin_year, origin_month, origin_day, origin_hour, origin_min
622 real(DP):: origin_sec
623 integer:: month_in_year, hour_in_day, min_in_hour
624 integer, pointer:: day_in_month(:) =>null()
625 real(DP):: sec_in_min
626 character(*), parameter:: subname = "HistoryAutoCreate3"
627 continue
628 call beginsub(subname, version = version)
630 cause_c = ""
631
632
633
634
635 if ( initialized ) then
637 cause_c = 'gtool_historyauto'
638 goto 999
639 end if
640
641
642
643
644 zero_time = 0.0_dp
645
646
647
648
649
650
651
652 numdims = size(dims)
653
654 if ( size(dimsizes) /= numdims ) then
655 cause_c = 'dimsizes, dims'
656 elseif ( size(longnames) /= numdims ) then
657 cause_c = 'longnames, dims'
658 elseif ( size(units) /= numdims ) then
659 cause_c = 'units, dims'
660 endif
661 if ( trim(cause_c) /= "" ) then
663 goto 999
664 end if
665
666 if ( numdims > nf90_max_dims ) then
667 stat = nf90_emaxdims
668 goto 999
669 end if
670
671
672
673
674 if ( dimsizes(numdims) /= 0 ) then
675 call messagenotify( 'W', subname, &
676 & 'time dimension must be specified to the last of "dims"' )
678 goto 999
679 end if
680
681
682
683
684 title_save = title
685 source_save = source
686 institution_save = institution
687
688 conventions_save = ''
689 if ( present(conventions) ) conventions_save = conventions
690
691 gt_version_save = ''
692 if ( present(gt_version) ) gt_version_save = gt_version
693
694 rank_save = ''
695 if ( present(rank) ) rank_save = rank
696
697
698
699
700 save_mpi_split = present_and_true( flag_mpi_split )
701 save_mpi_gather = present_and_true( flag_mpi_gather )
702
703 msnot_rank = -1
704 if ( save_mpi_gather ) msnot_rank = 0
705
706
707
708
709 time_unit_bycreate = units(numdims)
710 time_unit_suffix = ''
711 blank_index = index( trim( adjustl(time_unit_bycreate) ), ' ' )
712 if ( blank_index > 1 ) then
713 time_unit_suffix = time_unit_bycreate(blank_index+1:)
714 time_unit_bycreate = time_unit_bycreate(1:blank_index-1)
715 end if
716
717
718
719
720 do i = 1, numdims
721 my_xtype = ''
722 if ( present(xtypes) ) then
723 if ( size(xtypes) >= i ) then
724 my_xtype = xtypes(i)
725 end if
726 end if
727
728 call historyaxiscreate( &
729 & axis = gthst_axes(i), &
730 & name = dims(i), size = dimsizes(i), &
731 & longname = longnames(i), units = units(i), &
732 & xtype = my_xtype )
733
734 allocate( data_axes(i) % a_axis( dimsizes(i) ) )
735 data_axes(i) % a_axis = (/ ( real( j,
dp ), j = 1, dimsizes(i) ) /)
736
737 end do
738
739
740
741
742 if ( present(cal) ) then
743 cal_save = cal
744 else
745 call dccaldefault( cal_save )
746 end if
747
748
749
750
751 if ( present(start_date) ) then
752
753 call dccaldateinquire( &
754 & date_str = date_str, &
755 & date = start_date, &
756 & cal = cal &
757
758 & )
759
760 call dccaldateinquire( &
761 & origin_year, origin_month, origin_day, &
762 & origin_hour, origin_min, origin_sec, &
763 & date = start_date, &
764 & cal = cal &
765 & )
766
767 call dccalinquire( &
768 & cal_str, &
769 & month_in_year = month_in_year, &
770 & day_in_month_ptr = day_in_month , &
771 & hour_in_day = hour_in_day , &
772 & min_in_hour = min_in_hour , &
773 & sec_in_min = sec_in_min , &
774 & cal = cal_save )
775
776
777
778 select case ( trim(cal_str) )
779 case ( 'gregorian' )
780 time_unit_suffix = trim(time_unit_suffix) // &
781 & ' since ' // trim(date_str)
782 case ( 'julian' )
783 time_unit_suffix = trim(time_unit_suffix) // &
784 & ' since ' // trim(date_str)
785 case ( 'noleap' )
786 time_unit_suffix = trim(time_unit_suffix) // &
787 & ' since ' // trim(date_str)
788 case ( '360day' )
789 time_unit_suffix = trim(time_unit_suffix) // &
790 & ' since ' // trim(date_str)
791 case ( 'cyclic' )
792 time_unit_suffix = trim(time_unit_suffix) // &
793 & ' since ' // trim(date_str)
794 end select
795
796
797
798 call historyaxisaddattr( &
799 & axis = gthst_axes(numdims), &
800 & attrname = 'origin', &
801 & value = 'origin_year origin_month origin_day ' // &
802 & 'origin_hour origin_min origin_sec' )
803
804 call historyaxisaddattr( gthst_axes(numdims), 'origin_year', origin_year )
805 call historyaxisaddattr( gthst_axes(numdims), 'origin_month', origin_month )
806 call historyaxisaddattr( gthst_axes(numdims), 'origin_day', origin_day )
807 call historyaxisaddattr( gthst_axes(numdims), 'origin_hour', origin_hour )
808 call historyaxisaddattr( gthst_axes(numdims), 'origin_min', origin_min )
809
810
811
812 call historyaxisaddattr( &
813 & axis = gthst_axes(numdims), &
814 & attrname = 'calendar', &
815 & value = cal_str )
816
817 if ( trim(cal_str) == 'user_defined' ) then
818 call historyaxisaddattr( gthst_axes(numdims), 'month_in_year', month_in_year )
819 call historyaxisaddattr( gthst_axes(numdims), 'day_in_month', day_in_month )
820 call historyaxisaddattr( gthst_axes(numdims), 'hour_in_day', hour_in_day )
821 call historyaxisaddattr( gthst_axes(numdims), 'min_in_hour', min_in_hour )
822 call historyaxisaddattr( gthst_axes(numdims), 'sec_in_min', sec_in_min )
823 end if
824
825 deallocate( day_in_month )
826
827 elseif ( present(origin_date) &
828 & .and. .not. present_and_true(origin_date_invalid) ) then
829 call eval( origin_date, &
830 & day = date_day, sec = date_sec )
831 if ( date_day /= 0 .or. date_sec /= 0.0 ) then
832 time_unit_suffix = trim(time_unit_suffix) // &
833 & ' since ' // tochar(origin_date)
834
835 call historyaxisaddattr( &
836 & axis = gthst_axes(numdims), &
837 & attrname = 'calendar', &
838 & value = tocharcal(origin_date) )
839
840 end if
841 end if
842
843
844
845
846 if ( present(all_output) ) all_output_save = all_output
847 if ( .not. present_and_not_empty(namelist_filename) ) all_output_save = .true.
848 alloutput = all_output_save
849
850
851
852
853 if ( all_output_save ) then
854 if ( present(interval) ) then
855 interval_work = evalbyunit( interval, time_unit_bycreate )
856 else
857 interval_work = 1.0
858 end if
859 else
860 interval_work = - 1.0
861 end if
862
863
864
865
866 origin_work = evalbyunit( origin, 'sec' )
867 terminus_work = evalbyunit( terminus, time_unit_bycreate )
868
869
870
871
873
875 & gthstnml = gthstnml, &
876 & name = '', &
877 & precision = 'float', &
878 & fileprefix = file_prefix, &
879 & interval_value = interval_work, &
880 & interval_unit = time_unit_bycreate, &
881 & origin_value = origin_work, &
882 & origin_unit = 'sec', &
883
884 & terminus_value = terminus_work, &
885 & terminus_unit = time_unit_bycreate, &
886 & time_average = time_average, &
887 & slice_start = slice_start, &
888 & slice_end = slice_end, &
889 & slice_stride = slice_stride, &
890 & space_average = space_average, &
891 & newfile_intvalue = newfile_interval, &
892 & newfile_intunit = time_unit_bycreate )
893
894
895
896
897 if ( present_and_not_empty(namelist_filename) ) then
899 & namelist_filename, mode = 'r' )
900
901 iostat_nml = 0
902 pos_nml = ''
903
904 call messagenotify( 'M', sub_sname, '----- "gtool_historyauto_nml" is loaded from "%c" -----', &
905 & c1 = trim(namelist_filename), rank_mpi = msnot_rank )
906
907 do while ( trim(pos_nml) /= 'APPEND' .and. iostat_nml == 0 )
908
909 name = ''
910 file = ''
912 & gthstnml = gthstnml, &
913 & interval_value = intvalue, &
914 & interval_unit = intunit, &
915 & precision = precision, &
916 & time_average = timeaverage, &
917 & origin_value = originvalue, &
918 & origin_unit = originunit, &
919 & terminus_value = terminusvalue, &
920 & terminus_unit = terminusunit, &
921 & slice_start = slicestart, &
922 & slice_end = sliceend, &
923 & slice_stride = slicestride, &
924 & space_average = spaceaverage, &
925 & newfile_intvalue = newfileintvalue, &
926 & newfile_intunit = newfileintunit, &
927 & fileprefix = fileprefix )
928
929 read( unit = unit_nml, &
930 & nml = gtool_historyauto_nml, &
931 & iostat = iostat_nml )
932 inquire( unit = unit_nml, &
933 & position = pos_nml )
934
935 if ( iostat_nml == 0 ) then
936
937
938
939
940 if ( .not. intvalue > 0.0 ) then
941 intvalue = interval_work
942 intunit = time_unit_bycreate
943 end if
944 if ( .not. originvalue > 0.0 ) then
945 originvalue = origin_work
946 originunit = 'sec'
947 end if
948 if ( .not. terminusvalue > 0.0 ) then
949 terminusvalue = terminus_work
950 terminusunit = time_unit_bycreate
951 end if
952
953
954
955
957 & gthstnml = gthstnml, &
958 & name = name, &
959 & file = file, &
960 & interval_value = intvalue, &
961 & interval_unit = intunit, &
962 & precision = precision, &
963 & time_average = timeaverage, &
964 & origin_value = originvalue, &
965 & origin_unit = originunit, &
966 & terminus_value = terminusvalue, &
967 & terminus_unit = terminusunit, &
968 & slice_start = slicestart, &
969 & slice_end = sliceend, &
970 & slice_stride = slicestride, &
971 & space_average = spaceaverage, &
972 & newfile_intvalue = newfileintvalue, &
973 & newfile_intunit = newfileintunit, &
974 & fileprefix = fileprefix )
975
976
977
978
979 if ( trim(name) == '' ) then
980 all_output_save = alloutput
981 end if
982
983
984
985 if ( trim(file) == '' ) file = trim(fileprefix) // '<Name>.nc'
986
987 if ( trim(name) == '' ) then
988 call messagenotify( 'M', sub_sname, 'Global Settings:', rank_mpi = msnot_rank )
989 call messagenotify( 'M', sub_sname, ' AllOutput = %b', l = (/ alloutput /), rank_mpi = msnot_rank )
990 call messagenotify( 'M', sub_sname, ' FilePrefix = %c', c1 = trim(fileprefix ), rank_mpi = msnot_rank )
991 else
992 call messagenotify( 'M', sub_sname, 'Individual Settings:', rank_mpi = msnot_rank )
993 call messagenotify( 'M', sub_sname, ' Name = %c', c1 = trim(name ), rank_mpi = msnot_rank )
994 call messagenotify( 'M', sub_sname, ' File = %c', c1 = trim(file ), rank_mpi = msnot_rank )
995 end if
996 call messagenotify( 'M', sub_sname, ' Interval = %f [%c]', &
997 & d = (/ intvalue /), c1 = trim( intunit ), rank_mpi = msnot_rank )
998 call messagenotify( 'M', sub_sname, ' Precision = %c', c1 = trim(precision ), rank_mpi = msnot_rank )
999 call messagenotify( 'M', sub_sname, ' TimeAverage = %b', l = (/ timeaverage /), rank_mpi = msnot_rank )
1000 call messagenotify( 'M', sub_sname, ' Origin = %f [%c]', &
1001 & d = (/ originvalue /), c1 = trim( originunit ), rank_mpi = msnot_rank )
1002 call messagenotify( 'M', sub_sname, ' Terminus = %f [%c]', &
1003 & d = (/ terminusvalue /), c1 = trim( terminusunit ), rank_mpi = msnot_rank )
1004 call messagenotify( 'M', sub_sname, ' SliceStart = (/ %*d /)', &
1005 & i = slicestart(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
1006 call messagenotify( 'M', sub_sname, ' SliceEnd = (/ %*d /)', &
1007 & i = sliceend(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
1008 call messagenotify( 'M', sub_sname, ' SliceStride = (/ %*d /)', &
1009 & i = slicestride(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
1010 call messagenotify( 'M', sub_sname, ' SpaceAverage = (/ %*b /)', &
1011 & l = spaceaverage(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
1012 call messagenotify( 'M', sub_sname, ' NewFileInterval = %d [%c]', &
1013 & i = (/ newfileintvalue /), c1 = trim( newfileintunit ), rank_mpi = msnot_rank )
1014 call messagenotify( 'M', sub_sname, '', rank_mpi = msnot_rank )
1015
1016 else
1017 call messagenotify( 'M', sub_sname, '----- loading is finished (iostat=%d) -----', &
1018 & i = (/iostat_nml/), rank_mpi = msnot_rank )
1019 end if
1020 end do
1021
1022 close( unit_nml )
1023
1024
1025
1026
1027
1028 else
1029 call messagenotify( 'M', sub_sname, '----- "gtool_historyauto_nml" is not loaded" -----', rank_mpi = msnot_rank )
1030 name = ''
1031 file = ''
1033 & gthstnml = gthstnml, &
1034 & interval_value = intvalue, &
1035 & interval_unit = intunit, &
1036 & precision = precision, &
1037 & time_average = timeaverage, &
1038 & origin_value = originvalue, &
1039 & origin_unit = originunit, &
1040 & terminus_value = terminusvalue, &
1041 & terminus_unit = terminusunit, &
1042 & slice_start = slicestart, &
1043 & slice_end = sliceend, &
1044 & slice_stride = slicestride, &
1045 & space_average = spaceaverage, &
1046 & newfile_intvalue = newfileintvalue, &
1047 & newfile_intunit = newfileintunit, &
1048 & fileprefix = fileprefix )
1049
1050
1051
1052 call messagenotify( 'M', sub_sname, 'Global Settings:', rank_mpi = msnot_rank )
1053 call messagenotify( 'M', sub_sname, ' AllOutput = %b', l = (/ alloutput /), rank_mpi = msnot_rank )
1054 call messagenotify( 'M', sub_sname, ' FilePrefix = %c', c1 = trim(fileprefix ), rank_mpi = msnot_rank )
1055 call messagenotify( 'M', sub_sname, ' Interval = %f [%c]', &
1056 & d = (/ intvalue /), c1 = trim( intunit ), rank_mpi = msnot_rank )
1057 call messagenotify( 'M', sub_sname, ' Precision = %c', c1 = trim(precision ), rank_mpi = msnot_rank )
1058 call messagenotify( 'M', sub_sname, ' TimeAverage = %b', l = (/ timeaverage /), rank_mpi = msnot_rank )
1059 call messagenotify( 'M', sub_sname, ' Origin = %f [%c]', &
1060 & d = (/ originvalue /), c1 = trim( originunit ), rank_mpi = msnot_rank )
1061 call messagenotify( 'M', sub_sname, ' Terminus = %f [%c]', &
1062 & d = (/ terminusvalue /), c1 = trim( terminusunit ), rank_mpi = msnot_rank )
1063 call messagenotify( 'M', sub_sname, ' SliceStart = (/ %*d /)', &
1064 & i = slicestart(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
1065 call messagenotify( 'M', sub_sname, ' SliceEnd = (/ %*d /)', &
1066 & i = sliceend(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
1067 call messagenotify( 'M', sub_sname, ' SliceStride = (/ %*d /)', &
1068 & i = slicestride(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
1069 call messagenotify( 'M', sub_sname, ' SpaceAverage = (/ %*b /)', &
1070 & l = spaceaverage(1:numdims-1), n = (/ numdims-1 /), rank_mpi = msnot_rank )
1071 call messagenotify( 'M', sub_sname, ' NewFileInterval = %d [%c]', &
1072 & i = (/ newfileintvalue /), c1 = trim( newfileintunit ), rank_mpi = msnot_rank )
1073 call messagenotify( 'M', sub_sname, '' , rank_mpi = msnot_rank)
1074
1075 end if
1076
1077
1078
1079
1080 initialized = .true.
1081
1082999 continue
1083 call storeerror(stat, subname, cause_c = cause_c)
1084 call endsub(subname, 'stat=%d', i = (/stat/) )