-
Notifications
You must be signed in to change notification settings - Fork 162
/
Copy pathGFS_physics_driver.F90
6010 lines (5601 loc) · 270 KB
/
GFS_physics_driver.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
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
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
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
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
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
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
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
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
module module_physics_driver
use machine, only: kind_phys
use physcons, only: con_cp, con_fvirt, con_g, con_rd, &
con_rv, con_hvap, con_hfus, &
con_rerth, con_pi, rhc_max, dxmin, &
dxinv, pa2mb, rlapse, con_eps, &
con_epsm1, PQ0, A2A, A3, A4, RHmin, &
tgice => con_tice
use cs_conv, only: cs_convr
use ozne_def, only: levozp, oz_coeff, oz_pres
use h2o_def, only: levh2o, h2o_coeff, h2o_pres
use gfs_fv3_needs, only: get_prs_fv3, get_phi_fv3
use module_nst_water_prop, only: get_dtzm_2d
use GFS_typedefs, only: GFS_statein_type, GFS_stateout_type, &
GFS_sfcprop_type, GFS_coupling_type, &
GFS_control_type, GFS_grid_type, &
GFS_tbd_type, GFS_cldprop_type, &
! GFS_radtend_type, GFS_diag_type
GFS_radtend_type, GFS_diag_type, huge
use gfdl_cloud_microphys_mod, only: gfdl_cloud_microphys_driver, &
cloud_diagnosis
use module_mp_thompson, only: mp_gt_driver
use module_mp_wsm6, only: wsm6
use funcphys, only: ftdp
use surface_perturbation, only: cdfnor
use module_sfc_diff, only: sfc_diff
use module_sfc_ocean, only: sfc_ocean
use module_sfc_drv, only: sfc_drv
use module_sfc_sice, only: sfc_sice
use module_sfc_cice, only: sfc_cice
use module_sfc_nst, only: sfc_nst
use module_sfc_diag, only: sfc_diag
!
!vay-2018
!
use cires_ugwp_module, only: cires_ugwp_driver, knob_ugwp_version
!
implicit none
!--- CONSTANT PARAMETERS
real(kind=kind_phys), parameter :: hocp = con_hvap/con_cp
real(kind=kind_phys), parameter :: epsln = 1.0e-10_kind_phys
real(kind=kind_phys), parameter :: qmin = 1.0e-8_kind_phys
real(kind=kind_phys), parameter :: qsmall = 1.0e-20_kind_phys
real(kind=kind_phys), parameter :: rainmin = 1.0e-13_kind_phys
real(kind=kind_phys), parameter :: p850 = 85000.0_kind_phys
real(kind=kind_phys), parameter :: epsq = 1.0e-20_kind_phys
real(kind=kind_phys), parameter :: hsub = con_hvap+con_hfus
real(kind=kind_phys), parameter :: czmin = 0.0001_kind_phys ! cos(89.994)
real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys, &
half = 0.5_kind_phys, onebg = one/con_g
real(kind=kind_phys), parameter :: albdf = 0.06_kind_phys
real(kind=kind_phys), parameter :: tf=258.16_kind_phys, tcr=273.16_kind_phys, tcrf=one/(tcr-tf)
real(kind=kind_phys), parameter :: con_p001= 0.001_kind_phys
real(kind=kind_phys), parameter :: con_day = 86400.0_kind_phys
real(kind=kind_phys), parameter :: rad2dg = 180.0_kind_phys/con_pi
real(kind=kind_phys), parameter :: omz1 = 2.0_kind_phys
! real(kind=kind_phys), parameter :: huge = 0.0_kind_phys
!> GFS Physics Implementation Layer
!> @brief Layer that invokes individual GFS physics routines
!> @{
!at tune step===========================================================!
! description: !
! !
! usage: !
! !
! call GFS_physics_driver !
! !
! --- interface variables !
! type(GFS_control_type), intent(in) :: Model !
! type(GFS_statein_type), intent(inout) :: Statein !
! type(GFS_stateout_type), intent(inout) :: Stateout !
! type(GFS_sfcprop_type), intent(inout) :: Sfcprop !
! type(GFS_coupling_type), intent(inout) :: Coupling !
! type(GFS_grid_type), intent(in) :: Grid !
! type(GFS_tbd_type), intent(inout :: Tbd !
! type(GFS_cldprop_type), intent(inout) :: Cldprop !
! type(GFS_radtend_type), intent(inout) :: Radtend !
! type(GFS_diag_type), intent(inout) :: Diag !
! !
! subprograms called: !
! !
! get_prs, dcyc2t2_pre_rad (testing), dcyc2t3, sfc_diff, !
! sfc_ocean,sfc_drv, sfc_sice, sfc_cice, sfc_diag, moninp1, !
! moninp, moninq1, moninq, satmedmfvdif, !
! gwdps, ozphys, get_phi, !
! sascnv, sascnvn, samfdeepcnv, rascnv, cs_convr, gwdc, !
! shalcvt3, shalcv, samfshalcnv, !
! shalcnv, cnvc90, lrgscl, gsmdrive, gscond, precpd, !
! progt2. !
! !
! !
! program history log: !
! 19xx - ncep mrf/gfs !
! 2002 - s. moorthi modify and restructure and add Ferrier !
! microphysics as an option !
! 200x - h. juang modify (what?) !
! nov 2004 - x. wu modify sea-ice model !
! may 2005 - s. moorthi modify and restructure !
! 2005 - s. lu modify to include noah lsm !
! oct 2006 - h. wei modify lsm options to include both !
! noah and osu lsms. !
! 2006 - s. moorthi added a. johansson's convective gravity !
! wave parameterization code !
! 2007 - s. moorthi added j. han's modified pbl/sas options !
! dec 2007 - xu li modified the operational version for !
! nst model !
! 2008 - s. moorthi applied xu li's nst model to new gfs !
! mar 2008 - y.-t. hou added sunshine duration var (suntim) as !
! an input/output argument. !
! 2008 - jun wang added spfhmax/spfhmin as input/output. !
! apr 2008 - y.-t. hou added lw sfc emissivity var (sfcemis), !
! define the lw sfc dn/up fluxes in two forms: atmos!
! and ground. also changed sw sfc net flux direction!
! (positive) from ground -> atmos to the direction !
! of atmos -> ground. recode the program and add !
! program documentation block.
! 2008/ - s. moorthi and y.t. hou upgraded the code to more !
! 2009 modern form and changed all the inputs to MKS units.!
! feb 2009 - s. moorthi upgraded to add Hochun's gocart changes !
! jul 2009 - s. moorthi added rqtk for sela's semi-lagrangian !
! aug 2009 - s. moorthi added j. han and h. pan updated shallow !
! convection package !
! sep 2009 - s. moorthi updated for the mcica (rrtm3) radiation !
! feb 2011 - sarah lu add the option to update surface diag !
! fields (t2m,q2m,u10m,v10m) at the end !
! Jun 2011 - s. moorthi and Xu Li - updated the nst model !
! !
! sep 2011 - sarah lu correct dqdt_v calculations !
! apr 2012 - henry juang add idea !
! sep 2012 - s. moorthi merge with operational version !
! Mar 2013 - Jun Wang set idea heating rate to tmp tendency !
! May 2013 - Jun Wang tmp updated after idea phys !
! Jun 2013 - s. moorthi corrected a bug in 3d diagnostics for T !
! Aug 2013 - s. moorthi updating J. Whitekar's changes related !
! to stochastic physics perturnbation !
! Oct 2013 - Xingren Wu add dusfci/dvsfci !
! Mar 2014 - Xingren Wu add "_cpl" for coupling !
! Mar 2014 - Xingren Wu add "nir/vis beam and nir/vis diff" !
! Apr 2014 - Xingren Wu add "NET LW/SW including nir/vis" !
! Jan 2014 - Jun Wang merge Moorthi's gwdc change and H.Juang !
! and F. Yang's energy conversion from GWD!
! jan 2014 - y-t hou revised sw sfc spectral component fluxes!
! for coupled mdl, added estimation of ocean albedo !
! without ice contamination. !
! Jun 2014 - Xingren Wu update net SW fluxes over the ocean !
! (no ice contamination) !
! Jul 2014 - Xingren Wu add Sea/Land/Ice Mask - slmsk_cpl !
! Jul 2014 - s. moorthi merge with standalone gfs and cleanup !
! Aug 2014 - s. moorthi add tracer fixer !
! Sep 2014 - Sarah Lu disable the option to compute tracer !
! scavenging in GFS phys (set fscav=0.) !
! Dec 2014 - Jun Wang add cnvqc_v for gocart !
! ==================== defination of variables ==================== !
! --- 2014 - D. Dazlich Added Chikira-Sugiyama (CS) convection !
! as an option in opr GFS. !
! Apr 2015 S. Moorthi Added CS scheme to NEMS/GSM !
! Jun 2015 S. Moorthi Added SHOC to NEMS/GSM !
! Aug 2015 - Xu Li change nst_fcst to be nstf_name !
! and introduce depth mean SST !
! Sep 2015 - Xingren Wu remove oro_cpl & slmsk_cpl !
! Sep 2015 - Xingren Wu add sfc_cice !
! Sep 2015 - Xingren Wu connect CICE output to sfc_cice !
! Jan 2016 - P. Tripp NUOPC/GSM merge !
! Mar 2016 - J. Han - add ncnvcld3d integer !
! for convective cloudiness enhancement !
! Mar 2016 - J. Han - change newsas & sashal to imfdeepcnv !
! & imfshalcnv, respectively !
! Mar 2016 F. Yang add pgr to rayleigh damping call !
! Mar 2016 S. Moorthi add ral_ts !
! Mar 2016 Ann Cheng add morrison 2m microphysics (gsfc) !
! May 2016 S. Moorthi cleanup 2m microphysics implementation !
! Jun 2016 X. Li change all nst_fld as inout !
! jul 2016 S. Moorthi fix some bugs in shoc/2m microphysics !
! au-nv2016a S. Moorthi CS with AW and connect with shoc/2m !
! Dec 2016 Anning C. Add prognostic rain and snow with 2M !
! Oct 2017 S. Moorthi fix tracers to account for ice, snow etc!
! with this RAS and CSAW advect condensates!
! Mar 2017 Ruiyu S. Add Thompson's 2M aerosol MP !
! May 2017 Ruiyu S. Add WSM6 MP !
! Dec 2017 S. Moorthi Merge/update Ruiyu's update on vertical !
! diffusion of tracers for all monins !
! Jan 04 2018 S. Moorthi fix a bug in rhc for use in MG !
! macrophysics and replace ntrac by nvdiff!
! in call to moninshoc !
! Jun 2018 J. Han Add scal-aware TKE-based moist EDMF !
! vertical turbulent mixng scheme !
! Nov 2018 J. Han Add canopy heat storage parameterization!
! Feb 2019 Ruiyu S. Add an alternate method to use !
! hydrometeors from GFDL MP in radiation !
! Mar 2019 Rongqian &Helin Add Noah MP LSM !
! Mar 2019 S. Moorthi update slflag for MG3 and update !
! rain/snow over sea-ice. Update sfc_sice!
! sfc_cice calls !
!
! Apr 22 2019 S. Moorthi Porting Unified Gravitiy Wave drag !
! parameterrizaion package from V. Yudin, !
! J. Alpert, T. Fuller-Rowll and R. Akmaev!
! May 2019 J. Han Add updated scal-aware TKE-based moist !
! EDMF vertical turbulent mixng scheme !
! july 2019 S. Moorthi Move original GWD to inside of UGW such !
! that it can be called along with non- !
! stationary GWD and make this part a !
! function of precip or TKE. !
! Jul 2019 Weiguo Wang Update PBL scheme for HAFS !
!
! ==================== end of description =====================
! ==================== definition of variables ==================== !
!> @details This subroutine is the suite driver for the GFS atmospheric physics and surface.
!! It is responsible for calculating and applying tendencies of the atmospheric state
!! variables due to the atmospheric physics and due to the surface layer scheme. In addition,
!! this routine applies radiative heating rates that were calculated during the
!! antecedent call to the radiation scheme. Code within this subroutine is executed on the
!! physics sub-timestep. The sub-timestep loop is executed in the subroutine gloopb.
!!
!! \section general General Algorithm
!! -# Prepare input variables for calling individual parameterizations.
!! -# Using a two-iteration loop, calculate the state variable tendencies for the surface layer.
!! -# Calculate the state variable tendencies due to the PBL (vertical diffusion) scheme.
!! -# Calculate the state variable tendencies due to orographic gravity wave drag and Rayleigh damping.
!! -# Apply tendencies to the state variables calculated so far:
!! - for temperature: radiation, surface, PBL, oro. GWD, Rayleigh damping
!! - for momentum: surface, PBL, oro. GWD, Rayleigh damping
!! - for water vapor: surface, PBL
!! -# Calculate and apply the tendency of ozone.
!! -# Prepare input variables for physics routines that update the state variables within their subroutines.
!! -# If SHOC is active and is supposed to be called before convection, call it and update the state variables within.
!! -# Calculate and apply the state variable tendencies (within the subroutine) due to deep convection.
!! -# Calculate the state variable tendencies due to convective gravity wave drag and apply them afterwards.
!! -# Calculate and apply the state variable tendencies (within the subroutine) due to shallow convection.
!! -# If SHOC is active and is supposed to be called after convection, call it and update the state variables within.
!! -# Prepare for microphysics call by calculating preliminary variables.
!! -# If necessary, call the moist convective adjustment subroutine and update the state temperature and moisture variable within.
!! -# Calculate and apply the state variable tendencies (within the subroutine) due to microphysics.
!! -# Determine the precipitation type and update land surface properties if necessary.
!! -# Fill the output variables from the local variables as necessary and deallocate allocatable arrays.
!! \section detailed Detailed Algorithm
!! ## Prepare input variables for calling individual parameterizations.
!! Before calling any parameterizations, there is a section at the beginning of the subroutine for
!! preparing input arguments to the various schemes based on general input to the driver and initializing
!! variables used throughout the driver.
!! - General initialization:
!! - set a flag for running in debug mode and the horizontal index of the column to print
!! - calculate the pressure at layer centers, the exner function at layer centers and interfaces,
!! geopotential at layer centers and interfaces, and the layer-centered pressure difference
!! - calculate the ratio of dynamics time step to physics time step for applying tendencies
!! - initialize local tendency arrays to zero
!! - Radiation:
!! - adjust radiative fluxes and heating rates to the shorter physics time step (from the longer radiation time step),
!! unless idealized physics is true (lsidea) where radiative heating rates are set to 0
!! - compute diagnostics from the radiation scheme needed for other schemes (e.g., downward longwave flux absorbed by the surface)
!! - accumulate the upward and downward longwave fluxes at the surface
!! - Surface:
!! - set NOAH and OSU scheme variables from gbphys input arguments and initialize local soil moisture variables
!! - set local sea ice variables from gbphys arguments
!! - set up A/O/I coupling variables from gbphys arguments
!! - PBL:
!! - set the number of tracers that are diffused vertically
!! - SHOC:
!! - determine the index of TKE (ntk) in the convectively transported tracer array (clw)
!! - allocate precipitation mixing ratio cloud droplet number concentration arrays
!! - Deep Convection:
!! - determine which tracers in the tracer input array undergo convective transport (valid for the RAS and Chikira-Sugiyama, and SAMF schemes) and allocate a local convective transported tracer array (clw)
!! - apply an adjustment to the tracers from the dynamics
!! - calculate horizontal grid-related parameters needed for some parameterizations
!! - calculate the maxiumum cloud base updraft speed for the Chikira-Sugiyama scheme
!! - allocate array for cloud water and cloud cover (for non-RAS and non-Chikira-Sugiyama deep convective schemes)
!! - Shallow Convection:
!! - when using the Tiedtke shallow convection scheme with the stratus modifications, find the lowest
!! model level where a temperature inversion exists in the absence of CTEI
!! - Microphysics:
!! - for the Morrison (MGB) scheme, calculate 'FRLAND' if the grid point is over land
!! - allocate arrays associated with the Morrison scheme
!! - assign the local critical relative humidity variables from the gbphys arguments
!! - Gravity Wave Drag:
!! - calculate the deep convective cloud fraction at cloud top for the convective GWD scheme
!! .
!! ## Using a two-iteration loop, calculate the state variable tendencies for the surface layer.
!! - Each iteration of the loop calls the following:
!! - 'sfc_diff' to calculate surface exchange coefficients and near-surface wind
!! - surface energy balances routines are called regardless of surface type; the surface type is checked within each to determine whether the routine is "active"
!! - for the surface energy balance over the ocean, call 'sfc_nst' if NSST is on, otherwise, call 'sfc_ocean'
!! - for the surface energy balance over the land, call 'sfc_drv' for the NOAH model and 'sfc_land' for the OSU model
!! - for the surface energy balance over sea ice, call sfc_sice; if A/O/I coupling, call sfc_cice
!! - The initial iteration has flag_guess = F unless wind < 2 m/s; flag_iter = T
!! - After the initial iteration, flag_guess = F and flag_iter = F (unless wind < 2 m/s and over a land surface or an ocean surface with NSST on)
!! - The following actions are performed after the iteration to calculate surface energy balance:
!! - set surface output variables from their local values
!! - call 'sfc_diag' to calculate state variable values at 2 and 10 m as appropriate from near-surface model levels and the surface exchange coefficients
!! - if A/O/I coupling, set coupling variables from local variables and calculate the open water albedo
!! - finally, accumulate surface-related diagnostics and calculate the max/min values of T and q at 2 m height.
!! .
!! ## Calculate the state variable tendencies due to the PBL (vertical diffusion) scheme.
!! - Call the vertical diffusion scheme (PBL) based on the following logical flags: do_shoc, hybedmf, satmedmf, old_monin, mstrat
!! - the PBL scheme is expected to return tendencies of the state variables
!! - If A/O/I coupling and the surface is sea ice, overwrite some surface-related variables to their states before PBL was called
!! - For diagnostics, do the following:
!! - accumulate surface state variable tendencies and set the instantaneous values for output
!! - accumulate the temperature tendency due to the PBL scheme in dt3dt(:,:,3), subtracting out the radiative heating rate if necessary
!! - accumulate the u, v tendencies due to the PBL in du3dt(:,:,1:2) and dv3dt(:,:,1:2)
!! - accumulate the water vapor tendency due to the PBL in dq3dt(:,:,1)
!! - accumulate the ozone tendency in dq3dt(:,:,5)
!! .
!! ## Calculate the state variable tendencies due to orographic gravity wave drag and Rayleigh damping.
!! - Based on the variable nmtvr, unpack orographic gravity wave varibles from the hprime array
!! - Call 'gwdps' to calculate tendencies of u, v, T, and surface stress
!! - Accumulate gravity wave drag surface stresses.
!! - Accumulate change in u, v, and T due to oro. gravity wave drag in du3dt(:,:,2), dv3dt(:,:,2), and dt3dt(:,:,2)
!! - Call 'rayleigh_damp' to calculate tendencies to u, v, and T due to Rayleigh friction
!! .
!! ## Apply tendencies to the state variables calculated so far.
!! ## Calculate and apply the tendency of ozone.
!! - Call the convective adjustment scheme for IDEA
!! - Call 'ozphys_2015' or 'ozphys' depending on the value of pl_coeff, updating the ozone tracer within and outputing the tendency of ozone in dq3dt(:,:,6)
!! - Call 'h2ophys' if necessary ("adaptation of NRL H2O phys for stratosphere and mesophere")
!! .
!! ## Prepare input variables for physics routines that update the state variables within their subroutines.
!! - If diagnostics is active, save the updated values of the state variables in 'dudt', 'dvdt', 'dTdt', and 'dqdt(:,:,1)'
!! - Call 'get_phi' to calculate geopotential from p, q, T
!! - Initialize the cloud water and ice portions of the convectively transported tracer array (clw) and (if the deep convective scheme is not RAS or Chikira-Sugiyama) the convective cloud water and cloud cover.
!! - If the dep convective scheme is RAS or Chikira-Sugiyama, fill the 'clw' array with tracers to be transported by convection
!! - Initialize 'ktop' and 'kbot' (to be modified by all convective schemes except Chikira-Sugiyama)
!! - Prepare for microphysics call (if cloud condensate is in the input tracer array):
!! - all schemes: calculate critical relative humidity
!! - Morrison et al. scheme (occasionally denoted MGB) (when ncld==2): set clw(:,:,1) to cloud ice and clw(:,:,2) to cloud liquid water
!! - Ferrier scheme (num_p3d==3): set the cloud water variable and separate hydrometeors into cloud ice, cloud water, and rain; set clw(:,:,1) to cloud ice and clw(:,:,2) to cloud liquid water
!! - Zhao-Carr scheme (num_p3d==4): calculate autoconversion coefficients from input constants and grid info; set set clw(:,:,1) to cloud liquid water
!! - otherwise: set autoconversion parameters like in Zhao-Carr and set critical relative humidity to 1
!! .
!! ## If SHOC is active and is supposed to be called before convection, call it and update the state variables within.
!! - Prior to calling SHOC, prepare some microphysics variables:
!! - if Morrison et al. scheme: set 'skip_macro', fill clw(:,:,1,2) with cloud ice, liquid from the tracer array, and fill cloud droplet number concentration arrays from the input tracer array
!! - if Zhao-Carr scheme: initialize precip. mixing ratios to 0, fill clw(:,:,1,2) with cloud ice, liquid from the tracer array (as a function of temperature)
!! - Call 'shoc' (modifies state variables within the subroutine)
!! - Afterward, set updated cloud number concentrations in the tracer array from the updated 'ncpl' and 'ncpi'
!! .
!! ## Calculate and apply the state variable tendencies (within the subroutine) due to deep convection.
!! - Call deep convective scheme according to the parameter 'imfdeepcnv', 'ras', and 'cscnv'.
!! - if imfdeepcnv == 0, 1, or 2, no special processing is needed
!! - if the Chikira-Sugiyama scheme (cscnv), convert rain rate to accumulated rain (rain1)
!! - if RAS, initialize 'ccwfac', 'dlqfac', and revap before the call to 'rascnv'
!! - Zero out 'cld1d' (cloud work function calculated in non-RAS, non-Chikira-Sugiyama schemes)
!! - Update tracers in the tracer array (gq0) due to convective transport (RAS, CS only) from the 'clw' array
!! - Calculate accumulated surface convective precip. for this physics time step (rainc)
!! - If necessary, accumulate cloud work function, convective precipitation, and convective mass fluxes; accumulate dt3dt(:,:,4), dq3dt(:,:,2), du3dt(:,:,3), dv3dt(:,:,3) as change in state variables due to deep convection
!! - If PDF-based clouds are active and Zhao-Carr microphysics, save convective cloud cover and water in 'phy_f3d' array
!! - otherwise, if non-PDF-based clouds and the "convective cloudiness enhancement" is active, save convective cloud water in 'phy_f3d' array
!! .
!! ## Calculate the state variable tendencies due to convective gravity wave drag and apply them afterwards.
!! - Calculate the average deep convective heating rate in the column to pass into 'gwdc'
!! - Call 'gwdc' to calculate tendencies of u, v due to convective GWD
!! - For diagnostics, accumulate the vertically-integrated change in u, v due to conv. GWD; accumulate change in u, v, due to conv. GWD in du3dt(:,:,4) and dv3dt(:,:,4)
!! - Calculate updated values of u, v, T using conv. GWD tendencies
!! .
!! ## Calculate and apply the state variable tendencies (within the subroutine) due to shallow convection.
!! - If diagnostics are active, set 'dtdt' and 'dqdt' to updated values of T and q before shallow convection
!! - If SHOC is not active, do the following:
!! - for the mass-flux shallow convection scheme (imfshalcnv == 1), call 'shalcnv'
!! - for the scale- and aerosol-aware scheme (imfshalcnv == 2), call 'samfshalcnv'
!! - for either of the first two schemes, perform the following after the call:
!! - if Zhao-Carr microphysics with PDF-based clouds, save convective cloud water an cover in 'phy_f3d'
!! - if non-PDF-based clouds and convective cloudiness enhancement is active, save convective cloud water in 'phy_f3d'
!! - calculate shallow convective precip. and add it to convective precip; accumulate convective precip.
!! - for the Tiedtke scheme (imfshalcnv == 0), find the top level where shallow convection must stratosphere
!! - if using Moorthi's approach to stratus, call 'shalcv'
!! - otherwise, call 'shalcvt3'
!! - save the change in T and q due to shallow convection in dt3dt(:,:,5) and dq3dt(:,:,3); reset dtdt and dqdt to the updated values of T, q after shallow Convection
!! - if 'clw' is not partitioned into ice/water, set 'clw(ice)' to zero
!! - If SHOC is active (and shocaftcnv)
!! - if Morrison et al. scheme: set 'skip_macro' and fill cloud droplet number concentration arrays from the input tracer array
!! - initialize precip. mixing ratios to 0
!! - call 'shoc' (modifies state variables within the subroutine)
!! - afterward, set updated cloud number concentrations in the tracer array from the updated 'ncpl' and 'ncpi'
!! .
!! ## Prepare for microphysics call by calculating preliminary variables.
!! - For Morrison et al. microphysics, set cloud water and ice arrays to the convecitvely transported values
!! - For Ferrier microphysics, combine convectively transported cloud water and ice with column rain and save in cloud water array
!! - calculate and save ice fraction and rain fraction in phy_f3d(1),(2)
!! - For Zhao-Carr, combine convectively transported cloud water and ice into the cloud water array
!! - Otherwise, combine convectively transported cloud water and ice into the convectively transported cloud water
!! - Call 'cnvc90'; a "legacy routine which determines convective clouds"; outputs 'acv','acvb','acvt','cv','cvb','cvt'
!! .
!! ## If necessary, call the moist convective adjustment subroutine and update the state temperature and moisture variable within.
!! - Updates T, q, 'rain1', cloud water array
!! - Accumulate convective precip
!! - For diagnostics, accumulate the change in T, q due to moist convective adjustment; reset 'dtdt' and 'dqdt' to updated T, q before call to microphysics
!! .
!! ## Calculate and apply the state variable tendencies (within the subroutine) due to microphysics.
!! - If no cloud microphysics (ncld == 0), call 'lrgscl' to update T, q and output large scale precipitation and cloud water
!! - Otherwise, a more advanced microphysics scheme is called (which scheme depends on values of 'num_p3d','do_shoc',and 'ncld')
!! - Ferrier scheme (num_p3d == 3):
!! - calculate droplet number concentration and minimum large ice fraction
!! - call 'gsmdrive' (modifies T, q, cloud water, 'f_ice', 'f_rain', 'f_rimef', 'rain1')
!! - Zhao-Carr-Sundqvist scheme (num_p3d == 4):
!! - if non-PDF-based clouds:
!! - if 'do_shoc', call 'precpd_shoc' (precpd modified for SHOC)
!! - else, call 'gscond' (grid-scale condensation/evaporation); updates water vapor, cloud water, temperature
!! - call 'precpd'; updates water vapor, cloud water, temperature and outputs precip., snow ratio, and rain water path
!! - for PDF-based clouds:
!! - call 'gscondp' followed by 'precpdp' (similar arguments to gscond, precpd above)
!! - Morrison et al. scheme (ncld = 2):
!! - if 'do_shoc', set clw(1),(2) from updated values; set phy_f3d(:,:,1) from phy_f3d(:,:,ntot3d-2)
!! - else, set clw(1),(2) from updated values; set phy_f3d(:,:,1) to cloud cover from previous time step + convective cloud water from convective scheme
!! - call 'm_micro_driver'; updates water vapor, temperature, droplet number concentrations, cloud cover
!! - Combine large scale and convective precip.
!! - For diagnostics, accumulate total surface precipitation and accumulate change in T and q due to microphysics in dt3dt(:,:,6) and dq3dt(:,:,4)
!! .
!! ## Determine the precipitation type and update land surface properties if necessary.
!! - If 'cal_pre', diagnose the surface precipitation type
!! - call 'calpreciptype'; set snow flag to 1 if snow or sleet, 0 otherwise
!! - For rain/snow decision, calculate temperature at 850 hPa (\f$T_{850}\f$)
!! - If not 'cal_pre', set snow flag to 1 if \f$T_{850}\f$ is below freezing
!! - For coupling, accumulate rain if \f$T_{850}\f$ is above freezing, otherwise accumulate snow
!! - If using the OSU land model, accumulate surface snow depth if \f$T_{850}\f$ is below freezing and not over an ocean surface
!! - call 'progt2' (canopy and soil moisture?) and set the soil liquid water equal to soil total water
!! - If necessary (lssav), update the 2m max/min values of T and q
!! - If necessary (lssav), accumulate total runoff and surface runoff.
!! .
!! ## Fill the output variables from the local variables as necessary and deallocate allocatable arrays.
!! - Set global sea ice thickness and concentration as well as the temperature of the sea ice
!! - Set global soil moisture variables
!! - Calculate precipitable water and water vapor mass change due to all physics for the column
!! - Deallocate arrays for SHOC scheme, deep convective scheme, and Morrison et al. microphysics
public GFS_physics_driver
CONTAINS
!*******************************************************************************************
subroutine GFS_physics_driver &
(Model, Statein, Stateout, Sfcprop, Coupling, &
Grid, Tbd, Cldprop, Radtend, Diag)
implicit none
!
! --- interface variables
type(GFS_control_type), intent(inout) :: Model
type(GFS_statein_type), intent(inout) :: Statein
type(GFS_stateout_type), intent(inout) :: Stateout
type(GFS_sfcprop_type), intent(inout) :: Sfcprop
type(GFS_coupling_type), intent(inout) :: Coupling
type(GFS_grid_type), intent(inout) :: Grid
type(GFS_tbd_type), intent(inout) :: Tbd
type(GFS_cldprop_type), intent(inout) :: Cldprop
type(GFS_radtend_type), intent(inout) :: Radtend
type(GFS_diag_type), intent(inout) :: Diag
!
!## CCPP ## Note: Variables defined locally in this file for temporary calculations
! or transfer of data between schemes are defined in gfsphysics/GFS_layer/GFS_typedefs.F90
! in the GFS_interstitial_type datatype. Type-bound procedures create, rad_reset,
! phys_reset, and mprint exist to allocate memory, to reset variables used in GFS_radiation_driver.F90,
! to reset variables used in GFS_physics_driver.F90, and to print the contents of the
! data type to the console
! --- local variables
!--- INTEGER VARIABLES
integer :: me, ipr, ix, im, levs, ntrac, nvdiff, kdt, &
ntoz, ntcw, ntiw, ncld,ntke,ntkev, ntlnc, ntinc, lsoil,&
ntrw, ntsw, ntrnc, ntsnc, ntot3d, ntgl, ntgnc, ntclamt,&
ims, ime, kms, kme, its, ite, kts, kte, imp_physics, &
ntwa, ntia, nmtvr
integer :: i, kk, ic, itc, k, n, k1, iter, levshcm, tracers, &
tottracer, nsamftrac, num2, num3, nshocm, nshoc, ntk, &
nn, nncl, ntiwx, seconds
integer, dimension(size(Grid%xlon,1)) :: &
kbot, ktop, kcnv, soiltyp, vegtype, kpbl, slopetyp, kinver, &
levshc, islmsk, &
!--- coupling inputs for physics
islmsk_cice
!--- LOGICAL VARIABLES
logical :: lprnt, revap, mg3_as_mg2, skip_macro, trans_aero
logical, dimension(size(Grid%xlon,1)) :: &
flag_iter, flag_guess, invrsn, &
!--- coupling inputs for physics
flag_cice
logical, dimension(Model%ntrac+1,2) :: otspt
real(kind=kind_phys), dimension(Model%ntrac+2) :: trcmin
!--- REAL VARIABLES
real(kind=kind_phys) :: &
dtf, dtp, frain, tem, tem1, tem2, &
xcosz_loc, zsea1, zsea2, eng0, eng1, dpshc, &
txl, txi, txo, dt_warm, &
!--- experimental for shoc sub-stepping
dtshoc, &
!--- GFDL Cloud microphysics
crain, csnow, total_precip
real(kind=kind_phys) :: rho
real(kind=kind_phys), dimension(Model%ntrac-Model%ncld+2) :: &
fscav, fswtr
real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: &
ccwfac, garea, dlength, cumabs, fice, zice, tice, gflx,&
rain1, snowmt, cd, cdq, qss, dusfcg, dvsfcg, dusfc1, &
dvsfc1, dtsfc1, dqsfc1, rb, drain, cld1d, evap, hflx, &
stress, t850, ep1d, gamt, gamq, sigmaf, &
wind, work1, work2, work3, work4, runof, xmu, fm10, fh2, &
tx1, tx2, tx3, tx4, ctei_r, evbs, evcw, trans, sbsno,&
snowc, frland, adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw, &
adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, adjnirbmd, &
adjnirdfd, adjvisbmd, adjvisdfd, xcosz, tseal, &
! adjnirdfd, adjvisbmd, adjvisdfd, gabsbdlw, xcosz, tseal, &
snohf, dlqfac, ctei_rml, cldf, domr, domzr, domip, &
doms, psautco_l, prautco_l, ocalnirbm_cpl, ocalnirdf_cpl, &
ocalvisbm_cpl, ocalvisdf_cpl, dtzm, temrain1, t2mmp, q2mp, &
psaur_l, praur_l, &
!--- for CS-convection
wcbmax
! 1 - land, 2 - ice, 3 - ocean
real(kind=kind_phys), dimension(size(Grid%xlon,1),3) :: &
zorl3, cd3, cdq3, rb3, stress3, ffmm3, ffhh3, uustar3, &
fm103, fh23, qss3, cmm3, chh3, gflx3, evap3, hflx3, ep1d3, &
weasd3, snowd3, tprcp3, tsfc3, tsurf3, adjsfculw3, semis3, &
gabsbdlw3
logical, dimension(size(Grid%xlon,1)) :: &
wet, dry, icy
real(kind=kind_phys), dimension(size(Grid%xlon,1),1) :: &
area, land, rain0, snow0, ice0, graupel0
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%lsoil) :: &
smsoil, stsoil, slsoil
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs) :: &
del, rhc, dtdt, dudt, dvdt, dtdtc, &
ud_mf, dd_mf, dt_mf, prnum, dkt
! ud_mf, dd_mf, dt_mf, prnum, dkt, sigmatot, sigmafrac, txa
real(kind=kind_phys), allocatable, dimension(:,:) :: sigmatot, &
gwdcu, gwdcv, rainp, sigmafrac, tke
!--- GFDL modification for FV3
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs+1) ::&
del_gz
real(kind=kind_phys), allocatable, dimension(:,:,:) :: &
delp, dz, uin, vin, pt, qv1, ql1, qr1, qg1, qa1, qn1, qi1, &
qs1, pt_dt, qa_dt, udt, vdt, w, qv_dt, ql_dt, qr_dt, qi_dt, &
qs_dt, qg_dt, p123, refl
!
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs,Model%ntrac) :: &
dqdt
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs,oz_coeff+5) :: &
dq3dt_loc
! mg, sfc perts
real (kind=kind_phys), dimension(size(Grid%xlon,1)) :: &
z01d, zt1d, bexp1d, xlai1d, alb1d, vegf1d
real(kind=kind_phys) :: cdfz
!--- ALLOCATABLE ELEMENTS
!--- in clw, the first two varaibles are cloud water and ice.
!--- from third to ntrac are convective transportable tracers,
!--- third being the ozone, when ntrac=3 (valid with ras, csaw, or samf)
!--- Anning Cheng 9/21/2016 leave a hook here for diagnosed snow,
!--- rain, and their numbers
real(kind=kind_phys), allocatable :: &
clw(:,:,:), qrn(:,:), qsnw(:,:), ncpl(:,:), ncpi(:,:), &
ncpr(:,:), ncps(:,:), cnvc(:,:), cnvw(:,:), &
qgl(:,:), ncgl(:,:)
!--- for 2 M microphysics
! real(kind=kind_phys), allocatable, dimension(:) :: &
! cn_prc, cn_snr
real(kind=kind_phys), allocatable, dimension(:,:) :: &
! qlcn, qicn, w_upi, cf_upi, CNV_MFD, CNV_PRC3, CNV_DQLDT, &
qlcn, qicn, w_upi, cf_upi, CNV_MFD, CNV_DQLDT, &
CLCN, CNV_FICE, CNV_NDROP, CNV_NICE
! real(kind=kind_phys),parameter :: slope_mg = 0.02, slope_upmg = 0.02, &
! real(kind=kind_phys),parameter :: slope_mg = 0.02, slope_upmg = 0.04, &
! turnrhcrit = 0.900, turnrhcrit_upper = 0.150
! in the following inverse of slope_mg and slope_upmg are specified
real(kind=kind_phys),parameter :: slope_mg = 50.0_kind_phys, &
slope_upmg = 25.0_kind_phys
!
!--- for 2 M Thompson MP
real(kind=kind_phys), allocatable, dimension(:,:,:) :: &
vdftra, dvdftra
real(kind=kind_phys), allocatable, dimension(:,:) :: &
ice00, liq0
! real(kind=kind_phys), allocatable, dimension(:) :: nwfa2d
real(kind=kind_phys), parameter :: liqm = 4./3.*con_pi*1.e-12, &
icem = 4./3.*con_pi*3.2768*1.e-14*890.
!===============================================================================
!
! vay --- local variables Local PdXdt after each Physics chain
! TdXdt total Tendency for X due to ALL GFS_physics except
! radiance
! vay-2018 PROCESS-oriented diagnostics for 3D-fields in UGWP for COORDE
!
! New 2D-process oriented arrays for Daily mean (6-hr aver) diagnostics
! Diag%dXdT_pbl Diag%dXdT_ogw Diag%dXdT_congw Diag%dXdT_moist
! Diag%dXdT_total
! Additional 2D/3D diagnostic containers and arrays
!
logical :: ldiag_ugwp
! real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs) :: &
real(kind=kind_phys) &
Pdtdt, Pdudt, Pdvdt
! real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs) :: &
! Tdtdt, Tdudt, Tdvdt
!-----------------------------------------
! ugwp: oro-stationary + non-stationary
!-----------------------------------------
real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: hprime, &
sigma, elvmax, oc, theta, gamma
real(kind=kind_phys), dimension(size(Grid%xlon,1),4) :: oa4, clx
real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: sgh30 !proxy for small-scale turb oro
!
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs) :: &
gw_dudt, gw_dvdt, gw_dtdt, gw_kdis
!
real(kind=kind_phys) :: ftausec, fdaily, fwindow
integer :: master
! COODRE-averaged diagnostics
!
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs) :: ax_mtb, &
ax_ogw, ax_tms, ax_ngw
real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: &
tau_tms, tau_mtb, tau_ogw, tau_ngw
real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: &
zm_mtb, zm_ogw, zm_ngw, zm_lwb
!------------------------------------------------------
! parameters for canopy heat storage parametrization
!------------------------------------------------------
real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: &
hflxq, evapq, hffac, hefac
real (kind=kind_phys), parameter :: z0min=0.2, z0max=1.0
real (kind=kind_phys), parameter :: u10min=2.5, u10max=7.5
real (kind=kind_phys), parameter :: z0ice=1.1
!
!===============================================================================
real, allocatable, dimension(:) :: refd, REFD263K
integer :: kdtminus1
logical :: reset
! For computing saturation vapor pressure and rh at 2m
real :: pshltr,QCQ,rh02
real(kind=kind_phys), allocatable, dimension(:,:) :: den
real(kind=kind_phys) :: lndp_vgf
!! Initialize local variables (for debugging purposes only,
!! because the corresponding variables Interstitial(nt)%...
!! are reset to zero every time).
!snowmt = 0.
!gamq = 0.
!gamt = 0.
!gflx = 0.
!hflx = 0.
!! Strictly speaking, this is not required. But when
!! hunting for bit-for-bit differences, doing the same as
!! in GFS_suite_stateout_reset makes life a lot easier.
!Stateout%gt0(:,:) = Statein%tgrs(:,:)
!Stateout%gu0(:,:) = Statein%ugrs(:,:)
!Stateout%gv0(:,:) = Statein%vgrs(:,:)
!Stateout%gq0(:,:,:) = Statein%qgrs(:,:,:)
!## CCPP ## Note: Setting local variables from the Model DDT (without additional
! logic attached) is not necessary with the CCPP interstitial schemes with exceptions
! noted below.
!===> ... begin here
ldiag_ugwp = Model%ldiag_ugwp
!
!===>
master = Model%master
me = Model%me
ix = size(Grid%xlon,1) !## CCPP ## set in GFS_typedefs.F90/interstitial_create
im = size(Grid%xlon,1) !## CCPP ## set in GFS_typedefs.F90/interstitial_create
ipr = min(im,10) !## CCPP ## set in GFS_typedefs.F90/interstitial_create
levs = Model%levs
lsoil = Model%lsoil
ntrac = Model%ntrac
dtf = Model%dtf
dtp = Model%dtp
!## CCPP ##* this block not yet in CCPP
!-------
! For COORDE-2019 averaging with fwindow, it was done before
! 3Diag fixes and averaging ingested using "fdaily"-factor
!
ftausec = 86400.0
fdaily = dtp / ftausec
if (Model%fhzero /= 0) then
ftausec = Model%fhzero*3600
fwindow = dtp/ftausec
fdaily = fwindow
else
print *, 'VAY Model%fhzero = 0., Bad Averaged-diagnostics '
endif
!-------
!*## CCPP ##
kdt = Model%kdt
lprnt = Model%lprnt
!## CCPP ## see GFS_typedefs.F90/interstitial_setup_tracers for logic for setting nvdiff
nvdiff = ntrac ! vertical diffusion of all tracers!
ntcw = Model%ntcw
ntoz = Model%ntoz
ntiw = Model%ntiw
ncld = Model%ncld
ntke = Model%ntke
!
ntlnc = Model%ntlnc
ntinc = Model%ntinc
ntrw = Model%ntrw
ntsw = Model%ntsw
ntrnc = Model%ntrnc
ntsnc = Model%ntsnc
ntgl = Model%ntgl
ntgnc = Model%ntgnc
ntclamt = Model%ntclamt
ntot3d = Model%ntot3d
ntwa = Model%ntwa
ntia = Model%ntia
nmtvr = Model%nmtvr
imp_physics = Model%imp_physics
!## CCPP ##* GFS_typedefs.F90/interstitial_setup_tracers
nncl = ncld
! perform aerosol convective transport and PBL diffusion
trans_aero = Model%cplchm .and. Model%trans_trac
if (imp_physics == Model%imp_physics_thompson) then
if (Model%ltaerosol) then
nvdiff = 8
else
nvdiff = 5
endif
if (Model%satmedmf) nvdiff = nvdiff + 1
nncl = 5
elseif (imp_physics == Model%imp_physics_wsm6) then
nvdiff = ntrac -3
if (Model%satmedmf) nvdiff = nvdiff + 1
nncl = 5
elseif (ntclamt > 0) then ! for GFDL MP don't diffuse cloud amount
nvdiff = ntrac - 1
endif
if (imp_physics == Model%imp_physics_gfdl) then
nncl = 5
endif
if (imp_physics == Model%imp_physics_mg) then
if (abs(Model%fprcp) == 1) then
nncl = 4 ! MG2 with rain and snow
mg3_as_mg2 = .false.
elseif (Model%fprcp >= 2) then
if (ntgl > 0 .and. (Model%mg_do_graupel .or. Model%mg_do_hail)) then
nncl = 5 ! MG3 with rain and snow and grapuel/hail
mg3_as_mg2 = .false.
else ! MG3 code run without graupel/hail i.e. as MG2
nncl = 4
mg3_as_mg2 = .true.
endif
endif
endif
!
if (Model%cplchm) then
! Only Zhao/Carr/Sundqvist and GFDL microphysics schemes are supported
! when coupling with chemistry. PBL diffusion of aerosols is only supported
! Adding MG microphysics - Moorthi
if (imp_physics == Model%imp_physics_zhao_carr) then
nvdiff = 3
elseif (imp_physics == Model%imp_physics_mg) then
if (ntgl > 0) then
nvdiff = 12
else
nvdiff = 10
endif
elseif (imp_physics == Model%imp_physics_gfdl) then
nvdiff = 7
endif
if (trans_aero) nvdiff = nvdiff + Model%ntchm
if (ntke > 0) nvdiff = nvdiff + 1 ! adding tke to the list
endif
!*## CCPP ##
!
!## CCPP ##* GFS_typedefs.F90/interstitial_phys_reset
kdtminus1 = kdt - 1
reset = mod(kdtminus1, nint(Model%avg_max_length/dtp)) == 0
!*## CCPP ##
!
!-------------------------------------------------------------------------------------------
! lprnt = .false.
! do i=1,im
! lprnt = Model%me == 23 .and. i == 25
! lprnt = Model%me == 127 .and. i == 11
! lprnt = kdt >= 20 .and. abs(grid%xlon(i)*rad2dg-102.65) < 0.101 &
! .and. abs(grid%xlat(i)*rad2dg-0.12) < 0.201
! lprnt = kdt >= 20 .and. abs(grid%xlon(i)*rad2dg-184.00) < 0.301 &
! .and. abs(grid%xlat(i)*rad2dg-83.23) < 0.301
! lprnt = kdt >= 7 .and. abs(grid%xlon(i)*rad2dg-216.20) < 0.101 &
! .and. abs(grid%xlat(i)*rad2dg-81.23) < 0.101
! lprnt = kdt >= 7 .and. abs(grid%xlon(i)*rad2dg-28.800) < 0.101 &
! .and. abs(grid%xlat(i)*rad2dg+2.45) < 0.101
! lprnt = kdt >= 1 .and. abs(grid%xlon(i)*rad2dg-293.91) < 0.101 &
! .and. abs(grid%xlat(i)*rad2dg+72.02) < 0.101
! lprnt = kdt >= 1 .and. abs(grid%xlon(i)*rad2dg-113.48) < 0.101 &
! .and. abs(grid%xlat(i)*rad2dg-21.07) < 0.101
! lprnt = kdt >= 1 .and. abs(grid%xlon(i)*rad2dg-169.453) < 0.501 &
! .and. abs(grid%xlat(i)*rad2dg-72.96) < 0.501
! if (kdt == 1) &
! write(2000+me,*)' i=',i,' xlon=',grid%xlon(i)*rad2dg, &
! ' xlat=',grid%xlat(i)*rad2dg,' me=',me
! if (lprnt) then
! ipr = i
! write(0,*)' ipr=',ipr,'xlon=',grid%xlon(i)*rad2dg,' xlat=',grid%xlat(i)*rad2dg,' me=',me
! exit
! endif
! enddo
! if (lprnt) then
! if (Model%cplflx) then
! write(0,*)' sfcprop%tisfc=',Sfcprop%tisfc(ipr),' kdt=',kdt, &
! ' fice=',Sfcprop%fice(ipr),' ulw=',Coupling%ulwsfcin_cpl(ipr), &
! ' tsfc=',Sfcprop%tsfc(ipr)
! else
! write(0,*)' sfcprop%tisfc=',Sfcprop%tisfc(ipr),' kdt=',kdt, &
! ' fice=',Sfcprop%fice(ipr), ' tsfc=',Sfcprop%tsfc(ipr), &
! 'tsfcl=',Sfcprop%tsfcl(ipr),' tsfco=',Sfcprop%tsfco(ipr)
! endif
! if (Model%nstf_name(1) > 0) then
! write(0,*)' begin sfcprop%tref=',Sfcprop%tref(ipr),' kdt=',kdt, &
! ' landfrac=',Sfcprop%landfrac(ipr)
! endif
! endif
!-------------------------------------------------------------------------------------------
!
! if (lprnt) then
! write(0,*)' in phydrv tgrs=',Statein%tgrs(ipr,:)
! write(0,*)' in phydrv ugrs=',Statein%ugrs(ipr,:)
! write(0,*)' in phydrv vgrs=',Statein%vgrs(ipr,:)
! write(0,*)' in phydrv qgrs=',Statein%qgrs(ipr,:,1)*1000.0
! write(0,*)' in phydrv tke=',Statein%qgrs(ipr,:,ntke)
! write(0,*)' in phydrv phii=',Statein%phii(ipr,:)
! endif
!
! --- ... frain=factor for centered difference scheme correction of rain amount.
frain = dtf / dtp
!## CCPP ##* GFS_typedefs.F90/interstitial_create
skip_macro = .false.
!*## CCPP ##
!## CCPP ##* GFS_typedefs.F90/interstitial_setup_tracers
if (ntiw > 0) then
if (ntclamt > 0) then
nn = ntrac - 2
else
nn = ntrac - 1
endif
elseif (ntcw > 0) then
nn = ntrac
else
nn = ntrac + 1
endif
!*## CCPP ##
!## CCPP ##* GFS_typedefs.F90/interstitial_create
allocate (clw(ix,levs,nn))
!*## CCPP ##
!## CCPP ##* GFS_typedefs.F90/interstitial_create Note: cnvc and cnvw are always allocated and initialized regardless of test condition
if (Model%imfdeepcnv >= 0 .or. Model%imfshalcnv > 0 .or. &
(Model%npdf3d == 3 .and. Model%num_p3d == 4) .or. &
(Model%npdf3d == 0 .and. Model%ncnvcld3d == 1) ) then
allocate (cnvc(ix,levs), cnvw(ix,levs))
do k=1,levs
do i=1,im
cnvc(i,k) = zero
cnvw(i,k) = zero
enddo
enddo
!*## CCPP ##
!## CCPP ##* GFS_typedefs.F90/control_initialize Note: these are calculated regardless of test condition
if (Model%npdf3d == 3 .and. Model%num_p3d == 4) then
num2 = Model%num_p3d + 2
num3 = num2 + 1
elseif (Model%npdf3d == 0 .and. Model%ncnvcld3d == 1) then
num2 = Model%num_p3d + 1
endif
!CCPP: num2 = Model%ncnvw
!CCPP: num3 = Model%ncnvc
endif
!*## CCPP ##
!## CCPP ##* GFS_surface_generic.F90/GFS_surface_generic_pre_run
! --- set initial quantities for stochastic physics deltas
if (Model%do_sppt .or. Model%ca_global)then
Tbd%dtdtr = zero
endif
! mg, sfc-perts
! --- scale random patterns for surface perturbations with perturbation size
! --- turn vegetation fraction pattern into percentile pattern
!## CCPP ##* Note: initialzations to zero are not needed in GFS_surface_generic.F90/GFS_surface_generic_pre_run
! since this function occurs in GFS_typedefs.F90/interstitial_phys_reset
do i=1,im
z01d(i) = zero
zt1d(i) = zero
bexp1d(i) = zero
xlai1d(i) = zero
! alb1d(i) = zero
vegf1d(i) = zero
enddo
lndp_vgf=-999.
if (Model%lndp_type==1) then
do k =1,Model%n_var_lndp
select case(Model%lndp_var_list(k))
case ('rz0')
z01d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k)
case ('rzt')
zt1d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k)
case ('shc')
bexp1d(:) = Model%lndp_prt_list(k) * Coupling%sfc_wts(:,k)
case ('lai')
xlai1d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k)
case ('vgf')
! note that the pertrubed vegfrac is being used in sfc_drv, but not sfc_diff
do i=1,im
call cdfnor(Coupling%sfc_wts(i,k),cdfz)
vegf1d(i) = cdfz
enddo
lndp_vgf = Model%lndp_prt_list(k)
end select
enddo
endif
!*## CCPP ##
!
!## CCPP ##* GFS_typedefs.F90/interstitial_create
if (Model%do_shoc) then
allocate (qrn(im,levs), qsnw(im,levs), &
ncpl(im,levs), ncpi(im,levs))
do k=1,levs
do i=1,im
ncpl(i,k) = zero
ncpi(i,k) = zero
qrn(i,k) = zero
qsnw(i,k) = zero
enddo
enddo
endif
!## CCPP ##* GFS_typedefs.F90/coupling_create ##
if (imp_physics == Model%imp_physics_thompson) then
if(Model%ltaerosol) then
allocate(ice00(im,levs))
allocate(liq0(im,levs))
! allocate(nwfa2d(im))
else
allocate(ice00(im,levs))
endif
endif
!*## CCPP ##
!## CCPP ##* allocated in GFS_typedefs.F90/interstitial_create; initialized in GFS_typedefs.F90/interstitial_phys_reset
if (imp_physics == Model%imp_physics_mg) then ! For MGB double moment microphysics
allocate (qlcn(im,levs), qicn(im,levs), w_upi(im,levs), &
cf_upi(im,levs), CNV_MFD(im,levs), &
! cf_upi(im,levs), CNV_MFD(im,levs), CNV_PRC3(im,levs), &
CNV_DQLDT(im,levs), clcn(im,levs), cnv_fice(im,levs), &
cnv_ndrop(im,levs), cnv_nice(im,levs))
! allocate (cn_prc(im), cn_snr(im))
allocate (ncpr(im,levs), ncps(im,levs), ncgl(im,levs))
if (.not. allocated(qrn)) allocate (qrn(im,levs))
if (.not. allocated(qsnw)) allocate (qsnw(im,levs))
if (.not. allocated(qgl)) allocate (qgl(im,levs))
do k=1,levs
do i=1,im
qrn(i,k) = zero
qsnw(i,k) = zero
qgl(i,k) = zero
ncpr(i,k) = zero
ncps(i,k) = zero
ncgl(i,k) = zero