File: C:\NOAA\NEMS_11731\src\atmos\gfs\dyn\gfs_dynamics_grid_comp_mod.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23 module gfs_dynamics_grid_comp_mod
24
25
26
27 use esmf_mod
28
29 use gfs_dynamics_err_msg_mod
30 use gfs_dynamics_initialize_mod
31 use gfs_dynamics_run_mod
32 use gfs_dynamics_finalize_mod
33
34 use gfs_dyn_mpi_def
35 use gfs_dynamics_output, only : point_dynamics_output_gfs
36
37 implicit none
38
39 private
40
41 public gfs_dyn_setservices
42
43
44
45
46
47 contains
48
49
50
51
52
53
54
55
56
57
58 subroutine gfs_dyn_setservices (gc_gfs_dyn, rc)
59
60
61
62
63 type(esmf_gridcomp), intent(in) :: gc_gfs_dyn
64 integer, intent(out) :: rc
65
66
67
68
69
70
71 integer :: rc1 = esmf_success
72
73
74
75 = esmf_success
76
77
78
79
80
81
82
83
84
85 call esmf_logwrite("set entry point for initialize", &
86 esmf_log_info, rc = rc1)
87 call esmf_gridcompsetentrypoint (gc_gfs_dyn, &
88 esmf_setinit, &
89 gfs_dyn_initialize, &
90 esmf_singlephase, rc1)
91 call gfs_dynamics_err_msg(rc1,'set entry point for initialize',rc)
92
93
94
95 call esmf_logwrite("set entry point for run", &
96 esmf_log_info, rc = rc1)
97 call esmf_gridcompsetentrypoint (gc_gfs_dyn, &
98 esmf_setrun, &
99 gfs_dyn_run, &
100 esmf_singlephase, rc1)
101 call gfs_dynamics_err_msg(rc1,'set entry point for run',rc)
102
103
104
105
106 call esmf_logwrite("set entry point for finalize", &
107 esmf_log_info, rc = rc1)
108 call esmf_gridcompsetentrypoint (gc_gfs_dyn, &
109 esmf_setfinal, &
110 gfs_dyn_finalize, &
111 esmf_singlephase, rc1)
112 call gfs_dynamics_err_msg(rc1,'set entry point for finalize',rc)
113
114
115
116 call gfs_dynamics_err_msg_final(rc1, &
117 'setservice for gfs dynamics grid comp.',rc)
118
119 end subroutine gfs_dyn_setservices
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149 subroutine gfs_dyn_initialize(gc_gfs_dyn, &
150 imp_gfs_dyn, exp_gfs_dyn, clock, rc)
151
152
153
154 use gfs_dyn_states_mod, only : gfs_dynamics_import2internal, &
155 gfs_dynamics_internal2export
156 use gfs_dynamics_grid_create_mod
157 USE GFS_AddParameterToStateMod
158
159
160
161
162 type(esmf_gridcomp), intent(inout) :: gc_gfs_dyn
163 type(esmf_state), intent(inout) :: imp_gfs_dyn
164 type(esmf_state), intent(inout) :: exp_gfs_dyn
165 type(esmf_clock), intent(inout) :: clock
166
167
168
169
170
171 integer, intent(out) :: rc
172
173
174
175
176
177
178 type(gfs_dyn_wrap) :: wrap
179
180
181
182 type(gfs_dynamics_internal_state), pointer :: int_state
183 type(esmf_vm) :: vm_local
184 type(esmf_timeinterval) :: timestep
185 type(esmf_timeinterval) :: runduration
186 type(esmf_time) :: starttime
187 type(esmf_time) :: stoptime
188 type(esmf_time) :: currtime
189 type(esmf_timeinterval) :: reftimeinterval
190
191 type(esmf_state) :: imp_state_write
192
193 integer(kind=esmf_kind_i4) :: yy, mm, dd
194 integer(kind=esmf_kind_i4) :: hh, mns, sec
195 integer :: advancecount4, timestep_sec
196 integer :: atm_timestep_s, dyn_timestep_s
197 integer(esmf_kind_i8) :: advancecount
198
199 TYPE(ESMF_DistGrid) :: DistGrid5
200
201 integer :: rc1
202 integer :: rcfinal, grib_inp
203 integer :: ifhmax
204 integer :: runduration_hour
205
206
207
208 = esmf_success
209 rcfinal = esmf_success
210
211
212
213 call esmf_logwrite("allocate the dyn internal state", &
214 esmf_log_info, rc = rc1)
215
216 allocate(int_state, stat = rc1)
217
218 call gfs_dynamics_err_msg(rc1,' - allocate the internal state',rc)
219
220 wrap%int_state => int_state
221
222
223
224
225
226
227
228 call esmf_logwrite("get write gc import state", &
229 esmf_log_info, rc = rc1)
230
231 CALL ESMF_StateGet(state =exp_gfs_dyn &
232 ,itemName ='Write Import State' &
233 ,nestedState=IMP_STATE_WRITE &
234 ,rc =RC)
235 call gfs_dynamics_err_msg(rc1,'get write gc import state',rc)
236
237
238
239
240 call esmf_logwrite("set up the internal state", &
241 esmf_log_info, rc = rc1)
242
243 call esmf_gridcompsetinternalstate(gc_gfs_dyn, wrap, rc1)
244
245 call gfs_dynamics_err_msg(rc1,'set up the internal state',rc)
246
247
248
249
250 call esmf_logwrite("getting information from the configure file", &
251 esmf_log_info, rc = rc1)
252
253 call gfs_dynamics_getcf(gc_gfs_dyn, int_state, rc1)
254
255 call gfs_dynamics_err_msg(rc1,'get configure file information',rc)
256
257
258
259 call esmf_logwrite("getting the start time", &
260 esmf_log_info, rc = rc1)
261
262 call gfs_dynamics_start_time_get( &
263 yy, mm, dd, hh, mns, sec, int_state%kfhour, &
264 int_state%n1,int_state%n2,int_state%grib_inp, &
265 int_state%nam_gfs_dyn%grid_ini, &
266 int_state%nam_gfs_dyn%grid_ini2, rc1)
267
268 call gfs_dynamics_err_msg(rc1,'getting the start time',rc)
269
270 advancecount4 = nint(real(int_state%kfhour) * 3600.0 / &
271 int_state%nam_gfs_dyn%deltim)
272 int_state%phour = advancecount4 * &
273 int_state%nam_gfs_dyn%deltim / 3600.0
274 int_state%kfhour = nint(int_state%phour)
275
276 %kdt = advancecount4
277
278
279
280
281
282
283
284 call esmf_logwrite("set up the esmf time", &
285 esmf_log_info, rc = rc1)
286
287 call esmf_timeset(starttime, yy = yy, mm = mm, dd = dd, &
288 h = hh, m = mns, s = sec, rc = rc1)
289
290 call gfs_dynamics_err_msg(rc1,'set up the esmf time',rc)
291
292 call esmf_logwrite("set up the reference time interval", &
293 esmf_log_info, rc = rc1)
294
295 call esmf_timeintervalset(reftimeinterval, h = int_state%kfhour, &
296 m = 0, rc = rc1)
297
298
299
300
301
302
303
304
305
306
307
308 = starttime + reftimeinterval
309 call esmf_clockset(clock, currtime = currtime, &
310 rc = rc1)
311
312
313
314
315
316
317 call esmf_vmgetcurrent(vm_local, rc = rc1)
318
319 call gfs_dynamics_err_msg(rc1,'get the vm',rc)
320
321
322
323
324
325
326
327
328 call esmf_vmget(vm_local, localpet = int_state%me, &
329 mpicommunicator = mpi_comm_all, &
330 petcount = int_state%nodes, &
331 rc = rc1)
332
333 call gfs_dynamics_err_msg(rc1,'get me and nodes from vm',rc)
334
335
336
337
338
339
340 call esmf_logwrite("run the gfs_dynamics_initialize", &
341 esmf_log_info, rc = rc1)
342
343
344
345
346
347 call gfs_dynamics_initialize(int_state, rc1)
348
349
350
351
352
353
354 call gfs_dynamics_err_msg(rc1,'run the gfs_dynamics_initialize',rc)
355
356 call esmf_clockget(clock, timestep = timestep, &
357 runduration = runduration, &
358 starttime = starttime, &
359 currtime = currtime, &
360 rc = rc1)
361
362
363 call esmf_timeintervalget(runduration, &
364 h = runduration_hour, rc = rc1)
365
366
367
368 = nint(fhmax)
369 if(runduration_hour <= 0 .or. &
370 ifhmax /= 0 .and. &
371 ifhmax <= int_state%kfhour + runduration_hour) then
372 ifhmax = nint(fhmax)
373 runduration_hour = nint(fhmax) - nint(fhini)
374 call esmf_timeintervalset(runduration, &
375 h = runduration_hour, rc = rc1)
376 end if
377 if (runduration_hour <= 0) then
378 write(0,*)'WRONG: fhini=',fhini, ' >= fhmax=',fhmax,' job aborted'
379 if(me.eq.0) call mpi_quit(444)
380 endif
381 stoptime = currtime + runduration
382
383 call esmf_clockset(clock, stoptime = stoptime, &
384 rc = rc1)
385
386 call esmf_timeintervalget(timestep, s = timestep_sec, rc = rc1)
387
388
389 if (me.eq.0) then
390 call out_para(real(timestep_sec))
391 endif
392
393 if (me.eq.0) then
394 print *,' the gsm will forecast ',runduration_hour,' hours', &
395 ' from hour ',int_state%kfhour,' to hour ', &
396 runduration_hour+int_state%kfhour
397 endif
398
399
400 call synchro
401
402
403
404
405 call gfs_dynamics_grid_create_Gauss3D(vm_local,int_state,DistGrid5,rc1)
406
407 call gfs_dynamics_err_msg(rc1,'gfs_dynamics_grid_create_gauss3d',rc)
408
409 int_state%fhour_idate(1,1)=fhour
410 int_state%fhour_idate(1,2:5)=idate(1:4)
411
412 IF(int_state%ENS) THEN
413 int_state%end_step = .true.
414
415 CALL AddParameterToState(exp_gfs_dyn, int_state, rc = rc1)
416
417 call gfs_dynamics_err_msg(rc1, &
418 'Add Parameter To export State',rc)
419 END IF
420
421
422
423
424 call gfs_dynamics_internal2export(int_state, exp_gfs_dyn, rc1)
425
426 call gfs_dynamics_err_msg(rc1,'gfs_dynamics_internal2export',rc)
427
428
429
430
431
432 call point_dynamics_output_gfs(int_state,IMP_STATE_WRITE)
433
434
435
436
437
438 call gfs_dynamics_err_msg_final(rcfinal, &
439 'initialize from gfs dynamics grid comp.',rc)
440
441 end subroutine gfs_dyn_initialize
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471 subroutine gfs_dyn_run(gc_gfs_dyn, &
472 imp_gfs_dyn, exp_gfs_dyn, clock, rc)
473
474 use gfs_dyn_states_mod
475 use gfs_dyn_date_def
476
477
478
479 type(esmf_gridcomp), intent(inout) :: gc_gfs_dyn
480 type(esmf_state), intent(inout) :: imp_gfs_dyn
481
482
483
484 type(esmf_clock), intent(inout) :: clock
485 type(esmf_timeinterval) :: timestep, donetime
486 type(esmf_time) :: starttime
487 type(esmf_time) :: currtime
488 type(esmf_time) :: stoptime
489 type(esmf_time) :: dfitime
490 type(esmf_state), intent(inout) :: exp_gfs_dyn
491 integer, intent(out) :: rc
492
493
494
495
496
497
498 type(gfs_dyn_wrap) :: wrap
499
500
501
502 type(gfs_dynamics_internal_state), pointer :: int_state
503 integer :: rc1
504 integer :: rcfinal
505
506 type(esmf_state) :: imp_state_write
507 logical,save :: first_reset=.true.
508 logical,save :: first_dfiend=.true.
509 TYPE(ESMF_TimeInterval) :: HALFDFIINTVAL
510 integer :: DFIHR
511 TYPE(ESMF_LOGICAL) :: Cpl_flag1
512
513
514
515 TYPE(ESMF_Field) :: ESMFField
516 TYPE(ESMF_FieldBundle) :: ESMFBundle
517 REAL , DIMENSION(:,:,:), POINTER :: fArr3D
518 integer :: localPE,ii1,ii2,ii3
519 integer :: n, k, rc2
520 logical, parameter :: ckprnt = .false.
521 integer, parameter :: item_count = 3
522 character(5) :: item_name(item_count)
523 character(20) :: vname
524 data item_name/'t','u','v'/
525
526 = 0
527
528
529
530 = esmf_success
531 rcfinal = esmf_success
532
533
534
535 call esmf_logwrite("get the internal state in the run routine", &
536 esmf_log_info, rc = rc1)
537
538 call esmf_gridcompgetinternalstate(gc_gfs_dyn, wrap, rc1)
539
540 call gfs_dynamics_err_msg(rc1, &
541 'get the internal state in the run routine',rc)
542
543
544
545 => wrap%int_state
546
547
548
549
550
551 call esmf_logwrite("esmf import state to internal state", &
552 esmf_log_info, rc = rc1)
553
554 %reset_step = .false.
555 if(int_state%restart_step ) first_reset=.false.
556
557 if( int_state%ndfi>0 .and. first_reset.and. int_state%kdt==int_state%ndfi) then
558 if( first_dfiend ) then
559
560 %dfiend_step=.true.
561 first_dfiend=.false.
562 else
563
564 %reset_step = .true.
565 int_state%dfiend_step = .false.
566 first_reset=.false.
567 endif
568 endif
569
570
571
572
573 IF(.NOT. int_state%restart_step .AND. .NOT. int_state%start_step ) THEN
574 IF(.NOT. int_state%reset_step) THEN
575 CALL gfs_dynamics_import2internal(imp_gfs_dyn, int_state, rc1)
576 ELSE
577 CALL gfs_dynamics_import2internal(imp_gfs_dyn, &
578 int_state, rc = rc1, exp_gfs_dyn = exp_gfs_dyn)
579
580 END IF
581
582 CALL gfs_dynamics_err_msg(rc1, 'esmf import state to internal state', rc)
583 idate(1 : 4) = int_state%fhour_idate(1, 2 : 5)
584 END IF
585
586
587
588 call esmf_clockget(clock, &
589 timestep = timestep, &
590 starttime = starttime, &
591 currtime = currtime, &
592 stoptime = stoptime, &
593 rc = rc1)
594
595 call gfs_dynamics_err_msg(rc1,'esmf clockget',rc)
596
597 donetime = currtime-starttime
598
599 int_state%kdt = nint(donetime/timeStep)
600
601
602
603 CALL ESMF_AttributeGet(imp_gfs_dyn, 'Cpl_flag', Cpl_flag1, rc = rc1)
604 IF(Cpl_flag1 == ESMF_TRUE) THEN
605 int_state%Cpl_flag = .true.
606 ELSE
607 int_state%Cpl_flag = .false.
608 END IF
609
610 if( currtime .eq. stoptime ) then
611 print *,' currtime equals to stoptime '
612 int_state%end_step = .true.
613 else
614 int_state%end_step=.false.
615 endif
616
617
618 call esmf_timeget(currtime, &
619 yy=int_state%nfcstdate7(1), &
620 mm=int_state%nfcstdate7(2), &
621 dd=int_state%nfcstdate7(3), &
622 h =int_state%nfcstdate7(4), &
623 m =int_state%nfcstdate7(5), &
624 s =int_state%nfcstdate7(6), &
625 rc=rc1)
626 call gfs_dynamics_err_msg(rc1,'esmf timeget',rc)
627
628
629
630
631
632 call esmf_logwrite("run the gfs_dynamics_run", &
633 esmf_log_info, rc = rc1)
634
635 call gfs_dynamics_run(int_state, imp_gfs_dyn, rc = rc1)
636 call gfs_dynamics_err_msg(rc1,'run the gfs_dynamics_run',rc)
637
638
639
640
641
642
643
644 call esmf_logwrite("internal state to esmf export state", &
645 esmf_log_info, rc = rc1)
646
647
648
649 call gfs_dynamics_internal2export(int_state, exp_gfs_dyn, rc = rc1)
650
651 call gfs_dynamics_err_msg(rc1,'internal state to esmf export state',rc)
652
653
654 lab_if_ckprnt_ex : if ( ckprnt .and. (int_state%me ==0) ) then
655 do n = 1, item_count
656 = trim(item_name(n))
657 if(associated(fArr3D)) nullify(fArr3D)
658 CALL ESMF_StateGet(state = exp_gfs_dyn &
659 ,itemName = vname &
660 ,field = ESMFField &
661 ,rc = rc1)
662 call gfs_dynamics_err_msg(rc1,'LU_DYN: get ESMFarray',rc)
663 CALL ESMF_FieldGet(field=ESMFField, localDe=0, &
664 farray=fArr3D, rc = rc1)
665 call gfs_dynamics_err_msg(rc1,'LU_DYN: get F90array',rc)
666
667
668
669
670
671
672 enddo
673
674 call ESMF_StateGet(state=exp_gfs_dyn, ItemName='tracers', &
675 fieldbundle=ESMFBundle, rc = rc1 )
676 call gfs_dynamics_err_msg(rc1,'LU_DYN: get Bundle from exp',rc)
677 do n = 1, int_state%ntrac
678 = int_state%gfs_dyn_tracer%vname(n, 1)
679 print *,'LU_DYN:',trim(vname)
680 CALL ESMF_FieldBundleGet(bundle=ESMFBundle, &
681 name=vname, field=ESMFfield, rc = rc1)
682 CALL ESMF_FieldGet(field=ESMFfield, localDe=0, &
683 farray=fArr3D, rc = rc1)
684
685
686
687
688
689
690
691
692
693 enddo
694
695 endif lab_if_ckprnt_ex
696
697
698
699
700
701
702 call esmf_logwrite("get imp_state_write from esmf export state", &
703 esmf_log_info, rc = rc1)
704
705
706 CALL ESMF_StateGet(state =exp_gfs_dyn &
707 ,itemName ="Write Import State" &
708 ,nestedState =IMP_STATE_WRITE &
709 ,rc =RC1)
710
711
712 call gfs_dynamics_err_msg(rc1,'get imp_state_write from esmf export state',rc)
713
714
715 call esmf_logwrite("set pdryini in imp_state_write", &
716 esmf_log_info, rc = rc1)
717 CALL ESMF_AttributeSet(state =IMP_STATE_WRITE &
718 ,name ='pdryini' &
719 ,value =int_state%pdryini &
720 ,rc =RC1)
721 call gfs_dynamics_err_msg(rc1,'set pdryini in imp_state_write',rc)
722
723
724
725
726 call gfs_dynamics_err_msg_final(rcfinal, &
727 'run from gfs dynamics grid comp.',rc)
728
729 end subroutine gfs_dyn_run
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750 subroutine gfs_dyn_finalize(gc_gfs_dyn, &
751 imp_gfs_dyn, exp_gfs_dyn, clock, rc)
752
753
754
755
756 type(esmf_gridcomp), intent(inout) :: gc_gfs_dyn
757 type(esmf_state), intent(inout) :: imp_gfs_dyn
758 type(esmf_state), intent(inout) :: exp_gfs_dyn
759 type(esmf_clock), intent(inout) :: clock
760
761
762
763 integer, intent(out) :: rc
764
765
766
767 type(gfs_dyn_wrap) :: wrap
768 type(gfs_dynamics_internal_state), pointer :: int_state
769 integer :: rc1
770 integer :: rcfinal
771
772
773
774
775
776
777 = esmf_success
778 rcfinal = esmf_success
779
780
781
782 call esmf_logwrite( &
783 "get the internal state in the finalize routine", &
784 esmf_log_info, rc = rc1)
785
786 call esmf_gridcompgetinternalstate(gc_gfs_dyn, wrap, rc1)
787
788 call gfs_dynamics_err_msg(rc1, &
789 'get the internal state in the finalize routine',rc)
790
791
792
793 => wrap%int_state
794
795
796
797
798 call esmf_logwrite("run the gfs_dynamics_finalize", &
799 esmf_log_info, rc = rc1)
800
801 call gfs_dynamics_finalize(int_state, rc = rc1)
802
803 call gfs_dynamics_err_msg(rc1,'run the gfs_dynamics_finalize',rc)
804
805
806
807
808
809 call gfs_dynamics_err_msg_final(rcfinal, &
810 'finalize from gfs dynamics grid comp.',rc)
811
812 end subroutine gfs_dyn_finalize
813
814
815
816 end module gfs_dynamics_grid_comp_mod
817