データ出力するための変数登録を行います.
データ出力するための変数登録を行います. HistoryAutoAllVarFix を呼ぶ前にこのサブルーチンを使用してください.
137
138
139
140
155 use gtool_history,
only: historyvarinfocreate, historyvarinfoinquire, &
156 & historyaxisinquire
162 use dc_calendar,
only: dccalconvertbyunit, dccalparseunit
163 use dc_date,
only: dcdifftimecreate,
operator(/), mod, evalsec, &
164 & operator(-), evalbyunit
166 use netcdf, only: nf90_emaxvars, nf90_max_dims
168
169
170
171 implicit none
172 character(*), intent(in):: varname
173
174 character(*), intent(in):: dims(:)
175
176
177
178
179
180
181 character(*), intent(in):: longname
182
183
184
185 character(*), intent(in):: units
186
187
188
189 character(*), intent(in), optional:: xtype
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209 character(*), intent(in), optional:: time_units
210
211
212 logical, intent(in), optional:: time_average
213
214
215
216
217
218
219
220
221 character(*), intent(in), optional:: file
222
223
224
225 real(DP), intent(in), optional:: origin
226
227
228
229
230
231
232
233
234
235
236
237 real(DP), intent(in), optional:: terminus
238
239
240
241
242
243
244
245
246
247
248
249 real(DP), intent(in), optional:: interval
250
251
252
253
254
255
256
257
258
259
260
261 integer, intent(in), optional:: slice_start(:)
262
263
264
265
266
267
268
269
270
271 integer, intent(in), optional:: slice_end(:)
272
273
274
275
276
277
278
279
280
281 integer, intent(in), optional:: slice_stride(:)
282
283
284
285
286
287
288
289
290
291 logical, intent(in), optional:: space_average(:)
292
293
294
295
296
297
298
299
300
301
302
303
304 integer, intent(in), optional:: newfile_interval
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319 character(TOKEN):: interval_unit_work
320
321
322 character(TOKEN):: origin_unit_work
323
324
325 character(TOKEN):: terminus_unit_work
326
327
328 character(TOKEN):: newfile_intunit_work
329
330
331
332 real(DP):: interval_value
333
334
335 real(DP):: origin_value
336
337
338 real(DP):: terminus_value
339
340
341 integer:: newfile_intvalue
342
343
344 character(TOKEN):: time_name
345
346
347 character(STRING), allocatable:: dims_work(:)
348
349
350 character(TOKEN):: precision
351
352
353 logical:: time_average_work
354
355
356 logical:: space_average_work(1:numdims-1)
357 integer:: slice_start_work(1:numdims-1)
358
359
360 integer:: slice_end_work(1:numdims-1)
361
362
363 integer:: slice_stride_work(1:numdims-1)
364
365
366
367 logical:: define_mode, varname_not_found
368 integer:: cause_i, stat, i, j, k, cnt, cnt2, dim_size
369 character(STRING), pointer:: dims_noavr(:) =>null(), dims_avr(:) =>null()
370 character(STRING):: longname_avrmsg
371 character(STRING):: name, cause_c
372 character(*), parameter:: subname = "HistoryAutoAddVariable1"
373 continue
376 cause_c = ""
377 cause_i = 0
378
379
380
381
384 cause_c = 'gtool_historyauto'
385 goto 999
386 end if
387
388
389
390
393 & '"HistoryAutoAddVariable" (varname = %c) must be called before "HistoryAutoAllVarFix"', &
394 & c1 = trim(varname) )
396 cause_c = 'HistoryAutoAllVarFix'
397 goto 999
398 end if
399
400
401
402
404 call historyvarinfoinquire( &
406 & name = name )
407 if ( trim(varname) == trim(name) ) then
409 cause_c = varname
410 goto 999
411 end if
412 end do
413
414
415
416
418 stat = nf90_emaxvars
419 goto 999
420 end if
421
422
423
424
425 call historyaxisinquire( &
427 & name = time_name )
428
429 if ( size(dims) > 0 ) then
431 if ( trim( dims(size(dims)) ) == trim( time_name ) ) then
432 allocate( dims_work(size(dims)) )
433 dims_work = dims
434 else
435 allocate( dims_work(size(dims)) )
436 cnt = 1
437 do i = 1, size(dims)
438 if ( trim( dims(i) ) /= trim( time_name ) ) then
439 dims_work( cnt ) = dims( i )
440 cnt = cnt + 1
441 end if
442 end do
443 dims_work(size(dims)) = time_name
444
446 & 'last entity of "dims=<%c>" must be time dimension (varname=<%c>). ' // &
447 & ' "dims" are resequenced forcibly => <%c>', &
448 & c1 = trim(
joinchar(dims,
',') ), c2 = trim( varname ), &
449 & c3 = trim(
joinchar(dims_work,
',') ) )
450
451 end if
452 else
453 allocate( dims_work(size(dims)+1) )
454 dims_work(1:size(dims)) = dims
455 dims_work(size(dims)+1) = time_name
457 & 'time dimension is not found in "dims=<%c>" (varname=<%c>). ' // &
458 & ' time dimension "%c" is appended to "dims" forcibly.', &
459 & c1 = trim(
joinchar(dims,
',') ), c2 = trim( varname ), &
460 & c3 = trim( time_name ) )
461 end if
462 else
463 allocate( dims_work(1) )
464 dims_work(1) = time_name
466 & 'time dimension is not found (varname=<%c>). ' // &
467 & ' time dimension "%c" is appended to "dims" forcibly.', &
468 & c1 = trim( varname ), &
469 & c2 = trim( time_name ) )
470 end if
471
472
473
474
477 & 'number of dimensions' // &
478 & ' on which one variable depends must not be greater than %d (varname=<%c>, dims=<%c>). ', &
479 & i = (/ 7 + 1 /), &
480 & c1 = trim( varname ), c2 = trim(
joinchar(dims_work,
',') ) )
482 cause_i = size( dims_work )
483 cause_c = varname
484 end if
485
486
487
488
492 & err = varname_not_found )
493 if ( varname_not_found ) then
496
499 & interval_unit = interval_unit_work, &
500 & origin_unit = origin_unit_work , &
501 & terminus_unit = terminus_unit_work, &
502 & newfile_intunit = newfile_intunit_work )
503
504
505
506
507 if ( present( interval ) ) then
509 if ( present(time_units) ) interval_unit_work = time_units
510 end if
511 if ( present( origin ) ) then
513 if ( present(time_units) ) origin_unit_work = time_units
514 end if
515 if ( present( terminus ) ) then
517 if ( present(time_units) ) terminus_unit_work = time_units
518 end if
519 if ( present( newfile_interval ) ) then
521 if ( present(time_units) ) newfile_intunit_work = time_units
522 end if
523
526 & name = varname, &
527 & file = file, &
528 & precision = xtype, &
529 & interval_value = interval, &
530 & interval_unit = interval_unit_work, &
531 & origin_value = origin, &
532 & origin_unit = origin_unit_work, &
533 & terminus_value = terminus, &
534 & terminus_unit = terminus_unit_work, &
535 & slice_start = slice_start, &
536 & slice_end = slice_end, &
537 & slice_stride = slice_stride, &
538 & time_average = time_average, &
539 & space_average = space_average, &
540 & newfile_intvalue = newfile_interval, &
541 & newfile_intunit = newfile_intunit_work )
543 end if
544 end if
545
546
547
548
549
552 & precision = precision, &
553 & time_average = time_average_work, &
554 & space_average = space_average_work, &
555 & slice_start = slice_start_work, &
556 & slice_end = slice_end_work, &
557 & slice_stride = slice_stride_work, &
558 & err = varname_not_found )
559 if ( varname_not_found ) then
562 & precision = precision, &
563 & time_average = time_average_work, &
564 & space_average = space_average_work, &
565 & slice_start = slice_start_work, &
566 & slice_end = slice_end_work, &
567 & slice_stride = slice_stride_work )
568 end if
569
572
574 do i = 1, size( dims_work ) - 1
576 call historyaxisinquire( &
578 & name = name )
579 if ( trim(dims_work(i)) == trim(name) ) then
581 exit
582 end if
583 end do
584 end do
585
588 dims_noavr = dims_work
589 longname_avrmsg = ''
590 else
592 cnt = 1 ; cnt2 = 1
593 do i = 1, size( dims_work ) - 1
595 dims_noavr( cnt ) = dims_work( i )
596 cnt = cnt + 1
597 else
598 dims_avr( cnt2 ) = dims_work( i )
599 cnt2 = cnt2 + 1
600 end if
601 end do
602 dims_noavr( cnt ) = dims_work( size ( dims_work ) )
603
604 longname_avrmsg =
' averaged in ' // trim(
joinchar( dims_avr,
',' ) ) //
'-direction'
605 deallocate( dims_avr )
606 end if
607
608
609
610
620
621 if ( size(dims_work) > 1 ) then
622 slice_subscript_search: do i = 1, size( dims_work ) - 1
624 call historyaxisinquire( &
626 & name = name, &
627 & size = dim_size )
628 if ( slice_end_work(j) < 1 ) slice_end_work(j) = dim_size
629 if ( trim(dims_work(i)) == trim(name) ) then
633 cycle slice_subscript_search
634 end if
635 end do
636 end do slice_subscript_search
637 end if
638
639
640
641
642
643
647
648 if ( size(dims_work) >= 1 ) then
650 call historyaxisinquire( &
652 & name = name, &
653 & size = dim_size )
654 if ( trim(dims_work(1)) == trim(name) ) then
659 call historyvarinfoinquire( &
661 & name = name )
662 if ( trim(dims_work(1)) //
wgtsuf == trim(name) )
then
664 exit
665 end if
666 end do
667 exit
668 end if
669 end do
670 end if
671
672
673
677
678 if ( size(dims_work) >= 2 ) then
680 call historyaxisinquire( &
682 & name = name, &
683 & size = dim_size )
684 if ( trim(dims_work(2)) == trim(name) ) then
689 call historyvarinfoinquire( &
691 & name = name )
692 if ( trim(dims_work(2)) //
wgtsuf == trim(name) )
then
694 exit
695 end if
696 end do
697 exit
698 end if
699 end do
700 end if
701
702
703
707
708 if ( size(dims_work) >= 3 ) then
710 call historyaxisinquire( &
712 & name = name, &
713 & size = dim_size )
714 if ( trim(dims_work(3)) == trim(name) ) then
719 call historyvarinfoinquire( &
721 & name = name )
722 if ( trim(dims_work(3)) //
wgtsuf == trim(name) )
then
724 exit
725 end if
726 end do
727 exit
728 end if
729 end do
730 end if
731
732
733
737
738 if ( size(dims_work) >= 4 ) then
740 call historyaxisinquire( &
742 & name = name, &
743 & size = dim_size )
744 if ( trim(dims_work(4)) == trim(name) ) then
749 call historyvarinfoinquire( &
751 & name = name )
752 if ( trim(dims_work(4)) //
wgtsuf == trim(name) )
then
754 exit
755 end if
756 end do
757 exit
758 end if
759 end do
760 end if
761
762
763
767
768 if ( size(dims_work) >= 5 ) then
770 call historyaxisinquire( &
772 & name = name, &
773 & size = dim_size )
774 if ( trim(dims_work(5)) == trim(name) ) then
779 call historyvarinfoinquire( &
781 & name = name )
782 if ( trim(dims_work(5)) //
wgtsuf == trim(name) )
then
784 exit
785 end if
786 end do
787 exit
788 end if
789 end do
790 end if
791
792
793
797
798 if ( size(dims_work) >= 6 ) then
800 call historyaxisinquire( &
802 & name = name, &
803 & size = dim_size )
804 if ( trim(dims_work(6)) == trim(name) ) then
809 call historyvarinfoinquire( &
811 & name = name )
812 if ( trim(dims_work(6)) //
wgtsuf == trim(name) )
then
814 exit
815 end if
816 end do
817 exit
818 end if
819 end do
820 end if
821
822
823
827
828 if ( size(dims_work) >= 7 ) then
830 call historyaxisinquire( &
832 & name = name, &
833 & size = dim_size )
834 if ( trim(dims_work(7)) == trim(name) ) then
839 call historyvarinfoinquire( &
841 & name = name )
842 if ( trim(dims_work(7)) //
wgtsuf == trim(name) )
then
844 exit
845 end if
846 end do
847 exit
848 end if
849 end do
850 end if
851
852
853
854
855
856
859
860
861
862
863 call historyvarinfocreate( &
865 & name = varname, dims = dims_noavr, &
866 & longname = trim(longname) // longname_avrmsg , &
867 & units = units, xtype = precision, &
868 & time_average = time_average_work )
871 deallocate( dims_noavr )
872 deallocate( dims_work )
873
874
875
876
878
879
880
881
883
884
885
886
889 & name = varname, &
890 & interval_value = interval_value, &
891 & interval_unit = interval_unit_work, &
892 & origin_value = origin_value, &
893 & origin_unit = origin_unit_work, &
894 & terminus_value = terminus_value, &
895 & terminus_unit = terminus_unit_work, &
896 & newfile_intvalue = newfile_intvalue, &
897 & newfile_intunit = newfile_intunit_work )
898
899
900
901
903 & dccalconvertbyunit( interval_value, interval_unit_work,
'sec',
cal_save )
904
905 call dccalparseunit( interval_unit_work, &
907
908
909
910
911
912
913
914
916 & dccalconvertbyunit( origin_value, origin_unit_work,
'sec',
cal_save )
917
918
919
920
921
922
923
924
926 & dccalconvertbyunit( terminus_value, terminus_unit_work,
'sec',
cal_save )
927
928
929
930
931
932
933
934
936 & dccalconvertbyunit( real( newfile_intvalue,
dp ), newfile_intunit_work,
'sec',
cal_save )
937
938
939
940
941
942 end if
943
944
945
946
953
955 end if
956
957
958
959
961
962999 continue
963 call storeerror(stat, subname, cause_c = cause_c, cause_i = cause_i)
964 call endsub(subname,
'stat=%d', i = (/stat/) )
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public dc_enotinit
-400 以下: dc ユーティリティのエラー
integer, parameter, public dc_noerr
エラー等を保持
integer, parameter, public hst_ealreadyregvarfix
integer, parameter, public hst_emaxdimsdepended
integer, parameter, public hst_evarinuse
character(string) function, public joinchar(carray, expr)
subroutine, public beginsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca, version)
subroutine, public endsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca)
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
integer, parameter, public dp
倍精度実数型変数
integer, save, public numdims
type(axes_weight), dimension(1:max_vars), target, save, public weight_vars
type(gthst_nmlinfo), save, public gthstnml
type(gt_history_multi), dimension(1:max_vars), save, public gthst_history_vars
character(token), dimension(1:max_vars), save, public varname_vars
real(dp), dimension(1:max_vars), save, public newfile_inttime_vars
type(space_avr_info), dimension(1:max_vars), target, save, public space_avr_vars
type(slice_info), dimension(1:max_vars), target, save, public slice_vars
real(dp), dimension(1:max_vars), save, public interval_time_vars
character(*), parameter, public wgtsuf
integer, parameter, public max_dims_depended_by_var
character(token), save, public time_unit_bycreate
type(gt_history_varinfo), dimension(1:max_vars), save, public gthst_vars
real(dp), dimension(1:max_vars), save, public terminus_time_vars
logical, dimension(1:max_vars), save, public tavr_vars
type(gt_history_axis_data), dimension(1:nf90_max_dims), target, save, public data_weights
type(gt_history_varinfo), dimension(1:nf90_max_dims), save, public gthst_weights
type(dc_cal), save, public cal_save
real(dp), dimension(1:max_vars), save, public origin_time_vars
integer, save, public numwgts
integer, parameter, public max_vars
character(*), parameter, public version
type(gt_history_axis), dimension(1:nf90_max_dims), target, save, public gthst_axes
logical, save, public flag_allvarfixed
integer, dimension(1:max_vars), save, public interval_unitsym_vars
logical, save, public initialized
integer, save, public numvars
logical, dimension(1:max_vars), save, public output_valid_vars
logical, save, public all_output_save