diff --git a/GFS_layer/GFS_driver.F90 b/GFS_layer/GFS_driver.F90 index 3e284bcda..dd6bb4e88 100644 --- a/GFS_layer/GFS_driver.F90 +++ b/GFS_layer/GFS_driver.F90 @@ -22,7 +22,7 @@ module GFS_driver !-------------------------------------------------------------------------------- ! This container is the minimum set of data required from the dycore/atmosphere ! component to allow proper initialization of the GFS physics -! +! ! Type is defined in GFS_typedefs.F90 !-------------------------------------------------------------------------------- ! type GFS_init_type @@ -62,7 +62,7 @@ module GFS_driver ! character(len=65) :: fn_nml !< namelist filename ! end type GFS_init_type !-------------------------------------------------------------------------------- - + !------------------ ! Module parameters !------------------ @@ -96,7 +96,7 @@ module GFS_driver ! GFS initialze !-------------- subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, & - Coupling, Grid, Tbd, Cldprop, Radtend, & + Coupling, Grid, Tbd, Cldprop, Radtend, & Diag, Init_parm) use module_microphysics, only: gsmconst @@ -160,7 +160,7 @@ subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, & !--- populate the grid components call GFS_grid_populate (Grid, Init_parm%xlon, Init_parm%xlat, Init_parm%area) - + !--- read in and initialize ozone and water if (Model%ntoz > 0) then do nb = 1, nblks @@ -181,7 +181,7 @@ subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, & call gsmconst (Model%dtp, Model%me, .TRUE.) - !--- define sigma level for radiation initialization + !--- define sigma level for radiation initialization !--- The formula converting hybrid sigma pressure coefficients to sigma coefficients follows Eckermann (2009, MWR) !--- ps is replaced with p0. The value of p0 uses that in http://www.emc.ncep.noaa.gov/officenotes/newernotes/on461.pdf !--- ak/bk have been flipped from their original FV3 orientation and are defined sfc -> toa @@ -233,9 +233,12 @@ end subroutine GFS_initialize ! 5) interpolates coefficients for prognostic ozone calculation ! 6) performs surface data cycling via the GFS gcycle routine !------------------------------------------------------------------------- - subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & + subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & Grid, Tbd, Cldprop, Radtend, Diag) + use physparam, only: ictmflg, isolar + use GFS_suite_setup_1, only: GFS_suite_setup_1_run + use GFS_suite_setup_2, only: GFS_suite_setup_2_run use GFS_rad_time_vary, only: GFS_rad_time_vary_run implicit none @@ -251,43 +254,13 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & type(GFS_radtend_type), intent(inout) :: Radtend(:) type(GFS_diag_type), intent(inout) :: Diag(:) !--- local variables - integer :: nblks, ictmflg, isolar - real(kind=kind_phys) :: rinc(5) real(kind=kind_phys) :: sec + call GFS_suite_setup_1_run (Model, sec) - ! Set the value of nblks - call Set_nblks (nblks) - - !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 - !--- update calendars and triggers - call Update_cal_and_triggers (Model, rinc, sec) - - !--- set current bucket hour - call Set_bucket_hour (Model, sec) - - !--- radiation triggers - call Set_radiation_triggers (Model) - - !--- set the solar hour based on a combination of phour and time initial hour - call Set_solar_h (Model) - - ! Print debug info - call Print_debug_info (Model, sec) + call GFS_rad_time_vary_run(Model, Statein, Tbd, blksz, sec, ictmflg, isolar) - !--- radiation time varying routine -! CCPP - call GFS_rad_time_vary_run(Model,Statein, Tbd, blksz, sec, & - ictmflg, isolar) - - !--- physics time varying routine - call GFS_phys_time_vary (Model, Grid, Tbd) - - !--- repopulate specific time-varying sfc properties for AMIP/forecast runs - call Gcycle_driver (nblks, Model, Grid, Sfcprop, Cldprop) - - !--- determine if diagnostics buckets need to be cleared - call Clear_buckets (Model, Diag, nblks) + call GFS_suite_setup_2_run (blksz, Grid, Model, Tbd, Sfcprop, Cldprop, Diag) end subroutine GFS_time_vary_step @@ -325,15 +298,15 @@ subroutine GFS_stochastic_driver (Model, Statein, Stateout, Sfcprop, Coupling, & if (Model%do_sppt) then do k = 1,size(Statein%tgrs,2) do i = 1,size(Statein%tgrs,1) - + upert = (Stateout%gu0(i,k) - Statein%ugrs(i,k)) * Coupling%sppt_wts(i,k) vpert = (Stateout%gv0(i,k) - Statein%vgrs(i,k)) * Coupling%sppt_wts(i,k) tpert = (Stateout%gt0(i,k) - Statein%tgrs(i,k)) * Coupling%sppt_wts(i,k) - Tbd%dtdtr(i,k) qpert = (Stateout%gq0(i,k,1) - Statein%qgrs(i,k,1)) * Coupling%sppt_wts(i,k) - + Stateout%gu0(i,k) = Statein%ugrs(i,k)+upert Stateout%gv0(i,k) = Statein%vgrs(i,k)+vpert - + !negative humidity check qnew = Statein%qgrs(i,k,1)+qpert if (qnew .GE. 1.0e-10) then @@ -342,7 +315,7 @@ subroutine GFS_stochastic_driver (Model, Statein, Stateout, Sfcprop, Coupling, & endif enddo enddo - + Diag%totprcp(:) = Diag%totprcp(:) + (Coupling%sppt_wts(:,15) - 1.0)*Tbd%dtotprcp(:) Diag%cnvprcp(:) = Diag%cnvprcp(:) + (Coupling%sppt_wts(:,15) - 1.0)*Tbd%dcnvprcp(:) Coupling%rain_cpl(:) = Coupling%rain_cpl(:) + (Coupling%sppt_wts(:,15) - 1.0)*Tbd%drain_cpl(:) @@ -356,168 +329,6 @@ subroutine GFS_stochastic_driver (Model, Statein, Stateout, Sfcprop, Coupling, & end subroutine GFS_stochastic_driver - -!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -! -! PRIVATE SUBROUTINES -! -!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -!----------------------------------------------------------------------- -! GFS_rad_time_vary -!----------------------------------------------------------------------- -! -! Routine containing all of the setup logic originally in phys/gloopr.f -! -!----------------------------------------------------------------------- -! subroutine GFS_rad_time_vary (Model, Statein, Tbd, sec) - -! use physparam, only: ipsd0, ipsdlim, iaerflg -! use mersenne_twister, only: random_setseed, random_index, random_stat - -! implicit none - -! type(GFS_control_type), intent(inout) :: Model -! type(GFS_statein_type), intent(in) :: Statein(:) -! type(GFS_tbd_type), intent(inout) :: Tbd(:) -! real(kind=kind_phys), intent(in) :: sec - !--- local variables -! type (random_stat) :: stat -! integer :: ix, nb, j, i, nblks, ipseed -! integer :: numrdm(Model%cnx*Model%cny*2) - -! nblks = size(blksz,1) - -! call radupdate (Model%idat, Model%jdat, Model%fhswr, Model%dtf, Model%lsswr, & -! Model%me, Model%slag, Model%sdec, Model%cdec, Model%solcon ) - - !--- set up random seed index in a reproducible way for entire cubed-sphere face (lat-lon grid) -! if ((Model%isubc_lw==2) .or. (Model%isubc_sw==2)) then -! ipseed = mod(nint(con_100*sqrt(sec)), ipsdlim) + 1 + ipsd0 -! call random_setseed (ipseed, stat) -! call random_index (ipsdlim, numrdm, stat) - - !--- set the random seeds for each column in a reproducible way -! ix = 0 -! nb = 1 -! do j = 1,Model%ny -! do i = 1,Model%nx -! ix = ix + 1 -! if (ix .gt. blksz(nb)) then -! ix = 1 -! nb = nb + 1 -! endif -! !--- for testing purposes, replace numrdm with '100' -! Tbd(nb)%icsdsw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx) -! Tbd(nb)%icsdlw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + Model%cnx*Model%cny) -! enddo -! enddo -! endif ! isubc_lw and isubc_sw - -! if (Model%num_p3d == 4) then -! if (Model%kdt == 1) then -! do nb = 1,nblks -! Tbd(nb)%phy_f3d(:,:,1) = Statein(nb)%tgrs -! Tbd(nb)%phy_f3d(:,:,2) = max(qmin,Statein(nb)%qgrs(:,:,1)) -! Tbd(nb)%phy_f3d(:,:,3) = Statein(nb)%tgrs -! Tbd(nb)%phy_f3d(:,:,4) = max(qmin,Statein(nb)%qgrs(:,:,1)) -! Tbd(nb)%phy_f2d(:,1) = Statein(nb)%prsi(:,1) -! Tbd(nb)%phy_f2d(:,2) = Statein(nb)%prsi(:,1) -! enddo -! endif -! endif - -! end subroutine GFS_rad_time_vary - - -!----------------------------------------------------------------------- -! GFS_phys_time_vary -!----------------------------------------------------------------------- -! -! Routine containing all of the setup logic originally in phys/gloopb.f -! -!----------------------------------------------------------------------- - subroutine GFS_phys_time_vary (Model, Grid, Tbd) - use mersenne_twister, only: random_setseed, random_number - - implicit none - type(GFS_control_type), intent(inout) :: Model - type(GFS_grid_type), intent(inout) :: Grid(:) - type(GFS_tbd_type), intent(inout) :: Tbd(:) - !--- local variables - integer :: nb, ix, k, j, i, nblks, iseed, iskip - real(kind=kind_phys) :: wrk(1) - real(kind=kind_phys) :: rannie(Model%cny) - real(kind=kind_phys) :: rndval(Model%cnx*Model%cny*Model%nrcm) - - nblks = size(blksz,1) - - !--- switch for saving convective clouds - cnvc90.f - !--- aka Ken Campana/Yu-Tai Hou legacy - if ((mod(Model%kdt,Model%nsswr) == 0) .and. (Model%lsswr)) then - !--- initialize,accumulate,convert - Model%clstp = 1100 + min(Model%fhswr/con_hr,Model%fhour,con_99) - elseif (mod(Model%kdt,Model%nsswr) == 0) then - !--- accumulate,convert - Model%clstp = 0100 + min(Model%fhswr/con_hr,Model%fhour,con_99) - elseif (Model%lsswr) then - !--- initialize,accumulate - Model%clstp = 1100 - else - !--- accumulate - Model%clstp = 0100 - endif - - !--- random number needed for RAS and old SAS and when cal_pre=.true. - if ( ((Model%imfdeepcnv <= 0) .or. (Model%cal_pre)) .and. (Model%random_clds) ) then - iseed = mod(con_100*sqrt(Model%fhour*con_hr),1.0d9) + Model%seed0 - call random_setseed(iseed) - call random_number(wrk) - do i = 1,Model%cnx*Model%nrcm - iseed = iseed + nint(wrk(1)) * i - call random_setseed(iseed) - call random_number(rannie) - rndval(1+(i-1)*Model%cny:i*Model%cny) = rannie(1:Model%cny) - enddo - - do k = 1,Model%nrcm - iskip = (k-1)*Model%cnx*Model%cny - ix = 0 - nb = 1 - do j = 1,Model%ny - do i = 1,Model%nx - ix = ix + 1 - if (ix .gt. blksz(nb)) then - ix = 1 - nb = nb + 1 - endif - Tbd(nb)%rann(ix,k) = rndval(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + iskip) - enddo - enddo - enddo - endif ! imfdeepcnv, cal_re, random_clds - - !--- o3 interpolation - if (Model%ntoz > 0) then - do nb = 1, nblks - call ozinterpol (Model%me, blksz(nb), Model%idate, Model%fhour, & - Grid(nb)%jindx1_o3, Grid(nb)%jindx2_o3, & - Tbd(nb)%ozpl, Grid(nb)%ddy_o3) - enddo - endif - - !--- h2o interpolation - if (Model%h2o_phys) then - do nb = 1, nblks - call h2ointerpol (Model%me, blksz(nb), Model%idate, Model%fhour, & - Grid(nb)%jindx1_h, Grid(nb)%jindx2_h, & - Tbd(nb)%h2opl, Grid(nb)%ddy_h) - enddo - endif - - end subroutine GFS_phys_time_vary - - !------------------ ! GFS_grid_populate !------------------ @@ -557,161 +368,4 @@ subroutine GFS_grid_populate (Grid, xlon, xlat, area) end subroutine GFS_grid_populate - - ! Subroutines added by PAJ - - subroutine Set_nblks (nblks) - - implicit none - - integer, intent(out) :: nblks - - ! blksz is a global var - nblks = size(blksz) - - end subroutine Set_nblks - - - subroutine Update_cal_and_triggers (Model, rinc, sec) - - implicit none - - type(GFS_control_type), intent(inout) :: Model - real(kind=kind_phys), intent(inout) :: rinc(:) - real(kind=kind_phys), intent(inout) :: sec - - - rinc(1:5) = 0 - call W3difdat (Model%jdat, Model%idat, 4, rinc) - sec = rinc(4) - Model%phour = sec/con_hr - - end subroutine Update_cal_and_triggers - - - subroutine Set_bucket_hour (Model, sec) - - implicit none - - type(GFS_control_type), intent(inout) :: Model - real(kind=kind_phys), intent(in) :: sec - - Model%zhour = Model%phour - ! con_hr is a global var - Model%fhour = (sec + Model%dtp)/con_hr - Model%kdt = nint((sec + Model%dtp)/Model%dtp) - - Model%ipt = 1 - Model%lprnt = .false. - Model%lssav = .true. - - end subroutine Set_bucket_hour - - - subroutine Set_radiation_triggers (Model) - - implicit none - - type(GFS_control_type), intent(inout) :: Model - - Model%lsswr = (mod (Model%kdt, Model%nsswr) == 1) - Model%lslwr = (mod (Model%kdt, Model%nslwr) == 1) - - end subroutine Set_radiation_triggers - - - subroutine Set_solar_h (Model) - - implicit none - - type(GFS_control_type), intent(inout) :: Model - - ! con_24 is a global variable - Model%solhr = mod (Model%phour + Model%idate(1), con_24) - - end subroutine Set_solar_h - - - subroutine Print_debug_info (Model, sec) - - implicit none - - type(GFS_control_type), intent(inout) :: Model - real(kind=kind_phys), intent(in) :: sec - - if ((Model%debug) .and. (Model%me == Model%master)) then - print *,' sec ', sec - print *,' kdt ', Model%kdt - print *,' nsswr ', Model%nsswr - print *,' nslwr ', Model%nslwr - print *,' nscyc ', Model%nscyc - print *,' lsswr ', Model%lsswr - print *,' lslwr ', Model%lslwr - print *,' fhour ', Model%fhour - print *,' phour ', Model%phour - print *,' solhr ', Model%solhr - endif - - end subroutine Print_debug_info - - -! subroutine Gfs_rad_time_vary_driver (Model, Statein, Tbd, sec) - -! implicit none - -! type(GFS_control_type), intent(inout) :: Model -! type(GFS_statein_type), intent(in) :: Statein(:) -! type(GFS_tbd_type), intent(inout) :: Tbd(:) -! real(kind=kind_phys), intent(in) :: sec - -! if (Model%lsswr .or. Model%lslwr) then -! call GFS_rad_time_vary (Model, Statein, Tbd, sec) -! endif - -! end subroutine Gfs_rad_time_vary_driver - - - subroutine Gcycle_driver (nblks, Model, Grid, Sfcprop, Cldprop) - - implicit none - - integer, intent(in) :: nblks - type(GFS_control_type), intent(in) :: Model - type(GFS_grid_type), intent(in) :: Grid(nblks) - type(GFS_sfcprop_type), intent(inout) :: Sfcprop(nblks) - type(GFS_cldprop_type), intent(inout) :: Cldprop(nblks) - - - if (Model%nscyc > 0) then - if (mod (Model%kdt, Model%nscyc) == 1) then - call gcycle (nblks, Model, Grid(:), Sfcprop(:), Cldprop(:)) - end if - end if - - end subroutine Gcycle_driver - - - subroutine Clear_buckets (Model, Diag, nblks) - - implicit none - - type(GFS_control_type), intent(in) :: Model - type(GFS_diag_type), intent(inout) :: Diag(:) - integer, intent(in) :: nblks - - ! Local vars - integer :: nb - - - if (mod (Model%kdt, Model%nszero) == 1) then - do nb = 1, nblks - call Diag(nb)%rad_zero (Model) - call Diag(nb)%phys_zero (Model) - enddo - endif - - end subroutine Clear_buckets - - end module GFS_driver - diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index dabaa56bf..73f1341d5 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -41,7 +41,6 @@ module module_physics_driver use GFS_MP_generic_post, only: GFS_MP_generic_post_run use GFS_MP_generic_pre, only: GFS_MP_generic_pre_run use GFS_zhao_carr_pre, only: GFS_zhao_carr_pre_run - use lsm_noah use lsm_noah_pre use lsm_noah_post @@ -660,8 +659,8 @@ subroutine GFS_physics_driver & call GFS_suite_interstitial_2_run (Model, Grid, Sfcprop, Statein, & Diag, rhbbot, rhpbl, rhbtop, frain, islmsk, work1, work2, & dudt, dvdt, dtdt, dtdtc, dqdt ) -! -! + + ! --- ... frain=factor for centered difference scheme correction of rain amount. ! frain = dtf / dtp @@ -2663,9 +2662,6 @@ subroutine GFS_physics_driver & ! enddo ! endif -! if (Model%lssav) then -! Diag%totprcp(:) = Diag%totprcp(:) + Diag%rain(:) - ! --- ... estimate t850 for rain-snow decision ! t850(:) = Stateout%gt0(:,1) diff --git a/makefile b/makefile index 7c692eb43..f3b035ea9 100644 --- a/makefile +++ b/makefile @@ -22,150 +22,152 @@ FFLAGS += -I../fms -I../fms/include CPPDEFS = -DNEW_TAUCTMAX -DSMALL_PE -DNEMS_GSM SRCS_f = \ - ./physics/cnvc90.f \ - ./physics/co2hc.f \ - ./physics/date_def.f \ - ./physics/dcyc2.f \ - ./physics/dcyc2.pre.rad.f \ - ./physics/efield.f \ - ./physics/get_prs.f \ - ./physics/gfs_phy_tracer_config.f \ - ./physics/gocart_tracer_config_stub.f \ - ./physics/gscond.f \ - ./physics/gscondp.f \ - ./physics/gwdc.f \ - ./physics/gwdps.f \ - ./physics/h2o_def.f \ - ./physics/h2oc.f \ - ./physics/h2ohdc.f \ - ./physics/h2ophys.f \ - ./physics/ideaca.f \ - ./physics/idea_co2.f \ - ./physics/idea_composition.f \ - ./physics/idea_dissipation.f \ - ./physics/idea_h2o.f \ - ./physics/idea_ion.f \ - ./physics/idea_o2_o3.f \ - ./physics/idea_phys.f \ - ./physics/idea_solar_heating.f \ - ./physics/idea_tracer.f \ - ./physics/iounitdef.f \ - ./physics/lrgsclr.f \ - ./physics/mersenne_twister.f \ - ./physics/mfdeepcnv.f \ - ./physics/mfpbl.f \ - ./physics/mfshalcnv.f \ - ./physics/module_bfmicrophysics.f \ - ./physics/moninedmf.f \ - ./physics/moninp.f \ - ./physics/moninp1.f \ - ./physics/moninq.f \ - ./physics/moninq1.f \ - ./physics/moninshoc.f \ - ./physics/mstadb.f \ - ./physics/mstadbtn.f \ - ./physics/mstadbtn2.f \ - ./physics/mstcnv.f \ - ./physics/namelist_soilveg.f \ - ./physics/ozne_def.f \ - ./physics/ozphys.f \ - ./physics/ozphys_2015.f \ - ./physics/physparam.f \ - ./physics/precpd.f \ - ./physics/precpd_shoc.f \ - ./physics/precpdp.f \ - ./physics/precpd_shoc.f \ - ./physics/progt2.f \ - ./physics/progtm_module.f \ - ./physics/rad_initialize.f \ - ./physics/radiation_aerosols.f \ - ./physics/radiation_astronomy.f \ - ./physics/radiation_clouds.f \ - ./physics/radiation_gases.f \ - ./physics/radiation_surface.f \ - ./physics/radlw_datatb.f \ - ./physics/radlw_main.f \ - ./physics/radlw_param.f \ - ./physics/radsw_datatb.f \ - ./physics/radsw_main.f \ - ./physics/radsw_param.f \ - ./physics/rascnvv2.f \ - ./physics/rayleigh_damp.f \ - ./physics/rayleigh_damp_mesopause.f \ - ./physics/sascnv.f \ - ./physics/sascnvn.f \ - ./physics/set_soilveg.f \ - ./physics/GFS_surface_loop_control.f \ - ./physics/sfc_cice.f \ - ./physics/sfc_diag.f \ - ./physics/sfc_diff.f \ - ./physics/sfc_drv.f \ - ./physics/sfc_land.f \ - ./physics/sfc_nst.f \ - ./physics/sfc_ocean.f \ - ./physics/sfc_sice.f \ - ./physics/sfcsub.f \ - ./physics/sflx.f \ - ./physics/shalcnv.f \ - ./physics/shalcv.f \ - ./physics/shalcv_1lyr.f \ - ./physics/shalcv_fixdp.f \ - ./physics/shalcv_opr.f \ - ./physics/tracer_const_h.f \ - ./physics/tridi.f \ - ./physics/tridi2t3.f + ./physics/cnvc90.f \ + ./physics/co2hc.f \ + ./physics/date_def.f \ + ./physics/dcyc2.f \ + ./physics/dcyc2.pre.rad.f \ + ./physics/efield.f \ + ./physics/get_prs.f \ + ./physics/gfs_phy_tracer_config.f \ + ./physics/gocart_tracer_config_stub.f \ + ./physics/gscond.f \ + ./physics/gscondp.f \ + ./physics/gwdc.f \ + ./physics/gwdps.f \ + ./physics/h2o_def.f \ + ./physics/h2oc.f \ + ./physics/h2ohdc.f \ + ./physics/h2ophys.f \ + ./physics/ideaca.f \ + ./physics/idea_co2.f \ + ./physics/idea_composition.f \ + ./physics/idea_dissipation.f \ + ./physics/idea_h2o.f \ + ./physics/idea_ion.f \ + ./physics/idea_o2_o3.f \ + ./physics/idea_phys.f \ + ./physics/idea_solar_heating.f \ + ./physics/idea_tracer.f \ + ./physics/iounitdef.f \ + ./physics/lrgsclr.f \ + ./physics/mersenne_twister.f \ + ./physics/mfdeepcnv.f \ + ./physics/mfpbl.f \ + ./physics/mfshalcnv.f \ + ./physics/module_bfmicrophysics.f \ + ./physics/moninedmf.f \ + ./physics/moninp.f \ + ./physics/moninp1.f \ + ./physics/moninq.f \ + ./physics/moninq1.f \ + ./physics/moninshoc.f \ + ./physics/mstadb.f \ + ./physics/mstadbtn.f \ + ./physics/mstadbtn2.f \ + ./physics/mstcnv.f \ + ./physics/namelist_soilveg.f \ + ./physics/ozne_def.f \ + ./physics/ozphys.f \ + ./physics/ozphys_2015.f \ + ./physics/physparam.f \ + ./physics/precpd.f \ + ./physics/precpd_shoc.f \ + ./physics/precpdp.f \ + ./physics/precpd_shoc.f \ + ./physics/progt2.f \ + ./physics/progtm_module.f \ + ./physics/rad_initialize.f \ + ./physics/radiation_aerosols.f \ + ./physics/radiation_astronomy.f \ + ./physics/radiation_clouds.f \ + ./physics/radiation_gases.f \ + ./physics/radiation_surface.f \ + ./physics/radlw_datatb.f \ + ./physics/radlw_main.f \ + ./physics/radlw_param.f \ + ./physics/radsw_datatb.f \ + ./physics/radsw_main.f \ + ./physics/radsw_param.f \ + ./physics/rascnvv2.f \ + ./physics/rayleigh_damp.f \ + ./physics/rayleigh_damp_mesopause.f \ + ./physics/sascnv.f \ + ./physics/sascnvn.f \ + ./physics/set_soilveg.f \ + ./physics/GFS_surface_loop_control.f \ + ./physics/sfc_cice.f \ + ./physics/sfc_diag.f \ + ./physics/sfc_diff.f \ + ./physics/sfc_drv.f \ + ./physics/sfc_land.f \ + ./physics/sfc_nst.f \ + ./physics/sfc_ocean.f \ + ./physics/sfc_sice.f \ + ./physics/sfcsub.f \ + ./physics/sflx.f \ + ./physics/shalcnv.f \ + ./physics/shalcv.f \ + ./physics/shalcv_1lyr.f \ + ./physics/shalcv_fixdp.f \ + ./physics/shalcv_opr.f \ + ./physics/tracer_const_h.f \ + ./physics/tridi.f \ + ./physics/tridi2t3.f SRCS_f90 = \ - ./physics/GFS_calpreciptype.f90 \ - ./physics/GFS_MP_generic_post.f90 \ - ./physics/GFS_MP_generic_pre.f90 \ - ./physics/GFS_zhao_carr_pre.f90 \ - ./physics/GFS_RRTMG_pre.f90 \ - ./physics/GFS_RRTMG_post.f90 \ - ./physics/GFS_radsw_pre.f90 \ - ./physics/GFS_radsw_post.f90 \ - ./physics/GFS_radlw_pre.f90 \ - ./physics/GFS_radlw_post.f90 \ - ./physics/GFS_rad_time_vary.f90 \ - ./physics/GFS_radupdate.f90 \ - ./physics/cs_conv.f90 \ - ./physics/funcphys.f90 \ - ./physics/gcm_shoc.f90 \ - ./physics/gcycle.f90 \ - ./physics/get_prs_fv3.f90 \ - ./physics/GFS_DCNV_generic.f90 \ - ./physics/GFS_SCNV_generic.f90 \ - ./physics/GFS_PBL_generic.f90 \ - ./physics/GFS_suite_interstitial.f90 \ - ./physics/GFS_surface_generic.f90 \ - ./physics/h2ointerp.f90 \ - ./physics/m_micro_driver.f90 \ - ./physics/module_nst_model.f90 \ - ./physics/module_nst_parameters.f90 \ - ./physics/module_nst_water_prop.f90 \ - ./physics/ozinterp.f90 \ - ./physics/physcons.f90 \ - ./physics/radcons.f90 \ - ./physics/wam_f107_kp_mod.f90 - -SRCS_F = ./physics/aer_cloud.F \ - ./physics/cldmacro.F \ - ./physics/cldwat2m_micro.F \ - ./physics/machine.F \ - ./physics/num_parthds.F \ - ./physics/wv_saturation.F + ./physics/GFS_calpreciptype.f90 \ + ./physics/GFS_MP_generic_post.f90 \ + ./physics/GFS_MP_generic_pre.f90 \ + ./physics/GFS_zhao_carr_pre.f90 \ + ./physics/GFS_RRTMG_pre.f90 \ + ./physics/GFS_RRTMG_post.f90 \ + ./physics/GFS_radsw_pre.f90 \ + ./physics/GFS_radsw_post.f90 \ + ./physics/GFS_radlw_pre.f90 \ + ./physics/GFS_radlw_post.f90 \ + ./physics/GFS_rad_time_vary.f90 \ + ./physics/GFS_radupdate.f90 \ + ./physics/cs_conv.f90 \ + ./physics/funcphys.f90 \ + ./physics/gcm_shoc.f90 \ + ./physics/gcycle.f90 \ + ./physics/get_prs_fv3.f90 \ + ./physics/GFS_DCNV_generic.f90 \ + ./physics/GFS_SCNV_generic.f90 \ + ./physics/GFS_PBL_generic.f90 \ + ./physics/GFS_suite_interstitial.f90 \ + ./physics/GFS_suite_setup.f90 \ + ./physics/GFS_surface_generic.f90 \ + ./physics/h2ointerp.f90 \ + ./physics/m_micro_driver.f90 \ + ./physics/module_nst_model.f90 \ + ./physics/module_nst_parameters.f90 \ + ./physics/module_nst_water_prop.f90 \ + ./physics/ozinterp.f90 \ + ./physics/physcons.f90 \ + ./physics/radcons.f90 \ + ./physics/wam_f107_kp_mod.f90 + +SRCS_F = \ + ./physics/aer_cloud.F \ + ./physics/cldmacro.F \ + ./physics/cldwat2m_micro.F \ + ./physics/machine.F \ + ./physics/num_parthds.F \ + ./physics/wv_saturation.F SRCS_F90 = \ - ./physics/GFDL_parse_tracers.F90 \ - ./GFS_layer/GFS_abstraction_layer.F90 \ - ./GFS_layer/GFS_diagnostics.F90 \ - ./GFS_layer/GFS_driver.F90 \ - ./GFS_layer/GFS_physics_driver.F90 \ - ./GFS_layer/GFS_radiation_driver.F90 \ - ./GFS_layer/GFS_restart.F90 \ - ./GFS_layer/GFS_typedefs.F90 \ - ./IPD_layer/IPD_driver.F90 \ - ./IPD_layer/IPD_typedefs.F90 + ./physics/GFDL_parse_tracers.F90 \ + ./GFS_layer/GFS_abstraction_layer.F90 \ + ./GFS_layer/GFS_diagnostics.F90 \ + ./GFS_layer/GFS_driver.F90 \ + ./GFS_layer/GFS_physics_driver.F90 \ + ./GFS_layer/GFS_radiation_driver.F90 \ + ./GFS_layer/GFS_restart.F90 \ + ./GFS_layer/GFS_typedefs.F90 \ + ./IPD_layer/IPD_driver.F90 \ + ./IPD_layer/IPD_typedefs.F90 SRCS_c = diff --git a/physics/GFS_suite_setup.f90 b/physics/GFS_suite_setup.f90 new file mode 100644 index 000000000..08fc768e3 --- /dev/null +++ b/physics/GFS_suite_setup.f90 @@ -0,0 +1,200 @@ +!> \file GFS_suite_setup.f90 +!! Contains code related to GFS physics suite setup. + + module GFS_suite_setup_1 + + contains + + subroutine GFS_suite_setup_1_init () + end subroutine GFS_suite_setup_1_init + + subroutine GFS_suite_setup_1_finalize() + end subroutine GFS_suite_setup_1_finalize + +!> \section arg_table_GFS_suite_setup_1_run Argument Table +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | inout | F | +!! | sec | seconds_elapsed | seconds elapsed since the initialization | s | 0 | real | kind_phys | inout | F | +!! + subroutine GFS_suite_setup_1_run (Model, sec) + + use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type + + type(GFS_control_type), intent(inout) :: Model + + real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys + real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys + real(kind=kind_phys) :: rinc(5) + real(kind=kind_phys), intent(inout) :: sec + + !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 + !--- update calendars and triggers + rinc(1:5) = 0 + call w3difdat(Model%jdat,Model%idat,4,rinc) + sec = rinc(4) + Model%phour = sec/con_hr + !--- set current bucket hour + Model%zhour = Model%phour + Model%fhour = (sec + Model%dtp)/con_hr + Model%kdt = nint((sec + Model%dtp)/Model%dtp) + + Model%ipt = 1 + Model%lprnt = .false. + Model%lssav = .true. + + !--- radiation triggers + Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) + Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) + + !--- set the solar hour based on a combination of phour and time initial hour + Model%solhr = mod(Model%phour+Model%idate(1),con_24) + + if ((Model%debug) .and. (Model%me == Model%master)) then + print *,' sec ', sec + print *,' kdt ', Model%kdt + print *,' nsswr ', Model%nsswr + print *,' nslwr ', Model%nslwr + print *,' nscyc ', Model%nscyc + print *,' lsswr ', Model%lsswr + print *,' lslwr ', Model%lslwr + print *,' fhour ', Model%fhour + print *,' phour ', Model%phour + print *,' solhr ', Model%solhr + endif + + end subroutine GFS_suite_setup_1_run + + end module GFS_suite_setup_1 + + module GFS_suite_setup_2 + + contains + + subroutine GFS_suite_setup_2_init () + end subroutine GFS_suite_setup_2_init + + subroutine GFS_suite_setup_2_finalize() + end subroutine GFS_suite_setup_2_finalize + +!> \section arg_table_GFS_suite_setup_2_run Argument Table +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|-------------------------------------------------------------------------|-------------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | blksz | horizontal_block_size | number of grid columns used for explicit data blocking for physics | count | 1 | integer | | in | F | +!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 1 | GFS_typedefs%GFS_grid_type | | in | F | +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | inout | F | +!! | Tbd | FV3-GFS_Tbd_type | Fortran DDT containing FV3-GFS miscellaneous data | DDT | 1 | GFS_typedefs%GFS_tbd_type | | inout | F | +!! | Sfcprop | FV3-GFS_Sfcprop_type | Fortran DDT containing FV3-GFS surface fields | DDT | 1 | GFS_typedefs%GFS_sfcprop_type | | inout | F | +!! | Cldprop | FV3-GFS_Cldprop_type | Fortran DDT containing FV3-GFS cloud fields | DDT | 1 | GFS_typedefs%GFS_cldprop_type | | inout | F | +!! | Diag | FV3-GFS_Diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 1 | GFS_typedefs%GFS_diag_type | | inout | F | +!! + subroutine GFS_suite_setup_2_run (blksz, Grid, Model, Tbd, Sfcprop, Cldprop, Diag) + use mersenne_twister, only: random_setseed, random_number + use machine, only: kind_phys + use physcons, only: dxmin, dxinv + use GFS_typedefs, only: GFS_control_type, GFS_grid_type, & + GFS_Tbd_type, GFS_sfcprop_type, GFS_cldprop_type, GFS_diag_type + + type(GFS_grid_type), intent(in) :: Grid(:) + type(GFS_control_type), intent(inout) :: Model + type(GFS_tbd_type), intent(inout) :: Tbd(:) + type(GFS_sfcprop_type), intent(inout) :: Sfcprop(:) + type(GFS_cldprop_type), intent(inout) :: Cldprop(:) + type(GFS_diag_type), intent(inout) :: Diag(:) + + integer, allocatable, intent(in) :: blksz(:) + + real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys + real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys + real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys + + integer :: i, j, k, iseed, iskip, ix, nb + real(kind=kind_phys) :: wrk(1) + real(kind=kind_phys) :: rannie(Model%cny) + real(kind=kind_phys) :: rndval(Model%cnx*Model%cny*Model%nrcm) + + nblks = size(blksz) + + !--- switch for saving convective clouds - cnvc90.f + !--- aka Ken Campana/Yu-Tai Hou legacy + if ((mod(Model%kdt,Model%nsswr) == 0) .and. (Model%lsswr)) then + !--- initialize,accumulate,convert + Model%clstp = 1100 + min(Model%fhswr/con_hr,Model%fhour,con_99) + elseif (mod(Model%kdt,Model%nsswr) == 0) then + !--- accumulate,convert + Model%clstp = 0100 + min(Model%fhswr/con_hr,Model%fhour,con_99) + elseif (Model%lsswr) then + !--- initialize,accumulate + Model%clstp = 1100 + else + !--- accumulate + Model%clstp = 0100 + endif + + !--- random number needed for RAS and old SAS and when cal_pre=.true. + if ( ((Model%imfdeepcnv <= 0) .or. (Model%cal_pre)) .and. (Model%random_clds) ) then + iseed = mod(con_100*sqrt(Model%fhour*con_hr),1.0d9) + Model%seed0 + call random_setseed(iseed) + call random_number(wrk) + do i = 1,Model%cnx*Model%nrcm + iseed = iseed + nint(wrk(1)) * i + call random_setseed(iseed) + call random_number(rannie) + rndval(1+(i-1)*Model%cny:i*Model%cny) = rannie(1:Model%cny) + enddo + + do k = 1,Model%nrcm + iskip = (k-1)*Model%cnx*Model%cny + ix = 0 + nb = 1 + do j = 1,Model%ny + do i = 1,Model%nx + ix = ix + 1 + if (ix .gt. blksz(nb)) then + ix = 1 + nb = nb + 1 + endif + Tbd(nb)%rann(ix,k) = rndval(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + iskip) + enddo + enddo + enddo + endif ! imfdeepcnv, cal_re, random_clds + + !--- o3 interpolation + if (Model%ntoz > 0) then + do nb = 1, nblks + call ozinterpol (Model%me, blksz(nb), Model%idate, Model%fhour, & + Grid(nb)%jindx1_o3, Grid(nb)%jindx2_o3, & + Tbd(nb)%ozpl, Grid(nb)%ddy_o3) + enddo + endif + + !--- h2o interpolation + if (Model%h2o_phys) then + do nb = 1, nblks + call h2ointerpol (Model%me, blksz(nb), Model%idate, Model%fhour, & + Grid(nb)%jindx1_h, Grid(nb)%jindx2_h, & + Tbd(nb)%h2opl, Grid(nb)%ddy_h) + enddo + endif + + !--- repopulate specific time-varying sfc properties for AMIP/forecast runs + if (Model%nscyc > 0) then + if (mod(Model%kdt,Model%nscyc) == 1) THEN + call gcycle (nblks, Model, Grid(:), Sfcprop(:), Cldprop(:)) + endif + endif + + !--- determine if diagnostics buckets need to be cleared + if (mod(Model%kdt,Model%nszero) == 1) then + do nb = 1,nblks + call Diag(nb)%rad_zero (Model) + call Diag(nb)%phys_zero (Model) + !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED + enddo + endif + + end subroutine GFS_suite_setup_2_run + + end module GFS_suite_setup_2