From b706c9b38cbfac46f5bfcdda1883ab33aa0f6c73 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 17 Dec 2020 20:33:30 -0700 Subject: [PATCH 01/20] Implementation of CCPP timestep_init and timestep_final phases in fv3atm; cleanup work in GFS_typedefs for o3 and h2o physics as a result of the changes to the time vary physics in CCPP --- atmos_model.F90 | 14 +++- ccpp/config/ccpp_prebuild_config.py | 2 + ccpp/driver/CCPP_driver.F90 | 36 ++++++--- gfsphysics/GFS_layer/GFS_typedefs.F90 | 48 ++++-------- gfsphysics/GFS_layer/GFS_typedefs.meta | 100 +++++++++++++++---------- 5 files changed, 116 insertions(+), 84 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 860079949..221b3e31d 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -289,13 +289,12 @@ subroutine update_atmos_radiation_physics (Atmos) !--- execute the IPD atmospheric setup step call mpp_clock_begin(setupClock) #ifdef CCPP - call CCPP_step (step="time_vary", nblks=Atm_block%nblks, ierr=ierr) - if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP time_vary step failed') + call CCPP_step (step="timestep_init", nblks=Atm_block%nblks, ierr=ierr) + if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP timestep_init step failed') !--- call stochastic physics pattern generation / cellular automata call stochastic_physics_wrapper(IPD_Control, IPD_Data, Atm_block, ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed') - #else Func1d => time_vary_step call IPD_step (IPD_Control, IPD_Data(:), IPD_Diag, IPD_Restart, IPD_func1d=Func1d) @@ -419,6 +418,15 @@ subroutine update_atmos_radiation_physics (Atmos) endif call getiauforcing(IPD_Control,IAU_data) if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "end of radiation and physics step" + +#ifdef CCPP +!--- execute the IPD atmospheric timestep finalize step + call mpp_clock_begin(setupClock) + call CCPP_step (step="timestep_finalize", nblks=Atm_block%nblks, ierr=ierr) + if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP timestep_finalize step failed') + call mpp_clock_end(setupClock) +#endif + endif #ifdef CCPP diff --git a/ccpp/config/ccpp_prebuild_config.py b/ccpp/config/ccpp_prebuild_config.py index 6d8693e62..db0b1a0a3 100755 --- a/ccpp/config/ccpp_prebuild_config.py +++ b/ccpp/config/ccpp_prebuild_config.py @@ -17,6 +17,8 @@ # actual variable definition files 'ccpp/physics/physics/machine.F', 'ccpp/physics/physics/radsw_param.f', + 'ccpp/physics/physics/h2o_def.f', + 'ccpp/physics/physics/ozne_def.f', 'ccpp/physics/physics/radlw_param.f', 'gfsphysics/CCPP_layer/CCPP_typedefs.F90', 'gfsphysics/GFS_layer/GFS_typedefs.F90', diff --git a/ccpp/driver/CCPP_driver.F90 b/ccpp/driver/CCPP_driver.F90 index 06e6dc63f..05cd69f5e 100644 --- a/ccpp/driver/CCPP_driver.F90 +++ b/ccpp/driver/CCPP_driver.F90 @@ -3,7 +3,9 @@ module CCPP_driver use ccpp_api, only: ccpp_t use ccpp_static_api, only: ccpp_physics_init, & + ccpp_physics_timestep_init, & ccpp_physics_run, & + ccpp_physics_timestep_finalize, & ccpp_physics_finalize use CCPP_data, only: cdata_tile, & @@ -95,9 +97,9 @@ subroutine CCPP_step (step, nblks, ierr) else if (trim(step)=="physics_init") then - ! Since the physics init steps are independent of the blocking structure, + ! Since the physics init step is independent of the blocking structure, ! we can use cdata_domain here. Since we don't use threading on the outside, - ! we can allow threading inside the time_vary routines. + ! we can allow threading inside the physics init routines. GFS_control%nthreads = nthrds call ccpp_physics_init(cdata_domain, suite_name=trim(ccpp_suite), ierr=ierr) @@ -107,18 +109,17 @@ subroutine CCPP_step (step, nblks, ierr) return end if - else if (trim(step)=="time_vary") then + ! Timestep init = time_vary + else if (trim(step)=="timestep_init") then - ! Since the time_vary steps only use data structures for all blocks (except the - ! CCPP-internal variables ccpp_error_flag and ccpp_error_message, which are defined - ! for all cdata structures independently), we can use cdata_domain here. - ! Since we don't use threading on the outside, we can allow threading - ! inside the time_vary routines. + ! Since the physics timestep init step is independent of the blocking structure, + ! we can use cdata_domain here. Since we don't use threading on the outside, + ! we can allow threading inside the timestep init (time_vary) routines. GFS_control%nthreads = nthrds - call ccpp_physics_run(cdata_domain, suite_name=trim(ccpp_suite), group_name="time_vary", ierr=ierr) + call ccpp_physics_timestep_init(cdata_domain, suite_name=trim(ccpp_suite), group_name="time_vary", ierr=ierr) if (ierr/=0) then - write(0,'(a)') "An error occurred in ccpp_physics_run for group time_vary" + write(0,'(a)') "An error occurred in ccpp_physics_timestep_init for group time_vary" write(0,'(a)') trim(cdata_domain%errmsg) return end if @@ -162,6 +163,21 @@ subroutine CCPP_step (step, nblks, ierr) !$OMP end parallel if (ierr/=0) return + ! Timestep finalize = time_vary + else if (trim(step)=="timestep_finalize") then + + ! Since the physics timestep finalize step is independent of the blocking structure, + ! we can use cdata_domain here. Since we don't use threading on the outside, + ! we can allow threading inside the timestep finalize (time_vary) routines. + GFS_control%nthreads = nthrds + + call ccpp_physics_timestep_finalize(cdata_domain, suite_name=trim(ccpp_suite), group_name="time_vary", ierr=ierr) + if (ierr/=0) then + write(0,'(a)') "An error occurred in ccpp_physics_timestep_finalize for group time_vary" + write(0,'(a)') trim(cdata_domain%errmsg) + return + end if + ! Finalize else if (trim(step)=="finalize") then diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 5e5fa3fb2..930668853 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -13,6 +13,8 @@ module GFS_typedefs use module_radsw_parameters, only: topfsw_type, sfcfsw_type, profsw_type, cmpfsw_type, NBDSW use module_radlw_parameters, only: topflw_type, sfcflw_type, proflw_type, NBDLW + use ozne_def, only: levozp, oz_coeff + use h2o_def, only: levh2o, h2o_coeff use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_optical_props, only: ty_optical_props_1scl,ty_optical_props_2str use mo_cloud_optics, only: ty_cloud_optics @@ -47,10 +49,10 @@ module GFS_typedefs ! from aerclm_def integer, parameter :: ntrcaerm = 15 - ! These will be set later in GFS_Control%initialize, - ! since they depend on the runtime config (e.g. Model%ntoz, Model%h2o_phys, Model%aero_in) - private :: levozp, oz_coeff, levh2o, h2o_coeff, ntrcaer - integer :: levozp, oz_coeff, levh2o, h2o_coeff, ntrcaer + ! This will be set later in GFS_Control%initialize, since + ! it depends on the runtime config (Model%aero_in) + private :: ntrcaer + integer :: ntrcaer #endif ! If these are changed to >99, need to adjust formatting string in GFS_diagnostics.F90 (and names in diag_tables) integer, parameter :: naux2dmax = 20 !< maximum number of auxiliary 2d arrays in output (for debugging) @@ -1852,8 +1854,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: graupelmp(:) => null() !< real (kind=kind_phys), pointer :: gwdcu(:,:) => null() !< real (kind=kind_phys), pointer :: gwdcv(:,:) => null() !< - integer :: h2o_coeff !< - real (kind=kind_phys), pointer :: h2o_pres(:) => null() !< + real (kind=kind_phys), pointer :: hefac(:) => null() !< real (kind=kind_phys), pointer :: hffac(:) => null() !< real (kind=kind_phys), pointer :: hflxq(:) => null() !< @@ -1887,8 +1888,6 @@ module GFS_typedefs integer, pointer :: ktop(:) => null() !< integer :: latidxprnt !< integer :: levi !< - integer :: levh2o !< - integer :: levozp !< integer :: lmk !< integer :: lmp !< integer, pointer :: mbota(:,:) => null() !< @@ -1918,9 +1917,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: oc(:) => null() !< real (kind=kind_phys), pointer :: olyr(:,:) => null() !< logical , pointer :: otspt(:,:) => null() !< - integer :: oz_coeff !< integer :: oz_coeffp5 !< - real (kind=kind_phys), pointer :: oz_pres(:) => null() !< logical :: phys_hydrostatic !< real (kind=kind_phys), pointer :: plvl(:,:) => null() !< real (kind=kind_phys), pointer :: plyr(:,:) => null() !< @@ -4313,7 +4310,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & stop else levozp = 1 - oz_coeff = 0 + oz_coeff = 1 end if end if #endif @@ -5166,6 +5163,8 @@ subroutine control_print(Model) print *, ' shocaftcnv : ', Model%shocaftcnv print *, ' shoc_cld : ', Model%shoc_cld print *, ' uni_cld : ', Model%uni_cld + print *, ' oz_phys : ', Model%oz_phys + print *, ' oz_phys_2015 : ', Model%oz_phys_2015 print *, ' h2o_phys : ', Model%h2o_phys print *, ' pdfcld : ', Model%pdfcld print *, ' shcnvcw : ', Model%shcnvcw @@ -5455,8 +5454,6 @@ subroutine tbd_create (Tbd, IM, Model) endif !--- ozone and stratosphere h2o needs - ! DH* oz_coeff is set to zero if both ozphys options are false, - ! better to use conditional allocations here for ozpl (and h2opl)? *DH allocate (Tbd%ozpl (IM,levozp,oz_coeff)) allocate (Tbd%h2opl (IM,levh2o,h2o_coeff)) Tbd%ozpl = clear_val @@ -5475,8 +5472,6 @@ subroutine tbd_create (Tbd, IM, Model) Tbd%aer_nm = clear_val #ifdef CCPP -! DH* TODO - MOVE THIS TO a block-vector dependent structure in GFS_control? -! e.g. GFS_Control%imap(blk), GFS_Control%jmap(blk), or ii instead if imap etc? *DH !--- maps of local index ix to global indices i and j for this block allocate (Tbd%imap (IM)) allocate (Tbd%jmap (IM)) @@ -6475,7 +6470,6 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%gflx_ocean (IM)) allocate (Interstitial%gwdcu (IM,Model%levs)) allocate (Interstitial%gwdcv (IM,Model%levs)) - allocate (Interstitial%h2o_pres (levh2o)) allocate (Interstitial%hefac (IM)) allocate (Interstitial%hffac (IM)) allocate (Interstitial%hflxq (IM)) @@ -6504,7 +6498,6 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%oa4 (IM,4)) allocate (Interstitial%oc (IM)) allocate (Interstitial%olyr (IM,Model%levr+LTP)) - allocate (Interstitial%oz_pres (levozp)) allocate (Interstitial%plvl (IM,Model%levr+1+LTP)) allocate (Interstitial%plyr (IM,Model%levr+LTP)) allocate (Interstitial%prnum (IM,Model%levs)) @@ -6752,23 +6745,18 @@ subroutine interstitial_create (Interstitial, IM, Model) Interstitial%ipr = min(IM,10) Interstitial%latidxprnt = 1 Interstitial%levi = Model%levs+1 - Interstitial%levh2o = levh2o - Interstitial%levozp = levozp Interstitial%lmk = Model%levr+LTP Interstitial%lmp = Model%levr+1+LTP - Interstitial%h2o_coeff = h2o_coeff Interstitial%nbdlw = NBDLW Interstitial%nbdsw = NBDSW Interstitial%nf_aelw = NF_AELW Interstitial%nf_aesw = NF_AESW Interstitial%nspc1 = NSPC1 - Interstitial%oz_coeff = oz_coeff - Interstitial%oz_coeffp5 = oz_coeff+5 - ! h2o_pres and oz_pres do not change during the run, but - ! need to be set later in GFS_phys_time_vary_init (after - ! h2o_pres/oz_pres are read in read_h2odata/read_o3data) - Interstitial%h2o_pres = clear_val - Interstitial%oz_pres = clear_val + if (Model%oz_phys .or. Model%oz_phys_2015) then + Interstitial%oz_coeffp5 = oz_coeff+5 + else + Interstitial%oz_coeffp5 = 5 + endif ! Interstitial%skip_macro = .false. ! The value phys_hydrostatic from dynamics does not match the @@ -7372,14 +7360,10 @@ subroutine interstitial_print(Interstitial, Model, mpirank, omprank, blkno) ! Print static variables write (0,'(a,3i6)') 'Interstitial_print for mpirank, omprank, blkno: ', mpirank, omprank, blkno write (0,*) 'Interstitial_print: values that do not change' - write (0,*) 'Interstitial%h2o_coeff = ', Interstitial%h2o_coeff - write (0,*) 'sum(Interstitial%h2o_pres) = ', sum(Interstitial%h2o_pres) write (0,*) 'Interstitial%ipr = ', Interstitial%ipr write (0,*) 'Interstitial%itc = ', Interstitial%itc write (0,*) 'Interstitial%latidxprnt = ', Interstitial%latidxprnt write (0,*) 'Interstitial%levi = ', Interstitial%levi - write (0,*) 'Interstitial%levh2o = ', Interstitial%levh2o - write (0,*) 'Interstitial%levozp = ', Interstitial%levozp write (0,*) 'Interstitial%lmk = ', Interstitial%lmk write (0,*) 'Interstitial%lmp = ', Interstitial%lmp write (0,*) 'Interstitial%nbdlw = ', Interstitial%nbdlw @@ -7391,8 +7375,6 @@ subroutine interstitial_print(Interstitial, Model, mpirank, omprank, blkno) write (0,*) 'Interstitial%nspc1 = ', Interstitial%nspc1 write (0,*) 'Interstitial%ntiwx = ', Interstitial%ntiwx write (0,*) 'Interstitial%nvdiff = ', Interstitial%nvdiff - write (0,*) 'Interstitial%oz_coeff = ', Interstitial%oz_coeff - write (0,*) 'sum(Interstitial%oz_pres) = ', sum(Interstitial%oz_pres) write (0,*) 'Interstitial%phys_hydrostatic = ', Interstitial%phys_hydrostatic write (0,*) 'Interstitial%skip_macro = ', Interstitial%skip_macro write (0,*) 'Interstitial%trans_aero = ', Interstitial%trans_aero diff --git a/gfsphysics/GFS_layer/GFS_typedefs.meta b/gfsphysics/GFS_layer/GFS_typedefs.meta index ed0f84b69..a0ee0b7d7 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.meta +++ b/gfsphysics/GFS_layer/GFS_typedefs.meta @@ -20,6 +20,13 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys +[prsi(:,1)] + standard_name = air_pressure_at_lowest_model_interface + long_name = air pressure at lowest model interface + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [prsik] standard_name = dimensionless_exner_function_at_model_interfaces long_name = dimensionless Exner function at model layer interfaces @@ -2397,6 +2404,13 @@ units = flag dimensions = () type = logical +[fhcyc] + standard_name = frequency_for_surface_cycling_calls + long_name = frequency for surface cycling calls + units = h + dimensions = () + type = real + kind = kind_phys [nscyc] standard_name = number_of_timesteps_between_surface_cycling_calls long_name = number of timesteps between surface cycling calls @@ -3406,6 +3420,12 @@ units = index dimensions = () type = integer +[use_ufo] + standard_name = flag_for_gcycle_surface_option + long_name = flag for gcycle surface option + units = flag + dimensions = () + type = logical [lcurr_sf] standard_name = flag_for_ocean_currents_in_surface_layer_scheme long_name = flag for taking ocean currents into account in surface layer scheme @@ -3926,6 +3946,12 @@ dimensions = () type = real kind = kind_phys +[nst_anl] + standard_name = flag_for_nsstm_analysis_in_gcycle + long_name = flag for NSSTM analysis in gcycle/sfcsub + units = flag + dimensions = () + type = logical [nstf_name(1)] standard_name = flag_for_nsstm_run long_name = NSSTM flag: off/uncoupled/coupled=0/1/2 @@ -4896,12 +4922,14 @@ units = index dimensions = (horizontal_loop_extent) type = integer + active = (index_for_ozone>0) [jindx2_o3] standard_name = upper_ozone_interpolation_index long_name = interpolation high index for ozone units = index dimensions = (horizontal_loop_extent) type = integer + active = (index_for_ozone>0) [ddy_o3] standard_name = ozone_interpolation_weight long_name = interpolation high index for ozone @@ -4909,18 +4937,21 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (index_for_ozone>0) [jindx1_h] standard_name = lower_water_vapor_interpolation_index long_name = interpolation low index for stratospheric water vapor units = index dimensions = (horizontal_loop_extent) type = integer + active = (flag_for_stratospheric_water_vapor_physics) [jindx2_h] standard_name = upper_water_vapor_interpolation_index long_name = interpolation high index for stratospheric water vapor units = index dimensions = (horizontal_loop_extent) type = integer + active = (flag_for_stratospheric_water_vapor_physics) [ddy_h] standard_name = water_vapor_interpolation_weight long_name = interpolation high index for stratospheric water vapor @@ -4928,18 +4959,21 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (flag_for_stratospheric_water_vapor_physics) [jindx1_aer] standard_name = lower_aerosol_y_interpolation_index long_name = interpolation low index for prescribed aerosols in the y direction units = index dimensions = (horizontal_loop_extent) type = integer + active = (flag_for_aerosol_input_MG_radiation) [jindx2_aer] standard_name = upper_aerosol_y_interpolation_index long_name = interpolation high index for prescribed aerosols in the y direction units = index dimensions = (horizontal_loop_extent) type = integer + active = (flag_for_aerosol_input_MG_radiation) [ddy_aer] standard_name = aerosol_y_interpolation_weight long_name = interpolation high index for prescribed aerosols in the y direction @@ -4947,18 +4981,21 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (flag_for_aerosol_input_MG_radiation) [iindx1_aer] standard_name = lower_aerosol_x_interpolation_index long_name = interpolation low index for prescribed aerosols in the x direction units = index dimensions = (horizontal_loop_extent) type = integer + active = (flag_for_aerosol_input_MG_radiation) [iindx2_aer] standard_name = upper_aerosol_x_interpolation_index long_name = interpolation high index for prescribed aerosols in the x direction units = index dimensions = (horizontal_loop_extent) type = integer + active = (flag_for_aerosol_input_MG_radiation) [ddx_aer] standard_name = aerosol_x_interpolation_weight long_name = interpolation high index for prescribed aerosols in the x direction @@ -4966,18 +5003,21 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (flag_for_aerosol_input_MG_radiation) [jindx1_ci] standard_name = lower_cloud_nuclei_y_interpolation_index long_name = interpolation low index for ice and cloud condensation nuclei in the y direction units = index dimensions = (horizontal_loop_extent) type = integer + active = (flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics==1) [jindx2_ci] standard_name = upper_cloud_nuclei_y_interpolation_index long_name = interpolation high index for ice and cloud condensation nuclei in the y direction units = index dimensions = (horizontal_loop_extent) type = integer + active = (flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics==1) [ddy_ci] standard_name = cloud_nuclei_y_interpolation_weight long_name = interpolation high index for ice and cloud condensation nuclei in the y direction @@ -4985,18 +5025,21 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics==1) [iindx1_ci] standard_name = lower_cloud_nuclei_x_interpolation_index long_name = interpolation low index for ice and cloud condensation nuclei in the x direction units = index dimensions = (horizontal_loop_extent) type = integer + active = (flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics==1) [iindx2_ci] standard_name = upper_cloud_nuclei_x_interpolation_index long_name = interpolation high index for ice and cloud condensation nuclei in the x direction units = index dimensions = (horizontal_loop_extent) type = integer + active = (flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics==1) [ddx_ci] standard_name = cloud_nuclei_x_interpolation_weight long_name = interpolation high index for ice and cloud condensation nuclei in the x direction @@ -5004,6 +5047,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics==1) ######################################################################## [ccpp-table-properties] @@ -5149,6 +5193,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (index_for_surface_air_pressure_two_timesteps_back > 0) [phy_f2d(:,index_for_surface_air_pressure_at_previous_timestep)] standard_name = surface_air_pressure_at_previous_timestep long_name = surface air pressure at previous timestep @@ -5156,6 +5201,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (index_for_surface_air_pressure_at_previous_timestep > 0) [phy_f2d(:,array_dimension_of_2d_arrays_for_microphysics)] standard_name = surface_wind_enhancement_due_to_convection long_name = surface wind enhancement due to convection @@ -5163,6 +5209,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (array_dimension_of_2d_arrays_for_microphysics > 0) [phy_f3d(:,:,index_for_air_temperature_two_timesteps_back)] standard_name = air_temperature_two_timesteps_back long_name = air temperature two timesteps back @@ -5170,6 +5217,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys + active = (index_for_air_temperature_two_timesteps_back > 0) [phy_f3d(:,:,index_for_specific_humidity_two_timesteps_back)] standard_name = water_vapor_specific_humidity_two_timesteps_back long_name = water vapor specific humidity two timesteps back @@ -5177,6 +5225,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys + active = (index_for_specific_humidity_two_timesteps_back > 0) [phy_f3d(:,:,index_for_air_temperature_at_previous_timestep)] standard_name = air_temperature_at_previous_timestep long_name = air temperature at previous timestep @@ -5184,6 +5233,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys + active = (index_for_air_temperature_at_previous_timestep > 0) [phy_f3d(:,:,index_for_specific_humidity_at_previous_timestep)] standard_name = water_vapor_specific_humidity_at_previous_timestep long_name = water vapor specific humidity at previous timestep @@ -5191,6 +5241,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys + active = (index_for_specific_humidity_at_previous_timestep > 0) [phy_f3d(:,:,index_for_convective_cloud_water_mixing_ratio_in_phy_f3d)] standard_name = convective_cloud_water_mixing_ratio_in_phy_f3d long_name = convective cloud water mixing ratio in the phy_f3d array @@ -5198,6 +5249,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys + active = (index_for_convective_cloud_water_mixing_ratio_in_phy_f3d > 0) [phy_f3d(:,:,index_for_convective_cloud_cover_in_phy_f3d)] standard_name = convective_cloud_cover_in_phy_f3d long_name = convective cloud cover in the phy_f3d array @@ -5205,6 +5257,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys + active = (index_for_convective_cloud_cover_in_phy_f3d > 0) [phy_f3d(:,:,index_of_kinematic_buoyancy_flux_from_shoc_in_phy_f3d)] standard_name = kinematic_buoyancy_flux_from_shoc long_name = upward kinematic buoyancy flux from the SHOC scheme @@ -5212,6 +5265,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys + active = (index_of_kinematic_buoyancy_flux_from_shoc_in_phy_f3d > 0) [phy_f3d(:,:,index_of_atmosphere_heat_diffusivity_from_shoc_in_phy_f3d)] standard_name = atmosphere_heat_diffusivity_from_shoc long_name = diffusivity for heat from the SHOC scheme @@ -5219,6 +5273,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys + active = (index_of_atmosphere_heat_diffusivity_from_shoc_in_phy_f3d > 0) [phy_f3d(:,:,index_of_subgrid_scale_cloud_fraction_from_shoc_in_phy_f3d)] standard_name = subgrid_scale_cloud_fraction_from_shoc long_name = subgrid-scale cloud fraction from the SHOC scheme @@ -5226,6 +5281,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys + active = (index_of_subgrid_scale_cloud_fraction_from_shoc_in_phy_f3d > 0) [phy_f3d(:,:,index_for_cloud_fraction_in_3d_arrays_for_microphysics)] standard_name = cloud_fraction_for_MG long_name = cloud fraction used by Morrison-Gettelman MP @@ -5233,6 +5289,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys + active = (index_for_cloud_fraction_in_3d_arrays_for_microphysics > 0) [phy_f3d(:,:,index_for_cloud_liquid_water_effective_radius)] standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um long_name = eff. radius of cloud liquid water particle in micrometer @@ -5240,6 +5297,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys + active = (index_for_cloud_liquid_water_effective_radius > 0) [phy_f3d(:,:,index_for_ice_effective_radius)] standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um long_name = eff. radius of cloud ice water particle in micrometer @@ -5247,6 +5305,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys + active = (index_for_ice_effective_radius > 0) [phy_f3d(:,:,index_for_rain_effective_radius)] standard_name = effective_radius_of_stratiform_cloud_rain_particle_in_um long_name = effective radius of cloud rain particle in micrometers @@ -5254,6 +5313,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys + active = (index_for_rain_effective_radius > 0) [phy_f3d(:,:,index_for_snow_effective_radius)] standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um long_name = effective radius of cloud snow particle in micrometers @@ -5261,6 +5321,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys + active = (index_for_snow_effective_radius > 0) [phy_f3d(:,:,index_for_graupel_effective_radius)] standard_name = effective_radius_of_stratiform_cloud_graupel_particle_in_um long_name = eff. radius of cloud graupel particle in micrometer @@ -5268,6 +5329,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys + active = (index_for_graupel_effective_radius > 0) [forcet] standard_name = temperature_tendency_due_to_dynamics long_name = temperature tendency due to dynamics only @@ -8345,19 +8407,6 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys -[h2o_coeff] - standard_name = number_of_coefficients_in_h2o_forcing_data - long_name = number of coefficients in h2o forcing data - units = index - dimensions = () - type = integer -[h2o_pres] - standard_name = natural_log_of_h2o_forcing_data_pressure_levels - long_name = natural log of h2o forcing data pressure levels - units = log(Pa) - dimensions = (vertical_dimension_of_h2o_forcing_data) - type = real - kind = kind_phys [hefac] standard_name = surface_upward_latent_heat_flux_reduction_factor long_name = surface upward latent heat flux reduction factor from canopy heat storage @@ -8556,18 +8605,6 @@ units = count dimensions = () type = integer -[levh2o] - standard_name = vertical_dimension_of_h2o_forcing_data - long_name = number of vertical layers in h2o forcing data - units = count - dimensions = () - type = integer -[levozp] - standard_name = vertical_dimension_of_ozone_forcing_data - long_name = number of vertical layers in ozone forcing data - units = count - dimensions = () - type = integer [lmk] standard_name = adjusted_vertical_layer_dimension_for_radiation long_name = adjusted number of vertical layers for radiation @@ -8779,25 +8816,12 @@ units = flag dimensions = (number_of_tracers_plus_one,2) type = logical -[oz_coeff] - standard_name = number_of_coefficients_in_ozone_forcing_data - long_name = number of coefficients in ozone forcing data - units = index - dimensions = () - type = integer [oz_coeffp5] standard_name = number_of_coefficients_in_ozone_forcing_data_plus_five long_name = number of coefficients in ozone forcing data plus five units = index dimensions = () type = integer -[oz_pres] - standard_name = natural_log_of_ozone_forcing_data_pressure_levels - long_name = natural log of ozone forcing data pressure levels - units = log(Pa) - dimensions = (vertical_dimension_of_ozone_forcing_data) - type = real - kind = kind_phys [phys_hydrostatic] standard_name = flag_for_hydrostatic_heating_from_physics long_name = flag for use of hydrostatic heating in physics From a72b94ad156353936843f8c34d18dd1e8f7777e1 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 17 Dec 2020 21:04:42 -0700 Subject: [PATCH 02/20] Update .gitmodules and submodule pointer for GFDL_atmos_cubed_sphere, ccpp-framework and ccpp-physics for code review and testing --- .gitmodules | 18 ++++++++++++------ atmos_cubed_sphere | 2 +- ccpp/framework | 2 +- ccpp/physics | 2 +- 4 files changed, 15 insertions(+), 9 deletions(-) diff --git a/.gitmodules b/.gitmodules index d253f6966..3966e0dbb 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,12 +1,18 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = https://github.com/NOAA-EMC/GFDL_atmos_cubed_sphere - branch = dev/emc + #url = https://github.com/NOAA-EMC/GFDL_atmos_cubed_sphere + #branch = dev/emc + url = https://github.com/climbfuji/GFDL_atmos_cubed_sphere + branch = timestep_init_final [submodule "ccpp/framework"] path = ccpp/framework - url = https://github.com/NCAR/ccpp-framework - branch = master + #url = https://github.com/NCAR/ccpp-framework + #branch = master + url = https://github.com/climbfuji/ccpp-framework + branch = timestep_init_final [submodule "ccpp/physics"] path = ccpp/physics - url = https://github.com/NCAR/ccpp-physics - branch = master + #url = https://github.com/NCAR/ccpp-physics + #branch = master + url = https://github.com/climbfuji/ccpp-physics + branch = timestep_init_final diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 61875852b..994d478cc 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 61875852b52951f6c6215603a19c826b952fc534 +Subproject commit 994d478cc23ea486425a29a544be4022436171b3 diff --git a/ccpp/framework b/ccpp/framework index dca1240e6..e41664349 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit dca1240e6f19a5bbcfa0b14aa8526f36e99ed135 +Subproject commit e4166434908ff30071aa43efeba7502292477d96 diff --git a/ccpp/physics b/ccpp/physics index 8ef88ca46..eb1287fc5 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 8ef88ca46c11535fc7984d39ec38d1582f9db5ff +Subproject commit eb1287fc5c1924a035e2215a10d2b3edf7416a92 From 3cdfa3fefda049d40406fb5b3d98211a7d6f874a Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 18 Dec 2020 08:09:16 -0700 Subject: [PATCH 03/20] Update submodule pointer for ccpp-physics --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index eb1287fc5..04ee898cf 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit eb1287fc5c1924a035e2215a10d2b3edf7416a92 +Subproject commit 04ee898cfabb6af07087c6ea9a3108f758ac668a From 9e59de2344a4b87da13b7bc5221f88381b2b41dc Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 29 Dec 2020 09:40:15 -0700 Subject: [PATCH 04/20] Use proper index variable for surface wind enhancement due to convection in phy_f2d array in GFS_typedefs.{F90,meta} --- ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_typedefs.F90 | 6 +++++- gfsphysics/GFS_layer/GFS_typedefs.meta | 10 ++++++++-- 3 files changed, 14 insertions(+), 4 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index 08bd98387..7107b4970 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 08bd983879df9c3e7d491912190170d6dcfb0c56 +Subproject commit 7107b4970af1aa39d4a908030767b5bbaab51efe diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 5c239e5dd..98b966450 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -1173,10 +1173,11 @@ module GFS_typedefs integer :: nqvdelt !< the index of specific humidity at the previous timestep for Z-C MP in phy_f3d integer :: nps2delt !< the index of surface air pressure 2 timesteps back for Z-C MP in phy_f2d integer :: npsdelt !< the index of surface air pressure at the previous timestep for Z-C MP in phy_f2d + integer :: ncnvwind !< the index of surface wind enhancement due to convection for MYNN SFC and RAS CNV in phy f2d #endif !--- debug flag - logical :: debug + logical :: debug logical :: pre_rad !< flag for testing purpose !--- variables modified at each time step @@ -4873,6 +4874,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & #endif if(Model%cnvcld) Model%ncnvcld3d = 1 +!--- get cnvwind index in phy_f2d; last entry in phy_f2d array + Model%ncnvwind = Model%num_p2d + !--- get cnvw and cnvc indices in phy_f3d Model%ncnvw = -999 Model%ncnvc = -999 diff --git a/gfsphysics/GFS_layer/GFS_typedefs.meta b/gfsphysics/GFS_layer/GFS_typedefs.meta index 532988445..708f2ef8e 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.meta +++ b/gfsphysics/GFS_layer/GFS_typedefs.meta @@ -4504,6 +4504,12 @@ units = dimensions = () type = integer +[ncnvwind] + standard_name = index_for_surface_wind_enhancement_due_to_convection + long_name = the index of surface wind enhancement due to convection in phy f2d + units = + dimensions = () + type = integer [debug] standard_name = flag_debug long_name = control flag for debug @@ -5285,14 +5291,14 @@ type = real kind = kind_phys active = (index_for_surface_air_pressure_at_previous_timestep > 0) -[phy_f2d(:,array_dimension_of_2d_arrays_for_microphysics)] +[phy_f2d(:,index_for_surface_wind_enhancement_due_to_convection)] standard_name = surface_wind_enhancement_due_to_convection long_name = surface wind enhancement due to convection units = m s-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (array_dimension_of_2d_arrays_for_microphysics > 0) + active = (index_for_surface_wind_enhancement_due_to_convection > 0) [phy_f3d(:,:,index_for_air_temperature_two_timesteps_back)] standard_name = air_temperature_two_timesteps_back long_name = air temperature two timesteps back From dacd56afa1be0d0bd8d7eb6096aea0b89252c1a6 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 30 Dec 2020 07:48:05 -0700 Subject: [PATCH 05/20] Add code to reset diagnostic buckets to atmos_model.F90 --- atmos_model.F90 | 25 ++++++++++++++++++++++++- ccpp/physics | 2 +- 2 files changed, 25 insertions(+), 2 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 4a7d1043a..31602fdf6 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -253,7 +253,7 @@ subroutine update_atmos_radiation_physics (Atmos) !----------------------------------------------------------------------- type (atmos_data_type), intent(in) :: Atmos !--- local variables--- - integer :: nb, jdat(8), rc + integer :: nb, jdat(8), rc, kdt_rad procedure(IPD_func0d_proc), pointer :: Func0d => NULL() procedure(IPD_func1d_proc), pointer :: Func1d => NULL() ! @@ -300,6 +300,29 @@ subroutine update_atmos_radiation_physics (Atmos) call IPD_step (IPD_Control, IPD_Data(:), IPD_Diag, IPD_Restart, IPD_func1d=Func1d) #endif + !--- determine if radiation diagnostics buckets need to be cleared + if (nint(IPD_Control%fhzero*3600) >= nint(max(IPD_Control%fhswr,IPD_Control%fhlwr))) then + if (mod(IPD_Control%kdt,IPD_Control%nszero) == 1) then + do nb = 1,Atm_block%nblks + call IPD_Data(nb)%Intdiag%rad_zero(IPD_Control) + end do + endif + else + kdt_rad = nint(min(IPD_Control%fhswr,IPD_Control%fhlwr)/IPD_Control%dtp) + if (mod(IPD_Control%kdt,kdt_rad) == 1) then + do nb = 1,Atm_block%nblks + call IPD_Data(nb)%Intdiag%rad_zero(IPD_Control) + enddo + endif + endif + + !--- determine if physics diagnostics buckets need to be cleared + if (mod(IPD_Control%kdt,IPD_Control%nszero) == 1) then + do nb = 1,Atm_block%nblks + call IPD_Data(nb)%Intdiag%phys_zero(IPD_Control) + end do + endif + !--- if coupled, assign coupled fields if( IPD_Control%cplflx .or. IPD_Control%cplwav ) then diff --git a/ccpp/physics b/ccpp/physics index 7107b4970..1eebface8 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 7107b4970af1aa39d4a908030767b5bbaab51efe +Subproject commit 1eebface86c4a134e742bf15c2ce1de3eb6462f3 From 9fc029bff39f172b3438952ff0cbb8f4c94b4d6a Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 30 Dec 2020 15:39:54 -0700 Subject: [PATCH 06/20] Update submodule pointer for ccpp-physics --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 1eebface8..f18c4ef6a 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 1eebface86c4a134e742bf15c2ce1de3eb6462f3 +Subproject commit f18c4ef6a46c479ac8d2cc725bba77e9b88bbff0 From a86790ea3eb8b2ba969fb369faed36d7d0cf1956 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 4 Jan 2021 13:10:36 -0700 Subject: [PATCH 07/20] Move code to clear diagnostic buckets using GFS DDT bound procedures from atmos_model.F90 to CCPP_driver.F90 --- atmos_model.F90 | 26 ++------------------------ ccpp/driver/CCPP_driver.F90 | 37 ++++++++++++++++++++++++++++++++++++- 2 files changed, 38 insertions(+), 25 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 31602fdf6..d6a32750b 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -253,7 +253,8 @@ subroutine update_atmos_radiation_physics (Atmos) !----------------------------------------------------------------------- type (atmos_data_type), intent(in) :: Atmos !--- local variables--- - integer :: nb, jdat(8), rc, kdt_rad + integer :: nb, jdat(8), rc + procedure(IPD_func0d_proc), pointer :: Func0d => NULL() procedure(IPD_func1d_proc), pointer :: Func1d => NULL() ! @@ -300,29 +301,6 @@ subroutine update_atmos_radiation_physics (Atmos) call IPD_step (IPD_Control, IPD_Data(:), IPD_Diag, IPD_Restart, IPD_func1d=Func1d) #endif - !--- determine if radiation diagnostics buckets need to be cleared - if (nint(IPD_Control%fhzero*3600) >= nint(max(IPD_Control%fhswr,IPD_Control%fhlwr))) then - if (mod(IPD_Control%kdt,IPD_Control%nszero) == 1) then - do nb = 1,Atm_block%nblks - call IPD_Data(nb)%Intdiag%rad_zero(IPD_Control) - end do - endif - else - kdt_rad = nint(min(IPD_Control%fhswr,IPD_Control%fhlwr)/IPD_Control%dtp) - if (mod(IPD_Control%kdt,kdt_rad) == 1) then - do nb = 1,Atm_block%nblks - call IPD_Data(nb)%Intdiag%rad_zero(IPD_Control) - enddo - endif - endif - - !--- determine if physics diagnostics buckets need to be cleared - if (mod(IPD_Control%kdt,IPD_Control%nszero) == 1) then - do nb = 1,Atm_block%nblks - call IPD_Data(nb)%Intdiag%phys_zero(IPD_Control) - end do - endif - !--- if coupled, assign coupled fields if( IPD_Control%cplflx .or. IPD_Control%cplwav ) then diff --git a/ccpp/driver/CCPP_driver.F90 b/ccpp/driver/CCPP_driver.F90 index 05cd69f5e..392b37151 100644 --- a/ccpp/driver/CCPP_driver.F90 +++ b/ccpp/driver/CCPP_driver.F90 @@ -12,7 +12,8 @@ module CCPP_driver cdata_domain, & cdata_block, & ccpp_suite, & - GFS_control + GFS_control, & + GFS_data implicit none @@ -57,6 +58,8 @@ subroutine CCPP_step (step, nblks, ierr) ! Local variables integer :: nb, nt, ntX integer :: ierr2 + ! DH* 20210104 - remove kdt_rad when code to clear diagnostic buckets is removed + integer :: kdt_rad ierr = 0 @@ -124,6 +127,38 @@ subroutine CCPP_step (step, nblks, ierr) return end if + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! DH* 20210104 - this block of code will be removed once the CCPP framework ! + ! fully supports handling diagnostics through its metadata, work in progress ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + !--- determine if radiation diagnostics buckets need to be cleared + if (nint(GFS_control%fhzero*3600) >= nint(max(GFS_control%fhswr,GFS_control%fhlwr))) then + if (mod(GFS_control%kdt,GFS_control%nszero) == 1) then + do nb = 1,nblks + call GFS_data(nb)%Intdiag%rad_zero(GFS_control) + end do + endif + else + kdt_rad = nint(min(GFS_control%fhswr,GFS_control%fhlwr)/GFS_control%dtp) + if (mod(GFS_control%kdt,kdt_rad) == 1) then + do nb = 1,nblks + call GFS_data(nb)%Intdiag%rad_zero(GFS_control) + enddo + endif + endif + + !--- determine if physics diagnostics buckets need to be cleared + if (mod(GFS_control%kdt,GFS_control%nszero) == 1) then + do nb = 1,nblks + call GFS_data(nb)%Intdiag%phys_zero(GFS_control) + end do + endif + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! *DH 20210104 ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Radiation and stochastic physics else if (trim(step)=="radiation" .or. trim(step)=="physics" .or. trim(step)=="stochastics") then From f3c3bdd6696606e07a9a3bd9a62534f278cb0d3a Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 6 Jan 2021 09:46:42 -0700 Subject: [PATCH 08/20] Update .gitmodules and submodule pointers for GFDL_atmos_cubed_sphere and ccpp-physics for code review and testing --- .gitmodules | 6 +++--- atmos_cubed_sphere | 2 +- ccpp/physics | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/.gitmodules b/.gitmodules index 3966e0dbb..751654989 100644 --- a/.gitmodules +++ b/.gitmodules @@ -3,16 +3,16 @@ #url = https://github.com/NOAA-EMC/GFDL_atmos_cubed_sphere #branch = dev/emc url = https://github.com/climbfuji/GFDL_atmos_cubed_sphere - branch = timestep_init_final + branch = remove_ipd_step3_and_5 [submodule "ccpp/framework"] path = ccpp/framework #url = https://github.com/NCAR/ccpp-framework #branch = master url = https://github.com/climbfuji/ccpp-framework - branch = timestep_init_final + branch = remove_ipd_step3_and_5 [submodule "ccpp/physics"] path = ccpp/physics #url = https://github.com/NCAR/ccpp-physics #branch = master url = https://github.com/climbfuji/ccpp-physics - branch = timestep_init_final + branch = remove_ipd_step3_and_5 diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 8190e4b5c..dd11e4d19 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 8190e4b5c87da2d33d70f7f8c617442d873468e7 +Subproject commit dd11e4d193ebee82155b8677eeea891ee71235c1 diff --git a/ccpp/physics b/ccpp/physics index e6c009d46..ca1afdb3e 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit e6c009d46d936ffaa400590c91e5bf6c5d75d654 +Subproject commit ca1afdb3ecebea579cfe13848130756ef6b39411 From 8866fa8394fef47194d7133396a83aecf2504991 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 6 Jan 2021 10:20:22 -0700 Subject: [PATCH 09/20] First step of cleanup process: remove CCPP preprocessor directives, remove parts of unused IPD code, update cmake build system --- CMakeLists.txt | 98 +- atmos_model.F90 | 750 ++++++-------- ccpp/CMakeLists.txt | 4 - gfsphysics/CMakeLists.txt | 187 +--- .../GFS_layer/GFS_abstraction_layer.F90 | 50 +- gfsphysics/GFS_layer/GFS_diagnostics.F90 | 120 --- gfsphysics/GFS_layer/GFS_driver.F90 | 973 +----------------- gfsphysics/GFS_layer/GFS_restart.F90 | 9 +- gfsphysics/GFS_layer/GFS_typedefs.F90 | 512 ++------- io/CMakeLists.txt | 10 +- io/FV3GFS_io.F90 | 258 +---- ipd/CMakeLists.txt | 10 +- ipd/IPD_driver.F90 | 44 +- ipd/IPD_typedefs.F90 | 128 +-- stochastic_physics/CMakeLists.txt | 6 +- 15 files changed, 563 insertions(+), 2596 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index d59702147..0c1e45c06 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,36 +1,24 @@ -if(CCPP) - - if(DEBUG) - set(_ccpp_debug_arg "--debug") - endif() - if(DEFINED CCPP_SUITES) - set(_ccpp_suites_arg "--suites=${CCPP_SUITES}") - message("Calling CCPP code generator (ccpp_prebuild.py) for suites ${_ccpp_suites_arg} ...") - else() - message("Calling CCPP code generator (ccpp_prebuild.py) for all available suites ...") - endif() - execute_process(COMMAND ${Python_EXECUTABLE} - "ccpp/framework/scripts/ccpp_prebuild.py" - "--config=ccpp/config/ccpp_prebuild_config.py" - "--builddir=${CMAKE_CURRENT_BINARY_DIR}" ${_ccpp_suites_arg} ${_ccpp_debug_arg} - WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR} - OUTPUT_FILE ${CMAKE_CURRENT_BINARY_DIR}/ccpp_prebuild.out - ERROR_FILE ${CMAKE_CURRENT_BINARY_DIR}/ccpp_prebuild.err - RESULT_VARIABLE RC) - # Check return code from ccpp_prebuild.py - if(NOT RC EQUAL 0) - message(FATAL_ERROR "An error occured while running ccpp_prebuild.py, check ${CMAKE_CURRENT_BINARY_DIR}/ccpp_prebuild.{out,err}") - endif() - # this should not be necessary; including CCPP_*.cmake here and passing - # SCHEMES, CAPS and TYPEDEFS via environment variables to CCPP build. - # CCPP should be able to directly include those three .cmake files. - include(${CMAKE_CURRENT_BINARY_DIR}/ccpp/physics/CCPP_SCHEMES.cmake) - include(${CMAKE_CURRENT_BINARY_DIR}/ccpp/physics/CCPP_CAPS.cmake) - include(${CMAKE_CURRENT_BINARY_DIR}/ccpp/physics/CCPP_TYPEDEFS.cmake) - set(ENV{CCPP_SCHEMES} "${SCHEMES}") - set(ENV{CCPP_CAPS} "${CAPS}") - set(ENV{CCPP_TYPEDEFS} "${TYPEDEFS}") - +# Call to CCPP code generator +if(DEBUG) + set(_ccpp_debug_arg "--debug") +endif() +if(DEFINED CCPP_SUITES) + set(_ccpp_suites_arg "--suites=${CCPP_SUITES}") + message("Calling CCPP code generator (ccpp_prebuild.py) for suites ${_ccpp_suites_arg} ...") +else() + message("Calling CCPP code generator (ccpp_prebuild.py) for all available suites ...") +endif() +execute_process(COMMAND ${Python_EXECUTABLE} + "ccpp/framework/scripts/ccpp_prebuild.py" + "--config=ccpp/config/ccpp_prebuild_config.py" + "--builddir=${CMAKE_CURRENT_BINARY_DIR}" ${_ccpp_suites_arg} ${_ccpp_debug_arg} + WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR} + OUTPUT_FILE ${CMAKE_CURRENT_BINARY_DIR}/ccpp_prebuild.out + ERROR_FILE ${CMAKE_CURRENT_BINARY_DIR}/ccpp_prebuild.err + RESULT_VARIABLE RC) +# Check return code from ccpp_prebuild.py +if(NOT RC EQUAL 0) + message(FATAL_ERROR "An error occured while running ccpp_prebuild.py, check ${CMAKE_CURRENT_BINARY_DIR}/ccpp_prebuild.{out,err}") endif() add_subdirectory(cpl) @@ -82,10 +70,6 @@ list(APPEND _fv3dycore_srcs atmos_cubed_sphere/driver/fvGFS/fv_nggps_diag.F90 atmos_cubed_sphere/driver/fvGFS/atmosphere.F90) -if(NOT CCPP) - list(APPEND _fv3dycore_srcs atmos_cubed_sphere/model/fv_cmp.F90) -endif() - add_library(fv3dycore ${_fv3dycore_srcs}) list(APPEND _fv3dycore_defs_private SPMD @@ -104,9 +88,7 @@ if(32BIT) OVERLOAD_R8) endif() -if(CCPP) - list(APPEND _fv3dycore_defs_private CCPP) -endif() +list(APPEND _fv3dycore_defs_private CCPP) if(OpenMP_Fortran_FOUND) list(APPEND _fv3dycore_defs_private OPENMP) @@ -131,19 +113,18 @@ if(OpenMP_Fortran_FOUND) endif() ############################################################################### -### ccpp +### CCPP ############################################################################### -if(CCPP) - add_subdirectory(ccpp) - add_subdirectory(ccpp/driver) - add_dependencies(gfsphysics ccpp ccppphys) - add_dependencies(ccppdriver ccpp ccppphys) - add_dependencies(ccppphys ccpp) - target_include_directories(fv3dycore PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/ccpp/framework/src - ${CMAKE_CURRENT_BINARY_DIR}/ccpp/driver) - target_link_libraries(ccppphys PUBLIC sp::sp_d - w3nco::w3nco_d) -endif() + +add_subdirectory(ccpp) +add_subdirectory(ccpp/driver) +add_dependencies(gfsphysics ccpp ccppphys) +add_dependencies(ccppdriver ccpp ccppphys) +add_dependencies(ccppphys ccpp) +target_include_directories(fv3dycore PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/ccpp/framework/src + ${CMAKE_CURRENT_BINARY_DIR}/ccpp/driver) +target_link_libraries(ccppphys PUBLIC sp::sp_d + w3nco::w3nco_d) ############################################################################### ### stochastic_physics @@ -170,13 +151,12 @@ set_target_properties(fv3atm PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT target_include_directories(fv3atm INTERFACE $ $) -if(CCPP) - list(APPEND _fv3atm_defs_private CCPP) - target_include_directories(fv3atm PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/ccpp/driver/mod) - set(CCPP_LIBRARIES ccppdriver ccppphys ccpp) - add_dependencies(fv3atm ccppdriver ccppphys ccpp) - target_link_libraries(fv3atm PUBLIC ccppdriver ccppphys ccpp) -endif() +list(APPEND _fv3atm_defs_private CCPP) +target_include_directories(fv3atm PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/ccpp/driver/mod) +set(CCPP_LIBRARIES ccppdriver ccppphys ccpp) +add_dependencies(fv3atm ccppdriver ccppphys ccpp) +target_link_libraries(fv3atm PUBLIC ccppdriver ccppphys ccpp) + target_include_directories(fv3atm PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/stochastic_physics) target_compile_definitions(fv3atm PRIVATE "${_fv3atm_defs_private}") diff --git a/atmos_model.F90 b/atmos_model.F90 index d6a32750b..a34740c2f 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -81,30 +81,15 @@ module atmos_model_mod use atmosphere_mod, only: Atm, mygrid use block_control_mod, only: block_control_type, define_blocks_packed use DYCORE_typedefs, only: DYCORE_data_type, DYCORE_diag_type -#ifdef CCPP -use IPD_typedefs, only: IPD_init_type, IPD_diag_type, & - IPD_restart_type, IPD_kind_phys, & - IPD_func0d_proc, IPD_func1d_proc -#else -use IPD_typedefs, only: IPD_init_type, IPD_control_type, & - IPD_data_type, IPD_diag_type, & - IPD_restart_type, IPD_kind_phys, & - IPD_func0d_proc, IPD_func1d_proc -#endif -#ifdef CCPP -use CCPP_data, only: ccpp_suite, & - IPD_control => GFS_control, & - IPD_data => GFS_data, & - IPD_interstitial => GFS_interstitial +use IPD_typedefs, only: IPD_init_type, IPD_diag_type, & + IPD_restart_type, IPD_kind_phys +use CCPP_data, only: ccpp_suite, GFS_control, & + GFS_data, GFS_interstitial use IPD_driver, only: IPD_initialize, IPD_initialize_rst use CCPP_driver, only: CCPP_step, non_uniform_blocks use stochastic_physics_wrapper_mod, only: stochastic_physics_wrapper,stochastic_physics_wrapper_end -#else -use IPD_driver, only: IPD_initialize, IPD_initialize_rst, IPD_step -use physics_abstraction_layer, only: time_vary_step, radiation_step1, physics_step1, physics_step2 -#endif use FV3GFS_io_mod, only: FV3GFS_restart_read, FV3GFS_restart_write, & FV3GFS_IPD_checksum, & @@ -170,11 +155,7 @@ module atmos_model_mod integer, parameter :: maxhr = 4096 real, dimension(maxhr) :: fdiag = 0. real :: fhmax=384.0, fhmaxhf=120.0, fhout=3.0, fhouthf=1.0,avg_max_length=3600. -#ifdef CCPP namelist /atmos_model_nml/ blocksize, chksum_debug, dycore_only, debug, sync, fdiag, fhmax, fhmaxhf, fhout, fhouthf, ccpp_suite, avg_max_length -#else -namelist /atmos_model_nml/ blocksize, chksum_debug, dycore_only, debug, sync, fdiag, fhmax, fhmaxhf, fhout, fhouthf, avg_max_length -#endif type (time_type) :: diag_time, diag_time_fhzero @@ -188,16 +169,9 @@ module atmos_model_mod !---------------- ! IPD containers !---------------- -#ifndef CCPP -type(IPD_control_type) :: IPD_Control -type(IPD_data_type), allocatable :: IPD_Data(:) ! number of blocks -type(IPD_diag_type), target :: IPD_Diag(DIAG_SIZE) -type(IPD_restart_type) :: IPD_Restart -#else -! IPD_Control and IPD_Data are coming from CCPP_data +! GFS_control and GFS_data are coming from CCPP_data type(IPD_diag_type), target :: IPD_Diag(DIAG_SIZE) type(IPD_restart_type) :: IPD_Restart -#endif !-------------- ! IAU container @@ -253,63 +227,51 @@ subroutine update_atmos_radiation_physics (Atmos) !----------------------------------------------------------------------- type (atmos_data_type), intent(in) :: Atmos !--- local variables--- - integer :: nb, jdat(8), rc - - procedure(IPD_func0d_proc), pointer :: Func0d => NULL() - procedure(IPD_func1d_proc), pointer :: Func1d => NULL() - ! -#ifdef CCPP - integer :: ierr -#endif + integer :: nb, jdat(8), rc, ierr if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "statein driver" !--- get atmospheric state from the dynamic core call set_atmosphere_pelist() call mpp_clock_begin(getClock) - if (IPD_control%do_skeb) call atmosphere_diss_est (IPD_control%skeb_npass) ! do smoothing for SKEB - call atmos_phys_driver_statein (IPD_data, Atm_block, flip_vc) + if (GFS_control%do_skeb) call atmosphere_diss_est (GFS_control%skeb_npass) ! do smoothing for SKEB + call atmos_phys_driver_statein (GFS_data, Atm_block, flip_vc) call mpp_clock_end(getClock) !--- if dycore only run, set up the dummy physics output state as the input state if (dycore_only) then do nb = 1,Atm_block%nblks - IPD_Data(nb)%Stateout%gu0 = IPD_Data(nb)%Statein%ugrs - IPD_Data(nb)%Stateout%gv0 = IPD_Data(nb)%Statein%vgrs - IPD_Data(nb)%Stateout%gt0 = IPD_Data(nb)%Statein%tgrs - IPD_Data(nb)%Stateout%gq0 = IPD_Data(nb)%Statein%qgrs + GFS_data(nb)%Stateout%gu0 = GFS_data(nb)%Statein%ugrs + GFS_data(nb)%Stateout%gv0 = GFS_data(nb)%Statein%vgrs + GFS_data(nb)%Stateout%gt0 = GFS_data(nb)%Statein%tgrs + GFS_data(nb)%Stateout%gq0 = GFS_data(nb)%Statein%qgrs enddo else if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "setup step" -!--- update IPD_Control%jdat(8) +!--- update GFS_control%jdat(8) jdat(:) = 0 call get_date (Atmos%Time, jdat(1), jdat(2), jdat(3), & jdat(5), jdat(6), jdat(7)) - IPD_Control%jdat(:) = jdat(:) + GFS_control%jdat(:) = jdat(:) !--- execute the IPD atmospheric setup step call mpp_clock_begin(setupClock) -#ifdef CCPP call CCPP_step (step="timestep_init", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP timestep_init step failed') !--- call stochastic physics pattern generation / cellular automata - call stochastic_physics_wrapper(IPD_Control, IPD_Data, Atm_block, ierr) + call stochastic_physics_wrapper(GFS_control, GFS_data, Atm_block, ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed') -#else - Func1d => time_vary_step - call IPD_step (IPD_Control, IPD_Data(:), IPD_Diag, IPD_Restart, IPD_func1d=Func1d) -#endif !--- if coupled, assign coupled fields - if( IPD_Control%cplflx .or. IPD_Control%cplwav ) then + if( GFS_control%cplflx .or. GFS_control%cplwav ) then ! if (mpp_pe() == mpp_root_pe() .and. debug) then ! print *,'in atmos_model,nblks=',Atm_block%nblks -! print *,'in atmos_model,IPD_Data size=',size(IPD_Data) -! print *,'in atmos_model,tsfc(1)=',IPD_Data(1)%sfcprop%tsfc(1) -! print *,'in atmos_model, tsfc size=',size(IPD_Data(1)%sfcprop%tsfc) +! print *,'in atmos_model,GFS_data size=',size(GFS_data) +! print *,'in atmos_model,tsfc(1)=',GFS_data(1)%sfcprop%tsfc(1) +! print *,'in atmos_model, tsfc size=',size(GFS_data(1)%sfcprop%tsfc) ! endif call assign_importdata(rc) @@ -319,21 +281,21 @@ subroutine update_atmos_radiation_physics (Atmos) ! Calculate total non-physics tendencies by substracting old IPD Stateout ! variables from new/updated IPD Statein variables (gives the tendencies ! due to anything else than physics) - if (IPD_Control%ldiag3d) then + if (GFS_control%ldiag3d) then do nb = 1,Atm_block%nblks - IPD_Data(nb)%Intdiag%du3dt(:,:,8) = IPD_Data(nb)%Intdiag%du3dt(:,:,8) & - + (IPD_Data(nb)%Statein%ugrs - IPD_Data(nb)%Stateout%gu0) - IPD_Data(nb)%Intdiag%dv3dt(:,:,8) = IPD_Data(nb)%Intdiag%dv3dt(:,:,8) & - + (IPD_Data(nb)%Statein%vgrs - IPD_Data(nb)%Stateout%gv0) - IPD_Data(nb)%Intdiag%dt3dt(:,:,11) = IPD_Data(nb)%Intdiag%dt3dt(:,:,11) & - + (IPD_Data(nb)%Statein%tgrs - IPD_Data(nb)%Stateout%gt0) + GFS_data(nb)%Intdiag%du3dt(:,:,8) = GFS_data(nb)%Intdiag%du3dt(:,:,8) & + + (GFS_data(nb)%Statein%ugrs - GFS_data(nb)%Stateout%gu0) + GFS_data(nb)%Intdiag%dv3dt(:,:,8) = GFS_data(nb)%Intdiag%dv3dt(:,:,8) & + + (GFS_data(nb)%Statein%vgrs - GFS_data(nb)%Stateout%gv0) + GFS_data(nb)%Intdiag%dt3dt(:,:,11) = GFS_data(nb)%Intdiag%dt3dt(:,:,11) & + + (GFS_data(nb)%Statein%tgrs - GFS_data(nb)%Stateout%gt0) enddo - if (IPD_Control%qdiag3d) then + if (GFS_control%qdiag3d) then do nb = 1,Atm_block%nblks - IPD_Data(nb)%Intdiag%dq3dt(:,:,12) = IPD_Data(nb)%Intdiag%dq3dt(:,:,12) & - + (IPD_Data(nb)%Statein%qgrs(:,:,IPD_Control%ntqv) - IPD_Data(nb)%Stateout%gq0(:,:,IPD_Control%ntqv)) - IPD_Data(nb)%Intdiag%dq3dt(:,:,13) = IPD_Data(nb)%Intdiag%dq3dt(:,:,13) & - + (IPD_Data(nb)%Statein%qgrs(:,:,IPD_Control%ntoz) - IPD_Data(nb)%Stateout%gq0(:,:,IPD_Control%ntoz)) + GFS_data(nb)%Intdiag%dq3dt(:,:,12) = GFS_data(nb)%Intdiag%dq3dt(:,:,12) & + + (GFS_data(nb)%Statein%qgrs(:,:,GFS_control%ntqv) - GFS_data(nb)%Stateout%gq0(:,:,GFS_control%ntqv)) + GFS_data(nb)%Intdiag%dq3dt(:,:,13) = GFS_data(nb)%Intdiag%dq3dt(:,:,13) & + + (GFS_data(nb)%Statein%qgrs(:,:,GFS_control%ntoz) - GFS_data(nb)%Stateout%gq0(:,:,GFS_control%ntoz)) enddo endif endif @@ -345,27 +307,16 @@ subroutine update_atmos_radiation_physics (Atmos) !--- execute the IPD atmospheric radiation subcomponent (RRTM) call mpp_clock_begin(radClock) -#ifdef CCPP ! Performance improvement. Only enter if it is time to call the radiation physics. - if (IPD_Control%lsswr .or. IPD_Control%lslwr) then + if (GFS_control%lsswr .or. GFS_control%lslwr) then call CCPP_step (step="radiation", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP radiation step failed') endif -#else - Func0d => radiation_step1 -!$OMP parallel do default (none) & -!$OMP schedule (dynamic,1), & -!$OMP shared (Atm_block, IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, Func0d) & -!$OMP private (nb) - do nb = 1,Atm_block%nblks - call IPD_step (IPD_Control, IPD_Data(nb:nb), IPD_Diag, IPD_Restart, IPD_func0d=Func0d) - enddo -#endif call mpp_clock_end(radClock) if (chksum_debug) then - if (mpp_pe() == mpp_root_pe()) print *,'RADIATION STEP ', IPD_Control%kdt, IPD_Control%fhour - call FV3GFS_IPD_checksum(IPD_Control, IPD_Data, Atm_block) + if (mpp_pe() == mpp_root_pe()) print *,'RADIATION STEP ', GFS_control%kdt, GFS_control%fhour + call FV3GFS_IPD_checksum(GFS_control, GFS_data, Atm_block) endif if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "physics driver" @@ -373,24 +324,13 @@ subroutine update_atmos_radiation_physics (Atmos) !--- execute the IPD atmospheric physics step1 subcomponent (main physics driver) call mpp_clock_begin(physClock) -#ifdef CCPP call CCPP_step (step="physics", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP physics step failed') -#else - Func0d => physics_step1 -!$OMP parallel do default (none) & -!$OMP schedule (dynamic,1), & -!$OMP shared (Atm_block, IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, Func0d) & -!$OMP private (nb) - do nb = 1,Atm_block%nblks - call IPD_step (IPD_Control, IPD_Data(nb:nb), IPD_Diag, IPD_Restart, IPD_func0d=Func0d) - enddo -#endif call mpp_clock_end(physClock) if (chksum_debug) then - if (mpp_pe() == mpp_root_pe()) print *,'PHYSICS STEP1 ', IPD_Control%kdt, IPD_Control%fhour - call FV3GFS_IPD_checksum(IPD_Control, IPD_Data, Atm_block) + if (mpp_pe() == mpp_root_pe()) print *,'PHYSICS STEP1 ', GFS_control%kdt, GFS_control%fhour + call FV3GFS_IPD_checksum(GFS_control, GFS_data, Atm_block) endif if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "stochastic physics driver" @@ -398,42 +338,28 @@ subroutine update_atmos_radiation_physics (Atmos) !--- execute the IPD atmospheric physics step2 subcomponent (stochastic physics driver) call mpp_clock_begin(physClock) -#ifdef CCPP call CCPP_step (step="stochastics", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP stochastics step failed') -#else - Func0d => physics_step2 -!$OMP parallel do default (none) & -!$OMP schedule (dynamic,1), & -!$OMP shared (Atm_block, IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, Func0d) & -!$OMP private (nb) - do nb = 1,Atm_block%nblks - call IPD_step (IPD_Control, IPD_Data(nb:nb), IPD_Diag, IPD_Restart, IPD_func0d=Func0d) - enddo -#endif call mpp_clock_end(physClock) if (chksum_debug) then - if (mpp_pe() == mpp_root_pe()) print *,'PHYSICS STEP2 ', IPD_Control%kdt, IPD_Control%fhour - call FV3GFS_IPD_checksum(IPD_Control, IPD_Data, Atm_block) + if (mpp_pe() == mpp_root_pe()) print *,'PHYSICS STEP2 ', GFS_control%kdt, GFS_control%fhour + call FV3GFS_IPD_checksum(GFS_control, GFS_data, Atm_block) endif - call getiauforcing(IPD_Control,IAU_data) + call getiauforcing(GFS_control,IAU_data) if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "end of radiation and physics step" -#ifdef CCPP !--- execute the IPD atmospheric timestep finalize step call mpp_clock_begin(setupClock) call CCPP_step (step="timestep_finalize", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP timestep_finalize step failed') call mpp_clock_end(setupClock) -#endif endif -#ifdef CCPP ! Update flag for first time step of time integration - IPD_Control%first_time_step = .false. -#endif + GFS_control%first_time_step = .false. + !----------------------------------------------------------------------- end subroutine update_atmos_radiation_physics ! @@ -451,9 +377,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) #ifdef _OPENMP use omp_lib #endif -#ifdef CCPP use fv_mp_mod, only: commglobal -#endif use mpp_mod, only: mpp_npes type (atmos_data_type), intent(inout) :: Atmos @@ -494,12 +418,6 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !----------------------------------------------------------------------- ! initialize atmospheric model ----- -#ifndef CCPP -!---------- initialize atmospheric dynamics ------- - call atmosphere_init (Atmos%Time_init, Atmos%Time, Atmos%Time_step,& - Atmos%grid, Atmos%area) -#endif - IF ( file_exist('input.nml')) THEN #ifdef INTERNAL_FILE_NML read(input_nml_file, nml=atmos_model_nml, iostat=io) @@ -515,12 +433,10 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) #endif endif -#ifdef CCPP !---------- initialize atmospheric dynamics after reading the namelist ------- !---------- (need name of CCPP suite definition file from input.nml) --------- call atmosphere_init (Atmos%Time_init, Atmos%Time, Atmos%Time_step,& Atmos%grid, Atmos%area) -#endif !----------------------------------------------------------------------- call atmosphere_resolution (nlon, nlat, global=.false.) @@ -544,7 +460,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) blocksize, block_message) allocate(DYCORE_Data(Atm_block%nblks)) - allocate(IPD_Data(Atm_block%nblks)) + allocate(GFS_data(Atm_block%nblks)) #ifdef _OPENMP nthrds = omp_get_max_threads() @@ -552,7 +468,6 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) nthrds = 1 #endif -#ifdef CCPP ! This logic deals with non-uniform block sizes for CCPP. ! When non-uniform block sizes are used, it is required ! that only the last block has a different (smaller) @@ -564,18 +479,16 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) ! runs over the last, smaller block. if (minval(Atm_block%blksz)==maxval(Atm_block%blksz)) then non_uniform_blocks = .false. - allocate(IPD_Interstitial(nthrds)) + allocate(GFS_interstitial(nthrds)) else if (all(minloc(Atm_block%blksz)==(/size(Atm_block%blksz)/))) then non_uniform_blocks = .true. - allocate(IPD_Interstitial(nthrds+1)) + allocate(GFS_interstitial(nthrds+1)) else call mpp_error(FATAL, 'For non-uniform blocksizes, only the last element ' // & 'in Atm_block%blksz can be different from the others') end if -#endif - -!--- update IPD_Control%jdat(8) +!--- update GFS_control%jdat(8) bdat(:) = 0 call get_date (Time_init, bdat(1), bdat(2), bdat(3), & bdat(5), bdat(6), bdat(7)) @@ -614,10 +527,8 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) Init_parm%xlat => Atmos%lat Init_parm%area => Atmos%area Init_parm%tracer_names => tracer_names -#ifdef CCPP Init_parm%restart = Atm(mygrid)%flagstruct%warm_start Init_parm%hydrostatic = Atm(mygrid)%flagstruct%hydrostatic -#endif #ifdef INTERNAL_FILE_NML Init_parm%input_nml_file => input_nml_file @@ -631,24 +542,19 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) endif #endif -#ifdef CCPP - call IPD_initialize (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, & - IPD_Interstitial, commglobal, mpp_npes(), Init_parm) + call IPD_initialize (GFS_control, GFS_data, IPD_Diag, IPD_Restart, & + GFS_interstitial, commglobal, mpp_npes(), Init_parm) !--- Initialize stochastic physics pattern generation / cellular automata for first time step - call stochastic_physics_wrapper(IPD_Control, IPD_Data, Atm_block, ierr) + call stochastic_physics_wrapper(GFS_control, GFS_data, Atm_block, ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed') -#else - call IPD_initialize (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, Init_parm) -#endif - Atmos%Diag => IPD_Diag - Atm(mygrid)%flagstruct%do_skeb = IPD_Control%do_skeb + Atm(mygrid)%flagstruct%do_skeb = GFS_control%do_skeb ! initialize the IAU module - call iau_initialize (IPD_Control,IAU_data,Init_parm) + call iau_initialize (GFS_control,IAU_data,Init_parm) Init_parm%blksz => null() Init_parm%ak => null() @@ -660,40 +566,34 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) deallocate (tracer_names) !--- update tracers in FV3 with any initialized during the physics/radiation init phase -!rab call atmosphere_tracer_postinit (IPD_Data, Atm_block) +!rab call atmosphere_tracer_postinit (GFS_data, Atm_block) call atmosphere_nggps_diag (Time, init=.true.) - call FV3GFS_diag_register (IPD_Diag, Time, Atm_block, IPD_Control, Atmos%lon, Atmos%lat, Atmos%axes) - call IPD_initialize_rst (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, Init_parm) -#ifdef CCPP - call FV3GFS_restart_read (IPD_Data, IPD_Restart, Atm_block, IPD_Control, Atmos%domain, Atm(mygrid)%flagstruct%warm_start) -#else - call FV3GFS_restart_read (IPD_Data, IPD_Restart, Atm_block, IPD_Control, Atmos%domain) -#endif + call FV3GFS_diag_register (IPD_Diag, Time, Atm_block, GFS_control, Atmos%lon, Atmos%lat, Atmos%axes) + call IPD_initialize_rst (GFS_control, GFS_data, IPD_Diag, IPD_Restart, Init_parm) + call FV3GFS_restart_read (GFS_data, IPD_Restart, Atm_block, GFS_control, Atmos%domain, Atm(mygrid)%flagstruct%warm_start) - ! Populate the IPD_Data%Statein container with the prognostic state + ! Populate the GFS_data%Statein container with the prognostic state ! in Atm_block, which contains the initial conditions/restart data. - call atmos_phys_driver_statein (IPD_data, Atm_block, flip_vc) + call atmos_phys_driver_statein (GFS_data, Atm_block, flip_vc) ! When asked to calculate 3-dim. tendencies, set Stateout variables to ! Statein variables here in order to capture the first call to dycore - if (IPD_Control%ldiag3d) then + if (GFS_control%ldiag3d) then do nb = 1,Atm_block%nblks - IPD_Data(nb)%Stateout%gu0 = IPD_Data(nb)%Statein%ugrs - IPD_Data(nb)%Stateout%gv0 = IPD_Data(nb)%Statein%vgrs - IPD_Data(nb)%Stateout%gt0 = IPD_Data(nb)%Statein%tgrs - IPD_Data(nb)%Stateout%gq0 = IPD_Data(nb)%Statein%qgrs + GFS_data(nb)%Stateout%gu0 = GFS_data(nb)%Statein%ugrs + GFS_data(nb)%Stateout%gv0 = GFS_data(nb)%Statein%vgrs + GFS_data(nb)%Stateout%gt0 = GFS_data(nb)%Statein%tgrs + GFS_data(nb)%Stateout%gq0 = GFS_data(nb)%Statein%qgrs enddo endif -#ifdef CCPP ! Initialize the CCPP framework call CCPP_step (step="init", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP init step failed') ! Initialize the CCPP physics call CCPP_step (step="physics_init", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP physics_init step failed') -#endif !--- set the initial diagnostic timestamp diag_time = Time @@ -757,15 +657,14 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) call atmosphere_get_bottom_layer (Atm_block, DYCORE_Data) !if in coupled mode, set up coupled fields - if (IPD_Control%cplflx .or. IPD_Control%cplwav) then + if (GFS_control%cplflx .or. GFS_control%cplwav) then if (mpp_pe() == mpp_root_pe()) print *,'COUPLING: IPD layer' call setup_exportdata(ierr) endif -#ifdef CCPP ! Set flag for first time step of time integration - IPD_Control%first_time_step = .true. -#endif + GFS_control%first_time_step = .true. + !----------------------------------------------------------------------- end subroutine atmos_model_init ! @@ -814,7 +713,7 @@ subroutine atmos_model_exchange_phase_1 (Atmos, rc) if (present(rc)) rc = ESMF_SUCCESS !--- if coupled, exchange coupled fields - if( IPD_Control%cplchm ) then + if( GFS_control%cplchm ) then ! -- export fields to chemistry call update_atmos_chemistry('export', rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return @@ -850,7 +749,7 @@ subroutine atmos_model_exchange_phase_2 (Atmos, rc) if (present(rc)) rc = ESMF_SUCCESS !--- if coupled, exchange coupled fields - if( IPD_Control%cplchm ) then + if( GFS_control%cplchm ) then ! -- import fields from chemistry call update_atmos_chemistry('import', rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return @@ -875,14 +774,14 @@ subroutine update_atmos_model_state (Atmos) call set_atmosphere_pelist() call mpp_clock_begin(fv3Clock) call mpp_clock_begin(updClock) - call atmosphere_state_update (Atmos%Time, IPD_Data, IAU_Data, Atm_block, flip_vc) + call atmosphere_state_update (Atmos%Time, GFS_data, IAU_Data, Atm_block, flip_vc) call mpp_clock_end(updClock) call mpp_clock_end(fv3Clock) if (chksum_debug) then - if (mpp_pe() == mpp_root_pe()) print *,'UPDATE STATE ', IPD_Control%kdt, IPD_Control%fhour - if (mpp_pe() == mpp_root_pe()) print *,'in UPDATE STATE ', size(IPD_Data(1)%SfcProp%tsfc),'nblks=',Atm_block%nblks - call FV3GFS_IPD_checksum(IPD_Control, IPD_Data, Atm_block) + if (mpp_pe() == mpp_root_pe()) print *,'UPDATE STATE ', GFS_control%kdt, GFS_control%fhour + if (mpp_pe() == mpp_root_pe()) print *,'in UPDATE STATE ', size(GFS_data(1)%SfcProp%tsfc),'nblks=',Atm_block%nblks + call FV3GFS_IPD_checksum(GFS_control, GFS_data, Atm_block) endif !--- advance time --- @@ -891,7 +790,7 @@ subroutine update_atmos_model_state (Atmos) call get_time (Atmos%Time - diag_time, isec) call get_time (Atmos%Time - Atmos%Time_init, seconds) call atmosphere_nggps_diag(Atmos%Time,ltavg=.true.,avg_max_length=avg_max_length) - if (ANY(nint(fdiag(:)*3600.0) == seconds) .or. (IPD_Control%kdt == first_kdt) .or. nsout > 0) then + if (ANY(nint(fdiag(:)*3600.0) == seconds) .or. (GFS_control%kdt == first_kdt) .or. nsout > 0) then if (mpp_pe() == mpp_root_pe()) write(6,*) "---isec,seconds",isec,seconds time_int = real(isec) if(Atmos%iau_offset > zero) then @@ -911,13 +810,13 @@ subroutine update_atmos_model_state (Atmos) endif if (mpp_pe() == mpp_root_pe()) write(6,*) ' gfs diags time since last bucket empty: ',time_int/3600.,'hrs' call atmosphere_nggps_diag(Atmos%Time) - call FV3GFS_diag_output(Atmos%Time, IPD_DIag, Atm_block, IPD_Control%nx, IPD_Control%ny, & - IPD_Control%levs, 1, 1, 1.0_IPD_kind_phys, time_int, time_intfull, & - IPD_Control%fhswr, IPD_Control%fhlwr) - if (nint(IPD_Control%fhzero) > 0) then - if (mod(isec,3600*nint(IPD_Control%fhzero)) == 0) diag_time = Atmos%Time + call FV3GFS_diag_output(Atmos%Time, IPD_DIag, Atm_block, GFS_control%nx, GFS_control%ny, & + GFS_control%levs, 1, 1, 1.0_IPD_kind_phys, time_int, time_intfull, & + GFS_control%fhswr, GFS_control%fhlwr) + if (nint(GFS_control%fhzero) > 0) then + if (mod(isec,3600*nint(GFS_control%fhzero)) == 0) diag_time = Atmos%Time else - if (mod(isec,nint(3600*IPD_Control%fhzero)) == 0) diag_time = Atmos%Time + if (mod(isec,nint(3600*GFS_control%fhzero)) == 0) diag_time = Atmos%Time endif call diag_send_complete_instant (Atmos%Time) endif @@ -929,7 +828,7 @@ subroutine update_atmos_model_state (Atmos) call atmosphere_get_bottom_layer (Atm_block, DYCORE_Data) !if in coupled mode, set up coupled fields - if (IPD_Control%cplflx .or. IPD_Control%cplwav) then + if (GFS_control%cplflx .or. GFS_control%cplwav) then call setup_exportdata(rc) endif @@ -962,30 +861,25 @@ end subroutine update_atmos_model_state subroutine atmos_model_end (Atmos) type (atmos_data_type), intent(inout) :: Atmos !---local variables - integer :: idx, seconds -#ifdef CCPP - integer :: ierr -#endif + integer :: idx, seconds, ierr !----------------------------------------------------------------------- !---- termination routine for atmospheric model ---- call atmosphere_end (Atmos % Time, Atmos%grid, restart_endfcst) - call stochastic_physics_wrapper_end(IPD_Control) + call stochastic_physics_wrapper_end(GFS_control) if(restart_endfcst) then - call FV3GFS_restart_write (IPD_Data, IPD_Restart, Atm_block, & - IPD_Control, Atmos%domain) + call FV3GFS_restart_write (GFS_data, IPD_Restart, Atm_block, & + GFS_control, Atmos%domain) endif -#ifdef CCPP ! Fast physics (from dynamics) are finalized in atmosphere_end above; ! standard/slow physics (from IPD) are finalized in CCPP_step 'finalize'. ! The CCPP framework for all cdata structures is finalized in CCPP_step 'finalize'. call CCPP_step (step="finalize", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP finalize step failed') -#endif end subroutine atmos_model_end @@ -1000,8 +894,8 @@ subroutine atmos_model_restart(Atmos, timestamp) character(len=*), intent(in) :: timestamp call atmosphere_restart(timestamp) - call FV3GFS_restart_write (IPD_Data, IPD_Restart, Atm_block, & - IPD_Control, Atmos%domain, timestamp) + call FV3GFS_restart_write (GFS_data, IPD_Restart, Atm_block, & + GFS_control, Atmos%domain, timestamp) end subroutine atmos_model_restart ! @@ -1027,9 +921,9 @@ subroutine get_atmos_model_ungridded_dim(nlev, nsoillev, ntracers, & !--- number of soil levels if (present(nsoillev)) then nsoillev = 0 - if (allocated(IPD_Data)) then - if (associated(IPD_Data(1)%Sfcprop%slc)) & - nsoillev = size(IPD_Data(1)%Sfcprop%slc, dim=2) + if (allocated(GFS_data)) then + if (associated(GFS_data(1)%Sfcprop%slc)) & + nsoillev = size(GFS_data(1)%Sfcprop%slc, dim=2) end if end if @@ -1039,17 +933,17 @@ subroutine get_atmos_model_ungridded_dim(nlev, nsoillev, ntracers, & !--- number of tracers used in chemistry diagnostic output if (present(num_diag_down_flux)) then num_diag_down_flux = 0 - if (associated(IPD_Data(1)%IntDiag%sedim)) & - num_diag_down_flux = size(IPD_Data(1)%IntDiag%sedim, dim=2) + if (associated(GFS_data(1)%IntDiag%sedim)) & + num_diag_down_flux = size(GFS_data(1)%IntDiag%sedim, dim=2) if (present(num_diag_type_down_flux)) then num_diag_type_down_flux = 0 - if (associated(IPD_Data(1)%IntDiag%sedim)) & + if (associated(GFS_data(1)%IntDiag%sedim)) & num_diag_type_down_flux = num_diag_type_down_flux + 1 - if (associated(IPD_Data(1)%IntDiag%drydep)) & + if (associated(GFS_data(1)%IntDiag%drydep)) & num_diag_type_down_flux = num_diag_type_down_flux + 1 - if (associated(IPD_Data(1)%IntDiag%wetdpl)) & + if (associated(GFS_data(1)%IntDiag%wetdpl)) & num_diag_type_down_flux = num_diag_type_down_flux + 1 - if (associated(IPD_Data(1)%IntDiag%wetdpc)) & + if (associated(GFS_data(1)%IntDiag%wetdpc)) & num_diag_type_down_flux = num_diag_type_down_flux + 1 end if end if @@ -1057,25 +951,25 @@ subroutine get_atmos_model_ungridded_dim(nlev, nsoillev, ntracers, & !--- number of bins for chemistry diagnostic output if (present(num_diag_sfc_emis_flux)) then num_diag_sfc_emis_flux = 0 - if (associated(IPD_Data(1)%IntDiag%duem)) & - num_diag_sfc_emis_flux = size(IPD_Data(1)%IntDiag%duem, dim=2) - if (associated(IPD_Data(1)%IntDiag%ssem)) & + if (associated(GFS_data(1)%IntDiag%duem)) & + num_diag_sfc_emis_flux = size(GFS_data(1)%IntDiag%duem, dim=2) + if (associated(GFS_data(1)%IntDiag%ssem)) & num_diag_sfc_emis_flux = & - num_diag_sfc_emis_flux + size(IPD_Data(1)%IntDiag%ssem, dim=2) + num_diag_sfc_emis_flux + size(GFS_data(1)%IntDiag%ssem, dim=2) end if !--- number of tracers used in emission diagnostic output if (present(num_diag_burn_emis_flux)) then num_diag_burn_emis_flux = 0 - if (associated(IPD_Data(1)%IntDiag%abem)) & - num_diag_burn_emis_flux = size(IPD_Data(1)%IntDiag%abem, dim=2) + if (associated(GFS_data(1)%IntDiag%abem)) & + num_diag_burn_emis_flux = size(GFS_data(1)%IntDiag%abem, dim=2) end if !--- number of tracers used in column mass density diagnostics if (present(num_diag_cmass)) then num_diag_cmass = 0 - if (associated(IPD_Data(1)%IntDiag%aecm)) & - num_diag_cmass = size(IPD_Data(1)%IntDiag%aecm, dim=2) + if (associated(GFS_data(1)%IntDiag%aecm)) & + num_diag_cmass = size(GFS_data(1)%IntDiag%aecm, dim=2) end if end subroutine get_atmos_model_ungridded_dim @@ -1095,7 +989,7 @@ end subroutine get_atmos_model_ungridded_dim ! tracers must match their order in the chemistry component. ! ! Requires: -! IPD_Data +! GFS_data ! Atm_block ! subroutine update_atmos_chemistry(state, rc) @@ -1163,17 +1057,17 @@ subroutine update_atmos_chemistry(state, rc) nte = nt !--- if chemical tracers are present, set bounds appropriately - if (IPD_Control%ntchm > 0) then - if (IPD_Control%ntchs /= NO_TRACER) then - ntb = IPD_Control%ntchs - nte = IPD_Control%ntchm + ntb - 1 + if (GFS_control%ntchm > 0) then + if (GFS_control%ntchs /= NO_TRACER) then + ntb = GFS_control%ntchs + nte = GFS_control%ntchm + ntb - 1 end if end if !--- tracer concentrations do it = ntb, nte !$OMP parallel do default (none) & -!$OMP shared (it, nk, nj, ni, Atm_block, IPD_Data, q) & +!$OMP shared (it, nk, nj, ni, Atm_block, GFS_data, q) & !$OMP private (k, j, jb, i, ib, nb, ix) do k = 1, nk do j = 1, nj @@ -1182,7 +1076,7 @@ subroutine update_atmos_chemistry(state, rc) ib = i + Atm_block%isc - 1 nb = Atm_block%blkno(ib,jb) ix = Atm_block%ixp(ib,jb) - IPD_Data(nb)%Stateout%gq0(ix,k,it) = q(i,j,k,it) + GFS_data(nb)%Stateout%gq0(ix,k,it) = q(i,j,k,it) enddo enddo enddo @@ -1192,7 +1086,7 @@ subroutine update_atmos_chemistry(state, rc) !--- (a) column mass densities do it = 1, size(qm, dim=3) !$OMP parallel do default (none) & -!$OMP shared (it, nj, ni, Atm_block, IPD_Data, qm) & +!$OMP shared (it, nj, ni, Atm_block, GFS_data, qm) & !$OMP private (j, jb, i, ib, nb, ix) do j = 1, nj jb = j + Atm_block%jsc - 1 @@ -1200,17 +1094,17 @@ subroutine update_atmos_chemistry(state, rc) ib = i + Atm_block%isc - 1 nb = Atm_block%blkno(ib,jb) ix = Atm_block%ixp(ib,jb) - IPD_Data(nb)%IntDiag%aecm(ix,it) = qm(i,j,it) + GFS_data(nb)%IntDiag%aecm(ix,it) = qm(i,j,it) enddo enddo enddo !--- (b) dust and sea salt emissions - ntb = size(IPD_Data(1)%IntDiag%duem, dim=2) + ntb = size(GFS_data(1)%IntDiag%duem, dim=2) nte = size(qu, dim=3) do it = 1, min(ntb, nte) !$OMP parallel do default (none) & -!$OMP shared (it, nj, ni, Atm_block, IPD_Data, qu) & +!$OMP shared (it, nj, ni, Atm_block, GFS_data, qu) & !$OMP private (j, jb, i, ib, nb, ix) do j = 1, nj jb = j + Atm_block%jsc - 1 @@ -1218,16 +1112,16 @@ subroutine update_atmos_chemistry(state, rc) ib = i + Atm_block%isc - 1 nb = Atm_block%blkno(ib,jb) ix = Atm_block%ixp(ib,jb) - IPD_Data(nb)%IntDiag%duem(ix,it) = qu(i,j,it) + GFS_data(nb)%IntDiag%duem(ix,it) = qu(i,j,it) enddo enddo enddo nte = nte - ntb if (nte > 0) then - do it = 1, min(size(IPD_Data(1)%IntDiag%ssem, dim=2), nte) + do it = 1, min(size(GFS_data(1)%IntDiag%ssem, dim=2), nte) !$OMP parallel do default (none) & -!$OMP shared (it, nj, ni, ntb, Atm_block, IPD_Data, qu) & +!$OMP shared (it, nj, ni, ntb, Atm_block, GFS_data, qu) & !$OMP private (j, jb, i, ib, nb, ix) do j = 1, nj jb = j + Atm_block%jsc - 1 @@ -1235,7 +1129,7 @@ subroutine update_atmos_chemistry(state, rc) ib = i + Atm_block%isc - 1 nb = Atm_block%blkno(ib,jb) ix = Atm_block%ixp(ib,jb) - IPD_Data(nb)%IntDiag%ssem(ix,it) = qu(i,j,it+ntb) + GFS_data(nb)%IntDiag%ssem(ix,it) = qu(i,j,it+ntb) enddo enddo enddo @@ -1244,7 +1138,7 @@ subroutine update_atmos_chemistry(state, rc) !--- (c) sedimentation and dry/wet deposition do it = 1, size(qd, dim=3) !$OMP parallel do default (none) & -!$OMP shared (it, nj, ni, Atm_block, IPD_Data, qd) & +!$OMP shared (it, nj, ni, Atm_block, GFS_data, qd) & !$OMP private (j, jb, i, ib, nb, ix) do j = 1, nj jb = j + Atm_block%jsc - 1 @@ -1252,10 +1146,10 @@ subroutine update_atmos_chemistry(state, rc) ib = i + Atm_block%isc - 1 nb = Atm_block%blkno(ib,jb) ix = Atm_block%ixp(ib,jb) - IPD_Data(nb)%IntDiag%sedim (ix,it) = qd(i,j,it,1) - IPD_Data(nb)%IntDiag%drydep(ix,it) = qd(i,j,it,2) - IPD_Data(nb)%IntDiag%wetdpl(ix,it) = qd(i,j,it,3) - IPD_Data(nb)%IntDiag%wetdpc(ix,it) = qd(i,j,it,4) + GFS_data(nb)%IntDiag%sedim (ix,it) = qd(i,j,it,1) + GFS_data(nb)%IntDiag%drydep(ix,it) = qd(i,j,it,2) + GFS_data(nb)%IntDiag%wetdpl(ix,it) = qd(i,j,it,3) + GFS_data(nb)%IntDiag%wetdpc(ix,it) = qd(i,j,it,4) enddo enddo enddo @@ -1263,7 +1157,7 @@ subroutine update_atmos_chemistry(state, rc) !--- (d) anthropogenic and biomass burning emissions do it = 1, size(qb, dim=3) !$OMP parallel do default (none) & -!$OMP shared (it, nj, ni, Atm_block, IPD_Data, qb) & +!$OMP shared (it, nj, ni, Atm_block, GFS_data, qb) & !$OMP private (j, jb, i, ib, nb, ix) do j = 1, nj jb = j + Atm_block%jsc - 1 @@ -1271,12 +1165,12 @@ subroutine update_atmos_chemistry(state, rc) ib = i + Atm_block%isc - 1 nb = Atm_block%blkno(ib,jb) ix = Atm_block%ixp(ib,jb) - IPD_Data(nb)%IntDiag%abem(ix,it) = qb(i,j,it) + GFS_data(nb)%IntDiag%abem(ix,it) = qb(i,j,it) enddo enddo enddo - if (IPD_Control%debug) then + if (GFS_control%debug) then write(6,'("update_atmos: ",a,": qgrs - min/max/avg",3g16.6)') & trim(state), minval(q), maxval(q), sum(q)/size(q) write(6,'("update_atmos: ",a,": qup - min/max/avg",3g16.6)') & @@ -1401,7 +1295,7 @@ subroutine update_atmos_chemistry(state, rc) !--- handle all three-dimensional variables !$OMP parallel do default (none) & -!$OMP shared (nk, nj, ni, Atm_block, IPD_Data, prsi, phii, prsl, phil, temp, ua, va, vvl, dkt, dqdt) & +!$OMP shared (nk, nj, ni, Atm_block, GFS_data, prsi, phii, prsl, phil, temp, ua, va, vvl, dkt, dqdt) & !$OMP private (k, j, jb, i, ib, nb, ix) do k = 1, nk do j = 1, nj @@ -1411,17 +1305,17 @@ subroutine update_atmos_chemistry(state, rc) nb = Atm_block%blkno(ib,jb) ix = Atm_block%ixp(ib,jb) !--- interface values - prsi(i,j,k) = IPD_Data(nb)%Statein%prsi(ix,k) - phii(i,j,k) = IPD_Data(nb)%Statein%phii(ix,k) + prsi(i,j,k) = GFS_data(nb)%Statein%prsi(ix,k) + phii(i,j,k) = GFS_data(nb)%Statein%phii(ix,k) !--- layer values - prsl(i,j,k) = IPD_Data(nb)%Statein%prsl(ix,k) - phil(i,j,k) = IPD_Data(nb)%Statein%phil(ix,k) - temp(i,j,k) = IPD_Data(nb)%Stateout%gt0(ix,k) - ua (i,j,k) = IPD_Data(nb)%Stateout%gu0(ix,k) - va (i,j,k) = IPD_Data(nb)%Stateout%gv0(ix,k) - vvl (i,j,k) = IPD_Data(nb)%Statein%vvl (ix,k) - dkt (i,j,k) = IPD_Data(nb)%Coupling%dkt(ix,k) - dqdt(i,j,k) = IPD_Data(nb)%Coupling%dqdti(ix,k) + prsl(i,j,k) = GFS_data(nb)%Statein%prsl(ix,k) + phil(i,j,k) = GFS_data(nb)%Statein%phil(ix,k) + temp(i,j,k) = GFS_data(nb)%Stateout%gt0(ix,k) + ua (i,j,k) = GFS_data(nb)%Stateout%gu0(ix,k) + va (i,j,k) = GFS_data(nb)%Stateout%gv0(ix,k) + vvl (i,j,k) = GFS_data(nb)%Statein%vvl (ix,k) + dkt (i,j,k) = GFS_data(nb)%Coupling%dkt(ix,k) + dqdt(i,j,k) = GFS_data(nb)%Coupling%dqdti(ix,k) enddo enddo enddo @@ -1435,15 +1329,15 @@ subroutine update_atmos_chemistry(state, rc) ib = i + Atm_block%isc - 1 nb = Atm_block%blkno(ib,jb) ix = Atm_block%ixp(ib,jb) - prsi(i,j,k) = IPD_Data(nb)%Statein%prsi(ix,k) - phii(i,j,k) = IPD_Data(nb)%Statein%phii(ix,k) + prsi(i,j,k) = GFS_data(nb)%Statein%prsi(ix,k) + phii(i,j,k) = GFS_data(nb)%Statein%phii(ix,k) enddo enddo !--- tracers quantities do it = 1, nt !$OMP parallel do default (none) & -!$OMP shared (it, nk, nj, ni, Atm_block, IPD_Data, q) & +!$OMP shared (it, nk, nj, ni, Atm_block, GFS_data, q) & !$OMP private (k, j, jb, i, ib, nb, ix) do k = 1, nk do j = 1, nj @@ -1452,14 +1346,14 @@ subroutine update_atmos_chemistry(state, rc) ib = i + Atm_block%isc - 1 nb = Atm_block%blkno(ib,jb) ix = Atm_block%ixp(ib,jb) - q(i,j,k,it) = IPD_Data(nb)%Stateout%gq0(ix,k,it) + q(i,j,k,it) = GFS_data(nb)%Stateout%gq0(ix,k,it) enddo enddo enddo enddo !$OMP parallel do default (none) & -!$OMP shared (nj, ni, Atm_block, IPD_Data, & +!$OMP shared (nj, ni, Atm_block, GFS_data, & !$OMP hpbl, area, stype, rainc, rain, uustar, sfcdsw, & !$OMP slmsk, snowd, tsfc, shfsfc, vtype, vfrac, zorl, slc) & !$OMP private (j, jb, i, ib, nb, ix) @@ -1469,28 +1363,28 @@ subroutine update_atmos_chemistry(state, rc) ib = i + Atm_block%isc - 1 nb = Atm_block%blkno(ib,jb) ix = Atm_block%ixp(ib,jb) - hpbl(i,j) = IPD_Data(nb)%Tbd%hpbl(ix) - area(i,j) = IPD_Data(nb)%Grid%area(ix) - stype(i,j) = IPD_Data(nb)%Sfcprop%stype(ix) - rainc(i,j) = IPD_Data(nb)%Coupling%rainc_cpl(ix) - rain(i,j) = IPD_Data(nb)%Coupling%rain_cpl(ix) & - + IPD_Data(nb)%Coupling%snow_cpl(ix) - uustar(i,j) = IPD_Data(nb)%Sfcprop%uustar(ix) - sfcdsw(i,j) = IPD_Data(nb)%Coupling%sfcdsw(ix) - slmsk(i,j) = IPD_Data(nb)%Sfcprop%slmsk(ix) - snowd(i,j) = IPD_Data(nb)%Sfcprop%snowd(ix) - tsfc(i,j) = IPD_Data(nb)%Sfcprop%tsfc(ix) - shfsfc(i,j) = IPD_Data(nb)%Coupling%ushfsfci(ix) - vtype(i,j) = IPD_Data(nb)%Sfcprop%vtype(ix) - vfrac(i,j) = IPD_Data(nb)%Sfcprop%vfrac(ix) - zorl(i,j) = IPD_Data(nb)%Sfcprop%zorl(ix) - slc(i,j,:) = IPD_Data(nb)%Sfcprop%slc(ix,:) + hpbl(i,j) = GFS_data(nb)%Tbd%hpbl(ix) + area(i,j) = GFS_data(nb)%Grid%area(ix) + stype(i,j) = GFS_data(nb)%Sfcprop%stype(ix) + rainc(i,j) = GFS_data(nb)%Coupling%rainc_cpl(ix) + rain(i,j) = GFS_data(nb)%Coupling%rain_cpl(ix) & + + GFS_data(nb)%Coupling%snow_cpl(ix) + uustar(i,j) = GFS_data(nb)%Sfcprop%uustar(ix) + sfcdsw(i,j) = GFS_data(nb)%Coupling%sfcdsw(ix) + slmsk(i,j) = GFS_data(nb)%Sfcprop%slmsk(ix) + snowd(i,j) = GFS_data(nb)%Sfcprop%snowd(ix) + tsfc(i,j) = GFS_data(nb)%Sfcprop%tsfc(ix) + shfsfc(i,j) = GFS_data(nb)%Coupling%ushfsfci(ix) + vtype(i,j) = GFS_data(nb)%Sfcprop%vtype(ix) + vfrac(i,j) = GFS_data(nb)%Sfcprop%vfrac(ix) + zorl(i,j) = GFS_data(nb)%Sfcprop%zorl(ix) + slc(i,j,:) = GFS_data(nb)%Sfcprop%slc(ix,:) enddo enddo ! -- zero out accumulated fields !$OMP parallel do default (none) & -!$OMP shared (nj, ni, Atm_block, IPD_Control, IPD_Data) & +!$OMP shared (nj, ni, Atm_block, GFS_control, GFS_data) & !$OMP private (j, jb, i, ib, nb, ix) do j = 1, nj jb = j + Atm_block%jsc - 1 @@ -1498,15 +1392,15 @@ subroutine update_atmos_chemistry(state, rc) ib = i + Atm_block%isc - 1 nb = Atm_block%blkno(ib,jb) ix = Atm_block%ixp(ib,jb) - IPD_Data(nb)%coupling%rainc_cpl(ix) = zero - if (.not.IPD_Control%cplflx) then - IPD_Data(nb)%coupling%rain_cpl(ix) = zero - IPD_Data(nb)%coupling%snow_cpl(ix) = zero + GFS_data(nb)%coupling%rainc_cpl(ix) = zero + if (.not.GFS_control%cplflx) then + GFS_data(nb)%coupling%rain_cpl(ix) = zero + GFS_data(nb)%coupling%snow_cpl(ix) = zero end if enddo enddo - if (IPD_Control%debug) then + if (GFS_control%debug) then ! -- diagnostics write(6,'("update_atmos: prsi - min/max/avg",3g16.6)') minval(prsi), maxval(prsi), sum(prsi)/size(prsi) write(6,'("update_atmos: phii - min/max/avg",3g16.6)') minval(phii), maxval(phii), sum(phii)/size(phii) @@ -1631,18 +1525,18 @@ subroutine assign_importdata(rc) ! ! set up local dimension rc = -999 - isc = IPD_control%isc - iec = IPD_control%isc+IPD_control%nx-1 - jsc = IPD_control%jsc - jec = IPD_control%jsc+IPD_control%ny-1 + isc = GFS_control%isc + iec = GFS_control%isc+GFS_control%nx-1 + jsc = GFS_control%jsc + jec = GFS_control%jsc+GFS_control%ny-1 lcpl_fice = .false. allocate(datar8(isc:iec,jsc:jec)) ! if (mpp_pe() == mpp_root_pe() .and. debug) print *,'in cplImp,dim=',isc,iec,jsc,jec -! if (mpp_pe() == mpp_root_pe() .and. debug) print *,'in cplImp,IPD_Data, size', size(IPD_Data) -! if (mpp_pe() == mpp_root_pe() .and. debug) print *,'in cplImp,tsfc, size', size(IPD_Data(1)%sfcprop%tsfc) -! if (mpp_pe() == mpp_root_pe() .and. debug) print *,'in cplImp,tsfc, min_seaice', IPD_Control%min_seaice +! if (mpp_pe() == mpp_root_pe() .and. debug) print *,'in cplImp,GFS_data, size', size(GFS_data) +! if (mpp_pe() == mpp_root_pe() .and. debug) print *,'in cplImp,tsfc, size', size(GFS_data(1)%sfcprop%tsfc) +! if (mpp_pe() == mpp_root_pe() .and. debug) print *,'in cplImp,tsfc, min_seaice', GFS_control%min_seaice do n=1,nImportFields ! Each import field is only available if it was connected in the import state. @@ -1686,7 +1580,7 @@ subroutine assign_importdata(rc) ! do i=isc,iec ! nb = Atm_block%blkno(i,j) ! ix = Atm_block%ixp(i,j) -! IPD_Data(nb)%Coupling%slimskin_cpl(ix) = datar8(i,j) +! GFS_data(nb)%Coupling%slimskin_cpl(ix) = datar8(i,j) ! enddo ! enddo ! if( mpp_pe()==mpp_root_pe()) print *,'get land mask from mediator' @@ -1699,19 +1593,19 @@ subroutine assign_importdata(rc) fldname = 'wave_z0_roughness_length' if (trim(impfield_name) == trim(fldname)) then findex = QueryFieldList(ImportFieldsList,fldname) - if (importFieldsValid(findex) .and. IPD_control%cplwav2atm) then + if (importFieldsValid(findex) .and. GFS_control%cplwav2atm) then !$omp parallel do default(shared) private(i,j,nb,ix,tem) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero .and. datar8(i,j) > zorlmin) then + if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero .and. datar8(i,j) > zorlmin) then tem = 100.0_IPD_kind_phys * min(0.1_IPD_kind_phys, datar8(i,j)) -! IPD_Data(nb)%Coupling%zorlwav_cpl(ix) = tem - IPD_Data(nb)%Sfcprop%zorlo(ix) = tem - IPD_Data(nb)%Sfcprop%zorlw(ix) = tem +! GFS_data(nb)%Coupling%zorlwav_cpl(ix) = tem + GFS_data(nb)%Sfcprop%zorlo(ix) = tem + GFS_data(nb)%Sfcprop%zorlw(ix) = tem else - IPD_Data(nb)%Sfcprop%zorlw(ix) = -999.0_IPD_kind_phys + GFS_data(nb)%Sfcprop%zorlw(ix) = -999.0_IPD_kind_phys endif enddo @@ -1730,9 +1624,9 @@ subroutine assign_importdata(rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero .and. datar8(i,j) > 150.0) then -! IPD_Data(nb)%Coupling%tisfcin_cpl(ix) = datar8(i,j) - IPD_Data(nb)%Sfcprop%tisfc(ix) = datar8(i,j) + if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero .and. datar8(i,j) > 150.0) then +! GFS_data(nb)%Coupling%tisfcin_cpl(ix) = datar8(i,j) + GFS_data(nb)%Sfcprop%tisfc(ix) = datar8(i,j) endif enddo enddo @@ -1750,9 +1644,9 @@ subroutine assign_importdata(rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero .and. datar8(i,j) > 150.0) then -! IPD_Data(nb)%Coupling%tseain_cpl(ix) = datar8(i,j) - IPD_Data(nb)%Sfcprop%tsfco(ix) = datar8(i,j) + if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero .and. datar8(i,j) > 150.0) then +! GFS_data(nb)%Coupling%tseain_cpl(ix) = datar8(i,j) + GFS_data(nb)%Sfcprop%tsfco(ix) = datar8(i,j) endif enddo enddo @@ -1773,20 +1667,20 @@ subroutine assign_importdata(rc) nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - IPD_Data(nb)%Coupling%slimskin_cpl(ix) = IPD_Data(nb)%Sfcprop%slmsk(ix) - ofrac = IPD_Data(nb)%Sfcprop%oceanfrac(ix) + GFS_data(nb)%Coupling%slimskin_cpl(ix) = GFS_data(nb)%Sfcprop%slmsk(ix) + ofrac = GFS_data(nb)%Sfcprop%oceanfrac(ix) if (ofrac > zero) then - IPD_Data(nb)%Sfcprop%fice(ix) = max(zero, min(one, datar8(i,j)/ofrac)) !LHS: ice frac wrt water area - if (IPD_Data(nb)%Sfcprop%fice(ix) >= IPD_control%min_seaice) then - if (IPD_Data(nb)%Sfcprop%fice(ix) > one-epsln) IPD_Data(nb)%Sfcprop%fice(ix) = one - if (abs(one-ofrac) < epsln) IPD_Data(nb)%Sfcprop%slmsk(ix) = 2.0_IPD_kind_phys !slmsk=2 crashes in gcycle on partial land points -! IPD_Data(nb)%Sfcprop%slmsk(ix) = 2.0_IPD_kind_phys - IPD_Data(nb)%Coupling%slimskin_cpl(ix) = 4.0_IPD_kind_phys + GFS_data(nb)%Sfcprop%fice(ix) = max(zero, min(one, datar8(i,j)/ofrac)) !LHS: ice frac wrt water area + if (GFS_data(nb)%Sfcprop%fice(ix) >= GFS_control%min_seaice) then + if (GFS_data(nb)%Sfcprop%fice(ix) > one-epsln) GFS_data(nb)%Sfcprop%fice(ix) = one + if (abs(one-ofrac) < epsln) GFS_data(nb)%Sfcprop%slmsk(ix) = 2.0_IPD_kind_phys !slmsk=2 crashes in gcycle on partial land points +! GFS_data(nb)%Sfcprop%slmsk(ix) = 2.0_IPD_kind_phys + GFS_data(nb)%Coupling%slimskin_cpl(ix) = 4.0_IPD_kind_phys else - IPD_Data(nb)%Sfcprop%fice(ix) = zero + GFS_data(nb)%Sfcprop%fice(ix) = zero if (abs(one-ofrac) < epsln) then - IPD_Data(nb)%Sfcprop%slmsk(ix) = zero - IPD_Data(nb)%Coupling%slimskin_cpl(ix) = zero + GFS_data(nb)%Sfcprop%slmsk(ix) = zero + GFS_data(nb)%Coupling%slimskin_cpl(ix) = zero endif endif endif @@ -1807,15 +1701,15 @@ subroutine assign_importdata(rc) ! do i=isc,iec ! nb = Atm_block%blkno(i,j) ! ix = Atm_block%ixp(i,j) -! if (IPD_Data(nb)%Sfcprop%slmsk(ix) < 0.1 .or. IPD_Data(nb)%Sfcprop%slmsk(ix) > 1.9) then -! IPD_Data(nb)%Coupling%ulwsfcin_cpl(ix) = -datar8(i,j) +! if (GFS_data(nb)%Sfcprop%slmsk(ix) < 0.1 .or. GFS_data(nb)%Sfcprop%slmsk(ix) > 1.9) then +! GFS_data(nb)%Coupling%ulwsfcin_cpl(ix) = -datar8(i,j) ! endif ! enddo do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then - IPD_Data(nb)%Coupling%ulwsfcin_cpl(ix) = -datar8(i,j) + if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then + GFS_data(nb)%Coupling%ulwsfcin_cpl(ix) = -datar8(i,j) endif enddo enddo @@ -1834,8 +1728,8 @@ subroutine assign_importdata(rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then - IPD_Data(nb)%Coupling%dqsfcin_cpl(ix) = -datar8(i,j) + if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then + GFS_data(nb)%Coupling%dqsfcin_cpl(ix) = -datar8(i,j) endif enddo enddo @@ -1854,8 +1748,8 @@ subroutine assign_importdata(rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then - IPD_Data(nb)%Coupling%dtsfcin_cpl(ix) = -datar8(i,j) + if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then + GFS_data(nb)%Coupling%dtsfcin_cpl(ix) = -datar8(i,j) endif enddo enddo @@ -1874,8 +1768,8 @@ subroutine assign_importdata(rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then - IPD_Data(nb)%Coupling%dusfcin_cpl(ix) = -datar8(i,j) + if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then + GFS_data(nb)%Coupling%dusfcin_cpl(ix) = -datar8(i,j) endif enddo enddo @@ -1894,8 +1788,8 @@ subroutine assign_importdata(rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then - IPD_Data(nb)%Coupling%dvsfcin_cpl(ix) = -datar8(i,j) + if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then + GFS_data(nb)%Coupling%dvsfcin_cpl(ix) = -datar8(i,j) endif enddo enddo @@ -1914,9 +1808,9 @@ subroutine assign_importdata(rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then -! IPD_Data(nb)%Coupling%hicein_cpl(ix) = datar8(i,j) - IPD_Data(nb)%Sfcprop%hice(ix) = datar8(i,j) + if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then +! GFS_data(nb)%Coupling%hicein_cpl(ix) = datar8(i,j) + GFS_data(nb)%Sfcprop%hice(ix) = datar8(i,j) endif enddo enddo @@ -1935,8 +1829,8 @@ subroutine assign_importdata(rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then - IPD_Data(nb)%Coupling%hsnoin_cpl(ix) = datar8(i,j) + if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then + GFS_data(nb)%Coupling%hsnoin_cpl(ix) = datar8(i,j) endif enddo enddo @@ -1957,37 +1851,37 @@ subroutine assign_importdata(rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then + if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then !if it is ocean or ice get surface temperature from mediator - if (IPD_Data(nb)%Sfcprop%fice(ix) >= IPD_control%min_seaice) then - -! if(IPD_Data(nb)%Coupling%ficein_cpl(ix) >= IPD_control%min_seaice) then -! IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Coupling%tisfcin_cpl(ix) -! IPD_Data(nb)%Sfcprop%fice(ix) = IPD_Data(nb)%Coupling%ficein_cpl(ix) -! IPD_Data(nb)%Sfcprop%hice(ix) = IPD_Data(nb)%Coupling%hicein_cpl(ix) -! IPD_Data(nb)%Sfcprop%snowd(ix) = IPD_Data(nb)%Coupling%hsnoin_cpl(ix) - - IPD_Data(nb)%Coupling%hsnoin_cpl(ix) = IPD_Data(nb)%Coupling%hsnoin_cpl(ix) & - / max(0.01_IPD_kind_phys, IPD_Data(nb)%Sfcprop%fice(ix)) -! / max(0.01_IPD_kind_phys, IPD_Data(nb)%Coupling%ficein_cpl(ix)) - IPD_Data(nb)%Sfcprop%zorli(ix) = z0ice + if (GFS_data(nb)%Sfcprop%fice(ix) >= GFS_control%min_seaice) then + +! if(GFS_data(nb)%Coupling%ficein_cpl(ix) >= GFS_control%min_seaice) then +! GFS_data(nb)%Sfcprop%tisfc(ix) = GFS_data(nb)%Coupling%tisfcin_cpl(ix) +! GFS_data(nb)%Sfcprop%fice(ix) = GFS_data(nb)%Coupling%ficein_cpl(ix) +! GFS_data(nb)%Sfcprop%hice(ix) = GFS_data(nb)%Coupling%hicein_cpl(ix) +! GFS_data(nb)%Sfcprop%snowd(ix) = GFS_data(nb)%Coupling%hsnoin_cpl(ix) + + GFS_data(nb)%Coupling%hsnoin_cpl(ix) = GFS_data(nb)%Coupling%hsnoin_cpl(ix) & + / max(0.01_IPD_kind_phys, GFS_data(nb)%Sfcprop%fice(ix)) +! / max(0.01_IPD_kind_phys, GFS_data(nb)%Coupling%ficein_cpl(ix)) + GFS_data(nb)%Sfcprop%zorli(ix) = z0ice else -! IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Coupling%tseain_cpl(ix) - IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Sfcprop%tsfco(ix) - IPD_Data(nb)%Sfcprop%fice(ix) = zero - IPD_Data(nb)%Sfcprop%hice(ix) = zero -! IPD_Data(nb)%Sfcprop%snowd(ix) = zero - IPD_Data(nb)%Coupling%hsnoin_cpl(ix) = zero +! GFS_data(nb)%Sfcprop%tisfc(ix) = GFS_data(nb)%Coupling%tseain_cpl(ix) + GFS_data(nb)%Sfcprop%tisfc(ix) = GFS_data(nb)%Sfcprop%tsfco(ix) + GFS_data(nb)%Sfcprop%fice(ix) = zero + GFS_data(nb)%Sfcprop%hice(ix) = zero +! GFS_data(nb)%Sfcprop%snowd(ix) = zero + GFS_data(nb)%Coupling%hsnoin_cpl(ix) = zero ! - IPD_Data(nb)%Coupling%dtsfcin_cpl(ix) = -99999.0 ! over open water - should not be used in ATM - IPD_Data(nb)%Coupling%dqsfcin_cpl(ix) = -99999.0 ! ,, - IPD_Data(nb)%Coupling%dusfcin_cpl(ix) = -99999.0 ! ,, - IPD_Data(nb)%Coupling%dvsfcin_cpl(ix) = -99999.0 ! ,, - IPD_Data(nb)%Coupling%dtsfcin_cpl(ix) = -99999.0 ! ,, - IPD_Data(nb)%Coupling%ulwsfcin_cpl(ix) = -99999.0 ! ,, - if (abs(one-IPD_Data(nb)%Sfcprop%oceanfrac(ix)) < epsln) then ! 100% open water - IPD_Data(nb)%Coupling%slimskin_cpl(ix) = zero - IPD_Data(nb)%Sfcprop%slmsk(ix) = zero + GFS_data(nb)%Coupling%dtsfcin_cpl(ix) = -99999.0 ! over open water - should not be used in ATM + GFS_data(nb)%Coupling%dqsfcin_cpl(ix) = -99999.0 ! ,, + GFS_data(nb)%Coupling%dusfcin_cpl(ix) = -99999.0 ! ,, + GFS_data(nb)%Coupling%dvsfcin_cpl(ix) = -99999.0 ! ,, + GFS_data(nb)%Coupling%dtsfcin_cpl(ix) = -99999.0 ! ,, + GFS_data(nb)%Coupling%ulwsfcin_cpl(ix) = -99999.0 ! ,, + if (abs(one-GFS_data(nb)%Sfcprop%oceanfrac(ix)) < epsln) then ! 100% open water + GFS_data(nb)%Coupling%slimskin_cpl(ix) = zero + GFS_data(nb)%Sfcprop%slmsk(ix) = zero endif endif endif @@ -2000,13 +1894,13 @@ subroutine assign_importdata(rc) ! do i=isc,iec ! nb = Atm_block%blkno(i,j) ! ix = Atm_block%ixp(i,j) -! if (abs(IPD_Data(nb)%Grid%xlon_d(ix)-2.89) < 0.1 .and. & -! abs(IPD_Data(nb)%Grid%xlat_d(ix)+58.99) < 0.1) then -! write(0,*)' in assign tisfc=',IPD_Data(nb)%Sfcprop%tisfc(ix), & -! ' oceanfrac=',IPD_Data(nb)%Sfcprop%oceanfrac(ix),' i=',i,' j=',j,& -!! ' tisfcin=',IPD_Data(nb)%Coupling%tisfcin_cpl(ix), & -! ' tisfcin=',IPD_Data(nb)%Sfcprop%tisfc(ix), & -! ' fice=',IPD_Data(nb)%Sfcprop%fice(ix) +! if (abs(GFS_data(nb)%Grid%xlon_d(ix)-2.89) < 0.1 .and. & +! abs(GFS_data(nb)%Grid%xlat_d(ix)+58.99) < 0.1) then +! write(0,*)' in assign tisfc=',GFS_data(nb)%Sfcprop%tisfc(ix), & +! ' oceanfrac=',GFS_data(nb)%Sfcprop%oceanfrac(ix),' i=',i,' j=',j,& +!! ' tisfcin=',GFS_data(nb)%Coupling%tisfcin_cpl(ix), & +! ' tisfcin=',GFS_data(nb)%Sfcprop%tisfc(ix), & +! ' fice=',GFS_data(nb)%Sfcprop%fice(ix) ! endif ! enddo ! enddo @@ -2037,16 +1931,16 @@ subroutine setup_exportdata (rc) ! if (mpp_pe() == mpp_root_pe()) print *,'enter setup_exportdata' - isc = IPD_control%isc - iec = IPD_control%isc+IPD_control%nx-1 - jsc = IPD_control%jsc - jec = IPD_control%jsc+IPD_control%ny-1 + isc = GFS_control%isc + iec = GFS_control%isc+GFS_control%nx-1 + jsc = GFS_control%jsc + jec = GFS_control%jsc+GFS_control%ny-1 - rtime = one / IPD_control%dtp - rtimek = IPD_control%rho_h2o * rtime + rtime = one / GFS_control%dtp + rtimek = GFS_control%rho_h2o * rtime ! print *,'in cplExp,dim=',isc,iec,jsc,jec,'nExportFields=',nExportFields -! print *,'in cplExp,IPD_Data, size', size(IPD_Data) -! print *,'in cplExp,u10micpl, size', size(IPD_Data(1)%coupling%u10mi_cpl) +! print *,'in cplExp,GFS_data, size', size(GFS_data) +! print *,'in cplExp,u10micpl, size', size(GFS_data(1)%coupling%u10mi_cpl) if(.not.allocated(exportData)) then allocate(exportData(isc:iec,jsc:jec,nExportFields)) @@ -2054,7 +1948,7 @@ subroutine setup_exportdata (rc) ! set cpl fields to export Data - if (IPD_Control%cplflx .or. IPD_Control%cplwav) then + if (GFS_control%cplflx .or. GFS_control%cplwav) then ! Instantaneous u wind (m/s) 10 m above ground idx = queryfieldlist(exportFieldsList,'inst_zonal_wind_height10m') if (idx > 0 ) then @@ -2064,7 +1958,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%u10mi_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%u10mi_cpl(ix) enddo enddo endif @@ -2078,7 +1972,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%v10mi_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%v10mi_cpl(ix) enddo enddo if (mpp_pe() == mpp_root_pe() .and. debug) print *,'cpl, get v10mi_cpl, exportData=',exportData(isc,jsc,idx),'idx=',idx @@ -2086,7 +1980,7 @@ subroutine setup_exportdata (rc) endif !if cplflx or cplwav - if (IPD_Control%cplflx) then + if (GFS_control%cplflx) then ! MEAN Zonal compt of momentum flux (N/m**2) idx = queryfieldlist(exportFieldsList,'mean_zonal_moment_flx_atm') if (idx > 0 ) then @@ -2095,7 +1989,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dusfc_cpl(ix) * rtime + exportData(i,j,idx) = GFS_data(nb)%coupling%dusfc_cpl(ix) * rtime enddo enddo endif @@ -2108,7 +2002,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dvsfc_cpl(ix) * rtime + exportData(i,j,idx) = GFS_data(nb)%coupling%dvsfc_cpl(ix) * rtime enddo enddo endif @@ -2121,7 +2015,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dtsfc_cpl(ix) * rtime + exportData(i,j,idx) = GFS_data(nb)%coupling%dtsfc_cpl(ix) * rtime enddo enddo endif @@ -2134,7 +2028,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dqsfc_cpl(ix) * rtime + exportData(i,j,idx) = GFS_data(nb)%coupling%dqsfc_cpl(ix) * rtime enddo enddo endif @@ -2147,7 +2041,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dlwsfc_cpl(ix) * rtime + exportData(i,j,idx) = GFS_data(nb)%coupling%dlwsfc_cpl(ix) * rtime enddo enddo endif @@ -2160,7 +2054,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dswsfc_cpl(ix) * rtime + exportData(i,j,idx) = GFS_data(nb)%coupling%dswsfc_cpl(ix) * rtime enddo enddo endif @@ -2173,7 +2067,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%rain_cpl(ix) * rtimek + exportData(i,j,idx) = GFS_data(nb)%coupling%rain_cpl(ix) * rtimek enddo enddo endif @@ -2186,7 +2080,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dusfci_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%dusfci_cpl(ix) enddo enddo endif @@ -2199,7 +2093,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dvsfci_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%dvsfci_cpl(ix) enddo enddo endif @@ -2212,7 +2106,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dtsfci_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%dtsfci_cpl(ix) enddo enddo endif @@ -2225,7 +2119,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dqsfci_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%dqsfci_cpl(ix) enddo enddo endif @@ -2238,7 +2132,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dlwsfci_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%dlwsfci_cpl(ix) enddo enddo endif @@ -2251,7 +2145,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dswsfci_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%dswsfci_cpl(ix) enddo enddo endif @@ -2264,7 +2158,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%t2mi_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%t2mi_cpl(ix) enddo enddo endif @@ -2277,7 +2171,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%q2mi_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%q2mi_cpl(ix) enddo enddo endif @@ -2290,7 +2184,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%tsfci_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%tsfci_cpl(ix) enddo enddo endif @@ -2303,7 +2197,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%psurfi_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%psurfi_cpl(ix) enddo enddo endif @@ -2316,7 +2210,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%oro_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%oro_cpl(ix) enddo enddo endif @@ -2329,7 +2223,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%nlwsfc_cpl(ix) * rtime + exportData(i,j,idx) = GFS_data(nb)%coupling%nlwsfc_cpl(ix) * rtime enddo enddo endif @@ -2342,7 +2236,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%nswsfc_cpl(ix) * rtime + exportData(i,j,idx) = GFS_data(nb)%coupling%nswsfc_cpl(ix) * rtime enddo enddo endif @@ -2355,7 +2249,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%nlwsfci_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%nlwsfci_cpl(ix) enddo enddo endif @@ -2368,7 +2262,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%nswsfci_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%nswsfci_cpl(ix) enddo enddo endif @@ -2381,7 +2275,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dnirbm_cpl(ix) * rtime + exportData(i,j,idx) = GFS_data(nb)%coupling%dnirbm_cpl(ix) * rtime enddo enddo endif @@ -2394,7 +2288,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dnirdf_cpl(ix) * rtime + exportData(i,j,idx) = GFS_data(nb)%coupling%dnirdf_cpl(ix) * rtime enddo enddo endif @@ -2407,7 +2301,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dvisbm_cpl(ix) * rtime + exportData(i,j,idx) = GFS_data(nb)%coupling%dvisbm_cpl(ix) * rtime enddo enddo endif @@ -2420,7 +2314,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dvisdf_cpl(ix) * rtime + exportData(i,j,idx) = GFS_data(nb)%coupling%dvisdf_cpl(ix) * rtime enddo enddo endif @@ -2433,7 +2327,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dnirbmi_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%dnirbmi_cpl(ix) enddo enddo endif @@ -2446,7 +2340,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dnirdfi_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%dnirdfi_cpl(ix) enddo enddo endif @@ -2459,7 +2353,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dvisbmi_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%dvisbmi_cpl(ix) enddo enddo endif @@ -2472,7 +2366,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%dvisdfi_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%dvisdfi_cpl(ix) enddo enddo endif @@ -2485,7 +2379,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%nnirbm_cpl(ix) * rtime + exportData(i,j,idx) = GFS_data(nb)%coupling%nnirbm_cpl(ix) * rtime enddo enddo endif @@ -2498,7 +2392,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%nnirdf_cpl(ix) * rtime + exportData(i,j,idx) = GFS_data(nb)%coupling%nnirdf_cpl(ix) * rtime enddo enddo endif @@ -2511,7 +2405,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%nvisbm_cpl(ix) * rtime + exportData(i,j,idx) = GFS_data(nb)%coupling%nvisbm_cpl(ix) * rtime enddo enddo endif @@ -2524,7 +2418,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%nvisdf_cpl(ix) * rtime + exportData(i,j,idx) = GFS_data(nb)%coupling%nvisdf_cpl(ix) * rtime enddo enddo endif @@ -2537,7 +2431,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%nnirbmi_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%nnirbmi_cpl(ix) enddo enddo endif @@ -2550,7 +2444,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%nnirdfi_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%nnirdfi_cpl(ix) enddo enddo endif @@ -2563,7 +2457,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%nvisbmi_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%nvisbmi_cpl(ix) enddo enddo endif @@ -2576,7 +2470,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%nvisdfi_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%nvisdfi_cpl(ix) enddo enddo endif @@ -2589,7 +2483,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%slmsk_cpl(ix) + exportData(i,j,idx) = GFS_data(nb)%coupling%slmsk_cpl(ix) enddo enddo endif @@ -2711,7 +2605,7 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%snow_cpl(ix) * rtimek + exportData(i,j,idx) = GFS_data(nb)%coupling%snow_cpl(ix) * rtimek enddo enddo endif @@ -2722,34 +2616,34 @@ subroutine setup_exportdata (rc) call fillExportFields(exportData) !--- - if (IPD_Control%cplflx) then + if (GFS_control%cplflx) then ! zero out accumulated fields !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - IPD_Data(nb)%coupling%dusfc_cpl(ix) = zero - IPD_Data(nb)%coupling%dvsfc_cpl(ix) = zero - IPD_Data(nb)%coupling%dtsfc_cpl(ix) = zero - IPD_Data(nb)%coupling%dqsfc_cpl(ix) = zero - IPD_Data(nb)%coupling%dlwsfc_cpl(ix) = zero - IPD_Data(nb)%coupling%dswsfc_cpl(ix) = zero - IPD_Data(nb)%coupling%rain_cpl(ix) = zero - IPD_Data(nb)%coupling%nlwsfc_cpl(ix) = zero - IPD_Data(nb)%coupling%nswsfc_cpl(ix) = zero - IPD_Data(nb)%coupling%dnirbm_cpl(ix) = zero - IPD_Data(nb)%coupling%dnirdf_cpl(ix) = zero - IPD_Data(nb)%coupling%dvisbm_cpl(ix) = zero - IPD_Data(nb)%coupling%dvisdf_cpl(ix) = zero - IPD_Data(nb)%coupling%nnirbm_cpl(ix) = zero - IPD_Data(nb)%coupling%nnirdf_cpl(ix) = zero - IPD_Data(nb)%coupling%nvisbm_cpl(ix) = zero - IPD_Data(nb)%coupling%nvisdf_cpl(ix) = zero - IPD_Data(nb)%coupling%snow_cpl(ix) = zero + GFS_data(nb)%coupling%dusfc_cpl(ix) = zero + GFS_data(nb)%coupling%dvsfc_cpl(ix) = zero + GFS_data(nb)%coupling%dtsfc_cpl(ix) = zero + GFS_data(nb)%coupling%dqsfc_cpl(ix) = zero + GFS_data(nb)%coupling%dlwsfc_cpl(ix) = zero + GFS_data(nb)%coupling%dswsfc_cpl(ix) = zero + GFS_data(nb)%coupling%rain_cpl(ix) = zero + GFS_data(nb)%coupling%nlwsfc_cpl(ix) = zero + GFS_data(nb)%coupling%nswsfc_cpl(ix) = zero + GFS_data(nb)%coupling%dnirbm_cpl(ix) = zero + GFS_data(nb)%coupling%dnirdf_cpl(ix) = zero + GFS_data(nb)%coupling%dvisbm_cpl(ix) = zero + GFS_data(nb)%coupling%dvisdf_cpl(ix) = zero + GFS_data(nb)%coupling%nnirbm_cpl(ix) = zero + GFS_data(nb)%coupling%nnirdf_cpl(ix) = zero + GFS_data(nb)%coupling%nvisbm_cpl(ix) = zero + GFS_data(nb)%coupling%nvisdf_cpl(ix) = zero + GFS_data(nb)%coupling%snow_cpl(ix) = zero enddo enddo - if (mpp_pe() == mpp_root_pe()) print *,'zeroing coupling accumulated fields at kdt= ',IPD_Control%kdt + if (mpp_pe() == mpp_root_pe()) print *,'zeroing coupling accumulated fields at kdt= ',GFS_control%kdt endif !cplflx ! if (mpp_pe() == mpp_root_pe()) print *,'end of setup_exportdata' @@ -2771,10 +2665,10 @@ subroutine addLsmask2grid(fcstGrid, rc) integer, allocatable :: lsmask(:,:) integer(kind=ESMF_KIND_I4), pointer :: maskPtr(:,:) ! - isc = IPD_control%isc - iec = IPD_control%isc+IPD_control%nx-1 - jsc = IPD_control%jsc - jec = IPD_control%jsc+IPD_control%ny-1 + isc = GFS_control%isc + iec = GFS_control%isc+GFS_control%nx-1 + jsc = GFS_control%jsc + jec = GFS_control%jsc+GFS_control%ny-1 allocate(lsmask(isc:iec,jsc:jec)) ! !$omp parallel do default(shared) private(i,j,nb,ix) @@ -2783,7 +2677,7 @@ subroutine addLsmask2grid(fcstGrid, rc) nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) ! use land sea mask: land:1, ocean:0 - lsmask(i,j) = floor(one + epsln - IPD_Data(nb)%SfcProp%oceanfrac(ix)) + lsmask(i,j) = floor(one + epsln - GFS_data(nb)%SfcProp%oceanfrac(ix)) enddo enddo ! diff --git a/ccpp/CMakeLists.txt b/ccpp/CMakeLists.txt index 750ae5c14..5aebed122 100644 --- a/ccpp/CMakeLists.txt +++ b/ccpp/CMakeLists.txt @@ -160,10 +160,6 @@ else (APPLE) message (FATAL_ERROR "Unsupported platform, only Linux and MacOSX are supported at this time.") endif(APPLE) -#------------------------------------------------------------------------------ -# Add -DCCPP preprocessor flag (needed to preprocess GFS_typedefs.F90 from FV3) -ADD_DEFINITIONS(-DCCPP) - #------------------------------------------------------------------------------ # Add host-model specific preprocessor flag (needed for some physics schemes) ADD_DEFINITIONS(-DFV3) diff --git a/gfsphysics/CMakeLists.txt b/gfsphysics/CMakeLists.txt index 811e57dc7..e7ea245b2 100644 --- a/gfsphysics/CMakeLists.txt +++ b/gfsphysics/CMakeLists.txt @@ -25,166 +25,6 @@ set(CCPP_SOURCES GFS_layer/GFS_restart.F90 ) -set(IPD_SOURCES - - 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/gocart_tracer_config_stub.f - physics/gscond.f - physics/gscondp.f - physics/gwdc.f - physics/gwdps.f - physics/ugwp_driver_v0.f - physics/cires_orowam2017.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/mfpbl.f - physics/mfpblt.f - physics/mfpbltq.f - physics/mfscu.f - physics/mfscuq.f - physics/module_bfmicrophysics.f - physics/moninedmf.f - physics/moninedmf_hafs.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/iccn_def.f - physics/aerclm_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/samfaerosols.f - physics/samfdeepcnv.f - physics/samfshalcnv.f - physics/sascnv.f - physics/sascnvn.f - physics/satmedmfvdif.f - physics/satmedmfvdifq.f - physics/set_soilveg.f - physics/sfc_cice.f - physics/sfc_diag.f - physics/sfc_diff.f - physics/sfc_drv.f - physics/sfc_noahmp_drv.f - physics/sfc_nst.f - physics/sfc_ocean.f - physics/sfc_sice.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/tridi2t3.f - - physics/calpreciptype.f90 - physics/funcphys.f90 - physics/gcm_shoc.f90 - physics/get_prs_fv3.f90 - physics/h2ointerp.f90 - physics/module_nst_model.f90 - physics/module_nst_parameters.f90 - physics/module_nst_water_prop.f90 - physics/ozinterp.f90 - physics/module_wrf_utl.f90 - physics/noahmp_tables.f90 - physics/module_sf_noahmplsm.f90 - physics/module_sf_noahmp_glacier.f90 - physics/iccninterp.f90 - physics/aerinterp.f90 - physics/wam_f107_kp_mod.f90 - - physics/aer_cloud.F - physics/cldmacro.F - physics/cldwat2m_micro.F - physics/gfs_phy_tracer_config.F - physics/machine.F - physics/num_parthds.F - physics/sfcsub.F - physics/wv_saturation.F - - physics/GFDL_parse_tracers.F90 - physics/gcycle.F90 - physics/cires_ugwp_initialize.F90 - physics/cires_ugwp_module.F90 - physics/cires_ugwp_utils.F90 - physics/cires_ugwp_triggers.F90 - physics/cires_ugwp_solvers.F90 - physics/cires_vert_lsatdis.F90 - physics/cires_vert_orodis.F90 - physics/cires_vert_wmsdis.F90 - physics/gfdl_cloud_microphys.F90 - physics/micro_mg_utils.F90 - physics/micro_mg2_0.F90 - physics/micro_mg3_0.F90 - physics/m_micro_driver.F90 - physics/cs_conv.F90 - physics/module_mp_radar.F90 - physics/module_mp_thompson_gfs.F90 - physics/module_mp_wsm6_fv3.F90 - physics/physcons.F90 - physics/surface_perturbation.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 -) - list(APPEND _gfsphysics_defs_private NEMS_GSM MOIST_CAPPA USE_COND @@ -194,31 +34,18 @@ if(MULTI_GASES) list(APPEND _gfsphysics_defs_private MULTI_GASES) endif() -if(CCPP) - list(APPEND _gfsphysics_srcs ${CCPP_SOURCES}) - list(APPEND _gfsphysics_defs_private CCPP) - if(DYN32) - list(APPEND _gfsphysics_defs_private OVERLOAD_R4) - endif() -else() - list(APPEND _gfsphysics_srcs ${IPD_SOURCES}) +list(APPEND _gfsphysics_srcs ${CCPP_SOURCES}) +list(APPEND _gfsphysics_defs_private CCPP) +if(DYN32) + list(APPEND _gfsphysics_defs_private OVERLOAD_R4) endif() add_library(gfsphysics ${_gfsphysics_srcs}) -if(CCPP) - target_include_directories(gfsphysics PRIVATE ${CMAKE_BINARY_DIR}/FV3/ccpp/framework/src - ${CMAKE_BINARY_DIR}/FV3/ccpp/physics) - target_link_libraries(gfsphysics PRIVATE ccppphys ccpp) -endif() +target_include_directories(gfsphysics PRIVATE ${CMAKE_BINARY_DIR}/FV3/ccpp/framework/src + ${CMAKE_BINARY_DIR}/FV3/ccpp/physics) +target_link_libraries(gfsphysics PRIVATE ccppphys ccpp) -if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") - if(CMAKE_Platform MATCHES "jet") - set_property(SOURCE physics/radiation_aerosols.f APPEND_STRING PROPERTY COMPILE_FLAGS "-axSSE4.2,AVX,CORE-AVX-I") - else() - set_property(SOURCE physics/radiation_aerosols.f APPEND_STRING PROPERTY COMPILE_FLAGS "-xCORE-AVX-I") - endif() -endif() set_property(SOURCE GFS_layer/GFS_diagnostics.F90 APPEND_STRING PROPERTY COMPILE_FLAGS "-O0") set_target_properties(gfsphysics PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/mod) diff --git a/gfsphysics/GFS_layer/GFS_abstraction_layer.F90 b/gfsphysics/GFS_layer/GFS_abstraction_layer.F90 index 1a63a8d8a..9eca3dea2 100644 --- a/gfsphysics/GFS_layer/GFS_abstraction_layer.F90 +++ b/gfsphysics/GFS_layer/GFS_abstraction_layer.F90 @@ -11,36 +11,17 @@ module physics_abstraction_layer tbd_type => GFS_tbd_type, & cldprop_type => GFS_cldprop_type, & radtend_type => GFS_radtend_type, & - intdiag_type => GFS_diag_type -#ifdef CCPP - use GFS_typedefs, only: interstitial_type => GFS_interstitial_type, & - data_type => GFS_data_type -#endif + intdiag_type => GFS_diag_type, & + data_type => GFS_data_type, & + interstitial_type => GFS_interstitial_type - - use GFS_restart, only: restart_type => GFS_restart_type, & - restart_populate => GFS_restart_populate + use GFS_restart, only: restart_type => GFS_restart_type, & + restart_populate => GFS_restart_populate use GFS_diagnostics, only: diagnostic_type => GFS_externaldiag_type, & diagnostic_populate => GFS_externaldiag_populate -#ifdef CCPP - use GFS_driver, only: initialize => GFS_initialize -#else - use GFS_driver, only: initialize => GFS_initialize, & - time_vary_step => GFS_time_vary_step, & - radiation_step1 => GFS_radiation_driver, & - physics_step1 => GFS_physics_driver, & - physics_step2 => GFS_stochastic_driver -#endif - -#ifndef CCPP - ! DH* even in the non-CCPP build, these don't get used (same for NAM physics) - integer :: num_time_vary_steps = 1 - integer :: num_rad_steps = 1 - integer :: num_phys_steps = 2 - ! *DH -#endif + use GFS_driver, only: initialize => GFS_initialize !------------------------- ! public physics dataspec @@ -63,31 +44,12 @@ module physics_abstraction_layer public intdiag_type public restart_type public diagnostic_type -#ifdef CCPP public interstitial_type -#endif - -!------------------ -! public variables -!------------------ -#ifndef CCPP - ! DH* even in the non-CCPP build, these don't get used (same for NAM physics) - public num_time_vary_steps - public num_rad_steps - public num_phys_steps - ! *DH -#endif !-------------------------- ! public physics functions !-------------------------- public initialize -#ifndef CCPP - public time_vary_step - public radiation_step1 - public physics_step1 - public physics_step2 -#endif CONTAINS diff --git a/gfsphysics/GFS_layer/GFS_diagnostics.F90 b/gfsphysics/GFS_layer/GFS_diagnostics.F90 index a289df88a..13274056c 100644 --- a/gfsphysics/GFS_layer/GFS_diagnostics.F90 +++ b/gfsphysics/GFS_layer/GFS_diagnostics.F90 @@ -1844,19 +1844,15 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%unit = 'XXX' ExtDiag(idx)%mod_name = 'gfs_phys' allocate (ExtDiag(idx)%data(nblks)) -#ifdef CCPP if (Model%lsm==Model%lsm_ruc) then do nb = 1,nblks ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%wetness(:) enddo else -#endif do nb = 1,nblks ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%wet1(:) enddo -#ifdef CCPP endif -#endif idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2645,7 +2641,6 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%data(nb)%var3 => IntDiag(nb)%dv3dt(:,:,8) enddo -#ifdef CCPP if_qdiag3d: if(Model%qdiag3d) then idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -2804,7 +2799,6 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%data(nb)%var3 => IntDiag(nb)%dq3dt(:,:,13) enddo -#endif end if if_ldiag3d !rab @@ -3026,7 +3020,6 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%snowd(:) enddo -#ifdef CCPP if (Model%lsm == Model%lsm_ruc) then idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3050,7 +3043,6 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%acsnow(:) enddo endif -#endif idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3228,7 +3220,6 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%vfrac(:) enddo -#ifdef CCPP if (Model%rdlai) then idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -3279,23 +3270,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop enddo enddo endif -#else - do num = 1,4 - write (xtra,'(i1)') num - idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'slc_'//trim(xtra) - ExtDiag(idx)%desc = 'liquid soil mositure at layer-'//trim(xtra) - ExtDiag(idx)%unit = 'xxx' - ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%slc(:,num) - enddo - enddo -#endif -#ifdef CCPP if (Model%lsm == Model%lsm_ruc) then do num = 1,Model%lsoil_lsm write (xtra,'(i1)') num @@ -3325,53 +3300,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop enddo enddo endif -#else - idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'soilw1' - ExtDiag(idx)%desc = 'volumetric soil moisture 0-10cm' - ExtDiag(idx)%unit = 'fraction' - ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%smc(:,1) - enddo - - idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'soilw2' - ExtDiag(idx)%desc = 'volumetric soil moisture 10-40cm' - ExtDiag(idx)%unit = 'fraction' - ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%smc(:,2) - enddo - - idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'soilw3' - ExtDiag(idx)%desc = 'volumetric soil moisture 40-100cm' - ExtDiag(idx)%unit = 'fraction' - ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%smc(:,3) - enddo - - idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'soilw4' - ExtDiag(idx)%desc = 'volumetric soil moisture 100-200cm' - ExtDiag(idx)%unit = 'fraction' - ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%smc(:,4) - enddo -#endif -#ifdef CCPP if (Model%lsm == Model%lsm_ruc) then do num = 1,Model%lsoil_lsm write (xtra,'(i1)') num @@ -3401,51 +3330,6 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop enddo enddo endif -#else - idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'soilt1' - ExtDiag(idx)%desc = 'soil temperature 0-10cm' - ExtDiag(idx)%unit = 'K' - ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%stc(:,1) - enddo - - idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'soilt2' - ExtDiag(idx)%desc = 'soil temperature 10-40cm' - ExtDiag(idx)%unit = 'K' - ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%stc(:,2) - enddo - - idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'soilt3' - ExtDiag(idx)%desc = 'soil temperature 40-100cm' - ExtDiag(idx)%unit = 'K' - ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%stc(:,3) - enddo - - idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'soilt4' - ExtDiag(idx)%desc = 'soil temperature 100-200cm' - ExtDiag(idx)%unit = 'K' - ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%stc(:,4) - enddo -#endif !--------------------------nsst variables if (model%nstf_name(1) > 0) then @@ -3652,7 +3536,6 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop endif !--------------------------aerosols -#ifdef CCPP if (Model%ntwa>0) then idx = idx + 1 ExtDiag(idx)%axes = 3 @@ -3966,7 +3849,6 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop endif endif -#endif ! print *,'in gfdl_diag_register,af all extdiag, idx=',idx @@ -4204,7 +4086,6 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop end subroutine GFS_externaldiag_populate -#ifdef CCPP function soil_layer_depth(lsm, lsm_ruc, lsm_noah, layer) result(layer_depth) character(len=30) :: layer_depth integer, intent(in) :: lsm, lsm_ruc, lsm_noah, layer @@ -4254,7 +4135,6 @@ function soil_layer_depth(lsm, lsm_ruc, lsm_noah, layer) result(layer_depth) return ! end function soil_layer_depth -#endif !------------------------------------------------------------------------- diff --git a/gfsphysics/GFS_layer/GFS_driver.F90 b/gfsphysics/GFS_layer/GFS_driver.F90 index 2d676d8d4..782badbed 100644 --- a/gfsphysics/GFS_layer/GFS_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_driver.F90 @@ -6,97 +6,17 @@ module GFS_driver GFS_sfcprop_type, GFS_coupling_type, & GFS_control_type, GFS_grid_type, & GFS_tbd_type, GFS_cldprop_type, & - GFS_radtend_type, GFS_diag_type -#ifdef CCPP - use GFS_typedefs, only: GFS_interstitial_type -#else - use module_radiation_driver, only: GFS_radiation_driver, radupdate - use module_physics_driver, only: GFS_physics_driver - use funcphys, only: gfuncphys - use gfdl_cloud_microphys_mod, only: gfdl_cloud_microphys_init -#endif - use physcons, only: gravit => con_g, rair => con_rd, & - rh2o => con_rv, & - tmelt => con_ttp, cpair => con_cp, & - latvap => con_hvap, latice => con_hfus + GFS_radtend_type, GFS_diag_type, & + GFS_interstitial_type implicit none private -!-------------------------------------------------------------------------------- -! GFS_init_type -!-------------------------------------------------------------------------------- -! 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 -! public -! integer :: me !< my MPI-rank -! integer :: master !< master MPI-rank -! integer :: isc !< starting i-index for this MPI-domain -! integer :: jsc !< starting j-index for this MPI-domain -! integer :: nx !< number of points in i-dir for this MPI rank -! integer :: ny !< number of points in j-dir for this MPI rank -! integer :: levs !< number of vertical levels -! integer :: cnx !< number of points in i-dir for this cubed-sphere face -! !< equal to gnx for lat-lon grids -! integer :: cny !< number of points in j-dir for this cubed-sphere face -! !< equal to gny for lat-lon grids -! integer :: gnx !< number of global points in x-dir (i) along the equator -! integer :: gny !< number of global points in y-dir (j) along any meridian -! integer :: nlunit !< fortran unit number for file opens -! integer :: logunit !< fortran unit number for writing logfile -! integer :: dt_dycore !< dynamics time step in seconds -! integer :: dt_phys !< physics time step in seconds -! integer :: bdat(8) !< model begin date in GFS format (same as idat) -! integer :: cdat(8) !< model current date in GFS format (same as jdat) -! !--- blocking data -! integer, pointer :: blksz(:) !< for explicit data blocking -! !< default blksz(1)=[nx*ny] -! !--- ak/bk for pressure level calculations -! integer, pointer :: ak(:) !< from surface (k=1) to TOA (k=levs) -! integer, pointer :: bk(:) !< from surface (k=1) to TOA (k=levs) -! !--- grid metrics -! real(kind=kind_phys), pointer :: xlon(:,:) !< column longitude for MPI rank -! real(kind=kind_phys), pointer :: xlat(:,:) !< column latitude for MPI rank -! real(kind=kind_phys), pointer :: area(:,:) !< column area for length scale calculations -! -! character(len=32), pointer :: tracer_names(:) !< tracers names to dereference tracer id -! !< based on name location in array -! character(len=65) :: fn_nml !< namelist filename -! character(len=*), pointer :: input_nml_file(:) !< character string containing full namelist -! !< for use with internal file reads -! end type GFS_init_type -!-------------------------------------------------------------------------------- - -!------------------ -! Module parameters -!------------------ - -!---------------------------- -! Module variable definitions -!---------------------------- - 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), parameter :: con_99 = 99.0_kind_phys - real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys - real(kind=kind_phys), parameter :: qmin = 1.0e-10 - - integer, allocatable :: blksz(:) - !---------------- ! Public entities !---------------- public GFS_initialize !< GFS initialization routine -#ifndef CCPP - public GFS_time_vary_step !< perform operations needed prior radiation or physics - public GFS_radiation_driver !< radiation_driver (was grrad) - public GFS_physics_driver !< physics_driver (was gbphys) - public GFS_stochastic_driver !< stochastic physics -#endif CONTAINS !******************************************************************************************* @@ -105,82 +25,45 @@ module GFS_driver !-------------- ! GFS initialze !-------------- -!## CCPP ## For the CCPP, much (*but not all*) of the code in this routine has been -! put into CCPP interstitial schemes, especially their init stages. Where this has been -! done, the code is wrapped in both preprocessor directives and comments describing the -! location of the code for CCPP execution. Lines in this routine that are not wrapped in -! a CCPP comment are still executed through this subroutine. subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, & Coupling, Grid, Tbd, Cldprop, Radtend, & -#ifdef CCPP Diag, Interstitial, communicator, & ntasks, Init_parm) -#else - Diag, Init_parm) -#endif #ifdef _OPENMP use omp_lib #endif -#ifndef CCPP -! use module_microphysics, only: gsmconst - use cldwat2m_micro, only: ini_micro - use micro_mg2_0, only: micro_mg_init2_0 => micro_mg_init - use micro_mg3_0, only: micro_mg_init3_0 => micro_mg_init - use aer_cloud, only: aer_cloud_init - use module_ras, only: ras_init - use module_mp_thompson, only: thompson_init - use module_mp_wsm6, only: wsm6init - use cires_ugwp_module, only: cires_ugwp_init -#endif - !--- 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(:) -#ifdef CCPP + 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(:) type(GFS_interstitial_type), intent(inout) :: Interstitial(:) - integer, intent(in) :: communicator - integer, intent(in) :: ntasks -#endif - type(GFS_init_type), intent(in) :: Init_parm - + integer, intent(in) :: communicator + integer, intent(in) :: ntasks + type(GFS_init_type), intent(in) :: Init_parm !--- local variables integer :: nb integer :: nblks -#ifdef CCPP integer :: nt integer :: nthrds logical :: non_uniform_blocks -#endif - integer :: ntrac integer :: ix -#ifndef CCPP - integer :: blocksize,k - real(kind=kind_phys), allocatable :: si(:) - real(kind=kind_phys), parameter :: p_ref = 101325.0d0 -#endif nblks = size(Init_parm%blksz) - ntrac = size(Init_parm%tracer_names) - allocate (blksz(nblks)) - blksz(:) = Init_parm%blksz(:) -#ifdef CCPP #ifdef _OPENMP nthrds = omp_get_max_threads() #else nthrds = 1 -#endif #endif !--- set control properties (including namelist read) @@ -194,56 +77,29 @@ subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, & Init_parm%iau_offset, Init_parm%bdat, & Init_parm%cdat, Init_parm%tracer_names, & Init_parm%input_nml_file, Init_parm%tile_num, & - Init_parm%blksz,Init_parm%ak, Init_parm%bk & -#ifdef CCPP - ,Init_parm%restart, Init_parm%hydrostatic, & - communicator, ntasks, nthrds & -#endif - ) - -!## CCPP ##* These are called automatically in GFS_phys_time_vary.fv3.F90/GFS_phys_time_vary_init -! as part of CCPP physics init stage. The reason why these are in GFS_phys_time_vary_init and not -! in ozphys/h2ophys is that the ozone and h2o interpolation of the data read here is done in -! GFS_phys_time_vary_run, i.e. all work related to the ozone/h2o input data is in GFS_phys_time_vary, -! while ozphys/h2ophys are applying ozone/h2o forcing to the model state. -#ifndef CCPP - call read_o3data (Model%ntoz, Model%me, Model%master) - call read_h2odata (Model%h2o_phys, Model%me, Model%master) - if (Model%iaerclm) then - call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate) - endif - if (Model%iccn == 1) then - call read_cidata ( Model%me, Model%master) - endif -#endif -!*## CCPP ## + Init_parm%blksz, Init_parm%ak, Init_parm%bk, & + Init_parm%restart, Init_parm%hydrostatic, & + communicator, ntasks, nthrds) do nb = 1,nblks ix = Init_parm%blksz(nb) -! write(0,*)' ix in gfs_driver=',ix,' nb=',nb call Statein (nb)%create (ix, Model) call Stateout (nb)%create (ix, Model) call Sfcprop (nb)%create (ix, Model) call Coupling (nb)%create (ix, Model) call Grid (nb)%create (ix, Model) -#ifndef CCPP - call Tbd (nb)%create (ix, nb, Model) -#else call Tbd (nb)%create (ix, Model) -#endif call Cldprop (nb)%create (ix, Model) call Radtend (nb)%create (ix, Model) !--- internal representation of diagnostics call Diag (nb)%create (ix, Model) enddo -!## CCPP ##* This logic deals with non-uniform block sizes for CCPP. When non-uniform block sizes +! This logic deals with non-uniform block sizes for CCPP. When non-uniform block sizes ! are used, it is required that only the last block has a different (smaller) size than ! all other blocks. This is the standard in FV3. If this is the case, set non_uniform_blocks ! to .true. and initialize nthreads+1 elements of the interstitial array. The extra element ! will be used by the thread that runs over the last, smaller block. -#ifdef CCPP - if (minval(Init_parm%blksz)==maxval(Init_parm%blksz)) then non_uniform_blocks = .false. elseif (all(minloc(Init_parm%blksz)==(/size(Init_parm%blksz)/))) then @@ -267,180 +123,16 @@ subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, & if (non_uniform_blocks) then call Interstitial (nthrds+1)%create (Init_parm%blksz(nblks), Model) end if -#endif -!*## CCPP ## !--- populate the grid components call GFS_grid_populate (Grid, Init_parm%xlon, Init_parm%xlat, Init_parm%area) -!## CCPP ##* GFS_phys_time_vary.fv3.F90/GFS_phys_time_vary_init; Note: this is run -! automatically during the CCPP physics initialization stage. -#ifndef CCPP - !--- read in and initialize ozone and water - if (Model%ntoz > 0) then - do nb = 1, nblks - call setindxoz (Init_parm%blksz(nb), Grid(nb)%xlat_d, Grid(nb)%jindx1_o3, & - Grid(nb)%jindx2_o3, Grid(nb)%ddy_o3) - enddo - endif - - !--- read in and initialize IN and CCN - if (Model%iccn == 1) then - do nb = 1, nblks - call setindxci (Init_parm%blksz(nb), Grid(nb)%xlat_d, Grid(nb)%jindx1_ci, & - Grid(nb)%jindx2_ci, Grid(nb)%ddy_ci, Grid(nb)%xlon_d, & - Grid(nb)%iindx1_ci,Grid(nb)%iindx2_ci,Grid(nb)%ddx_ci) - enddo - endif - - !--- read in and initialize aerosols - if (Model%iaerclm) then - do nb = 1, nblks - call setindxaer (Init_parm%blksz(nb),Grid(nb)%xlat_d,Grid(nb)%jindx1_aer, & - Grid(nb)%jindx2_aer, Grid(nb)%ddy_aer, Grid(nb)%xlon_d, & - Grid(nb)%iindx1_aer,Grid(nb)%iindx2_aer,Grid(nb)%ddx_aer, & - Init_parm%me, Init_parm%master ) - enddo - endif - - if (Model%h2o_phys) then - do nb = 1, nblks - call setindxh2o (Init_parm%blksz(nb), Grid(nb)%xlat_d, Grid(nb)%jindx1_h, & - Grid(nb)%jindx2_h, Grid(nb)%ddy_h) - enddo - endif -#endif -!*## CCPP ## - -!## CCPP ##* GFS_time_vary_pre.fv3.F90/GFS_time_vary_pre_init; Note: This is called -! during the CCPP physics initialization stage. -#ifndef CCPP - !--- Call gfuncphys (funcphys.f) to compute all physics function tables. - call gfuncphys () -#endif -!*## CCPP ## - -! call gsmconst (Model%dtp, Model%me, .TRUE.) ! This is for Ferrier microphysics - notused - moorthi - -#ifndef CCPP -!## CCPP ##* GFS_typedefs.F90/control_initialize - !--- 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 - allocate(si(Model%levr+1)) - si = (Init_parm%ak + Init_parm%bk * p_ref - Init_parm%ak(Model%levr+1)) & - / (p_ref - Init_parm%ak(Model%levr+1)) -!*## CCPP ## - -!## CCPP ##* This functionality is now in GFS_rrtmg_setup.F90/GFS_rrtmg_setup_init; Note: it is automatically -! called during the CCPP physics initialization stage. - call rad_initialize (si, Model%levr, Model%ictm, Model%isol, & - Model%ico2, Model%iaer, Model%ialb, Model%iems, & - Model%ntcw, Model%num_p2d, Model%num_p3d, Model%npdf3d, & - Model%ntoz, Model%iovr_sw, Model%iovr_lw, Model%isubc_sw, & - Model%isubc_lw, Model%icliq_sw, Model%crick_proof, Model%ccnorm,& - Model%imp_physics, Model%norad_precip, Model%idate, Model%iflip, Model%me) -!*## CCPP ## - deallocate (si) -#endif - -! microphysics initialization calls -! --------------------------------- - - if (Model%imp_physics == Model%imp_physics_mg) then !--- initialize Morrison-Gettelman microphysics -#ifndef CCPP -!## CCPP ##* m_micro.F90/m_micro_init; Note: This is automatically called during the -! CCPP physics initialization stage. - if (Model%fprcp <= 0) then - call ini_micro (Model%mg_dcs, Model%mg_qcvar, Model%mg_ts_auto_ice(1)) - elseif (Model%fprcp == 1) then - call micro_mg_init2_0(kind_phys, gravit, rair, rh2o, cpair, & - tmelt, latvap, latice, Model%mg_rhmini, & - Model%mg_dcs, Model%mg_ts_auto_ice, & - Model%mg_qcvar, & - Model%microp_uniform, Model%do_cldice, & - Model%hetfrz_classnuc, & - Model%mg_precip_frac_method, & - Model%mg_berg_eff_factor, & - Model%sed_supersat, Model%do_sb_physics, & - Model%mg_do_ice_gmao, Model%mg_do_liq_liu, & - Model%mg_nccons, Model%mg_nicons, & - Model%mg_ncnst, Model%mg_ninst) - elseif (Model%fprcp == 2) then - call micro_mg_init3_0(kind_phys, gravit, rair, rh2o, cpair, & - tmelt, latvap, latice, Model%mg_rhmini, & - Model%mg_dcs, Model%mg_ts_auto_ice, & - Model%mg_qcvar, & - Model%mg_do_hail, Model%mg_do_graupel, & - Model%microp_uniform, Model%do_cldice, & - Model%hetfrz_classnuc, & - Model%mg_precip_frac_method, & - Model%mg_berg_eff_factor, & - Model%sed_supersat, Model%do_sb_physics, & - Model%mg_do_ice_gmao, Model%mg_do_liq_liu, & - Model%mg_nccons, Model%mg_nicons, & - Model%mg_ncnst, Model%mg_ninst, & - Model%mg_ngcons, Model%mg_ngnst) - else - write(0,*)' Model%fprcp = ',Model%fprcp,' is not a valid option - aborting' - stop - - endif - call aer_cloud_init () -!*## CCPP ## -#endif -! - elseif (Model%imp_physics == Model%imp_physics_thompson) then !--- initialize Thompson Cloud microphysics - if(Model%do_shoc) then - print *,'SHOC is not currently compatible with Thompson MP -- shutting down' - stop - endif -!## CCPP ##* mp_thompson.F90/mp_thompson_init; Note: This is automatically called during the -! CCPP physics initialization stage. The check for SHOC is not included in the initialization -! (it is only performed above as part of the current routine). -#ifndef CCPP - call thompson_init() !--- add aerosol version later - if(Model%ltaerosol) then - print *,'Aerosol awareness is not included in this version of Thompson MP -- shutting down' - stop - endif -!*## CCPP ## - elseif(Model%imp_physics == Model%imp_physics_wsm6) then !--- initialize WSM6 Cloud microphysics - if(Model%do_shoc) then - print *,'SHOC is not currently compatible with WSM6 -- shutting down' - stop - endif - call wsm6init() -#endif -! - else if(Model%imp_physics == Model%imp_physics_gfdl) then !--- initialize GFDL Cloud microphysics -!## CCPP ##* gfdl_cloud_microphys.F90/gfdl_cloud_microphys_init; Note: This is automatically called during the -! CCPP physics initialization stage. The check for SHOC is included in the GFDL microphysics initialization routine. -#ifndef CCPP - if(Model%do_shoc) then - print *,'SHOC is not currently compatible with GFDL MP -- shutting down' - stop - endif - call gfdl_cloud_microphys_init (Model%me, Model%master, Model%nlunit, Model%input_nml_file, & - Init_parm%logunit, Model%fn_nml) -#endif -!*## CCPP ## - endif - -#ifndef CCPP - !--- initialize ras - if (Model%ras) call ras_init (Model%levs, Model%me) -#endif - -!## CCPP ##* sfc_drv.f/lsm_noah_init and sfc_noahmp_drv.f/noahmpdrv_init; Note: This is +! DH* TODO - MOVE TO CCPP +! sfc_drv.f/lsm_noah_init and sfc_noahmp_drv.f/noahmpdrv_init; Note: This is ! automatically called during the CCPP physics initialization stage. -#if 1 -!ifndef CCPP !--- initialize soil vegetation call set_soilveg(Model%me, Model%isot, Model%ivegsrc, Model%nlunit) -#endif -!*## CCPP ## +! *DH !--- lsidea initialization if (Model%lsidea) then @@ -449,630 +141,13 @@ subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, & !--- NEED TO get the logic from the old phys/gloopb.f initialization area endif -#ifndef CCPP -!---- initialization of cires_ugwp . -! if ( Model%me == Model%master) print *, ' VAY-nml ', Model%fn_nml -! if ( Model%me == Model%master) print *, ' VAY-nml2 ', Model%input_nml_file - if (Model%do_ugwp .or. Model%cdmbgwd(3) > 0.0) then -! if ( Model%me == Model%master) print *, ' VAY-nml ', Model%fn_nml, -! Model%input_nml_file - call cires_ugwp_init(Model%me, Model%master, Model%nlunit, Init_parm%logunit, & - Model%fn_nml, Model%lonr, Model%latr, Model%levs, & - Init_parm%ak, Init_parm%bk, p_ref, Model%dtp, & - Model%cdmbgwd(1:2), Model%cgwf, Model%prslrd0, Model%ral_ts) - endif -#endif - - !--- sncovr may not exist in ICs from chgres. - !--- FV3GFS handles this as part of the IC ingest - !--- this note is placed here to alert users to study - !--- the FV3GFS_io.F90 module - -#ifndef CCPP - if(Model%do_ca .and. Model%ca_global)then - - do nb = 1,nblks - do k=1,Model%levs - if (Model%si(k) .lt. 0.1 .and. Model%si(k) .gt. 0.025) then - Coupling(nb)%vfact_ca(k) = (Model%si(k)-0.025)/(0.1-0.025) - else if (Model%si(k) .lt. 0.025) then - Coupling(nb)%vfact_ca(k) = 0.0 - else - Coupling(nb)%vfact_ca(k) = 1.0 - endif - enddo - enddo - - do nb = 1,nblks - Coupling(nb)%vfact_ca(2)=Coupling(nb)%vfact_ca(3)*0.5 - Coupling(nb)%vfact_ca(1)=0.0 - enddo - - endif -#endif - end subroutine GFS_initialize - -#ifndef CCPP -!------------------------------------------------------------------------- -! time_vary_step -!------------------------------------------------------------------------- -! routine called prior to radiation and physics steps to handle: -! 1) sets up various time/date variables -! 2) sets up various triggers -! 3) defines random seed indices for radiation (in a reproducible way) -! 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, & - 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(:) - - - !--- local variables - integer :: nb, nblks, k, kdt_rad, kdt_iau, blocksize - logical :: iauwindow_center - real(kind=kind_phys) :: rinc(5) - real(kind=kind_phys) :: sec, sec_zero, fjd - integer :: iyear, imon, iday, ihr, imin, jd0, jd1 - integer :: iw3jdn - real(kind=kind_phys), parameter :: cn_hr = 3600._kind_phys - -!## CCPP ##* GFS_time_vary_pre.fv3.F90/GFS_time_vary_pre_run - nblks = size(blksz) - !--- 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) - !--- allow for radiation to be called on every physics time step, if needed - if (Model%nsswr == 1) Model%lsswr = .true. - if (Model%nslwr == 1) Model%lslwr = .true. - - !--- 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%lsm == Model%lsm_noahmp) then -! -! Julian day calculation (fcst day of the year) -! we need imn to init lai and sai and yearln and julian to -! pass to noah mp sflx, idate is init, jdat is fcst;idate = jdat when kdt=1 -! jdat is changing -! - - Model%imn = Model%idate(2) - - iyear = Model%jdat(1) - imon = Model%jdat(2) - iday = Model%jdat(3) - ihr = Model%jdat(5) - imin = Model%jdat(6) - - jd1 = iw3jdn(iyear,imon,iday) - jd0 = iw3jdn(iyear,1,1) - fjd = float(ihr)/24.0 + float(imin)/1440.0 - - Model%julian = float(jd1-jd0) + fjd - -! -! Year length -! -! what if the integration goes from one year to another? -! iyr or jyr ? from 365 to 366 or from 366 to 365 -! -! is this against model's noleap yr assumption? - - if (mod(iyear,400) == 0) then - Model%yearlen = 366 - elseif (mod(iyear,100) == 0) then - Model%yearlen = 365 - elseif (mod(iyear,4) == 0) then - Model%yearlen = 366 - else - Model%yearlen = 365 - endif - endif ! if (Model%lsm == Model%lsm_noahmp) -! - - 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 -!*## CCPP ## - -!## CCPP ##* All functionality except for the call to radupdate is now in -! GFS_rad_time_vary.fv3.F90/GFS_rad_time_vary_run. The call to radupdate is now -! in GFS_rrtmg_setup.F90/GFS_rrtmg_setup_run. - !--- radiation time varying routine - if (Model%lsswr .or. Model%lslwr) then - call GFS_rad_time_vary (Model, Statein, Tbd, sec) - endif -!*## CCPP ## - -!## CCPP ##* All functionality is now in GFS_phys_time_vary.fv3.F90/GFS_phys_time_vary_run - !--- physics time varying routine - call GFS_phys_time_vary (Model, Grid, Tbd, Statein) - - !--- 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 - ! if not updating surface params through fcast, perturb params once at start of fcast - endif - - !--- determine if diagnostics buckets need to be cleared - sec_zero = nint(Model%fhzero*con_hr) - if (sec_zero >= nint(max(Model%fhswr,Model%fhlwr))) then - 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 - else - if (mod(Model%kdt,Model%nszero) == 1) then - do nb = 1,nblks - call Diag(nb)%phys_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - enddo - endif - kdt_rad = nint(min(Model%fhswr,Model%fhlwr)/Model%dtp) - if (mod(Model%kdt, kdt_rad) == 1) then - do nb = 1,nblks - call Diag(nb)%rad_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - enddo - endif - endif -!*## CCPP ## -!## CCPP ## This is not yet in the CCPP - if (Model%iau_offset > 0) then - kdt_iau = nint(Model%iau_offset*con_hr/Model%dtp) - if (Model%kdt == kdt_iau+1) then - iauwindow_center = .true. - do nb = 1,nblks - call Diag(nb)%rad_zero (Model) - call Diag(nb)%phys_zero (Model,iauwindow_center=iauwindow_center) - enddo - if(Model%me == Model%master) print *,'in gfs_driver, at iau_center, zero out rad/phys accumulated diag fields, kdt=',Model%kdt,'kdt_iau=',kdt_iau,'iau_offset=',Model%iau_offset - endif - endif -!*## CCPP ## - -! kludge for output - if (Model%do_skeb) then - do nb = 1,nblks - do k=1,Model%levs - Diag(nb)%skebu_wts(:,k) = Coupling(nb)%skebu_wts(:,Model%levs-k+1) - Diag(nb)%skebv_wts(:,k) = Coupling(nb)%skebv_wts(:,Model%levs-k+1) - enddo - enddo - endif - !if (Model%do_sppt) then - ! do nb = 1,nblks - ! do k=1,Model%levs - ! Diag(nb)%sppt_wts(:,k) = Coupling(nb)%sppt_wts(:,Model%levs-k+1) - ! enddo - ! enddo - !endif - if (Model%do_shum) then - do nb = 1,nblks - do k=1,Model%levs - Diag(nb)%shum_wts(:,k)=Coupling(nb)%shum_wts(:,Model%levs-k+1) - enddo - enddo - endif -!*## CCPP ## - end subroutine GFS_time_vary_step - -!## CCPP ##* GFS_stochastics.F90/GFS_stochastics_run -!------------------------------------------------------------------------- -! GFS stochastic_driver -!------------------------------------------------------------------------- -! routine called prior to radiation and physics steps to handle: -! 1) sets up various time/date variables -! 2) sets up various triggers -! 3) defines random seed indices for radiation (in a reproducible way) -! 5) interpolates coefficients for prognostic ozone calculation -! 6) performs surface data cycling via the GFS gcycle routine -!------------------------------------------------------------------------- - subroutine GFS_stochastic_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 - - !--- local variables - integer :: k, i - real(kind=kind_phys) :: upert, vpert, tpert, qpert, qnew,sppt_vwt - real(kind=kind_phys),dimension(size(Statein%tgrs,1),size(Statein%tgrs,2)) :: ca1 - - if (Model%do_sppt) then - do k = 1,size(Statein%tgrs,2) - do i = 1,size(Statein%tgrs,1) - sppt_vwt=1.0 - if (Diag%zmtnblck(i).EQ.0.0) then - sppt_vwt=1.0 - else - if (k.GT.Diag%zmtnblck(i)+2) then - sppt_vwt=1.0 - endif - if (k.LE.Diag%zmtnblck(i)) then - sppt_vwt=0.0 - endif - if (k.EQ.Diag%zmtnblck(i)+1) then - sppt_vwt=0.333333 - endif - if (k.EQ.Diag%zmtnblck(i)+2) then - sppt_vwt=0.666667 - endif - endif - if (Model%use_zmtnblck)then - Coupling%sppt_wts(i,k)=(Coupling%sppt_wts(i,k)-1)*sppt_vwt+1.0 - endif - Diag%sppt_wts(i,Model%levs-k+1)=Coupling%sppt_wts(i,k) - - - 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) - Tbd%dtdtr(i,k)) * Coupling%sppt_wts(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 >= 1.0e-10) then - Stateout%gq0(i,k,1) = qnew - Stateout%gt0(i,k) = Statein%tgrs(i,k) + tpert + Tbd%dtdtr(i,k) - endif - enddo - enddo - - ! instantaneous precip rate going into land model at the next time step - Sfcprop%tprcp(:) = Coupling%sppt_wts(:,15)*Sfcprop%tprcp(:) - Diag%totprcp(:) = Diag%totprcp(:) + (Coupling%sppt_wts(:,15) - 1 )*Diag%rain(:) - ! acccumulated total and convective preciptiation - Diag%cnvprcp(:) = Diag%cnvprcp(:) + (Coupling%sppt_wts(:,15) - 1 )*Diag%rainc(:) - ! bucket precipitation adjustment due to sppt - Diag%totprcpb(:) = Diag%totprcpb(:) + (Coupling%sppt_wts(:,15) - 1 )*Diag%rain(:) - Diag%cnvprcpb(:) = Diag%cnvprcpb(:) + (Coupling%sppt_wts(:,15) - 1 )*Diag%rainc(:) - - - if (Model%cplflx) then - Coupling%rain_cpl(:) = Coupling%rain_cpl(:) + (Coupling%sppt_wts(:,15) - 1.0)*Tbd%drain_cpl(:) - Coupling%snow_cpl(:) = Coupling%snow_cpl(:) + (Coupling%sppt_wts(:,15) - 1.0)*Tbd%dsnow_cpl(:) - endif - - endif - - - if (Model%do_ca .and. Model%ca_global) then - do k = 1,size(Statein%tgrs,2) - do i = 1,size(Statein%tgrs,1) - sppt_vwt=1.0 - if (Diag%zmtnblck(i).EQ.0.0) then - sppt_vwt=1.0 - else - if (k.GT.Diag%zmtnblck(i)+2) then - sppt_vwt=1.0 - endif - if (k.LE.Diag%zmtnblck(i)) then - sppt_vwt=0.0 - endif - if (k.EQ.Diag%zmtnblck(i)+1) then - sppt_vwt=0.333333 - endif - if (k.EQ.Diag%zmtnblck(i)+2) then - sppt_vwt=0.666667 - endif - endif - - ca1(i,k)=((Coupling%ca1(i)-1.)*sppt_vwt*Coupling%vfact_ca(k))+1.0 - - upert = (Stateout%gu0(i,k) - Statein%ugrs(i,k)) * ca1(i,k) - vpert = (Stateout%gv0(i,k) - Statein%vgrs(i,k)) * ca1(i,k) - tpert = (Stateout%gt0(i,k) - Statein%tgrs(i,k) - Tbd%dtdtr(i,k)) * ca1(i,k) - qpert = (Stateout%gq0(i,k,1) - Statein%qgrs(i,k,1)) * ca1(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 >= 1.0e-10) then - Stateout%gq0(i,k,1) = qnew - Stateout%gt0(i,k) = Statein%tgrs(i,k) + tpert + Tbd%dtdtr(i,k) - endif - - enddo - enddo - - - - ! instantaneous precip rate going into land model at the next time step - Sfcprop%tprcp(:) = ca1(:,15)*Sfcprop%tprcp(:) - Diag%totprcp(:) = Diag%totprcp(:) + (ca1(:,15) - 1 )*Diag%rain(:) - ! acccumulated total and convective preciptiation - Diag%cnvprcp(:) = Diag%cnvprcp(:) + (ca1(:,15) - 1 )*Diag%rainc(:) - ! bucket precipitation adjustment due to sppt - Diag%totprcpb(:) = Diag%totprcpb(:) + (ca1(:,15) - 1 )*Diag%rain(:) - Diag%cnvprcpb(:) = Diag%cnvprcpb(:) + (ca1(:,15) - 1 )*Diag%rainc(:) - - if (Model%cplflx) then - Coupling%rain_cpl(:) = Coupling%rain_cpl(:) + (ca1(:,15) - 1.0)*Tbd%drain_cpl(:) - Coupling%snow_cpl(:) = Coupling%snow_cpl(:) + (ca1(:,15) - 1.0)*Tbd%dsnow_cpl(:) - endif - - endif - - - - - if (Model%do_shum) then - Stateout%gq0(:,:,1) = Stateout%gq0(:,:,1)*(1.0 + Coupling%shum_wts(:,:)) - endif - - if (Model%do_skeb) then - do k = 1,size(Statein%tgrs,2) - Stateout%gu0(:,k) = Stateout%gu0(:,k)+Coupling%skebu_wts(:,k)*(Statein%diss_est(:,k)) - Stateout%gv0(:,k) = Stateout%gv0(:,k)+Coupling%skebv_wts(:,k)*(Statein%diss_est(:,k)) - ! print*,'in do skeb',Coupling%skebu_wts(1,k),Statein%diss_est(1,k) - enddo - endif - - end subroutine GFS_stochastic_driver -!*## CCPP ## - - -!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -! -! PRIVATE SUBROUTINES -! -!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -!## CCPP ##* GFS_rad_time_vary.fv3.F90/GFS_rad_time_vary_run except for the call to -! radupdate, which is in GFS_rrtmg_setup.F90/GFS_rrtmg_setup_run -!----------------------------------------------------------------------- -! 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 > 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%imp_physics == 99) 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 -!*## CCPP ## - -!## CCPP ## GFS_phys_time_vary.fv3.F90/GFS_phys_time_vary_run -!----------------------------------------------------------------------- -! GFS_phys_time_vary -!----------------------------------------------------------------------- -! -! Routine containing all of the setup logic originally in phys/gloopb.f -! -!----------------------------------------------------------------------- - subroutine GFS_phys_time_vary (Model, Grid, Tbd, Statein) - 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(:) - type(GFS_statein_type), intent(in) :: Statein(:) - !--- 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. - ! Model%imfdeepcnv < 0 when Model%ras = .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)*1000.0) * 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 > 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 - - !--- ICCN interpolation - if (Model%ICCN == 1) then - do nb = 1, nblks - call ciinterpol (Model%me, blksz(nb), Model%idate, Model%fhour, & - Grid(nb)%jindx1_ci, Grid(nb)%jindx2_ci, & - Grid(nb)%ddy_ci,Grid(nb)%iindx1_ci, & - Grid(nb)%iindx2_ci,Grid(nb)%ddx_ci, & - Model%levs,Statein(nb)%prsl, & - Tbd(nb)%in_nm, Tbd(nb)%ccn_nm) - enddo - endif - - !--- aerosol interpolation - if (Model%iaerclm ) then - do nb = 1, nblks - call aerinterpol (Model%me, Model%master, blksz(nb), & - Model%idate, Model%fhour, & - Grid(nb)%jindx1_aer, Grid(nb)%jindx2_aer, & - Grid(nb)%ddy_aer,Grid(nb)%iindx1_aer, & - Grid(nb)%iindx2_aer,Grid(nb)%ddx_aer, & - Model%levs,Statein(nb)%prsl, & - Tbd(nb)%aer_nm) - enddo - endif - - end subroutine GFS_phys_time_vary -#endif -!*## CCPP ## - -!## CCPP ##* This is not in the CCPP !------------------ ! GFS_grid_populate !------------------ subroutine GFS_grid_populate (Grid, xlon, xlat, area) - use physcons, only: pi => con_pi + use physcons, only: pi => con_pi implicit none @@ -1108,7 +183,5 @@ subroutine GFS_grid_populate (Grid, xlon, xlat, area) enddo end subroutine GFS_grid_populate -!*## CCPP ## end module GFS_driver - diff --git a/gfsphysics/GFS_layer/GFS_restart.F90 b/gfsphysics/GFS_layer/GFS_restart.F90 index eada1fc3d..c243c5da1 100644 --- a/gfsphysics/GFS_layer/GFS_restart.F90 +++ b/gfsphysics/GFS_layer/GFS_restart.F90 @@ -97,7 +97,6 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & Restart%ldiag = 3 + Model%ntot2d + Model%nctp + ndiag_rst Restart%num2d = 3 + Model%ntot2d + Model%nctp + ndiag_rst -#ifdef CCPP ! GF if (Model%imfdeepcnv == 3) then Restart%num2d = Restart%num2d + 1 @@ -114,13 +113,11 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & if (Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then Restart%num2d = Restart%num2d + 2 endif -#endif Restart%num3d = Model%ntot3d if(Model%lrefres) then Restart%num3d = Model%ntot3d+1 endif -#ifdef CCPP ! GF if (Model%imfdeepcnv == 3) then Restart%num3d = Restart%num3d + 3 @@ -129,7 +126,6 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & if (Model%do_mynnedmf) then Restart%num3d = Restart%num3d + 9 endif -#endif allocate (Restart%name2d(Restart%num2d)) allocate (Restart%name3d(Restart%num3d)) @@ -184,7 +180,6 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & ! print *,'in restart 2d field, Restart%name2d(',offset+idx,')=',trim(Restart%name2d(offset+idx)) enddo -#ifdef CCPP !--- RAP/HRRR-specific variables, 2D num = offset + ndiag_rst ! GF @@ -244,7 +239,6 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & Restart%data(nb,num)%var2p => Coupling(nb)%nifa2d(:) enddo endif -#endif !--- phy_f3d variables do num = 1,Model%ntot3d @@ -262,7 +256,7 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & Restart%data(nb,num)%var3p => IntDiag(nb)%refl_10cm(:,:) enddo endif -#ifdef CCPP + if (Model%lrefres) then num = Model%ntot3d+1 else @@ -335,7 +329,6 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & Restart%data(nb,num)%var3p => Tbd(nb)%cov(:,:) enddo endif -#endif end subroutine GFS_restart_populate diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 98b966450..3ba65a454 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -3,7 +3,6 @@ module GFS_typedefs use machine, only: kind_phys -#ifdef CCPP use physcons, only: con_cp, con_fvirt, con_g, & con_hvap, con_hfus, con_pi, con_rd, con_rv, & con_t0c, con_cvap, con_cliq, con_eps, con_epsq, & @@ -21,18 +20,9 @@ module GFS_typedefs use mo_cloud_optics, only: ty_cloud_optics use mo_gas_concentrations, only: ty_gas_concs use mo_source_functions, only: ty_source_func_lw -#else - use physcons, only: rhowater, con_p0 - use module_radsw_parameters, only: topfsw_type, sfcfsw_type - use module_radlw_parameters, only: topflw_type, sfcflw_type - use ozne_def, only: levozp, oz_coeff - use h2o_def, only: levh2o, h2o_coeff - use aerclm_def, only: ntrcaer, ntrcaerm -#endif implicit none -#ifdef CCPP ! To ensure that these values match what's in the physics, ! array sizes are compared during model init in GFS_rrtmg_setup_init() private :: NF_AESW, NF_AELW, NSPC, NSPC1, NF_CLDS, NF_VGAS, NF_ALBD, ntrcaerm @@ -54,7 +44,7 @@ module GFS_typedefs ! it depends on the runtime config (Model%aero_in) private :: ntrcaer integer :: ntrcaer -#endif + ! If these are changed to >99, need to adjust formatting string in GFS_diagnostics.F90 (and names in diag_tables) integer, parameter :: naux2dmax = 20 !< maximum number of auxiliary 2d arrays in output (for debugging) integer, parameter :: naux3dmax = 20 !< maximum number of auxiliary 3d arrays in output (for debugging) @@ -76,7 +66,7 @@ module GFS_typedefs real(kind=kind_phys), parameter :: cn_100 = 100._kind_phys real(kind=kind_phys), parameter :: cn_th = 1000._kind_phys real(kind=kind_phys), parameter :: cn_hr = 3600._kind_phys -#ifdef CCPP + ! optional extra top layer on top of low ceiling models ! this parameter was originally defined in the radiation driver ! (and is still for standard non-CCPP builds), but is required @@ -85,7 +75,6 @@ module GFS_typedefs ! LTP=0: no extra top layer integer, parameter :: LTP = 0 ! no extra top layer !integer, parameter :: LTP = 1 ! add an extra top layer -#endif !---------------- ! Data Containers @@ -104,10 +93,8 @@ module GFS_typedefs ! GFS_cldprop_type !< cloud fields needed by radiation from physics ! GFS_radtend_type !< radiation tendencies needed in physics ! GFS_diag_type !< fields targetted for diagnostic output -#ifdef CCPP ! GFS_interstitial_type !< fields required to replace interstitial code in GFS_{physics,radiation}_driver.F90 in CCPP ! GFS_data_type !< combined type of all of the above except GFS_control_type and GFS_interstitial_type -#endif !-------------------------------------------------------------------------------- ! GFS_init_type @@ -140,12 +127,10 @@ module GFS_typedefs integer :: iau_offset !< iau running window length real(kind=kind_phys) :: dt_dycore !< dynamics time step in seconds real(kind=kind_phys) :: dt_phys !< physics time step in seconds -#ifdef CCPP !--- restart information logical :: restart !< flag whether this is a coldstart (.false.) or a warmstart/restart (.true.) !--- hydrostatic/non-hydrostatic flag logical :: hydrostatic !< flag whether this is a hydrostatic or non-hydrostatic run -#endif !--- blocking data integer, pointer :: blksz(:) !< for explicit data blocking !< default blksz(1)=[nx*ny] @@ -282,9 +267,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: qss (:) => null() !< !-- In/Out -#ifdef CCPP - real (kind=kind_phys), pointer :: conv_act(:) => null() !< convective activity counter hli 09/2017 -#endif + real (kind=kind_phys), pointer :: conv_act(:) => null() !< convective activity counter for Grell-Freitas real (kind=kind_phys), pointer :: hice (:) => null() !< sea ice thickness real (kind=kind_phys), pointer :: weasd (:) => null() !< water equiv of accumulated snow depth (kg/m**2) !< over land and sea ice @@ -300,9 +283,7 @@ module GFS_typedefs !--- Out real (kind=kind_phys), pointer :: t2m (:) => null() !< 2 meter temperature -#ifdef CCPP real (kind=kind_phys), pointer :: th2m (:) => null() !< 2 meter potential temperature -#endif real (kind=kind_phys), pointer :: q2m (:) => null() !< 2 meter humidity ! -- In/Out for Noah MP @@ -365,7 +346,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: dt_cool(:) => null() !< nst_fld%dt_cool Sub layer cooling amount real (kind=kind_phys), pointer :: qrain (:) => null() !< nst_fld%qrain sensible heat flux due to rainfall (watts) -#ifdef CCPP ! Soil properties for RUC LSM (number of levels different from NOAH 4-layer model) real (kind=kind_phys), pointer :: wetness(:) => null() !< normalized soil wetness for lsm real (kind=kind_phys), pointer :: sh2o(:,:) => null() !< volume fraction of unfrozen soil moisture for lsm @@ -392,7 +372,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: chs2(:) => null() !exch coeff for heat at 2m real (kind=kind_phys), pointer :: cqs2(:) => null() !exch coeff for moisture at 2m real (kind=kind_phys), pointer :: lh(:) => null() !latent heating at the surface -#endif !---- precipitation amounts from previous time step for RUC LSM/NoahMP LSM real (kind=kind_phys), pointer :: raincprv (:) => null() !< explicit rainfall from previous timestep @@ -552,19 +531,15 @@ module GFS_typedefs integer :: me !< MPI rank designator integer :: master !< MPI rank of master atmosphere processor -#ifdef CCPP integer :: communicator !< MPI communicator integer :: ntasks !< MPI size in communicator integer :: nthreads !< OpenMP threads available for physics -#endif integer :: nlunit !< unit for namelist character(len=64) :: fn_nml !< namelist filename for surface data cycling character(len=256), pointer :: input_nml_file(:) !< character string containing full namelist - !< for use with internal file reads -#ifdef CCPP - integer :: input_nml_file_length + !< for use with internal file reads + integer :: input_nml_file_length !< length (number of lines) in namelist for internal reads integer :: logunit -#endif real(kind=kind_phys) :: fhzero !< hours between clearing of diagnostic buckets logical :: ldiag3d !< flag for 3d diagnostic fields logical :: qdiag3d !< flag for 3d tracer diagnostic fields @@ -589,13 +564,11 @@ module GFS_typedefs integer :: nx !< number of points in the i-dir for this MPI-domain integer :: ny !< number of points in the j-dir for this MPI-domain integer :: levs !< number of vertical levels - !--- ak/bk for pressure level calculations - real(kind=kind_phys), pointer :: ak(:) !< from surface (k=1) to TOA (k=levs) - real(kind=kind_phys), pointer :: bk(:) !< from surface (k=1) to TOA (k=levs) -#ifdef CCPP + !--- ak/bk for pressure level calculations + real(kind=kind_phys), pointer :: ak(:) !< from surface (k=1) to TOA (k=levs) + real(kind=kind_phys), pointer :: bk(:) !< from surface (k=1) to TOA (k=levs) integer :: levsp1 !< number of vertical levels plus one integer :: levsm1 !< number of vertical levels minus one -#endif integer :: cnx !< number of points in the i-dir for this cubed-sphere face integer :: cny !< number of points in the j-dir for this cubed-sphere face integer :: lonr !< number of global points in x-dir (i) along the equator @@ -603,9 +576,7 @@ module GFS_typedefs integer :: tile_num integer :: nblks !< for explicit data blocking: number of blocks integer, pointer :: blksz(:) !< for explicit data blocking: block sizes of all blocks -#ifdef CCPP integer :: ncols !< total number of columns for all blocks -#endif !--- coupling parameters logical :: cplflx !< default no cplflx collection @@ -638,18 +609,12 @@ module GFS_typedefs real(kind=kind_phys) :: fhlwr !< frequency for longwave radiation (secs) integer :: nsswr !< integer trigger for shortwave radiation integer :: nslwr !< integer trigger for longwave radiation -#ifdef CCPP integer :: nhfrad !< number of timesteps for which to call radiation on physics timestep (coldstarts) -#endif integer :: levr !< number of vertical levels for radiation calculations -#ifdef CCPP integer :: levrp1 !< number of vertical levels for radiation calculations plus one -#endif integer :: nfxr !< second dimension for fluxr diagnostic variable (radiation) logical :: iaerclm !< flag for initializing aerosol data -#ifdef CCPP integer :: ntrcaer !< number of aerosol tracers for Morrison-Gettelman microphysics -#endif logical :: lmfshal !< parameter for radiation logical :: lmfdeep2 !< parameter for radiation integer :: nrcm !< second dimension of random number stream for RAS @@ -682,17 +647,17 @@ module GFS_typedefs !< =1 => sub-grid cloud with prescribed seeds !< =2 => sub-grid cloud with randomly generated !< seeds - integer :: idcor !< Decorrelation length type for overlap assumption - !< =0 => Use constant decorrelation length, decorr_con - !< =1 => Use spatially varying decorrelation length (Hogan et al. 2010) - !< =2 => Use spatially and temporally varyint decorrelation length (Oreopoulos et al. 2012) + integer :: idcor !< Decorrelation length type for overlap assumption + !< =0 => Use constant decorrelation length, decorr_con + !< =1 => Use spatially varying decorrelation length (Hogan et al. 2010) + !< =2 => Use spatially and temporally varyint decorrelation length (Oreopoulos et al. 2012) real(kind_phys) :: dcorr_con !< Decorrelation length constant (km) (if idcor = 0) logical :: crick_proof !< CRICK-Proof cloud water logical :: ccnorm !< Cloud condensate normalized by cloud cover logical :: norad_precip !< radiation precip flag for Ferrier/Moorthi logical :: lwhtr !< flag to output lw heating rate (Radtend%lwhc) logical :: swhtr !< flag to output sw heating rate (Radtend%swhc) -#ifdef CCPP + ! RRTMGP logical :: do_RRTMGP !< Use RRTMGP character(len=128) :: active_gases !< Character list of active gases used in RRTMGP @@ -706,18 +671,18 @@ module GFS_typedefs character(len=128) :: sw_file_clouds !< RRTMGP file containing coefficients used to compute clouds optical properties integer :: rrtmgp_nBandsSW !< Number of RRTMGP SW bands. integer :: rrtmgp_nGptsSW !< Number of RRTMGP SW spectral points. - logical :: doG_cldoptics !< Use legacy RRTMG cloud-optics? - logical :: doGP_cldoptics_PADE !< Use RRTMGP cloud-optics: PADE approximation? - logical :: doGP_cldoptics_LUT !< Use RRTMGP cloud-optics: LUTs? + logical :: doG_cldoptics !< Use legacy RRTMG cloud-optics? + logical :: doGP_cldoptics_PADE !< Use RRTMGP cloud-optics: PADE approximation? + logical :: doGP_cldoptics_LUT !< Use RRTMGP cloud-optics: LUTs? integer :: rrtmgp_nrghice !< Number of ice-roughness categories integer :: rrtmgp_nGauss_ang !< Number of angles used in Gaussian quadrature logical :: do_GPsw_Glw !< If set to true use rrtmgp for SW calculation, rrtmg for LW. character(len=128) :: active_gases_array(100) !< character array for each trace gas name logical :: use_LW_jacobian !< If true, use Jacobian of LW to update radiation tendency. logical :: doGP_lwscat !< If true, include scattering in longwave cloud-optics, only compatible w/ GP cloud-optics -#endif + !--- microphysical switch - integer :: ncld !< choice of cloud scheme + integer :: ncld !< choice of cloud scheme !--- new microphysical switch integer :: imp_physics !< choice of microphysics scheme integer :: imp_physics_gfdl = 11 !< choice of GFDL microphysics scheme @@ -809,7 +774,6 @@ module GFS_typedefs !< isot = 1 => STATSGO soil type (19 category, AKA 'STAS'(?)) !< isot = 2 => STAS-RUC soil type (19 category, NOAH WRFv4 only) integer :: kice=2 !< number of layers in sice -#ifdef CCPP integer :: lsoil_lsm !< number of soil layers internal to land surface model integer :: lsnow_lsm !< maximum number of snow layers internal to land surface model integer :: lsnow_lsm_lbound!< lower bound for snow arrays, depending on lsnow_lsm @@ -825,9 +789,8 @@ module GFS_typedefs integer :: iopt_thcnd !< option to treat thermal conductivity in Noah LSM (new in 3.8) !< = 1, original (default) !< = 2, McCumber and Pielke for silt loam and sandy loam -#endif - ! -- the Noah MP options + ! -- the Noah MP options integer :: iopt_dveg ! 1-> off table lai 2-> on 3-> off;4->off;5 -> on integer :: iopt_crs !canopy stomatal resistance (1-> ball-berry; 2->jarvis) integer :: iopt_btr !soil moisture factor for stomatal resistance (1-> noah; 2-> clm; 3-> ssib) @@ -843,13 +806,11 @@ module GFS_typedefs logical :: use_ufo !< flag for gcycle surface option -#ifdef CCPP ! GFDL Surface Layer options logical :: lcurr_sf !< flag for taking ocean currents into account in GFDL surface layer logical :: pert_cd !< flag for perturbing the surface drag coefficient for momentum in surface layer scheme (1 = True) integer :: ntsflg !< flag for updating skin temperature in the GFDL surface layer scheme real(kind=kind_phys) :: sfenth !< enthalpy flux factor 0 zot via charnock ..>0 zot enhanced>15m/s -#endif !--- flake model parameters integer :: lkm !< flag for flake model @@ -861,7 +822,6 @@ module GFS_typedefs logical :: trans_trac !< flag for convective transport of tracers (RAS, CS, or SAMF) logical :: old_monin !< flag for diff monin schemes logical :: cnvgwd !< flag for conv gravity wave drag -#ifdef CCPP integer :: gwd_opt !< gwd_opt = 1 => original GFS gwd (gwdps.f) !< gwd_opt = 2 => unified ugwp GWD !< gwd_opt = 22 => unified ugwp GWD with extra output @@ -874,17 +834,14 @@ module GFS_typedefs logical :: do_gsl_drag_tofd !< flag for GSL drag (turbulent orog form drag only) logical :: do_ugwp_v1 !< flag for version 1 ugwp GWD logical :: do_ugwp_v1_orog_only !< flag for version 1 ugwp GWD (orographic drag only) -#endif logical :: mstrat !< flag for moorthi approach for stratus logical :: moist_adj !< flag for moist convective adjustment logical :: cscnv !< flag for Chikira-Sugiyama convection logical :: cal_pre !< flag controls precip type algorithm -#ifdef CCPP real(kind=kind_phys) :: rhgrd !< fer_hires microphysics only logical :: spec_adv !< flag for individual cloud species advected integer :: icloud !< cloud effect to the optical depth in radiation; this also controls the cloud fraction options !< 3: with cloud effect, and use cloud fraction option 3, based on Sundqvist et al. (1989) -#endif logical :: do_aw !< AW scale-aware option in cs convection logical :: do_awdd !< AW scale-aware option in cs convection logical :: flx_form !< AW scale-aware option in cs convection @@ -892,10 +849,8 @@ module GFS_typedefs logical :: shocaftcnv !< flag for SHOC logical :: shoc_cld !< flag for clouds logical :: uni_cld !< flag for clouds in grrad -#ifdef CCPP logical :: oz_phys !< flag for old (2006) ozone physics logical :: oz_phys_2015 !< flag for new (2015) ozone physics -#endif logical :: h2o_phys !< flag for stratosphere h2o logical :: pdfcld !< flag for pdfcld logical :: shcnvcw !< flag for shallow convective cloud @@ -906,12 +861,11 @@ module GFS_typedefs logical :: shinhong !< flag for scale-aware Shinhong vertical turbulent mixing scheme logical :: do_ysu !< flag for YSU turbulent mixing scheme logical :: dspheat !< flag for tke dissipative heating -#ifdef CCPP logical :: hurr_pbl !< flag for hurricane-specific options in PBL scheme -#endif logical :: lheatstrg !< flag for canopy heat storage parameterization - logical :: cnvcld + logical :: cnvcld logical :: random_clds !< flag controls whether clouds are random + logical :: shal_cnv !< flag for calling shallow convection logical :: do_deep !< whether to do deep convection integer :: imfshalcnv !< flag for mass-flux shallow convection scheme @@ -922,13 +876,11 @@ module GFS_typedefs !< 4: New Tiedtke scheme (CAPS) !< 0: modified Tiedtke's eddy-diffusion shallow conv scheme !< -1: no shallow convection used -#ifdef CCPP integer :: imfshalcnv_sas = 1 !< flag for SAS mass-flux shallow convection scheme integer :: imfshalcnv_samf = 2 !< flag for SAMF scale- & aerosol-aware mass-flux shallow convection scheme integer :: imfshalcnv_gf = 3 !< flag for scale- & aerosol-aware Grell-Freitas scheme (GSD) integer :: imfshalcnv_ntiedtke = 4 !< flag for new Tiedtke scheme (CAPS) logical :: hwrf_samfdeep !< flag for HWRF SAMF deepcnv scheme (HWRF) -#endif integer :: imfdeepcnv !< flag for mass-flux deep convection scheme !< 1: July 2010 version of SAS conv scheme !< current operational version as of 2016 @@ -936,20 +888,17 @@ module GFS_typedefs !< 3: scale- & aerosol-aware Grell-Freitas scheme (GSD) !< 4: New Tiedtke scheme (CAPS) !< 0: old SAS Convection scheme before July 2010 -#ifdef CCPP integer :: imfdeepcnv_sas = 1 !< flag for SAS mass-flux deep convection scheme integer :: imfdeepcnv_samf = 2 !< flag for SAMF scale- & aerosol-aware mass-flux deep convection scheme integer :: imfdeepcnv_gf = 3 !< flag for scale- & aerosol-aware Grell-Freitas scheme (GSD) integer :: imfdeepcnv_ntiedtke = 4 !< flag for new Tiedtke scheme (CAPS) logical :: hwrf_samfshal !< flag for HWRF SAMF shalcnv scheme (HWRF) -#endif integer :: isatmedmf !< flag for scale-aware TKE-based moist edmf scheme !< 0: initial version of satmedmf (Nov. 2018) !< 1: updated version of satmedmf (as of May 2019) -#ifdef CCPP integer :: isatmedmf_vdif = 0 !< flag for initial version of satmedmf (Nov. 2018) integer :: isatmedmf_vdifq = 1 !< flag for updated version of satmedmf (as of May 2019) -#endif + integer :: nmtvr !< number of topographic variables such as variance etc !< used in the GWD parameterization - 10 more added if !< GSL orographic drag scheme is used @@ -974,7 +923,7 @@ module GFS_typedefs integer :: seed0 !< random seed for radiation real(kind=kind_phys) :: rbcr !< Critical Richardson Number in the PBL scheme -#ifdef CCPP + !--- MYNN parameters/switches logical :: do_mynnedmf logical :: do_mynnsfclay @@ -999,7 +948,6 @@ module GFS_typedefs ! MYJ switches logical :: do_myjsfc !< flag for MYJ surface layer scheme logical :: do_myjpbl !< flag for MYJ PBL scheme -#endif !--- Rayleigh friction real(kind=kind_phys) :: prslrd0 !< pressure level from which Rayleigh Damping is applied @@ -1118,10 +1066,8 @@ module GFS_typedefs !--- tracer handling character(len=32), pointer :: tracer_names(:) !< array of initialized tracers from dynamic core integer :: ntrac !< number of tracers -#ifdef CCPP integer :: ntracp1 !< number of tracers plus one integer :: nqrimef !< tracer index for mass weighted rime factor -#endif integer :: ntqv !< tracer index for water vapor (specific humidity) integer :: ntoz !< tracer index for ozone mixing ratio integer :: ntcw !< tracer index for cloud condensate (or liquid water) @@ -1163,7 +1109,6 @@ module GFS_typedefs integer :: nreffr !< the index of rain effective radius in phy_f3d integer :: nseffr !< the index of snow effective radius in phy_f3d integer :: ngeffr !< the index of graupel effective radius in phy_f3d -#ifdef CCPP integer :: nkbfshoc !< the index of upward kinematic buoyancy flux from SHOC in phy_f3d integer :: nahdshoc !< the index of diffusivity for heat from from SHOC in phy_f3d integer :: nscfshoc !< the index of subgrid-scale cloud fraction from from SHOC in phy_f3d @@ -1174,7 +1119,6 @@ module GFS_typedefs integer :: nps2delt !< the index of surface air pressure 2 timesteps back for Z-C MP in phy_f2d integer :: npsdelt !< the index of surface air pressure at the previous timestep for Z-C MP in phy_f2d integer :: ncnvwind !< the index of surface wind enhancement due to convection for MYNN SFC and RAS CNV in phy f2d -#endif !--- debug flag logical :: debug @@ -1196,11 +1140,9 @@ module GFS_typedefs real(kind=kind_phys) :: fhour !< current forecast hour real(kind=kind_phys) :: zhour !< previous hour diagnostic buckets emptied integer :: kdt !< current forecast iteration -#ifdef CCPP logical :: first_time_step !< flag signaling first time step for time integration routine logical :: restart !< flag whether this is a coldstart (.false.) or a warmstart/restart (.true.) logical :: hydrostatic !< flag whether this is a hydrostatic or non-hydrostatic run -#endif integer :: jdat(1:8) !< current forecast date and time !< (yr, mon, day, t-zone, hr, min, sec, mil-sec) integer :: imn !< initial forecast month @@ -1209,9 +1151,7 @@ module GFS_typedefs ! integer :: iccn !< using IN CCN forcing for MG2/3 real(kind=kind_phys), pointer :: si(:) !< vertical sigma coordinate for model initialization -#ifdef CCPP real(kind=kind_phys) :: sec !< seconds since model initialization -#endif !--- IAU integer :: iau_offset @@ -1220,13 +1160,11 @@ module GFS_typedefs real(kind=kind_phys) :: iaufhrs(7) ! forecast hours associated with increment files logical :: iau_filter_increments, iau_drymassfixer -#ifdef CCPP ! From physcons.F90, updated/set in control_initialize real(kind=kind_phys) :: dxinv ! inverse scaling factor for critical relative humidity, replaces dxinv in physcons.F90 real(kind=kind_phys) :: dxmax ! maximum scaling factor for critical relative humidity, replaces dxmax in physcons.F90 real(kind=kind_phys) :: dxmin ! minimum scaling factor for critical relative humidity, replaces dxmin in physcons.F90 real(kind=kind_phys) :: rhcmax ! maximum critical relative humidity, replaces rhc_max in physcons.F90 -#endif contains procedure :: init => control_initialize @@ -1308,11 +1246,10 @@ module GFS_typedefs real (kind=kind_phys), pointer :: ccn_nm (:,:) => null() !< CCN number concentration real (kind=kind_phys), pointer :: aer_nm (:,:,:) => null() !< GOCART aerosol climo - !--- active when ((.not. newsas .or. cal_pre) .and. random_clds) -#ifdef CCPP integer, pointer :: imap (:) => null() !< map of local index ix to global index i for this block integer, pointer :: jmap (:) => null() !< map of local index ix to global index j for this block -#endif + + !--- active when ((.not. newsas .or. cal_pre) .and. random_clds) real (kind=kind_phys), pointer :: rann (:,:) => null() !< random number array (0-1) !--- In/Out @@ -1335,12 +1272,6 @@ module GFS_typedefs !--- Diagnostic that needs to be carried over to the next time step (removed from diag_type) real (kind=kind_phys), pointer :: hpbl (:) => null() !< Planetary boundary layer height -#ifndef CCPP -!--- for explicit data blocking - integer :: blkno !< block number of this block -#endif - -#ifdef CCPP !--- dynamical forcing variables for Grell-Freitas convection real (kind=kind_phys), pointer :: forcet (:,:) => null() !< real (kind=kind_phys), pointer :: forceq (:,:) => null() !< @@ -1372,7 +1303,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: phy_myj_a1u(:) => null() ! real (kind=kind_phys), pointer :: phy_myj_a1t(:) => null() ! real (kind=kind_phys), pointer :: phy_myj_a1q(:) => null() ! -#endif contains procedure :: create => tbd_create !< allocate array data @@ -1514,7 +1444,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: totsnwb(:) => null() !< accumulated snow precipitation in bucket (kg/m2) real (kind=kind_phys), pointer :: totgrpb(:) => null() !< accumulated graupel precipitation in bucket (kg/m2) -#ifdef CCPP !--- MYNN variables real (kind=kind_phys), pointer :: edmf_a (:,:) => null() ! real (kind=kind_phys), pointer :: edmf_w (:,:) => null() ! @@ -1549,7 +1478,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: dvsfc_ss (:) => null() ! real (kind=kind_phys), pointer :: dusfc_fd (:) => null() ! real (kind=kind_phys), pointer :: dvsfc_fd (:) => null() ! -#endif ! Output - only in physics real (kind=kind_phys), pointer :: u10m (:) => null() !< 10 meter u/v wind speed @@ -1567,9 +1495,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: dlwsfci(:) => null() !< instantaneous sfc dnwd lw flux ( w/m**2 ) real (kind=kind_phys), pointer :: ulwsfci(:) => null() !< instantaneous sfc upwd lw flux ( w/m**2 ) real (kind=kind_phys), pointer :: dswsfci(:) => null() !< instantaneous sfc dnwd sw flux ( w/m**2 ) -#ifdef CCPP real (kind=kind_phys), pointer :: nswsfci(:) => null() !< instantaneous sfc net dnwd sw flux ( w/m**2 ) -#endif real (kind=kind_phys), pointer :: uswsfci(:) => null() !< instantaneous sfc upwd sw flux ( w/m**2 ) real (kind=kind_phys), pointer :: dusfci (:) => null() !< instantaneous u component of surface stress real (kind=kind_phys), pointer :: dvsfci (:) => null() !< instantaneous v component of surface stress @@ -1616,10 +1542,8 @@ module GFS_typedefs real (kind=kind_phys), pointer :: det_mf (:,:) => null() !< instantaneous convective detrainment mass flux real (kind=kind_phys), pointer :: cldcov (:,:) => null() !< instantaneous 3D cloud fraction !--- F-A MP scheme -#ifdef CCPP - real (kind=kind_phys), pointer :: TRAIN (:,:) => null() !< accumulated stratiform T tendency (K s-1) -#endif - real (kind=kind_phys), pointer :: cldfra (:,:) => null() !< instantaneous 3D cloud fraction + real (kind=kind_phys), pointer :: train (:,:) => null() !< accumulated stratiform T tendency (K s-1) + real (kind=kind_phys), pointer :: cldfra (:,:) => null() !< instantaneous 3D cloud fraction !--- MP quantities for 3D diagnositics real (kind=kind_phys), pointer :: refl_10cm(:,:) => null() !< instantaneous refl_10cm @@ -1667,15 +1591,15 @@ module GFS_typedefs real (kind=kind_phys), pointer :: gwp_scheat(:,:) => null() ! instant shal-conv heat tendency real (kind=kind_phys), pointer :: gwp_dcheat(:,:) => null() ! instant deep-conv heat tendency - real (kind=kind_phys), pointer :: gwp_precip(:) => null() ! total precip rates - integer , pointer :: gwp_klevs(:,:)=> null() ! instant levels for GW-launches - real (kind=kind_phys), pointer :: gwp_fgf(:) => null() ! fgf triggers - real (kind=kind_phys), pointer :: gwp_okw(:) => null() ! okw triggers - - real (kind=kind_phys), pointer :: gwp_ax(:,:) => null() ! instant total UGWP tend m/s/s EW - real (kind=kind_phys), pointer :: gwp_ay(:,:) => null() ! instant total UGWP tend m/s/s NS - real (kind=kind_phys), pointer :: gwp_dtdt(:,:) => null() ! instant total heat tend K/s - real (kind=kind_phys), pointer :: gwp_kdis(:,:) => null() ! instant total eddy mixing m2/s + real (kind=kind_phys), pointer :: gwp_precip(:) => null() ! total precip rates + integer , pointer :: gwp_klevs(:,:) => null() ! instant levels for GW-launches + real (kind=kind_phys), pointer :: gwp_fgf(:) => null() ! fgf triggers + real (kind=kind_phys), pointer :: gwp_okw(:) => null() ! okw triggers + + real (kind=kind_phys), pointer :: gwp_ax(:,:) => null() ! instant total UGWP tend m/s/s EW + real (kind=kind_phys), pointer :: gwp_ay(:,:) => null() ! instant total UGWP tend m/s/s NS + real (kind=kind_phys), pointer :: gwp_dtdt(:,:) => null() ! instant total heat tend K/s + real (kind=kind_phys), pointer :: gwp_kdis(:,:) => null() ! instant total eddy mixing m2/s real (kind=kind_phys), pointer :: gwp_axc(:,:) => null() ! instant con-UGWP tend m/s/s EW real (kind=kind_phys), pointer :: gwp_ayc(:,:) => null() ! instant con-UGWP tend m/s/s NS real (kind=kind_phys), pointer :: gwp_axo(:,:) => null() ! instant oro-UGWP tend m/s/s EW @@ -1683,26 +1607,24 @@ module GFS_typedefs real (kind=kind_phys), pointer :: gwp_axf(:,:) => null() ! instant jet-UGWP tend m/s/s EW real (kind=kind_phys), pointer :: gwp_ayf(:,:) => null() ! instant jet-UGWP tend m/s/s NS - real (kind=kind_phys), pointer :: uav_ugwp(:,:) => null() ! aver wind UAV from physics - real (kind=kind_phys), pointer :: tav_ugwp(:,:) => null() ! aver temp UAV from physics - real (kind=kind_phys), pointer :: du3dt_dyn(:,:) => null() ! U Tend-dynamics "In"-"PhysOut" + real (kind=kind_phys), pointer :: uav_ugwp(:,:) => null() ! aver wind UAV from physics + real (kind=kind_phys), pointer :: tav_ugwp(:,:) => null() ! aver temp UAV from physics + real (kind=kind_phys), pointer :: du3dt_dyn(:,:) => null() ! U Tend-dynamics "In"-"PhysOut" !--- COODRE ORO diagnostics - real (kind=kind_phys), pointer :: zmtb(:) => null() ! - real (kind=kind_phys), pointer :: zogw(:) => null() ! - real (kind=kind_phys), pointer :: zlwb(:) => null() !! - real (kind=kind_phys), pointer :: tau_ogw(:) => null() !! - real (kind=kind_phys), pointer :: tau_ngw(:) => null() !! - real (kind=kind_phys), pointer :: tau_mtb(:) => null() ! - real (kind=kind_phys), pointer :: tau_tofd(:) => null() ! + real (kind=kind_phys), pointer :: zmtb(:) => null() ! + real (kind=kind_phys), pointer :: zogw(:) => null() ! + real (kind=kind_phys), pointer :: zlwb(:) => null() ! + real (kind=kind_phys), pointer :: tau_ogw(:) => null() ! + real (kind=kind_phys), pointer :: tau_ngw(:) => null() ! + real (kind=kind_phys), pointer :: tau_mtb(:) => null() ! + real (kind=kind_phys), pointer :: tau_tofd(:) => null() ! !---vay-2018 UGWP-diagnostics !--- Output diagnostics for coupled chemistry -#ifdef CCPP integer :: ndust !< number of dust bins for diagnostics integer :: nseasalt !< number of seasalt bins for diagnostics integer :: ntchmdiag !< number of chemical tracers for diagnostics -#endif real (kind=kind_phys), pointer :: duem (:,:) => null() !< instantaneous dust emission flux ( kg/m**2/s ) real (kind=kind_phys), pointer :: ssem (:,:) => null() !< instantaneous sea salt emission flux ( kg/m**2/s ) real (kind=kind_phys), pointer :: sedim (:,:) => null() !< instantaneous sedimentation ( kg/m**2/s ) @@ -1725,7 +1647,6 @@ module GFS_typedefs procedure :: chem_init => diag_chem_init end type GFS_diag_type -#ifdef CCPP !--------------------------------------------------------------------- ! GFS_interstitial_type ! fields required for interstitial code in CCPP schemes, previously @@ -2072,7 +1993,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: dudt_ogw(:,:) => null() !< daily aver u-wind tend due to orographic gravity wave drag real (kind=kind_phys), pointer :: dudt_tms(:,:) => null() !< daily aver u-wind tend due to TMS -#ifdef CCPP ! RRTMGP integer :: ipsdlw0 !< integer :: ipsdsw0 !< @@ -2141,7 +2061,6 @@ module GFS_typedefs type(ty_optical_props_2str) :: sw_optical_props_aerosol !< RRTMGP DDT type(ty_gas_concs) :: gas_concentrations !< RRTMGP DDT type(ty_source_func_lw) :: sources !< RRTMGP DDT -#endif !-- HWRF physics: dry mixing ratios real (kind=kind_phys), pointer :: qv_r(:,:) => null() !< @@ -2171,12 +2090,11 @@ module GFS_typedefs procedure :: mprint => interstitial_print !< print array data end type GFS_interstitial_type -#endif !------------------------- ! GFS sub-containers !------------------------- -#ifdef CCPP + !------------------------------------------------------------------------------------ ! combined type of all of the above except GFS_control_type and GFS_interstitial_type !------------------------------------------------------------------------------------ @@ -2194,7 +2112,6 @@ module GFS_typedefs type(GFS_radtend_type) :: Radtend type(GFS_diag_type) :: Intdiag end type GFS_data_type -#endif !---------------- ! PUBLIC ENTITIES @@ -2204,9 +2121,7 @@ module GFS_typedefs GFS_coupling_type public GFS_control_type, GFS_grid_type, GFS_tbd_type, & GFS_cldprop_type, GFS_radtend_type, GFS_diag_type -#ifdef CCPP - public GFS_interstitial_type -#endif + public GFS_interstitial_type, GFS_data_type !******************************************************************************************* CONTAINS @@ -2427,16 +2342,12 @@ subroutine sfcprop_create (Sfcprop, IM, Model) !--- Out allocate (Sfcprop%t2m (IM)) -#ifdef CCPP allocate (Sfcprop%th2m(IM)) -#endif allocate (Sfcprop%q2m (IM)) - Sfcprop%t2m = clear_val -#ifdef CCPP + Sfcprop%t2m = clear_val Sfcprop%th2m = clear_val -#endif - Sfcprop%q2m = clear_val + Sfcprop%q2m = clear_val if (Model%nstf_name(1) > 0) then allocate (Sfcprop%tref (IM)) @@ -2522,19 +2433,11 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%smcwtdxy (IM)) allocate (Sfcprop%deeprechxy (IM)) allocate (Sfcprop%rechxy (IM)) -#ifdef CCPP allocate (Sfcprop%snicexy (IM, Model%lsnow_lsm_lbound:0)) allocate (Sfcprop%snliqxy (IM, Model%lsnow_lsm_lbound:0)) allocate (Sfcprop%tsnoxy (IM, Model%lsnow_lsm_lbound:0)) allocate (Sfcprop%smoiseq (IM, Model%lsoil_lsm)) allocate (Sfcprop%zsnsoxy (IM, Model%lsnow_lsm_lbound:Model%lsoil_lsm)) -#else - allocate (Sfcprop%snicexy (IM,-2:0)) - allocate (Sfcprop%snliqxy (IM,-2:0)) - allocate (Sfcprop%tsnoxy (IM,-2:0)) - allocate (Sfcprop%smoiseq (IM, 1:4)) - allocate (Sfcprop%zsnsoxy (IM,-2:4)) -#endif Sfcprop%snowxy = clear_val Sfcprop%tvxy = clear_val @@ -2586,7 +2489,6 @@ subroutine sfcprop_create (Sfcprop, IM, Model) endif -#ifdef CCPP ! HWRF NOAH LSM allocate and init when used ! if (Model%lsm == Model%lsm_noah_wrfv4 ) then @@ -2667,8 +2569,6 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%conv_act(IM)) Sfcprop%conv_act = zero end if - -#endif end subroutine sfcprop_create @@ -2922,12 +2822,10 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%nifa2d = clear_val endif -#ifdef CCPP if (Model%imfdeepcnv == Model%imfdeepcnv_gf) then allocate (Coupling%qci_conv (IM,Model%levs)) Coupling%qci_conv = clear_val endif -#endif end subroutine coupling_create @@ -2941,23 +2839,11 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & dt_phys, iau_offset, idat, jdat, & tracer_names, & input_nml_file, tile_num, blksz, & - ak,bk & -#ifdef CCPP - ,restart, hydrostatic, & - communicator, ntasks, nthreads & -#endif - ) + ak, bk, restart, hydrostatic, & + communicator, ntasks, nthreads) !--- modules -#ifdef CCPP use physcons, only: con_rerth, con_pi -! use rascnv, only: nrcmax -#else - use physcons, only: dxmax, dxmin, dxinv, con_rerth, con_pi, rhc_max - use module_ras, only: nrcmax - use wam_f107_kp_mod, only: f107_kp_size, f107_kp_interval, & - f107_kp_skip_size, f107_kp_data_size -#endif use mersenne_twister, only: random_setseed, random_number use parse_tracers, only: get_tracer_index ! @@ -2990,13 +2876,12 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer, intent(in) :: blksz(:) real(kind=kind_phys), dimension(:), intent(in) :: ak real(kind=kind_phys), dimension(:), intent(in) :: bk -#ifdef CCPP logical, intent(in) :: restart logical, intent(in) :: hydrostatic integer, intent(in) :: communicator integer, intent(in) :: ntasks integer, intent(in) :: nthreads -#endif + !--- local variables integer :: i, j, n integer :: ios @@ -3033,9 +2918,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- radiation parameters real(kind=kind_phys) :: fhswr = 3600. !< frequency for shortwave radiation (secs) real(kind=kind_phys) :: fhlwr = 3600. !< frequency for longwave radiation (secs) -#ifdef CCPP integer :: nhfrad = 0 !< number of timesteps for which to call radiation on physics timestep (coldstarts) -#endif integer :: levr = -99 !< number of vertical levels for radiation calculations integer :: nfxr = 39+6 !< second dimension of input/output array fluxr logical :: iaerclm = .false. !< flag for initializing aero data @@ -3079,8 +2962,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: norad_precip = .false. !< radiation precip flag for Ferrier/Moorthi logical :: lwhtr = .true. !< flag to output lw heating rate (Radtend%lwhc) logical :: swhtr = .true. !< flag to output sw heating rate (Radtend%swhc) - ! RRTMGP -#ifdef CCPP + ! RRTMGP logical :: do_RRTMGP = .false. !< Use RRTMGP? character(len=128) :: active_gases = '' !< Character list of active gases used in RRTMGP integer :: nGases = 0 !< Number of active gases @@ -3093,15 +2975,14 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & character(len=128) :: sw_file_clouds = '' !< RRTMGP file containing coefficients used to compute clouds optical properties integer :: rrtmgp_nBandsSW = 14 !< Number of RRTMGP SW bands. integer :: rrtmgp_nGptsSW = 224 !< Number of RRTMGP SW spectral points. - logical :: doG_cldoptics = .false. !< Use legacy RRTMG cloud-optics? + logical :: doG_cldoptics = .false. !< Use legacy RRTMG cloud-optics? logical :: doGP_cldoptics_PADE = .false. !< Use RRTMGP cloud-optics: PADE approximation? - logical :: doGP_cldoptics_LUT = .false. !< Use RRTMGP cloud-optics: LUTs? + logical :: doGP_cldoptics_LUT = .false. !< Use RRTMGP cloud-optics: LUTs? integer :: rrtmgp_nrghice = 0 !< Number of ice-roughness categories integer :: rrtmgp_nGauss_ang = 1 !< Number of angles used in Gaussian quadrature logical :: do_GPsw_Glw = .false. - logical :: use_LW_jacobian = .false. !< Use Jacobian of LW to update LW radiation tendencies. + logical :: use_LW_jacobian = .false. !< Use Jacobian of LW to update LW radiation tendencies. logical :: doGP_lwscat = .false. !< If true, include scattering in longwave cloud-optics, only compatible w/ GP cloud-optics -#endif !--- Z-C microphysical parameters integer :: ncld = 1 !< choice of cloud scheme integer :: imp_physics = 99 !< choice of cloud scheme @@ -3112,12 +2993,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !---Max hourly real(kind=kind_phys) :: avg_max_length = 3600. !< reset value in seconds for max hourly !--- Ferrier-Aligo microphysical parameters -#ifdef CCPP real(kind=kind_phys) :: rhgrd = 1.0 !< fer_hires microphysics only; for 3-km domain logical :: spec_adv = .true. !< Individual cloud species advected integer :: icloud = 0 !< cloud effect to the optical depth in radiation; this also controls the cloud fraction options !< 3: with cloud effect from FA, and use cloud fraction option 3, based on Sundqvist et al. (1989) -#endif !--- M-G microphysical parameters integer :: fprcp = 0 !< no prognostic rain and snow (MG) integer :: pdfflag = 4 !< pdf flag for MG macro physics @@ -3166,7 +3045,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- land/surface model parameters integer :: lsm = 1 !< flag for land surface model to use =0 for osu lsm; =1 for noah lsm; =2 for noah mp lsm; =3 for RUC lsm integer :: lsoil = 4 !< number of soil layers -#ifdef CCPP integer :: lsoil_lsm = -1 !< number of soil layers internal to land surface model; -1 use lsoil integer :: lsnow_lsm = 3 !< maximum number of snow layers internal to land surface model logical :: rdlai = .false. !< read LAI from input file (for RUC LSM or NOAH LSM WRFv4) @@ -3177,7 +3055,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: iopt_thcnd = 1 !< option to treat thermal conductivity in Noah LSM (new in 3.8) !< = 1, original (default) !< = 2, McCumber and Pielke for silt loam and sandy loam -#endif integer :: ivegsrc = 2 !< ivegsrc = 0 => USGS, !< ivegsrc = 1 => IGBP (20 category) !< ivegsrc = 2 => UMD (13 category) @@ -3202,12 +3079,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: use_ufo = .false. !< flag for gcycle surface option -#ifdef CCPP logical :: lcurr_sf = .false. !< flag for taking ocean currents into account in GFDL surface layer logical :: pert_cd = .false. !< flag for perturbing the surface drag coefficient for momentum in surface layer scheme integer :: ntsflg = 0 !< flag for updating skin temperature in the GFDL surface layer scheme real(kind=kind_phys) :: sfenth = 0.0 !< enthalpy flux factor 0 zot via charnock ..>0 zot enhanced>15m/s -#endif !--- flake model parameters integer :: lkm = 0 !< flag for flake model @@ -3249,10 +3124,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: do_shoc = .false. !< flag for SHOC logical :: shocaftcnv = .false. !< flag for SHOC logical :: shoc_cld = .false. !< flag for SHOC in grrad -#ifdef CCPP logical :: oz_phys = .true. !< flag for old (2006) ozone physics logical :: oz_phys_2015 = .false. !< flag for new (2015) ozone physics -#endif logical :: h2o_phys = .false. !< flag for stratosphere h2o logical :: pdfcld = .false. !< flag for pdfcld logical :: shcnvcw = .false. !< flag for shallow convective cloud @@ -3263,9 +3136,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: shinhong = .false. !< flag for scale-aware Shinhong vertical turbulent mixing scheme logical :: do_ysu = .false. !< flag for YSU vertical turbulent mixing scheme logical :: dspheat = .false. !< flag for tke dissipative heating -#ifdef CCPP logical :: hurr_pbl = .false. !< flag for hurricane-specific options in PBL scheme -#endif logical :: lheatstrg = .false. !< flag for canopy heat storage parameterization logical :: cnvcld = .false. logical :: random_clds = .false. !< flag controls whether clouds are random @@ -3288,7 +3159,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !< 0: initial version of satmedmf (Nov. 2018) !< 1: updated version of satmedmf (as of May 2019) logical :: do_deep = .true. !< whether to do deep convection -#ifdef CCPP + logical :: hwrf_samfdeep = .false. !< flag for HWRF SAMF deepcnv scheme logical :: hwrf_samfshal = .false. !< flag for HWRF SAMF shalcnv scheme logical :: do_mynnedmf = .false. !< flag for MYNN-EDMF @@ -3313,7 +3184,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ! *DH logical :: do_myjsfc = .false. !< flag for MYJ surface layer scheme logical :: do_myjpbl = .false. !< flag for MYJ PBL scheme -#endif + integer :: nmtvr = 14 !< number of topographic variables such as variance etc !< used in the GWD parameterization integer :: jcap = 1 !< number of spectral wave trancation used only by sascnv shalcnv @@ -3335,9 +3206,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: psauras(2) = (/1.0d-3,1.0d-3/) !< [in] auto conversion coeff from ice to snow in ras real(kind=kind_phys) :: prauras(2) = (/2.0d-3,2.0d-3/) !< [in] auto conversion coeff from cloud to rain in ras real(kind=kind_phys) :: wminras(2) = (/1.0d-5,1.0d-5/) !< [in] water and ice minimum threshold for ras -#ifdef CCPP integer :: nrcmax = 32 !< number of random numbers used in RAS -#endif real(kind=kind_phys) :: rbcr = 0.25 !< Critical Richardson Number in PBL scheme real(kind=kind_phys) :: shoc_parm(5) = (/7000.0,1.0,4.2857143,0.7,-999.0/) !< some tunable parameters for shoc @@ -3481,7 +3350,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & fhswr, fhlwr, levr, nfxr, iaerclm, iflip, isol, ico2, ialb, & isot, iems, iaer, icliq_sw, iovr, ictm, isubc_sw, & isubc_lw, crick_proof, ccnorm, lwhtr, swhtr, & -#ifdef CCPP nhfrad, idcor, dcorr_con, & ! --- RRTMGP do_RRTMGP, active_gases, nGases, rrtmgp_root, & @@ -3490,7 +3358,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & doG_cldoptics, doGP_cldoptics_PADE, doGP_cldoptics_LUT, & rrtmgp_nrghice, rrtmgp_nGauss_ang, do_GPsw_Glw, & use_LW_jacobian, doGP_lwscat, & -#endif ! IN CCN forcing iccn, & !--- microphysical parameterizations @@ -3506,28 +3373,19 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- max hourly avg_max_length, & !--- land/surface model control -#ifdef CCPP lsm, lsoil, lsoil_lsm, lsnow_lsm, rdlai, & nmtvr, ivegsrc, use_ufo, iopt_thcnd, ua_phys, usemonalb, & aoasis, fasdas, & -#else - lsm, lsoil, nmtvr, ivegsrc, use_ufo, & -#endif ! Noah MP options iopt_dveg,iopt_crs,iopt_btr,iopt_run,iopt_sfc, iopt_frz, & iopt_inf, iopt_rad,iopt_alb,iopt_snf,iopt_tbot,iopt_stc, & -#ifdef CCPP ! GFDL surface layer options lcurr_sf, pert_cd, ntsflg, sfenth, & -#endif - !--- lake model control - lkm, & - + lkm, & !--- physical parameterizations ras, trans_trac, old_monin, cnvgwd, mstrat, moist_adj, & cscnv, cal_pre, do_aw, do_shoc, shocaftcnv, shoc_cld, & -#ifdef CCPP oz_phys, oz_phys_2015, & do_mynnedmf, do_mynnsfclay, & ! DH* TODO - move to MYNN namelist section @@ -3541,7 +3399,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & var_ric, coef_ric_l, coef_ric_s, hurr_pbl, & do_myjsfc, do_myjpbl, & hwrf_samfdeep, hwrf_samfshal, & -#endif h2o_phys, pdfcld, shcnvcw, redrag, hybedmf, satmedmf, & shinhong, do_ysu, dspheat, lheatstrg, cnvcld, & random_clds, shal_cnv, imfshalcnv, imfdeepcnv, isatmedmf, & @@ -3552,9 +3409,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- Rayleigh friction prslrd0, ral_ts, ldiag_ugwp, do_ugwp, do_tofd, & ! --- Ferrier-Aligo -#ifdef CCPP spec_adv, rhgrd, icloud, & -#endif !--- mass flux deep convection clam_deep, c0s_deep, c1_deep, betal_deep, & betas_deep, evfact_deep, evfactl_deep, pgcon_deep, & @@ -3604,10 +3459,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & #ifdef INTERNAL_FILE_NML Model%input_nml_file => input_nml_file read(Model%input_nml_file, nml=gfs_physics_nml) -#ifdef CCPP ! Set length (number of lines) in namelist for internal reads Model%input_nml_file_length = size(Model%input_nml_file) -#endif #else inquire (file=trim(fn_nml), exist=exists) if (.not. exists) then @@ -3619,11 +3472,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & rewind(nlunit) read (nlunit, nml=gfs_physics_nml) close (nlunit) -#ifdef CCPP ! Set length (number of lines) in namelist for internal reads Model%input_nml_file_length = 0 #endif -#endif !--- write version number and namelist to log file --- if (me == master) then write(logunit, '(a80)') '================================================================================' @@ -3634,16 +3485,12 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- MPI parameters Model%me = me Model%master = master -#ifdef CCPP Model%communicator = communicator Model%ntasks = ntasks Model%nthreads = nthreads -#endif Model%nlunit = nlunit Model%fn_nml = fn_nml -#ifdef CCPP Model%logunit = logunit -#endif Model%fhzero = fhzero Model%ldiag3d = ldiag3d Model%qdiag3d = qdiag3d @@ -3656,8 +3503,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%flag_for_scnv_generic_tend = .true. Model%flag_for_dcnv_generic_tend = .true. -#ifdef CCPP - if(gwd_opt==1) then if(me==master) & write(0,*) 'FLAG: gwd_opt==1 so gwd not generic' @@ -3707,7 +3552,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & elseif(me==master) then write(0,*) 'NO FLAG: dcnv is generic' endif -#endif + ! !VAY-ugwp --- set some GW-related switches ! @@ -3752,10 +3597,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & allocate(Model%bk(1:size(bk))) Model%ak = ak Model%bk = bk -#ifdef CCPP Model%levsp1 = Model%levs + 1 Model%levsm1 = Model%levs - 1 -#endif Model%cnx = cnx Model%cny = cny Model%lonr = gnx ! number longitudinal points @@ -3763,9 +3606,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%nblks = size(blksz) allocate(Model%blksz(1:Model%nblks)) Model%blksz = blksz -#ifdef CCPP Model%ncols = sum(Model%blksz) -#endif !--- coupling parameters Model%cplflx = cplflx @@ -3794,7 +3635,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%fhlwr = fhlwr Model%nsswr = nint(fhswr/Model%dtp) Model%nslwr = nint(fhlwr/Model%dtp) -#ifdef CCPP if (restart) then Model%nhfrad = 0 if (Model%me == Model%master .and. nhfrad>0) & @@ -3804,15 +3644,14 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & if (Model%me == Model%master .and. nhfrad>0) & write(*,'(a,i0)') 'Number of high-frequency radiation calls for coldstart run: ', nhfrad endif -#endif + if (levr < 0) then Model%levr = levs else Model%levr = levr endif -#ifdef CCPP Model%levrp1 = Model%levr + 1 -#endif + Model%nfxr = nfxr Model%iccn = iccn ! further down: set Model%iccn to .false. @@ -3831,11 +3670,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & else ntrcaer = 1 endif -#ifdef CCPP Model%ntrcaer = ntrcaer Model%idcor = idcor Model%dcorr_con = dcorr_con -#endif Model%icliq_sw = icliq_sw Model%icice_sw = icice_sw Model%icliq_lw = icliq_lw @@ -3848,7 +3685,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%ccnorm = ccnorm Model%lwhtr = lwhtr Model%swhtr = swhtr -#ifdef CCPP + ! RRTMGP Model%do_RRTMGP = do_RRTMGP Model%rrtmgp_nrghice = rrtmgp_nrghice @@ -3889,7 +3726,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & " of the lw/sw heating rates to be turned on (namelist options lwhtr and swhtr)" stop end if -#endif !--- microphysical switch Model%ncld = ncld @@ -3941,13 +3777,11 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%nsradar_reset = nsradar_reset Model%ttendlim = ttendlim !--- F-A MP parameters -#ifdef CCPP Model%rhgrd = rhgrd Model%spec_adv = spec_adv Model%icloud = icloud -#endif -!--- gfdl MP parameters +!--- GFDL MP parameters Model%lgfdlmprad = lgfdlmprad !--- Thompson,GFDL MP parameter Model%lrefres = lrefres @@ -3955,7 +3789,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- land/surface model parameters Model%lsm = lsm Model%lsoil = lsoil -#ifdef CCPP + ! Consistency check for HWRF Noah LSM if (Model%lsm == Model%lsm_noah_wrfv4 .and. Model%nscyc>0) then write(0,*) 'Logic error: NOAH WRFv4 LSM cannot be used with surface data cycling at this point (fhcyc>0)' @@ -3995,19 +3829,16 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%usemonalb = usemonalb Model%aoasis = aoasis Model%fasdas = fasdas -#endif Model%ivegsrc = ivegsrc Model%isot = isot Model%use_ufo = use_ufo -#ifdef CCPP ! GFDL surface layer options Model%lcurr_sf = lcurr_sf Model%pert_cd = pert_cd Model%ntsflg = ntsflg Model%sfenth = sfenth -#endif - + !--- flake model parameters Model%lkm = lkm @@ -4042,7 +3873,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%shoc_parm = shoc_parm Model%shocaftcnv = shocaftcnv Model%shoc_cld = shoc_cld -#ifdef CCPP + !HWRF physics suite if (hwrf_samfdeep .and. imfdeepcnv/=2) then write(*,*) 'Logic error: hwrf_samfdeep requires imfdeepcnv=2' @@ -4054,17 +3885,15 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & end if Model%hwrf_samfdeep = hwrf_samfdeep Model%hwrf_samfshal = hwrf_samfshal -#endif -#ifdef CCPP + if (oz_phys .and. oz_phys_2015) then write(*,*) 'Logic error: can only use one ozone physics option (oz_phys or oz_phys_2015), not both. Exiting.' stop end if Model%oz_phys = oz_phys Model%oz_phys_2015 = oz_phys_2015 -#endif Model%h2o_phys = h2o_phys -#ifdef CCPP + ! To ensure that these values match what's in the physics, ! array sizes are compared during model init in GFS_phys_time_vary_init() ! @@ -4076,7 +3905,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & levh2o = 1 h2o_coeff = 1 end if -#endif + Model%pdfcld = pdfcld Model%shcnvcw = shcnvcw Model%redrag = redrag @@ -4085,9 +3914,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%shinhong = shinhong Model%do_ysu = do_ysu Model%dspheat = dspheat -#ifdef CCPP Model%hurr_pbl = hurr_pbl -#endif Model%lheatstrg = lheatstrg Model%cnvcld = cnvcld Model%random_clds = random_clds @@ -4111,9 +3938,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%wminras = wminras Model%rbcr = rbcr Model%do_gwd = maxval(Model%cdmbgwd) > 0.0 - Model%do_cnvgwd = Model%cnvgwd .and. maxval(Model%cdmbgwd(3:4)) == 0.0 -#ifdef CCPP + Model%do_mynnedmf = do_mynnedmf Model%do_mynnsfclay = do_mynnsfclay ! DH* TODO - move to MYNN namelist section @@ -4133,6 +3959,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%coef_ric_l = coef_ric_l Model%coef_ric_s = coef_ric_s ! *DH + Model%gwd_opt = gwd_opt if (Model%gwd_opt==3 .or. Model%gwd_opt==33 .or. & Model%gwd_opt==2 .or. Model%gwd_opt==22) then @@ -4148,7 +3975,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%do_ugwp_v1_orog_only = do_ugwp_v1_orog_only Model%do_myjsfc = do_myjsfc Model%do_myjpbl = do_myjpbl -#endif !--- Rayleigh friction Model%prslrd0 = prslrd0 @@ -4252,9 +4078,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- tracer handling Model%ntrac = size(tracer_names) -#ifdef CCPP Model%ntracp1 = Model%ntrac + 1 -#endif allocate (Model%tracer_names(Model%ntrac)) Model%tracer_names(:) = tracer_names(:) Model%ntqv = 1 @@ -4277,9 +4101,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%ntsnc = get_tracer_index(Model%tracer_names, 'snow_nc', Model%me, Model%master, Model%debug) Model%ntgnc = get_tracer_index(Model%tracer_names, 'graupel_nc', Model%me, Model%master, Model%debug) Model%ntke = get_tracer_index(Model%tracer_names, 'sgs_tke', Model%me, Model%master, Model%debug) -#ifdef CCPP Model%nqrimef = get_tracer_index(Model%tracer_names, 'q_rimef', Model%me, Model%master, Model%debug) -#endif Model%ntwa = get_tracer_index(Model%tracer_names, 'liq_aero', Model%me, Model%master, Model%debug) Model%ntia = get_tracer_index(Model%tracer_names, 'ice_aero', Model%me, Model%master, Model%debug) Model%ntchm = 0 @@ -4334,7 +4156,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & enddo endif -#ifdef CCPP ! To ensure that these values match what's in the physics, ! array sizes are compared during model init in GFS_phys_time_vary_init() ! @@ -4359,7 +4180,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & oz_coeff = 1 end if end if -#endif !--- quantities to be used to derive phy_f*d totals Model%nshoc_2d = nshoc_2d @@ -4384,11 +4204,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%fhour = (rinc(4) + Model%dtp)/con_hr Model%zhour = mod(Model%phour,Model%fhzero) Model%kdt = 0 -#ifdef CCPP Model%first_time_step = .true. Model%restart = restart Model%hydrostatic = hydrostatic -#endif Model%jdat(1:8) = jdat(1:8) allocate(Model%si(Model%levr+1)) !--- Define sigma level for radiation initialization @@ -4396,29 +4214,13 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- 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 Model%si = (ak + bk * con_p0 - ak(Model%levr+1)) / (con_p0 - ak(Model%levr+1)) -#ifdef CCPP Model%sec = 0 Model%yearlen = 365 Model%julian = -9999. -#endif - -#ifndef CCPP - ! Beware! The values set here reside in wam_f107_kp_mod and determine sizes of arrays - ! inside that module. These arrays get used later in modules idea_tracer.f, idea_ion.f, - ! idea_solar_heating.f, efield.f, and idea_composition.f. - ! Since in wam_f107_kp_mod no default values are assigned to the four integers below, not - ! setting them here can lead to memory corruption that is hard to detect. -!--- stored in wam_f107_kp module - f107_kp_size = 56 - f107_kp_skip_size = 0 - f107_kp_data_size = 56 - f107_kp_interval = 10800 -#endif !--- BEGIN CODE FROM GFS_PHYSICS_INITIALIZE !--- define physcons module variables - tem = con_rerth*con_rerth*(con_pi+con_pi)*con_pi -#ifdef CCPP + tem = con_rerth*con_rerth*(con_pi+con_pi)*con_pi Model%dxmax = log(tem/(max_lon*max_lat)) Model%dxmin = log(tem/(min_lon*min_lat)) Model%dxinv = 1.0d0 / (Model%dxmax-Model%dxmin) @@ -4426,18 +4228,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & if (Model%me == Model%master) write(*,*)' dxmax=',Model%dxmax,' dxmin=',Model%dxmin,' dxinv=',Model%dxinv, & 'max_lon=',max_lon,' max_lat=',max_lat,' min_lon=',min_lon,' min_lat=',min_lat, & ' rhc_max=',Model%rhcmax -#else - dxmax = log(tem/(max_lon*max_lat)) - dxmin = log(tem/(min_lon*min_lat)) - dxinv = 1.0d0 / (dxmax-dxmin) - rhc_max = rhcmax - if (Model%me == Model%master) write(*,*)' dxmax=',dxmax,' dxmin=',dxmin,' dxinv=',dxinv, & - 'max_lon=',max_lon,' max_lat=',max_lat,' min_lon=',min_lon,' min_lat=',min_lat, & - ' rhc_max=',rhc_max -#endif !--- set nrcm - if (Model%ras) then Model%nrcm = min(nrcmax, Model%levs-1) * (Model%dtp/1200.d0) + 0.10001d0 else @@ -4454,6 +4246,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- BEGIN CODE FROM COMPNS_PHYSICS !--- shoc scheme if (do_shoc) then + if (Model%imp_physics == Model%imp_physics_thompson) then + print *,'SHOC is not currently compatible with Thompson MP -- shutting down' + stop + endif Model%nshoc_3d = 3 Model%nshoc_2d = 0 Model%shal_cnv = .false. @@ -4467,7 +4263,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ' ntke=',Model%ntke,' shoc_parm=',shoc_parm endif -#ifdef CCPP !--- mynn-edmf scheme if (Model%do_mynnedmf) then if (Model%do_shoc .or. Model%hybedmf .or. Model%satmedmf) then @@ -4489,7 +4284,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ' bl_mynn_edmf=',Model%bl_mynn_edmf, & ' bl_mynn_output=',Model%bl_mynn_output endif -#endif !--- set number of cloud types if (Model%cscnv) then @@ -4532,16 +4326,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & print *,'iopt_snf = ', Model%iopt_snf print *,'iopt_tbot = ',Model%iopt_tbot print *,'iopt_stc = ', Model%iopt_stc -#ifdef CCPP elseif (Model%lsm == Model%lsm_ruc) then print *,' RUC Land Surface Model used' elseif (Model%lsm == Model%lsm_noah_wrfv4) then print *,' NOAH WRFv4 Land Surface Model used' -#else - elseif (Model%lsm == Model%lsm_ruc) then - print *,' RUC Land Surface Model only available through CCPP - job aborted' - stop -#endif else print *,' Unsupported LSM type - job aborted - lsm=',Model%lsm stop @@ -4568,7 +4356,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & print *,' nstf_name(5)=',Model%nstf_name(5) endif if (Model%do_deep) then -#ifdef CCPP ! Consistency check for NTDK convection: deep and shallow convection are bundled ! and cannot be combined with any other deep or shallow convection scheme if ( (Model%imfdeepcnv == Model%imfdeepcnv_ntiedtke .or. Model%imfshalcnv == Model%imfshalcnv_ntiedtke) .and. & @@ -4576,15 +4363,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & write(0,*) "Logic error: if NTDK deep convection is used, must also use NTDK shallow convection (and vice versa)" stop end if -#else - if (Model%imfdeepcnv == 3 .or. Model%imfshalcnv == 3) then - write(0,*) "Error, GF convection scheme only available through CCPP" - stop - else if (Model%imfdeepcnv == 4 .or. Model%imfshalcnv == 4) then - write(0,*) "Error, NTDK convection scheme only available through CCPP" - stop - end if -#endif + if (.not. Model%cscnv) then if (Model%ras) then print *,' RAS Convection scheme used with ccwf=',Model%ccwf @@ -4592,7 +4371,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & else if (Model%imfdeepcnv == 0) then print *,' old SAS Convection scheme before July 2010 used' -#ifdef CCPP elseif(Model%imfdeepcnv == Model%imfdeepcnv_sas) then print *,' July 2010 version of SAS conv scheme used' elseif(Model%imfdeepcnv == Model%imfdeepcnv_samf) then @@ -4601,12 +4379,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & print *,' Grell-Freitas scale & aerosol-aware mass-flux deep conv scheme' elseif(Model%imfdeepcnv == Model%imfdeepcnv_ntiedtke) then print *,' New Tiedtke cumulus scheme' -#else - elseif(Model%imfdeepcnv == 1) then - print *,' July 2010 version of SAS conv scheme used' - elseif(Model%imfdeepcnv == 2) then - print *,' scale & aerosol-aware mass-flux deep conv scheme' -#endif endif endif else @@ -4622,29 +4394,19 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & print*, ' Deep convection scheme disabled' endif if (Model%satmedmf) then -#ifdef CCPP if (Model%isatmedmf == Model%isatmedmf_vdif) then print *,' initial version (Nov 2018) of sale-aware TKE-based moist EDMF scheme used' elseif(Model%isatmedmf == Model%isatmedmf_vdifq) then print *,' update version (May 2019) of sale-aware TKE-based moist EDMF scheme used' endif -#else - if (Model%isatmedmf == 0) then - print *,' initial version (Nov 2018) of sale-aware TKE-based moist EDMF scheme used' - elseif(Model%isatmedmf == 1) then - print *,' update version (May 2019) of sale-aware TKE-based moist EDMF scheme used' - endif -#endif elseif (Model%hybedmf) then print *,' scale-aware hybrid edmf PBL scheme used' elseif (Model%old_monin) then print *,' old (old_monin) PBL scheme used' -#ifdef CCPP elseif (Model%do_mynnedmf) then print *,' MYNN PBL scheme used' elseif (Model%do_myjpbl)then print *,' MYJ PBL scheme used' -#endif endif if (.not. Model%shal_cnv) then Model%imfshalcnv = -1 @@ -4652,7 +4414,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & else if (Model%imfshalcnv == 0) then print *,' modified Tiedtke eddy-diffusion shallow conv scheme used' -#ifdef CCPP elseif (Model%imfshalcnv == Model%imfshalcnv_sas) then print *,' July 2010 version of mass-flux shallow conv scheme used' elseif (Model%imfshalcnv == Model%imfshalcnv_samf) then @@ -4661,12 +4422,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & print *,' Grell-Freitas scale- & aerosol-aware mass-flux shallow conv scheme (2013)' elseif (Model%imfshalcnv == Model%imfshalcnv_ntiedtke) then print *,' New Tiedtke cumulus scheme' -#else - elseif (Model%imfshalcnv == 1) then - print *,' July 2010 version of mass-flux shallow conv scheme used' - elseif (Model%imfshalcnv == 2) then - print *,' scale- & aerosol-aware mass-flux shallow conv scheme (2017)' -#endif else print *,' unknown mass-flux scheme in use - defaulting to no shallow convection' Model%imfshalcnv = -1 @@ -4867,11 +4622,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & endif if(Model%ras .or. Model%cscnv) Model%cnvcld = .false. -#ifdef CCPP if(Model%do_shoc .or. Model%pdfcld .or. Model%do_mynnedmf) Model%cnvcld = .false. -#else - if(Model%do_shoc .or. Model%pdfcld) Model%cnvcld = .false. -#endif if(Model%cnvcld) Model%ncnvcld3d = 1 !--- get cnvwind index in phy_f2d; last entry in phy_f2d array @@ -4903,7 +4654,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%indcld = Model%ntot3d - 2 endif -#ifdef CCPP if (Model%do_shoc) then Model%nkbfshoc = Model%ntot3d !< the index of upward kinematic buoyancy flux from SHOC in phy_f3d Model%nahdshoc = Model%ntot3d-1 !< the index of diffusivity for heat from from SHOC in phy_f3d @@ -4913,7 +4663,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%nahdshoc = -999 Model%nscfshoc = -999 endif -#endif if (me == Model%master) & write(0,*) ' num_p3d=', Model%num_p3d, ' num_p2d=', Model%num_p2d, & @@ -4922,10 +4671,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ' cnvcld=', Model%cnvcld, ' ncnvcld3d=',Model%ncnvcld3d, & ' do_shoc=', Model%do_shoc, ' nshoc3d=', Model%nshoc_3d, & ' nshoc_2d=', Model%nshoc_2d, ' shoc_cld=', Model%shoc_cld, & -#ifdef CCPP ' nkbfshoc=', Model%nkbfshoc, ' nahdshoc=', Model%nahdshoc, & ' nscfshoc=', Model%nscfshoc, & -#endif ' uni_cld=', Model%uni_cld, & ' ntot3d=', Model%ntot3d, ' ntot2d=', Model%ntot2d, & ' shocaftcnv=',Model%shocaftcnv,' indcld=', Model%indcld, & @@ -4939,13 +4686,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- set up parameters for Xu & Randall's cloudiness computation (Radiation) Model%lmfshal = (Model%shal_cnv .and. Model%imfshalcnv > 0) -#ifdef CCPP Model%lmfdeep2 = (Model%imfdeepcnv == Model%imfdeepcnv_samf & .or. Model%imfdeepcnv == Model%imfdeepcnv_gf & .or. Model%imfdeepcnv == Model%imfdeepcnv_ntiedtke) -#else - Model%lmfdeep2 = (Model%imfdeepcnv == 2) -#endif !--- END CODE FROM GLOOPR !--- BEGIN CODE FROM GLOOPB @@ -4982,9 +4725,7 @@ subroutine control_print(Model) print *, 'basic control parameters' print *, ' me : ', Model%me print *, ' master : ', Model%master -#ifdef CCPP print *, ' communicator : ', Model%communicator -#endif print *, ' nlunit : ', Model%nlunit print *, ' fn_nml : ', trim(Model%fn_nml) print *, ' fhzero : ', Model%fhzero @@ -5016,9 +4757,7 @@ subroutine control_print(Model) print *, ' latr : ', Model%latr print *, ' blksz(1) : ', Model%blksz(1) print *, ' blksz(nblks) : ', Model%blksz(Model%nblks) -#ifdef CCPP print *, ' Model%ncols : ', Model%ncols -#endif print *, ' ' print *, 'coupling parameters' print *, ' cplflx : ', Model%cplflx @@ -5042,14 +4781,10 @@ subroutine control_print(Model) print *, ' fhlwr : ', Model%fhlwr print *, ' nsswr : ', Model%nsswr print *, ' nslwr : ', Model%nslwr -#ifdef CCPP print *, ' nhfrad : ', Model%nhfrad -#endif print *, ' levr : ', Model%levr print *, ' nfxr : ', Model%nfxr -#ifdef CCPP print *, ' ntrcaer : ', Model%ntrcaer -#endif print *, ' lmfshal : ', Model%lmfshal print *, ' lmfdeep2 : ', Model%lmfdeep2 print *, ' nrcm : ', Model%nrcm @@ -5074,7 +4809,6 @@ subroutine control_print(Model) print *, ' norad_precip : ', Model%norad_precip print *, ' lwhtr : ', Model%lwhtr print *, ' swhtr : ', Model%swhtr -#ifdef CCPP if (Model%do_RRTMGP) then print *, ' rrtmgp_nrghice : ', Model%rrtmgp_nrghice print *, ' rrtmgp_nrghice : ', Model%rrtmgp_nrghice @@ -5096,7 +4830,6 @@ subroutine control_print(Model) print *, ' use_LW_jacobian : ', Model%use_LW_jacobian print *, ' doGP_lwscat : ', Model%doGP_lwscat endif -#endif print *, ' ' print *, 'microphysical switch' print *, ' ncld : ', Model%ncld @@ -5138,7 +4871,6 @@ subroutine control_print(Model) print *, ' lrefres : ', Model%lrefres print *, ' ' endif -#ifdef CCPP if (Model%imp_physics == Model%imp_physics_fer_hires) then print *, ' Ferrier-Aligo microphysical parameters' print *, ' spec_adv : ', Model%spec_adv @@ -5146,11 +4878,9 @@ subroutine control_print(Model) print *, ' icloud : ', Model%icloud print *, ' ' endif -#endif print *, 'land/surface model parameters' print *, ' lsm : ', Model%lsm print *, ' lsoil : ', Model%lsoil -#ifdef CCPP print *, ' rdlai : ', Model%rdlai print *, ' lsoil_lsm : ', Model%lsoil_lsm print *, ' lsnow_lsm : ', Model%lsnow_lsm @@ -5159,7 +4889,6 @@ subroutine control_print(Model) print *, ' usemonalb : ', Model%usemonalb print *, ' aoasis : ', Model%aoasis print *, ' fasdas : ', Model%fasdas -#endif print *, ' ivegsrc : ', Model%ivegsrc print *, ' isot : ', Model%isot @@ -5179,12 +4908,10 @@ subroutine control_print(Model) print *, ' iopt_stc : ', Model%iopt_stc endif print *, ' use_ufo : ', Model%use_ufo -#ifdef CCPP print *, ' lcurr_sf : ', Model%lcurr_sf print *, ' pert_cd : ', Model%pert_cd print *, ' ntsflg : ', Model%ntsflg print *, ' sfenth : ', Model%sfenth -#endif print *, ' ' print *, 'flake model parameters' print *, 'lkm : ', Model%lkm @@ -5245,7 +4972,6 @@ subroutine control_print(Model) print *, ' dlqf : ', Model%dlqf print *, ' seed0 : ', Model%seed0 print *, ' rbcr : ', Model%rbcr -#ifdef CCPP print *, ' do_mynnedmf : ', Model%do_mynnedmf print *, ' do_mynnsfclay : ', Model%do_mynnsfclay print *, ' do_myjsfc : ', Model%do_myjsfc @@ -5263,7 +4989,6 @@ subroutine control_print(Model) print *, ' var_ric : ', Model%var_ric print *, ' coef_ric_l : ', Model%coef_ric_l print *, ' coef_ric_s : ', Model%coef_ric_s -#endif print *, ' ' print *, 'Rayleigh friction' print *, ' prslrd0 : ', Model%prslrd0 @@ -5346,9 +5071,7 @@ subroutine control_print(Model) print *, 'tracers' print *, ' tracer_names : ', Model%tracer_names print *, ' ntrac : ', Model%ntrac -#ifdef CCPP print *, ' nqrimef : ', Model%nqrimef -#endif print *, ' ntqv : ', Model%ntqv print *, ' ntoz : ', Model%ntoz print *, ' ntcw : ', Model%ntcw @@ -5381,11 +5104,9 @@ subroutine control_print(Model) print *, ' ncnvcld3d : ', Model%ncnvcld3d print *, ' npdf3d : ', Model%npdf3d print *, ' nctp : ', Model%nctp -#ifdef CCPP print *, ' nkbfshoc : ', Model%nkbfshoc print *, ' nahdshoc : ', Model%nahdshoc print *, ' nscfshoc : ', Model%nscfshoc -#endif print *, ' ' print *, 'debug flags' print *, ' debug : ', Model%debug @@ -5408,12 +5129,10 @@ subroutine control_print(Model) print *, ' kdt : ', Model%kdt print *, ' jdat : ', Model%jdat print *, ' si : ', Model%si -#ifdef CCPP print *, ' sec : ', Model%sec print *, ' first_time_step : ', Model%first_time_step print *, ' restart : ', Model%restart print *, ' hydrostatic : ', Model%hydrostatic -#endif endif end subroutine control_print @@ -5487,19 +5206,12 @@ end subroutine grid_create !-------------------- ! GFS_tbd_type%create !-------------------- -#ifndef CCPP - subroutine tbd_create (Tbd, IM, BLKNO, Model) -#else subroutine tbd_create (Tbd, IM, Model) -#endif implicit none class(GFS_tbd_type) :: Tbd integer, intent(in) :: IM -#ifndef CCPP - integer, intent(in) :: BLKNO -#endif type(GFS_control_type), intent(in) :: Model !--- In @@ -5529,13 +5241,11 @@ subroutine tbd_create (Tbd, IM, Model) allocate (Tbd%aer_nm (IM,Model%levs,ntrcaer)) Tbd%aer_nm = clear_val -#ifdef CCPP !--- maps of local index ix to global indices i and j for this block allocate (Tbd%imap (IM)) allocate (Tbd%jmap (IM)) Tbd%imap = 0 Tbd%jmap = 0 -#endif allocate (Tbd%rann (IM,Model%nrcm)) Tbd%rann = rann_init @@ -5581,11 +5291,6 @@ subroutine tbd_create (Tbd, IM, Model) allocate (Tbd%hpbl (IM)) Tbd%hpbl = clear_val -#ifndef CCPP - Tbd%blkno = BLKNO -#endif - -#ifdef CCPP if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_ntiedtke) then allocate(Tbd%forcet(IM, Model%levs)) allocate(Tbd%forceq(IM, Model%levs)) @@ -5630,16 +5335,16 @@ subroutine tbd_create (Tbd, IM, Model) if (Model%do_myjsfc.or.Model%do_myjpbl) then !print*,"Allocating all MYJ surface variables:" allocate (Tbd%phy_myj_qsfc (IM)) - allocate (Tbd%phy_myj_thz0 (IM)) - allocate (Tbd%phy_myj_qz0 (IM)) - allocate (Tbd%phy_myj_uz0 (IM)) - allocate (Tbd%phy_myj_vz0 (IM)) - allocate (Tbd%phy_myj_akhs (IM)) - allocate (Tbd%phy_myj_akms (IM)) - allocate (Tbd%phy_myj_chkqlm (IM)) - allocate (Tbd%phy_myj_elflx (IM)) - allocate (Tbd%phy_myj_a1u (IM)) - allocate (Tbd%phy_myj_a1t (IM)) + allocate (Tbd%phy_myj_thz0 (IM)) + allocate (Tbd%phy_myj_qz0 (IM)) + allocate (Tbd%phy_myj_uz0 (IM)) + allocate (Tbd%phy_myj_vz0 (IM)) + allocate (Tbd%phy_myj_akhs (IM)) + allocate (Tbd%phy_myj_akms (IM)) + allocate (Tbd%phy_myj_chkqlm (IM)) + allocate (Tbd%phy_myj_elflx (IM)) + allocate (Tbd%phy_myj_a1u (IM)) + allocate (Tbd%phy_myj_a1t (IM)) allocate (Tbd%phy_myj_a1q (IM)) !print*,"Allocating all MYJ schemes variables:" Tbd%phy_myj_qsfc = clear_val @@ -5655,7 +5360,6 @@ subroutine tbd_create (Tbd, IM, Model) Tbd%phy_myj_a1t = clear_val Tbd%phy_myj_a1q = clear_val end if -#endif end subroutine tbd_create @@ -5816,9 +5520,7 @@ subroutine diag_create (Diag, IM, Model) allocate (Diag%dlwsfci (IM)) allocate (Diag%ulwsfci (IM)) allocate (Diag%dswsfci (IM)) -#ifdef CCPP allocate (Diag%nswsfci (IM)) -#endif allocate (Diag%uswsfci (IM)) allocate (Diag%dusfci (IM)) allocate (Diag%dvsfci (IM)) @@ -5846,21 +5548,16 @@ subroutine diag_create (Diag, IM, Model) allocate (Diag%ca3 (IM)) ! F-A MP scheme -#ifdef CCPP if (Model%imp_physics == Model%imp_physics_fer_hires) then - allocate (Diag%TRAIN (IM,Model%levs)) + allocate (Diag%train (IM,Model%levs)) end if -#endif - -#ifdef CCPP allocate (Diag%cldfra (IM,Model%levs)) -#endif allocate (Diag%ca_deep (IM)) allocate (Diag%ca_turb (IM)) allocate (Diag%ca_shal (IM)) - allocate (Diag%ca_rad (IM)) - allocate (Diag%ca_micro (IM)) + allocate (Diag%ca_rad (IM)) + allocate (Diag%ca_micro (IM)) !--- 3D diagnostics if (Model%ldiag3d) then @@ -5959,7 +5656,6 @@ subroutine diag_create (Diag, IM, Model) allocate (Diag%rh02max(IM)) allocate (Diag%rh02min(IM)) -#ifdef CCPP !--- MYNN variables: if (Model%do_mynnedmf) then if (Model%bl_mynn_output .ne. 0) then @@ -6034,7 +5730,6 @@ subroutine diag_create (Diag, IM, Model) Diag%dusfc_fd = 0 Diag%dvsfc_fd = 0 endif -#endif ! Auxiliary arrays in output for debugging if (Model%naux2d>0) then @@ -6142,9 +5837,7 @@ subroutine diag_phys_zero (Diag, Model, linit, iauwindow_center) Diag%dlwsfci = zero Diag%ulwsfci = zero Diag%dswsfci = zero -#ifdef CCPP Diag%nswsfci = zero -#endif Diag%uswsfci = zero Diag%dusfci = zero Diag%dvsfci = zero @@ -6168,22 +5861,17 @@ subroutine diag_phys_zero (Diag, Model, linit, iauwindow_center) Diag%shum_wts = zero Diag%zmtnblck = zero -#ifdef CCPP if (Model%imp_physics == Model%imp_physics_fer_hires) then - Diag%TRAIN = zero + Diag%train = zero end if -#endif -#ifdef CCPP Diag%cldfra = zero -#endif Diag%totprcpb = zero Diag%cnvprcpb = zero Diag%toticeb = zero Diag%totsnwb = zero Diag%totgrpb = zero -! -#ifdef CCPP + !--- MYNN variables: if (Model%do_mynnedmf) then if (Model%bl_mynn_output .ne. 0) then @@ -6204,8 +5892,7 @@ subroutine diag_phys_zero (Diag, Model, linit, iauwindow_center) Diag%exch_h = clear_val Diag%exch_m = clear_val endif -#endif -! + if (Model%do_ca) then Diag%ca1 = zero Diag%ca2 = zero @@ -6336,9 +6023,7 @@ subroutine diag_chem_init(Diag, IM, Model) if (Model%ntchm > 0) then ! -- retrieve number of dust bins n = get_number_bins('dust') -#ifdef CCPP Diag%ndust = n -#endif if (n > 0) then allocate (Diag%duem(IM,n)) Diag%duem = zero @@ -6346,9 +6031,7 @@ subroutine diag_chem_init(Diag, IM, Model) ! -- retrieve number of sea salt bins n = get_number_bins('seas') -#ifdef CCPP Diag%nseasalt = n -#endif if (n > 0) then allocate (Diag%ssem(IM,n)) Diag%ssem = zero @@ -6359,9 +6042,8 @@ subroutine diag_chem_init(Diag, IM, Model) if (associated(Model%ntdiag)) then ! -- get number of tracers with enabled diagnostics n = count(Model%ntdiag) -#ifdef CCPP Diag%ntchmdiag = n -#endif + ! -- initialize sedimentation allocate (Diag%sedim(IM,n)) Diag%sedim = zero @@ -6419,7 +6101,6 @@ end function get_number_bins end subroutine diag_chem_init -#ifdef CCPP !------------------------- ! GFS_interstitial_type%create !------------------------- @@ -7837,6 +7518,5 @@ subroutine interstitial_print(Interstitial, Model, mpirank, omprank, blkno) write (0,*) 'Interstitial_print: end' ! end subroutine interstitial_print -#endif end module GFS_typedefs diff --git a/io/CMakeLists.txt b/io/CMakeLists.txt index 4cbaeb678..bbb079236 100644 --- a/io/CMakeLists.txt +++ b/io/CMakeLists.txt @@ -11,9 +11,7 @@ if(NOT PARALLEL_NETCDF) list(APPEND _io_defs_private NO_PARALLEL_NETCDF) endif() -if(CCPP) - list(APPEND _io_defs_private CCPP) -endif() +list(APPEND _io_defs_private CCPP) add_library( io @@ -41,10 +39,8 @@ if(INLINE_POST) target_link_libraries(io PRIVATE upp::upp) endif() -if(CCPP) - target_include_directories(io PRIVATE ${CMAKE_BINARY_DIR}/FV3/ccpp/framework/src - ${CMAKE_BINARY_DIR}/FV3/ccpp/physics) -endif() +target_include_directories(io PRIVATE ${CMAKE_BINARY_DIR}/FV3/ccpp/framework/src + ${CMAKE_BINARY_DIR}/FV3/ccpp/physics) target_link_libraries(io PRIVATE nemsio::nemsio esmf) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 6a07b3853..78afa4ec7 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -32,10 +32,10 @@ module FV3GFS_io_mod use physcons, only: con_tice !saltwater freezing temp (K) ! !--- GFS physics modules -!#ifndef CCPP +! DH* TO BE MOVED TO CCPP !--- variables needed for calculating 'sncovr' use namelist_soilveg, only: salp_data, snupx -!#endif +! *DH ! ! --- variables needed for Noah MP init @@ -128,26 +128,16 @@ module FV3GFS_io_mod !-------------------- ! FV3GFS_restart_read !-------------------- -#ifdef CCPP subroutine FV3GFS_restart_read (IPD_Data, IPD_Restart, Atm_block, Model, fv_domain, warm_start) -#else - subroutine FV3GFS_restart_read (IPD_Data, IPD_Restart, Atm_block, Model, fv_domain) -#endif type(IPD_data_type), intent(inout) :: IPD_Data(:) type(IPD_restart_type), intent(inout) :: IPD_Restart type(block_control_type), intent(in) :: Atm_block type(IPD_control_type), intent(inout) :: Model type(domain2d), intent(in) :: fv_domain -#ifdef CCPP logical, intent(in) :: warm_start -#endif !--- read in surface data from chgres -#ifdef CCPP call sfc_prop_restart_read (IPD_Data%Sfcprop, Atm_block, Model, fv_domain, warm_start) -#else - call sfc_prop_restart_read (IPD_Data%Sfcprop, Atm_block, Model, fv_domain) -#endif !--- read in physics restart data call phys_restart_read (IPD_Restart, Atm_block, Model, fv_domain) @@ -251,40 +241,37 @@ subroutine FV3GFS_IPD_checksum (Model, IPD_Data, Atm_block) temp2d(i,j,32) = IPD_Data(nb)%Sfcprop%f10m(ix) temp2d(i,j,33) = IPD_Data(nb)%Sfcprop%tprcp(ix) temp2d(i,j,34) = IPD_Data(nb)%Sfcprop%srflag(ix) -#ifdef CCPP - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4) then -#endif - temp2d(i,j,35) = IPD_Data(nb)%Sfcprop%slc(ix,1) - temp2d(i,j,36) = IPD_Data(nb)%Sfcprop%slc(ix,2) - temp2d(i,j,37) = IPD_Data(nb)%Sfcprop%slc(ix,3) - temp2d(i,j,38) = IPD_Data(nb)%Sfcprop%slc(ix,4) - temp2d(i,j,39) = IPD_Data(nb)%Sfcprop%smc(ix,1) - temp2d(i,j,40) = IPD_Data(nb)%Sfcprop%smc(ix,2) - temp2d(i,j,41) = IPD_Data(nb)%Sfcprop%smc(ix,3) - temp2d(i,j,42) = IPD_Data(nb)%Sfcprop%smc(ix,4) - temp2d(i,j,43) = IPD_Data(nb)%Sfcprop%stc(ix,1) - temp2d(i,j,44) = IPD_Data(nb)%Sfcprop%stc(ix,2) - temp2d(i,j,45) = IPD_Data(nb)%Sfcprop%stc(ix,3) - temp2d(i,j,46) = IPD_Data(nb)%Sfcprop%stc(ix,4) -#ifdef CCPP - elseif (Model%lsm == Model%lsm_ruc) then - temp2d(i,j,35) = IPD_Data(nb)%Sfcprop%sh2o(ix,1) - temp2d(i,j,36) = IPD_Data(nb)%Sfcprop%sh2o(ix,2) - temp2d(i,j,37) = IPD_Data(nb)%Sfcprop%sh2o(ix,3) - ! Combine levels 4 to lsoil_lsm (9 for RUC) into one - temp2d(i,j,38) = sum(IPD_Data(nb)%Sfcprop%sh2o(ix,4:Model%lsoil_lsm)) - temp2d(i,j,39) = IPD_Data(nb)%Sfcprop%smois(ix,1) - temp2d(i,j,40) = IPD_Data(nb)%Sfcprop%smois(ix,2) - temp2d(i,j,41) = IPD_Data(nb)%Sfcprop%smois(ix,3) - ! Combine levels 4 to lsoil_lsm (9 for RUC) into one - temp2d(i,j,42) = sum(IPD_Data(nb)%Sfcprop%smois(ix,4:Model%lsoil_lsm)) - temp2d(i,j,43) = IPD_Data(nb)%Sfcprop%tslb(ix,1) - temp2d(i,j,44) = IPD_Data(nb)%Sfcprop%tslb(ix,2) - temp2d(i,j,45) = IPD_Data(nb)%Sfcprop%tslb(ix,3) - ! Combine levels 4 to lsoil_lsm (9 for RUC) into one - temp2d(i,j,46) = sum(IPD_Data(nb)%Sfcprop%tslb(ix,4:Model%lsoil_lsm)) - endif ! LSM choice -#endif + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4) then + temp2d(i,j,35) = IPD_Data(nb)%Sfcprop%slc(ix,1) + temp2d(i,j,36) = IPD_Data(nb)%Sfcprop%slc(ix,2) + temp2d(i,j,37) = IPD_Data(nb)%Sfcprop%slc(ix,3) + temp2d(i,j,38) = IPD_Data(nb)%Sfcprop%slc(ix,4) + temp2d(i,j,39) = IPD_Data(nb)%Sfcprop%smc(ix,1) + temp2d(i,j,40) = IPD_Data(nb)%Sfcprop%smc(ix,2) + temp2d(i,j,41) = IPD_Data(nb)%Sfcprop%smc(ix,3) + temp2d(i,j,42) = IPD_Data(nb)%Sfcprop%smc(ix,4) + temp2d(i,j,43) = IPD_Data(nb)%Sfcprop%stc(ix,1) + temp2d(i,j,44) = IPD_Data(nb)%Sfcprop%stc(ix,2) + temp2d(i,j,45) = IPD_Data(nb)%Sfcprop%stc(ix,3) + temp2d(i,j,46) = IPD_Data(nb)%Sfcprop%stc(ix,4) + elseif (Model%lsm == Model%lsm_ruc) then + temp2d(i,j,35) = IPD_Data(nb)%Sfcprop%sh2o(ix,1) + temp2d(i,j,36) = IPD_Data(nb)%Sfcprop%sh2o(ix,2) + temp2d(i,j,37) = IPD_Data(nb)%Sfcprop%sh2o(ix,3) + ! Combine levels 4 to lsoil_lsm (9 for RUC) into one + temp2d(i,j,38) = sum(IPD_Data(nb)%Sfcprop%sh2o(ix,4:Model%lsoil_lsm)) + temp2d(i,j,39) = IPD_Data(nb)%Sfcprop%smois(ix,1) + temp2d(i,j,40) = IPD_Data(nb)%Sfcprop%smois(ix,2) + temp2d(i,j,41) = IPD_Data(nb)%Sfcprop%smois(ix,3) + ! Combine levels 4 to lsoil_lsm (9 for RUC) into one + temp2d(i,j,42) = sum(IPD_Data(nb)%Sfcprop%smois(ix,4:Model%lsoil_lsm)) + temp2d(i,j,43) = IPD_Data(nb)%Sfcprop%tslb(ix,1) + temp2d(i,j,44) = IPD_Data(nb)%Sfcprop%tslb(ix,2) + temp2d(i,j,45) = IPD_Data(nb)%Sfcprop%tslb(ix,3) + ! Combine levels 4 to lsoil_lsm (9 for RUC) into one + temp2d(i,j,46) = sum(IPD_Data(nb)%Sfcprop%tslb(ix,4:Model%lsoil_lsm)) + endif ! LSM choice + temp2d(i,j,47) = IPD_Data(nb)%Sfcprop%t2m(ix) temp2d(i,j,48) = IPD_Data(nb)%Sfcprop%q2m(ix) temp2d(i,j,49) = IPD_Data(nb)%Coupling%nirbmdi(ix) @@ -479,29 +466,20 @@ end subroutine FV3GFS_IPD_checksum ! opens: oro_data.tile?.nc, sfc_data.tile?.nc ! !---------------------------------------------------------------------- -#ifdef CCPP subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_start) -#else - subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) -#endif !--- interface variable definitions type(GFS_sfcprop_type), intent(inout) :: Sfcprop(:) type (block_control_type), intent(in) :: Atm_block type(IPD_control_type), intent(inout) :: Model type (domain2d), intent(in) :: fv_domain -#ifdef CCPP logical, intent(in) :: warm_start -#endif !--- local variables integer :: i, j, k, ix, lsoil, num, nb, i_start, j_start, i_end, j_end integer :: isc, iec, jsc, jec, npz, nx, ny integer :: id_restart integer :: nvar_o2, nvar_s2m, nvar_s2o, nvar_s3 integer :: nvar_oro_ls_ss - integer :: nvar_s2mp, nvar_s3mp,isnow -#ifdef CCPP - integer :: nvar_s2r -#endif + integer :: nvar_s2r, nvar_s2mp, nvar_s3mp, isnow real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p1 => NULL() @@ -527,7 +505,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) nvar_o2 = 19 nvar_oro_ls_ss = 10 nvar_s2o = 18 -#ifdef CCPP + if (Model%lsm == Model%lsm_ruc .and. warm_start) then if(Model%rdlai) then nvar_s2r = 7 @@ -543,9 +521,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) endif nvar_s3 = 3 endif -#else - nvar_s3 = 3 -#endif if (Model%lsm == Model%lsm_noahmp) then nvar_s2mp = 29 !mp 2D @@ -656,7 +631,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) deallocate(oro_name2, oro_var2) call free_restart_type(Oro_restart) -#ifdef CCPP !--- Modify/read-in additional orographic static fields for GSL drag suite if (Model%gwd_opt==3 .or. Model%gwd_opt==33 .or. & Model%gwd_opt==2 .or. Model%gwd_opt==22 ) then @@ -738,29 +712,20 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) call free_restart_type(Oro_ls_restart) call free_restart_type(Oro_ss_restart) end if -#endif !--- SURFACE FILE if (.not. allocated(sfc_name2)) then !--- allocate the various containers needed for restarts -#ifdef CCPP allocate(sfc_name2(nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r)) allocate(sfc_name3(0:nvar_s3+nvar_s3mp)) - allocate(sfc_var2(nx,ny,nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r),sfc_var3ice(nx,ny,Model%kice)) + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4 .or. (.not.warm_start)) then allocate(sfc_var3(nx,ny,Model%lsoil,nvar_s3)) else if (Model%lsm == Model%lsm_ruc) then allocate(sfc_var3(nx,ny,Model%lsoil_lsm,nvar_s3)) end if -#else - allocate(sfc_name2(nvar_s2m+nvar_s2o+nvar_s2mp)) - allocate(sfc_name3(0:nvar_s3+nvar_s3mp)) - allocate(sfc_var2(nx,ny,nvar_s2m+nvar_s2o+nvar_s2mp)) - allocate(sfc_var3ice(nx,ny,Model%kice)) - allocate(sfc_var3(nx,ny,Model%lsoil,nvar_s3)) -#endif sfc_var2 = -9999.0_r8 sfc_var3 = -9999.0_r8 sfc_var3ice= -9999.0_r8 @@ -869,7 +834,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) sfc_name2(nvar_s2m+45) = 'smcwtdxy' sfc_name2(nvar_s2m+46) = 'deeprechxy' sfc_name2(nvar_s2m+47) = 'rechxy' -#ifdef CCPP else if (Model%lsm == Model%lsm_ruc .and. warm_start) then sfc_name2(nvar_s2m+19) = 'wetness' sfc_name2(nvar_s2m+20) = 'clw_surf' @@ -882,7 +846,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) endif else if (Model%lsm == Model%lsm_ruc .and. Model%rdlai) then sfc_name2(nvar_s2m+19) = 'lai' -#endif endif !--- register the 2D fields @@ -905,14 +868,14 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=mand) enddo endif -#ifdef CCPP + if (Model%lsm == Model%lsm_ruc) then ! nvar_s2mp = 0 do num = nvar_s2m+nvar_s2o+1, nvar_s2m+nvar_s2o+nvar_s2r var2_p => sfc_var2(:,:,num) id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain) enddo endif ! mp/ruc -#endif + ! Noah MP register only necessary only lsm = 2, not necessary has values if (nvar_s2mp > 0) then mand = .false. @@ -926,7 +889,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) endif ! if not allocated -#ifdef CCPP if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4 .or. (.not.warm_start)) then !--- names of the 3D variables to save sfc_name3(1) = 'stc' @@ -947,20 +909,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) sfc_name3(4) = 'smfr' sfc_name3(5) = 'flfr' endif -#else - !--- names of the 3D variables to save - sfc_name3(1) = 'stc' - sfc_name3(2) = 'smc' - sfc_name3(3) = 'slc' - !--- Noah MP - if (Model%lsm == Model%lsm_noahmp) then - sfc_name3(4) = 'snicexy' - sfc_name3(5) = 'snliqxy' - sfc_name3(6) = 'tsnoxy' - sfc_name3(7) = 'smoiseq' - sfc_name3(8) = 'zsnsoxy' - endif -#endif + !--- register the 3D fields ! if (Model%frac_grid) then sfc_name3(0) = 'tiice' @@ -1148,7 +1097,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Sfcprop(nb)%qrain(ix) = sfc_var2(i,j,nvar_s2m+18) !--- nsstm qrain endif endif -#ifdef CCPP + if (Model%lsm == Model%lsm_ruc .and. warm_start) then !--- Extra RUC variables Sfcprop(nb)%wetness(ix) = sfc_var2(i,j,nvar_s2m+19) @@ -1164,11 +1113,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Sfcprop(nb)%xlaixy(ix) = sfc_var2(i,j,nvar_s2m+19) elseif (Model%lsm == Model%lsm_noahmp) then !--- Extra Noah MP variables -#else -! Noah MP -! ------- - if (Model%lsm == Model%lsm_noahmp) then -#endif Sfcprop(nb)%snowxy(ix) = sfc_var2(i,j,nvar_s2m+19) Sfcprop(nb)%tvxy(ix) = sfc_var2(i,j,nvar_s2m+20) Sfcprop(nb)%tgxy(ix) = sfc_var2(i,j,nvar_s2m+21) @@ -1200,7 +1144,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Sfcprop(nb)%rechxy(ix) = sfc_var2(i,j,nvar_s2m+47) endif -#ifdef CCPP if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4 .or. (.not.warm_start)) then !--- 3D variables do lsoil = 1,Model%lsoil @@ -1239,30 +1182,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) do k = 1,Model%kice Sfcprop(nb)%tiice(ix,k)= sfc_var3ice(i,j,k) !--- internal ice temp enddo -#else - !--- 3D variables - do lsoil = 1,Model%lsoil - Sfcprop(nb)%stc(ix,lsoil) = sfc_var3(i,j,lsoil,1) !--- stc - Sfcprop(nb)%smc(ix,lsoil) = sfc_var3(i,j,lsoil,2) !--- smc - Sfcprop(nb)%slc(ix,lsoil) = sfc_var3(i,j,lsoil,3) !--- slc - enddo - - if (Model%lsm == Model%lsm_noahmp) then - do lsoil = -2, 0 - Sfcprop(nb)%snicexy(ix,lsoil) = sfc_var3sn(i,j,lsoil,4) - Sfcprop(nb)%snliqxy(ix,lsoil) = sfc_var3sn(i,j,lsoil,5) - Sfcprop(nb)%tsnoxy(ix,lsoil) = sfc_var3sn(i,j,lsoil,6) - enddo - - do lsoil = 1, 4 - Sfcprop(nb)%smoiseq(ix,lsoil) = sfc_var3eq(i,j,lsoil,7) - enddo - - do lsoil = -2, 4 - Sfcprop(nb)%zsnsoxy(ix,lsoil) = sfc_var3zn(i,j,lsoil,8) - enddo - endif -#endif enddo !ix enddo !nb @@ -1279,12 +1198,11 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) ! It has to be done after the weasd is available ! sfc_var2(1,1,32) is the first; we need this to allocate snow related fields -#ifdef CCPP - ! Calculating sncovr does NOT belong into an I/O routine! - ! TODO: move to physics and stop building namelist_soilveg/set_soilveg +! DH* MOVE TO CCPP - all of it? some? need to check carefully what belongs here and what not + + ! Calculating sncovr does not belong into an I/O routine? + ! TODO? move to physics and stop building namelist_soilveg/set_soilveg ! in the FV3/non-CCPP physics when the CCPP-enabled executable is built. -#endif -!#ifndef CCPP i = Atm_block%index(1)%ii(1) - isc + 1 j = Atm_block%index(1)%jj(1) - jsc + 1 @@ -1354,8 +1272,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) enddo endif -!#endif - if(Model%frac_grid) then ! 3-way composite !$omp parallel do default(shared) private(nb, ix, tem, tem1) do nb = 1, Atm_block%nblks @@ -1416,7 +1332,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) endif endif ! if (Model%frac_grid) -!#ifdef CCPP if (nint(sfc_var3ice(1,1,1)) == -9999) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing tiice') do nb = 1, Atm_block%nblks @@ -1426,7 +1341,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) enddo enddo endif -!#endif if (Model%lsm == Model%lsm_noahmp) then if (nint(sfc_var2(1,1,nvar_s2m+19)) == -66666) then @@ -1692,6 +1606,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) endif endif !if Noah MP cold start ends +! *DH MOVE TO CCPP? + end subroutine sfc_prop_restart_read @@ -1717,10 +1633,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta integer :: isc, iec, jsc, jec, npz, nx, ny integer :: id_restart integer :: nvar2m, nvar2o, nvar3 - integer :: nvar2mp, nvar3mp -#ifdef CCPP - integer :: nvar2r -#endif + integer :: nvar2r, nvar2mp, nvar3mp logical :: mand character(len=32) :: fn_srf = 'sfc_data.nc' real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() @@ -1736,7 +1649,6 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta ! endif if (Model%cplwav) nvar2m = nvar2m + 1 nvar2o = 18 -#ifdef CCPP if (Model%lsm == Model%lsm_ruc) then if (Model%rdlai) then nvar2r = 7 @@ -1748,9 +1660,6 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta nvar2r = 0 nvar3 = 3 endif -#else - nvar3 = 3 -#endif nvar2mp = 0 nvar3mp = 0 if (Model%lsm == Model%lsm_noahmp) then @@ -1766,7 +1675,6 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta nx = (iec - isc + 1) ny = (jec - jsc + 1) -#ifdef CCPP if (Model%lsm == Model%lsm_ruc) then if (allocated(sfc_name2)) then ! Re-allocate if one or more of the dimensions don't match @@ -1782,11 +1690,9 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta end if end if end if -#endif if (.not. allocated(sfc_name2)) then !--- allocate the various containers needed for restarts -#ifdef CCPP allocate(sfc_name2(nvar2m+nvar2o+nvar2mp+nvar2r)) allocate(sfc_name3(0:nvar3+nvar3mp)) allocate(sfc_var2(nx,ny,nvar2m+nvar2o+nvar2mp+nvar2r)) @@ -1795,12 +1701,6 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta elseif (Model%lsm == Model%lsm_ruc) then allocate(sfc_var3(nx,ny,Model%lsoil_lsm,nvar3)) endif -#else - allocate(sfc_name2(nvar2m+nvar2o+nvar2mp)) - allocate(sfc_name3(0:nvar3+nvar3mp)) - allocate(sfc_var2(nx,ny,nvar2m+nvar2o+nvar2mp)) - allocate(sfc_var3(nx,ny,Model%lsoil,nvar3)) -#endif sfc_var2 = -9999.0_r8 sfc_var3 = -9999.0_r8 if (Model%lsm == Model%lsm_noahmp) then @@ -1875,7 +1775,6 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2m+16) = 'ifd' sfc_name2(nvar2m+17) = 'dt_cool' sfc_name2(nvar2m+18) = 'qrain' -#ifdef CCPP if (Model%lsm == Model%lsm_ruc) then sfc_name2(nvar2m+19) = 'wetness' sfc_name2(nvar2m+20) = 'clw_surf' @@ -1887,10 +1786,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2m+25) = 'lai' endif else if(Model%lsm == Model%lsm_noahmp) then -#else -! Only needed when Noah MP LSM is used - 29 2D - if(Model%lsm == Model%lsm_noahmp) then -#endif + ! Only needed when Noah MP LSM is used - 29 2D sfc_name2(nvar2m+19) = 'snowxy' sfc_name2(nvar2m+20) = 'tvxy' sfc_name2(nvar2m+21) = 'tgxy' @@ -1940,16 +1836,13 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=mand) enddo endif -#ifdef CCPP - if (Model%lsm == Model%lsm_ruc) then ! nvar2mp =0 + + if (Model%lsm == Model%lsm_ruc) then ! nvar2mp =0 do num = nvar2m+nvar2o+1, nvar2m+nvar2o+nvar2r var2_p => sfc_var2(:,:,num) id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain) enddo - else if (Model%lsm == Model%lsm_noahmp) then ! nvar2r =0 -#else - if (Model%lsm == Model%lsm_noahmp) then -#endif + else if (Model%lsm == Model%lsm_noahmp) then ! nvar2r =0 mand = .true. ! actually should be true since it is after cold start do num = nvar2m+nvar2o+1,nvar2m+nvar2o+nvar2mp var2_p => sfc_var2(:,:,num) @@ -1958,7 +1851,6 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta endif nullify(var2_p) -#ifdef CCPP if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4) then !--- names of the 3D variables to save sfc_name3(1) = 'stc' @@ -1979,19 +1871,6 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name3(4) = 'smfr' sfc_name3(5) = 'flfr' end if -#else - !--- names of the 3D variables to save - sfc_name3(1) = 'stc' - sfc_name3(2) = 'smc' - sfc_name3(3) = 'slc' - if (Model%lsm == Model%lsm_noahmp) then - sfc_name3(4) = 'snicexy' - sfc_name3(5) = 'snliqxy' - sfc_name3(6) = 'tsnoxy' - sfc_name3(7) = 'smoiseq' - sfc_name3(8) = 'zsnsoxy' - endif -#endif !--- register the 3D fields ! if (Model%frac_grid) then @@ -2099,7 +1978,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,nvar2m+17) = Sfcprop(nb)%dt_cool(ix)!--- nsstm dt_cool sfc_var2(i,j,nvar2m+18) = Sfcprop(nb)%qrain(ix) !--- nsstm qrain endif -#ifdef CCPP + if (Model%lsm == Model%lsm_ruc) then !--- Extra RUC variables sfc_var2(i,j,nvar2m+19) = Sfcprop(nb)%wetness(ix) @@ -2112,12 +1991,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,nvar2m+25) = Sfcprop(nb)%xlaixy(ix) endif else if (Model%lsm == Model%lsm_noahmp) then - -#else -! Noah MP - if (Model%lsm == Model%lsm_noahmp) then -#endif - + !--- Extra Noah MP variables sfc_var2(i,j,nvar2m+19) = Sfcprop(nb)%snowxy(ix) sfc_var2(i,j,nvar2m+20) = Sfcprop(nb)%tvxy(ix) sfc_var2(i,j,nvar2m+21) = Sfcprop(nb)%tgxy(ix) @@ -2149,7 +2023,6 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,nvar2m+47) = Sfcprop(nb)%rechxy(ix) endif -#ifdef CCPP do k = 1,Model%kice sfc_var3ice(i,j,k) = Sfcprop(nb)%tiice(ix,k) !--- internal ice temperature end do @@ -2189,32 +2062,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var3(i,j,lsoil,5) = Sfcprop(nb)%flag_frsoil(ix,lsoil) !--- flag_frsoil enddo end if -#else - !--- 3D variables - do lsoil = 1,Model%lsoil - sfc_var3(i,j,lsoil,1) = Sfcprop(nb)%stc(ix,lsoil) !--- stc - sfc_var3(i,j,lsoil,2) = Sfcprop(nb)%smc(ix,lsoil) !--- smc - sfc_var3(i,j,lsoil,3) = Sfcprop(nb)%slc(ix,lsoil) !--- slc - enddo -! 5 Noah MP 3D - if (Model%lsm == Model%lsm_noahmp) then - - do lsoil = -2,0 - sfc_var3sn(i,j,lsoil,4) = Sfcprop(nb)%snicexy(ix,lsoil) - sfc_var3sn(i,j,lsoil,5) = Sfcprop(nb)%snliqxy(ix,lsoil) - sfc_var3sn(i,j,lsoil,6) = Sfcprop(nb)%tsnoxy(ix,lsoil) - enddo - do lsoil = 1,Model%lsoil - sfc_var3eq(i,j,lsoil,7) = Sfcprop(nb)%smoiseq(ix,lsoil) - enddo - - do lsoil = -2,4 - sfc_var3zn(i,j,lsoil,8) = Sfcprop(nb)%zsnsoxy(ix,lsoil) - enddo - - endif ! Noah MP -#endif enddo enddo diff --git a/ipd/CMakeLists.txt b/ipd/CMakeLists.txt index d0a6bba23..a0fb453d3 100644 --- a/ipd/CMakeLists.txt +++ b/ipd/CMakeLists.txt @@ -11,9 +11,7 @@ if(32BIT) endif() endif() -if(CCPP) - list(APPEND _ipd_defs_private CCPP) -endif() +list(APPEND _ipd_defs_private CCPP) add_library( ipd @@ -25,9 +23,7 @@ set_target_properties(ipd PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BI target_compile_definitions(ipd PRIVATE "${_ipd_defs_private}") target_include_directories(ipd PUBLIC $) -if(CCPP) - target_include_directories(ipd PRIVATE ${CMAKE_BINARY_DIR}/FV3/ccpp/framework/src - ${CMAKE_BINARY_DIR}/FV3/ccpp/physics) -endif() +target_include_directories(ipd PRIVATE ${CMAKE_BINARY_DIR}/FV3/ccpp/framework/src + ${CMAKE_BINARY_DIR}/FV3/ccpp/physics) target_link_libraries(ipd PRIVATE gfsphysics) diff --git a/ipd/IPD_driver.F90 b/ipd/IPD_driver.F90 index 93a61055d..1d36bef86 100644 --- a/ipd/IPD_driver.F90 +++ b/ipd/IPD_driver.F90 @@ -3,13 +3,10 @@ module IPD_driver use IPD_typedefs, only: IPD_kind_phys, IPD_init_type, & IPD_control_type, IPD_data_type, & IPD_diag_type, IPD_restart_type, & - IPD_func0d_proc, IPD_func1d_proc, & + IPD_interstitial_type, & initialize, & diagnostic_populate, & restart_populate -#ifdef CCPP - use IPD_typedefs, only: IPD_interstitial_type -#endif implicit none @@ -27,7 +24,6 @@ module IPD_driver !---------------- ! functions public IPD_initialize, IPD_initialize_rst - public IPD_step CONTAINS !******************************************************************************************* @@ -36,34 +32,23 @@ module IPD_driver !---------------- ! IPD Initialize !---------------- -#ifdef CCPP subroutine IPD_initialize (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, & IPD_Interstitial, communicator, ntasks, IPD_init_parm) -#else - subroutine IPD_initialize (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, IPD_init_parm) -#endif type(IPD_control_type), intent(inout) :: IPD_Control type(IPD_data_type), intent(inout) :: IPD_Data(:) type(IPD_diag_type), intent(inout) :: IPD_Diag(:) type(IPD_restart_type), intent(inout) :: IPD_Restart -#ifdef CCPP type(IPD_interstitial_type), intent(inout) :: IPD_Interstitial(:) integer, intent(in) :: communicator integer, intent(in) :: ntasks -#endif type(IPD_init_type), intent(in) :: IPD_init_parm !--- initialize the physics suite call initialize (IPD_Control, IPD_Data(:)%Statein, IPD_Data(:)%Stateout, & IPD_Data(:)%Sfcprop, IPD_Data(:)%Coupling, IPD_Data(:)%Grid, & IPD_Data(:)%Tbd, IPD_Data(:)%Cldprop, IPD_Data(:)%Radtend, & -#ifdef CCPP IPD_Data(:)%Intdiag, IPD_Interstitial(:), communicator, & ntasks, IPD_init_parm) -#else - IPD_Data(:)%Intdiag, IPD_init_parm) -#endif - !--- populate/associate the Diag container elements call diagnostic_populate (IPD_Diag, IPD_Control, IPD_Data%Statein, IPD_Data%Stateout, & @@ -71,7 +56,6 @@ subroutine IPD_initialize (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, IPD_ini IPD_Data%Tbd, IPD_Data%Cldprop, IPD_Data%Radtend, & IPD_Data%Intdiag, IPD_init_parm) - end subroutine IPD_initialize !---------------- @@ -92,30 +76,4 @@ subroutine IPD_initialize_rst (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, IPD end subroutine IPD_initialize_rst -!---------------------------------------------------------- -! IPD step -! runs the given routine/function pointed to by IPD_func -!---------------------------------------------------------- - subroutine IPD_step (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, IPD_func0d, IPD_func1d) - type(IPD_control_type), intent(inout) :: IPD_Control - type(IPD_data_type), intent(inout) :: IPD_Data(:) - type(IPD_diag_type), intent(inout) :: IPD_Diag(:) - type(IPD_restart_type), intent(inout) :: IPD_Restart - procedure(IPD_func0d_proc), intent(in), optional, pointer :: IPD_func0d - procedure(IPD_func1d_proc), intent(in), optional, pointer :: IPD_func1d - - if (size(IPD_Data,1) == 1 .and. PRESENT(IPD_func0d)) then - call IPD_func0d (IPD_Control, IPD_Data(1)%Statein, IPD_Data(1)%Stateout, & - IPD_Data(1)%Sfcprop, IPD_Data(1)%Coupling, IPD_Data(1)%Grid, & - IPD_Data(1)%Tbd, IPD_Data(1)%Cldprop, IPD_Data(1)%Radtend, & - IPD_Data(1)%Intdiag) - else - call IPD_func1d (IPD_Control, IPD_Data(:)%Statein, IPD_Data(:)%Stateout, & - IPD_Data(:)%Sfcprop, IPD_Data(:)%Coupling, IPD_Data(:)%Grid, & - IPD_Data(:)%Tbd, IPD_Data(:)%Cldprop, IPD_Data(:)%Radtend, & - IPD_Data(:)%Intdiag) - endif - - end subroutine IPD_step - end module IPD_driver diff --git a/ipd/IPD_typedefs.F90 b/ipd/IPD_typedefs.F90 index 9a0bbbb77..d3cb6f502 100644 --- a/ipd/IPD_typedefs.F90 +++ b/ipd/IPD_typedefs.F90 @@ -3,14 +3,13 @@ module IPD_typedefs !--------------------------------------------------------- ! Physics/Radiation types used to create various IPD types !--------------------------------------------------------- - use physics_abstraction_layer, only: IPD_control_type => control_type, & - IPD_init_type => init_type, & - IPD_restart_type => restart_type, & - IPD_diag_type => diagnostic_type, & - IPD_kind_phys => kind_phys -#ifdef CCPP - use physics_abstraction_layer, only: IPD_interstitial_type => interstitial_type -#endif + use physics_abstraction_layer, only: IPD_control_type => control_type, & + IPD_init_type => init_type, & + IPD_restart_type => restart_type, & + IPD_diag_type => diagnostic_type, & + IPD_interstitial_type => interstitial_type, & + IPD_data_type => data_type, & + IPD_kind_phys => kind_phys !--------------------------------------------------------- ! Physics/Radiation types used to create the IPD_data_type @@ -20,9 +19,6 @@ module IPD_typedefs grid_type, tbd_type, & cldprop_type, radtend_type, & intdiag_type -#ifdef CCPP - use physics_abstraction_layer, only: IPD_data_type => data_type -#endif !------------------------------------------------- ! Physics/Radiation routines to pass to IPD_driver @@ -31,113 +27,6 @@ module IPD_typedefs diagnostic_populate, & restart_populate -#ifndef CCPP -!------------------------------------------------------- -! IPD_data_type -! container of physics data types that can be blocked -!------------------------------------------------------- - type IPD_data_type - type(statein_type) :: Statein - type(stateout_type) :: Stateout - type(sfcprop_type) :: Sfcprop - type(coupling_type) :: Coupling - type(grid_type) :: Grid - type(tbd_type) :: Tbd - type(cldprop_type) :: Cldprop - type(radtend_type) :: Radtend - type(intdiag_type) :: Intdiag - end type IPD_data_type -#endif - - -!------------------------------------------------------ -! IPD function procedures -! definitions for scalar(0d) and vector(1d) versions -!------------------------------------------------------ - abstract interface - subroutine IPD_func0d_proc (Control, Statein, Stateout, & - Sfcprop, Coupling, Grid, & - Tbd, Cldprop, Radtend, & - Intdiag) - import :: IPD_control_type, statein_type, stateout_type, & - sfcprop_type, coupling_type, grid_type, tbd_type, & - cldprop_type, radtend_type, intdiag_type - type(IPD_control_type), intent(inout) :: Control - type(statein_type), intent(inout) :: Statein - type(stateout_type), intent(inout) :: Stateout - type(sfcprop_type), intent(inout) :: Sfcprop - type(coupling_type), intent(inout) :: Coupling - type(grid_type), intent(inout) :: Grid - type(tbd_type), intent(inout) :: Tbd - type(cldprop_type), intent(inout) :: Cldprop - type(radtend_type), intent(inout) :: Radtend - type(intdiag_type), intent(inout) :: Intdiag - end subroutine IPD_func0d_proc - - subroutine IPD_func1d_proc (Control, Statein, Stateout, & - Sfcprop, Coupling, Grid, & - Tbd, Cldprop, Radtend, & - Intdiag) - import :: IPD_control_type, statein_type, stateout_type, & - sfcprop_type, coupling_type, grid_type, tbd_type, & - cldprop_type, radtend_type, intdiag_type - type(IPD_control_type), intent(inout) :: Control - type(statein_type), intent(inout) :: Statein(:) - type(stateout_type), intent(inout) :: Stateout(:) - type(sfcprop_type), intent(inout) :: Sfcprop(:) - type(coupling_type), intent(inout) :: Coupling(:) - type(grid_type), intent(inout) :: Grid(:) - type(tbd_type), intent(inout) :: Tbd(:) - type(cldprop_type), intent(inout) :: Cldprop(:) - type(radtend_type), intent(inout) :: Radtend(:) - type(intdiag_type), intent(inout) :: Intdiag(:) - end subroutine IPD_func1d_proc - end interface - - -!------------------------------------------------ -! SAMPLE var_subtype -! pointers to two and three dimensional objects -!------------------------------------------------ -! type var_subtype -! real(kind=kind_phys), pointer :: var2p(:) => null() !< 2D data saved in packed format [dim(ix)] -! real(kind=kind_phys), pointer :: var3p(:,:) => null() !< 3D data saved in packed format [dim(ix,levs)] -! end type var_subtype -! -!-------------------------------------------------- -! SAMPLE restart_type to import as IPD_restart_type -! data necessary for reproducible restarts -!-------------------------------------------------- -! type restart_type -! integer :: num2d !< current number of registered 2D restart variables -! integer :: num3d !< current number of registered 3D restart variables -! character(len=32), allocatable :: name2d(:) !< variable name as it will appear in the restart file -! character(len=32), allocatable :: name3d(:) !< variable name as it will appear in the restart file -! type(var_subtype), allocatable :: data(:,:) !< holds pointers to data in packed format (allocated to (nblks,max(2d/3dfields)) -! end type restart_type -! -!-------------------------------------------------- -! SAMPLE diagnostic_type to import as IPD_diag_type -! fields targetted as diagnostic output -!-------------------------------------------------- -! type diag_type -! character(len=32) :: name !< variable name in source -! character(len=32) :: output_name !< output name for variable -! character(len=32) :: mod_name !< module name (e.g. physics, radiation, etc) -! character(len=32) :: file_name !< output file name for variable -! character(len=128) :: desc !< long description of field -! character(len=32) :: unit !< units associated with fields -! character(len=32) :: type_stat_proc !< type of statistic processing: -! !< average, accumulation, maximal, minimal, etc. -! character(len=32) :: level_type !< vertical level of the field -! integer :: level !< vertical level(s) -! real(kind=kind_phys) :: cnvfac !< conversion factors to output in specified units -! real(kind=kind_phys) :: zhour !< forecast hour when bucket was last emptied for statistical processing -! real(kind=kind_phys) :: fcst_hour !< current forecast hour (same as fhour) -! type(var_subtype), allocatable :: data(:) !< holds pointers to data in packed format (allocated to nblks) -! end type diag_type - - !------------------------ ! IPD public declarations !------------------------ @@ -147,10 +36,7 @@ end subroutine IPD_func1d_proc public IPD_restart_type public IPD_diag_type public IPD_init_type -#ifdef CCPP public IPD_interstitial_type -#endif - !----------------------------------- ! public declarations for IPD_driver diff --git a/stochastic_physics/CMakeLists.txt b/stochastic_physics/CMakeLists.txt index be58afc0d..aed983669 100644 --- a/stochastic_physics/CMakeLists.txt +++ b/stochastic_physics/CMakeLists.txt @@ -1,10 +1,8 @@ add_library(stochastic_physics_wrapper stochastic_physics_wrapper.F90) target_include_directories(stochastic_physics_wrapper PRIVATE ${CMAKE_BINARY_DIR}/stochastic_physics) -if(CCPP) - target_include_directories(stochastic_physics_wrapper PRIVATE ${CMAKE_BINARY_DIR}/FV3/ccpp/framework/src - ${CMAKE_BINARY_DIR}/FV3/ccpp/physics) -endif() +target_include_directories(stochastic_physics_wrapper PRIVATE ${CMAKE_BINARY_DIR}/FV3/ccpp/framework/src + ${CMAKE_BINARY_DIR}/FV3/ccpp/physics) target_include_directories(stochastic_physics_wrapper PUBLIC $) target_link_libraries(stochastic_physics_wrapper PUBLIC fms stochastic_physics From f84805d700c694751d7ac76f41ca7a6d6a0fd8c1 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 6 Jan 2021 20:24:57 -0700 Subject: [PATCH 10/20] Delete IPD source code --- .../GFS_layer/GFS_abstraction_layer.F90 | 56 ------------- ipd/CMakeLists.txt | 29 ------- ipd/IPD_driver.F90 | 79 ------------------- ipd/IPD_typedefs.F90 | 51 ------------ ipd/makefile | 58 -------------- 5 files changed, 273 deletions(-) delete mode 100644 gfsphysics/GFS_layer/GFS_abstraction_layer.F90 delete mode 100644 ipd/CMakeLists.txt delete mode 100644 ipd/IPD_driver.F90 delete mode 100644 ipd/IPD_typedefs.F90 delete mode 100644 ipd/makefile diff --git a/gfsphysics/GFS_layer/GFS_abstraction_layer.F90 b/gfsphysics/GFS_layer/GFS_abstraction_layer.F90 deleted file mode 100644 index 9eca3dea2..000000000 --- a/gfsphysics/GFS_layer/GFS_abstraction_layer.F90 +++ /dev/null @@ -1,56 +0,0 @@ -module physics_abstraction_layer - - use machine, only: kind_phys - use GFS_typedefs, only: init_type => GFS_init_type, & - control_type => GFS_control_type, & - statein_type => GFS_statein_type, & - stateout_type => GFS_stateout_type, & - sfcprop_type => GFS_sfcprop_type, & - coupling_type => GFS_coupling_type, & - grid_type => GFS_grid_type, & - tbd_type => GFS_tbd_type, & - cldprop_type => GFS_cldprop_type, & - radtend_type => GFS_radtend_type, & - intdiag_type => GFS_diag_type, & - data_type => GFS_data_type, & - interstitial_type => GFS_interstitial_type - - use GFS_restart, only: restart_type => GFS_restart_type, & - restart_populate => GFS_restart_populate - - use GFS_diagnostics, only: diagnostic_type => GFS_externaldiag_type, & - diagnostic_populate => GFS_externaldiag_populate - - use GFS_driver, only: initialize => GFS_initialize - -!------------------------- -! public physics dataspec -!------------------------- - public kind_phys - -!---------------------- -! public physics types -!---------------------- - public init_type - public control_type - public statein_type - public stateout_type - public sfcprop_type - public coupling_type - public grid_type - public tbd_type - public cldprop_type - public radtend_type - public intdiag_type - public restart_type - public diagnostic_type - public interstitial_type - -!-------------------------- -! public physics functions -!-------------------------- - public initialize - -CONTAINS - -end module physics_abstraction_layer diff --git a/ipd/CMakeLists.txt b/ipd/CMakeLists.txt deleted file mode 100644 index a0fb453d3..000000000 --- a/ipd/CMakeLists.txt +++ /dev/null @@ -1,29 +0,0 @@ -if(32BIT) - message ("Force 64 bits in ipd") - if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") - if(REPRO) - string (REPLACE "-i4 -real-size 32" "-i4 -real-size 64" CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}") - else() - string (REPLACE "-i4 -real-size 32" "-i4 -real-size 64 -no-prec-div -no-prec-sqrt" CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}") - endif() - elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fdefault-real-8") - endif() -endif() - -list(APPEND _ipd_defs_private CCPP) - -add_library( - ipd - - IPD_driver.F90 - IPD_typedefs.F90 -) -set_target_properties(ipd PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/mod) -target_compile_definitions(ipd PRIVATE "${_ipd_defs_private}") -target_include_directories(ipd PUBLIC $) - -target_include_directories(ipd PRIVATE ${CMAKE_BINARY_DIR}/FV3/ccpp/framework/src - ${CMAKE_BINARY_DIR}/FV3/ccpp/physics) - -target_link_libraries(ipd PRIVATE gfsphysics) diff --git a/ipd/IPD_driver.F90 b/ipd/IPD_driver.F90 deleted file mode 100644 index 1d36bef86..000000000 --- a/ipd/IPD_driver.F90 +++ /dev/null @@ -1,79 +0,0 @@ -module IPD_driver - - use IPD_typedefs, only: IPD_kind_phys, IPD_init_type, & - IPD_control_type, IPD_data_type, & - IPD_diag_type, IPD_restart_type, & - IPD_interstitial_type, & - initialize, & - diagnostic_populate, & - restart_populate - - implicit none - -!------------------------------------------------------! -! IPD containers ! -!------------------------------------------------------! -! type(GFS_control_type) :: IPD_Control ! -! type(IPD_data_type) allocatable :: IPD_Data(:) ! -! type(IPD_diag_type), :: IPD_Diag(:) ! -! type(IPD_restart_type), :: IPD_Restart ! -!------------------------------------------------------! - -!---------------- -! Public Entities -!---------------- -! functions - public IPD_initialize, IPD_initialize_rst - - CONTAINS -!******************************************************************************************* - - -!---------------- -! IPD Initialize -!---------------- - subroutine IPD_initialize (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, & - IPD_Interstitial, communicator, ntasks, IPD_init_parm) - type(IPD_control_type), intent(inout) :: IPD_Control - type(IPD_data_type), intent(inout) :: IPD_Data(:) - type(IPD_diag_type), intent(inout) :: IPD_Diag(:) - type(IPD_restart_type), intent(inout) :: IPD_Restart - type(IPD_interstitial_type), intent(inout) :: IPD_Interstitial(:) - integer, intent(in) :: communicator - integer, intent(in) :: ntasks - type(IPD_init_type), intent(in) :: IPD_init_parm - - !--- initialize the physics suite - call initialize (IPD_Control, IPD_Data(:)%Statein, IPD_Data(:)%Stateout, & - IPD_Data(:)%Sfcprop, IPD_Data(:)%Coupling, IPD_Data(:)%Grid, & - IPD_Data(:)%Tbd, IPD_Data(:)%Cldprop, IPD_Data(:)%Radtend, & - IPD_Data(:)%Intdiag, IPD_Interstitial(:), communicator, & - ntasks, IPD_init_parm) - - !--- populate/associate the Diag container elements - call diagnostic_populate (IPD_Diag, IPD_Control, IPD_Data%Statein, IPD_Data%Stateout, & - IPD_Data%Sfcprop, IPD_Data%Coupling, IPD_Data%Grid, & - IPD_Data%Tbd, IPD_Data%Cldprop, IPD_Data%Radtend, & - IPD_Data%Intdiag, IPD_init_parm) - - end subroutine IPD_initialize - -!---------------- -! IPD Initialize phase_rst -!---------------- - subroutine IPD_initialize_rst (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, IPD_init_parm) - type(IPD_control_type), intent(inout) :: IPD_Control - type(IPD_data_type), intent(inout) :: IPD_Data(:) - type(IPD_diag_type), intent(inout) :: IPD_Diag(:) - type(IPD_restart_type), intent(inout) :: IPD_Restart - type(IPD_init_type), intent(in) :: IPD_init_parm - - !--- allocate and populate/associate the Restart container elements - call restart_populate (IPD_Restart, IPD_Control, IPD_Data%Statein, IPD_Data%Stateout, & - IPD_Data%Sfcprop, IPD_Data%Coupling, IPD_Data%Grid, & - IPD_Data%Tbd, IPD_Data%Cldprop, IPD_Data%Radtend, & - IPD_Data%Intdiag, IPD_init_parm, IPD_Diag) - - end subroutine IPD_initialize_rst - -end module IPD_driver diff --git a/ipd/IPD_typedefs.F90 b/ipd/IPD_typedefs.F90 deleted file mode 100644 index d3cb6f502..000000000 --- a/ipd/IPD_typedefs.F90 +++ /dev/null @@ -1,51 +0,0 @@ -module IPD_typedefs - -!--------------------------------------------------------- -! Physics/Radiation types used to create various IPD types -!--------------------------------------------------------- - use physics_abstraction_layer, only: IPD_control_type => control_type, & - IPD_init_type => init_type, & - IPD_restart_type => restart_type, & - IPD_diag_type => diagnostic_type, & - IPD_interstitial_type => interstitial_type, & - IPD_data_type => data_type, & - IPD_kind_phys => kind_phys - -!--------------------------------------------------------- -! Physics/Radiation types used to create the IPD_data_type -!--------------------------------------------------------- - use physics_abstraction_layer, only: statein_type, stateout_type, & - sfcprop_type, coupling_type, & - grid_type, tbd_type, & - cldprop_type, radtend_type, & - intdiag_type - -!------------------------------------------------- -! Physics/Radiation routines to pass to IPD_driver -!------------------------------------------------- - use physics_abstraction_layer, only: initialize, & - diagnostic_populate, & - restart_populate - -!------------------------ -! IPD public declarations -!------------------------ - public IPD_kind_phys - public IPD_control_type - public IPD_data_type - public IPD_restart_type - public IPD_diag_type - public IPD_init_type - public IPD_interstitial_type - -!----------------------------------- -! public declarations for IPD_driver -!----------------------------------- - public initialize - public diagnostic_populate - public restart_populate - - CONTAINS -!******************************************************************************************* - -end module IPD_typedefs diff --git a/ipd/makefile b/ipd/makefile deleted file mode 100644 index ed4a2749b..000000000 --- a/ipd/makefile +++ /dev/null @@ -1,58 +0,0 @@ -SHELL = /bin/sh - -inside_nems := $(wildcard ../../../conf/configure.nems) -ifneq ($(strip $(inside_nems)),) - include ../../../conf/configure.nems -else - exist_configure_fv3 := $(wildcard ../conf/configure.fv3) - ifneq ($(strip $(exist_configure_fv3)),) - include ../conf/configure.fv3 - else - $(error "../conf/configure.fv3 file is missing. Run ./configure") - endif - $(info ) - $(info Build standalone FV3 gfsphysics ...) - $(info ) -endif - -LIBRARY = libipd.a - -FFLAGS += -I$(FMS_DIR) -I../gfsphysics - -CPPDEFS += -DNEW_TAUCTMAX -DSMALL_PE -DNEMS_GSM -DINTERNAL_FILE_NML - -SRCS_F90 = \ - ./IPD_driver.F90 \ - ./IPD_typedefs.F90 - -SRCS_c = - -DEPEND_FILES = $(SRCS_f) $(SRCS_f90) $(SRCS_F) $(SRCS_F90) - -OBJS_f = $(SRCS_f:.f=.o) -OBJS_f90 = $(SRCS_f90:.f90=.o) -OBJS_F = $(SRCS_F:.F=.o) -OBJS_F90 = $(SRCS_F90:.F90=.o) -OBJS_c = $(SRCS_c:.c=.o) - -OBJS = $(OBJS_f) $(OBJS_f90) $(OBJS_F) $(OBJS_F90) $(OBJS_c) - -all default: depend $(LIBRARY) - -$(LIBRARY): $(OBJS) - $(AR) $(ARFLAGS) $@ $? - -.PHONY: clean -clean: - @echo "Cleaning ipd ... " - @echo - $(RM) -f $(LIBRARY) *__genmod.f90 *.o */*.o *.mod *.i90 *.lst *.i depend - -MKDEPENDS = ../mkDepends.pl -include ../conf/make.rules - -# do not include 'depend' file if the target contains string 'clean' -ifneq (clean,$(findstring clean,$(MAKECMDGOALS))) - -include depend -endif - From 9e0dded9fd1d43b8f7a12f77e7530b3597ec7670 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 6 Jan 2021 20:25:35 -0700 Subject: [PATCH 11/20] Replace IPD DDTs with GFS DDTs --- CMakeLists.txt | 8 +- atmos_cubed_sphere | 2 +- atmos_model.F90 | 90 +++---- gfsphysics/CMakeLists.txt | 1 - io/CMakeLists.txt | 3 +- io/FV3GFS_io.F90 | 479 +++++++++++++++++++------------------- 6 files changed, 291 insertions(+), 292 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 0c1e45c06..409426956 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -23,7 +23,6 @@ endif() add_subdirectory(cpl) add_subdirectory(gfsphysics) -add_subdirectory(ipd) add_subdirectory(io) ############################################################################### @@ -106,7 +105,6 @@ target_include_directories(fv3dycore INTERFACE $) list(APPEND _fv3atm_defs_private CCPP) -target_include_directories(fv3atm PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/ccpp/driver/mod) +target_include_directories(fv3atm PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/ccpp/physics + ${CMAKE_CURRENT_BINARY_DIR}/ccpp/driver/mod) set(CCPP_LIBRARIES ccppdriver ccppphys ccpp) add_dependencies(fv3atm ccppdriver ccppphys ccpp) target_link_libraries(fv3atm PUBLIC ccppdriver ccppphys ccpp) @@ -185,7 +185,7 @@ endif() ### Install ############################################################################### install( - TARGETS fv3atm fv3dycore io ipd gfsphysics ${CCPP_LIBRARIES} cpl stochastic_physics stochastic_physics_wrapper + TARGETS fv3atm fv3dycore io gfsphysics ${CCPP_LIBRARIES} cpl stochastic_physics stochastic_physics_wrapper EXPORT fv3atm-config LIBRARY DESTINATION lib ARCHIVE DESTINATION lib) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index dd11e4d19..70646435c 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit dd11e4d193ebee82155b8677eeea891ee71235c1 +Subproject commit 70646435c80f354e1add47d7729b9109b6ca76e2 diff --git a/atmos_model.F90 b/atmos_model.F90 index a34740c2f..14cf3c812 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -82,17 +82,18 @@ module atmos_model_mod use block_control_mod, only: block_control_type, define_blocks_packed use DYCORE_typedefs, only: DYCORE_data_type, DYCORE_diag_type -use IPD_typedefs, only: IPD_init_type, IPD_diag_type, & - IPD_restart_type, IPD_kind_phys -use CCPP_data, only: ccpp_suite, GFS_control, & +use GFS_typedefs, only: GFS_init_type, GFS_kind_phys => kind_phys +use GFS_restart, only: GFS_restart_type, GFS_restart_populate +use GFS_diagnostics, only: GFS_externaldiag_type +use CCPP_data, only: ccpp_suite, GFS_control, & GFS_data, GFS_interstitial -use IPD_driver, only: IPD_initialize, IPD_initialize_rst +use GFS_driver, only: GFS_initialize use CCPP_driver, only: CCPP_step, non_uniform_blocks use stochastic_physics_wrapper_mod, only: stochastic_physics_wrapper,stochastic_physics_wrapper_end use FV3GFS_io_mod, only: FV3GFS_restart_read, FV3GFS_restart_write, & - FV3GFS_IPD_checksum, & + FV3GFS_GFS_checksum, & FV3GFS_diag_register, FV3GFS_diag_output, & DIAG_SIZE use fv_iau_mod, only: iau_external_data_type,getiauforcing,iau_initialize @@ -128,9 +129,9 @@ module atmos_model_mod real(kind=8), pointer, dimension(:) :: ak, bk real, pointer, dimension(:,:) :: lon_bnd => null() ! local longitude axis grid box corners in radians. real, pointer, dimension(:,:) :: lat_bnd => null() ! local latitude axis grid box corners in radians. - real(kind=IPD_kind_phys), pointer, dimension(:,:) :: lon => null() ! local longitude axis grid box centers in radians. - real(kind=IPD_kind_phys), pointer, dimension(:,:) :: lat => null() ! local latitude axis grid box centers in radians. - real(kind=IPD_kind_phys), pointer, dimension(:,:) :: dx, dy + real(kind=GFS_kind_phys), pointer, dimension(:,:) :: lon => null() ! local longitude axis grid box centers in radians. + real(kind=GFS_kind_phys), pointer, dimension(:,:) :: lat => null() ! local latitude axis grid box centers in radians. + real(kind=GFS_kind_phys), pointer, dimension(:,:) :: dx, dy real(kind=8), pointer, dimension(:,:) :: area real(kind=8), pointer, dimension(:,:,:) :: layer_hgt, level_hgt type(domain2d) :: domain ! domain decomposition @@ -138,7 +139,7 @@ module atmos_model_mod type(time_type) :: Time_step ! atmospheric time step. type(time_type) :: Time_init ! reference time. type(grid_box_type) :: grid ! hold grid information needed for 2nd order conservative flux exchange - type(IPD_diag_type), pointer, dimension(:) :: Diag + type(GFS_externaldiag_type), pointer, dimension(:) :: Diag end type atmos_data_type ! to calculate gradient on cubic sphere grid. ! @@ -170,8 +171,8 @@ module atmos_model_mod ! IPD containers !---------------- ! GFS_control and GFS_data are coming from CCPP_data -type(IPD_diag_type), target :: IPD_Diag(DIAG_SIZE) -type(IPD_restart_type) :: IPD_Restart +type(GFS_externaldiag_type), target :: GFS_Diag(DIAG_SIZE) +type(GFS_restart_type) :: GFS_restart_var !-------------- ! IAU container @@ -194,10 +195,10 @@ module atmos_model_mod logical,parameter :: flip_vc = .true. #endif - real(kind=IPD_kind_phys), parameter :: zero = 0.0_IPD_kind_phys, & - one = 1.0_IPD_kind_phys, & - epsln = 1.0e-10_IPD_kind_phys, & - zorlmin = 1.0e-7_IPD_kind_phys + real(kind=GFS_kind_phys), parameter :: zero = 0.0_GFS_kind_phys, & + one = 1.0_GFS_kind_phys, & + epsln = 1.0e-10_GFS_kind_phys, & + zorlmin = 1.0e-7_GFS_kind_phys contains @@ -316,7 +317,7 @@ subroutine update_atmos_radiation_physics (Atmos) if (chksum_debug) then if (mpp_pe() == mpp_root_pe()) print *,'RADIATION STEP ', GFS_control%kdt, GFS_control%fhour - call FV3GFS_IPD_checksum(GFS_control, GFS_data, Atm_block) + call FV3GFS_GFS_checksum(GFS_control, GFS_data, Atm_block) endif if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "physics driver" @@ -330,7 +331,7 @@ subroutine update_atmos_radiation_physics (Atmos) if (chksum_debug) then if (mpp_pe() == mpp_root_pe()) print *,'PHYSICS STEP1 ', GFS_control%kdt, GFS_control%fhour - call FV3GFS_IPD_checksum(GFS_control, GFS_data, Atm_block) + call FV3GFS_GFS_checksum(GFS_control, GFS_data, Atm_block) endif if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "stochastic physics driver" @@ -344,7 +345,7 @@ subroutine update_atmos_radiation_physics (Atmos) if (chksum_debug) then if (mpp_pe() == mpp_root_pe()) print *,'PHYSICS STEP2 ', GFS_control%kdt, GFS_control%fhour - call FV3GFS_IPD_checksum(GFS_control, GFS_data, Atm_block) + call FV3GFS_GFS_checksum(GFS_control, GFS_data, Atm_block) endif call getiauforcing(GFS_control,IAU_data) if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "end of radiation and physics step" @@ -390,14 +391,14 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) integer :: isc, iec, jsc, jec integer :: isd, ied, jsd, jed integer :: blk, ibs, ibe, jbs, jbe - real(kind=IPD_kind_phys) :: dt_phys + real(kind=GFS_kind_phys) :: dt_phys real, allocatable :: q(:,:,:,:), p_half(:,:,:) character(len=80) :: control character(len=64) :: filename, filename2, pelist_name character(len=132) :: text logical :: p_hydro, hydro, fexist logical, save :: block_message = .true. - type(IPD_init_type) :: Init_parm + type(GFS_init_type) :: Init_parm integer :: bdat(8), cdat(8) integer :: ntracers, maxhf, maxh character(len=32), allocatable, target :: tracer_names(:) @@ -542,14 +543,15 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) endif #endif - call IPD_initialize (GFS_control, GFS_data, IPD_Diag, IPD_Restart, & - GFS_interstitial, commglobal, mpp_npes(), Init_parm) + call GFS_initialize (GFS_control, GFS_data%Statein, GFS_data%Stateout, GFS_data%Sfcprop, & + GFS_data%Coupling, GFS_data%Grid, GFS_data%Tbd, GFS_data%Cldprop, GFS_data%Radtend, & + GFS_data%Intdiag, GFS_interstitial, commglobal, mpp_npes(), Init_parm) !--- Initialize stochastic physics pattern generation / cellular automata for first time step call stochastic_physics_wrapper(GFS_control, GFS_data, Atm_block, ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed') - Atmos%Diag => IPD_Diag + Atmos%Diag => GFS_Diag Atm(mygrid)%flagstruct%do_skeb = GFS_control%do_skeb @@ -569,9 +571,11 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !rab call atmosphere_tracer_postinit (GFS_data, Atm_block) call atmosphere_nggps_diag (Time, init=.true.) - call FV3GFS_diag_register (IPD_Diag, Time, Atm_block, GFS_control, Atmos%lon, Atmos%lat, Atmos%axes) - call IPD_initialize_rst (GFS_control, GFS_data, IPD_Diag, IPD_Restart, Init_parm) - call FV3GFS_restart_read (GFS_data, IPD_Restart, Atm_block, GFS_control, Atmos%domain, Atm(mygrid)%flagstruct%warm_start) + call FV3GFS_diag_register (GFS_Diag, Time, Atm_block, GFS_control, Atmos%lon, Atmos%lat, Atmos%axes) + call GFS_restart_populate (GFS_restart_var, GFS_control, GFS_data%Statein, GFS_data%Stateout, GFS_data%Sfcprop, & + GFS_data%Coupling, GFS_data%Grid, GFS_data%Tbd, GFS_data%Cldprop, GFS_data%Radtend, & + GFS_data%IntDiag, Init_parm, GFS_Diag) + call FV3GFS_restart_read (GFS_data, GFS_restart_var, Atm_block, GFS_control, Atmos%domain, Atm(mygrid)%flagstruct%warm_start) ! Populate the GFS_data%Statein container with the prognostic state ! in Atm_block, which contains the initial conditions/restart data. @@ -769,7 +773,7 @@ subroutine update_atmos_model_state (Atmos) !--- local variables integer :: isec, seconds, isec_fhzero integer :: rc - real(kind=IPD_kind_phys) :: time_int, time_intfull + real(kind=GFS_kind_phys) :: time_int, time_intfull ! call set_atmosphere_pelist() call mpp_clock_begin(fv3Clock) @@ -781,7 +785,7 @@ subroutine update_atmos_model_state (Atmos) if (chksum_debug) then if (mpp_pe() == mpp_root_pe()) print *,'UPDATE STATE ', GFS_control%kdt, GFS_control%fhour if (mpp_pe() == mpp_root_pe()) print *,'in UPDATE STATE ', size(GFS_data(1)%SfcProp%tsfc),'nblks=',Atm_block%nblks - call FV3GFS_IPD_checksum(GFS_control, GFS_data, Atm_block) + call FV3GFS_GFS_checksum(GFS_control, GFS_data, Atm_block) endif !--- advance time --- @@ -810,8 +814,8 @@ subroutine update_atmos_model_state (Atmos) endif if (mpp_pe() == mpp_root_pe()) write(6,*) ' gfs diags time since last bucket empty: ',time_int/3600.,'hrs' call atmosphere_nggps_diag(Atmos%Time) - call FV3GFS_diag_output(Atmos%Time, IPD_DIag, Atm_block, GFS_control%nx, GFS_control%ny, & - GFS_control%levs, 1, 1, 1.0_IPD_kind_phys, time_int, time_intfull, & + call FV3GFS_diag_output(Atmos%Time, GFS_Diag, Atm_block, GFS_control%nx, GFS_control%ny, & + GFS_control%levs, 1, 1, 1.0_GFS_kind_phys, time_int, time_intfull, & GFS_control%fhswr, GFS_control%fhlwr) if (nint(GFS_control%fhzero) > 0) then if (mod(isec,3600*nint(GFS_control%fhzero)) == 0) diag_time = Atmos%Time @@ -871,7 +875,7 @@ subroutine atmos_model_end (Atmos) call stochastic_physics_wrapper_end(GFS_control) if(restart_endfcst) then - call FV3GFS_restart_write (GFS_data, IPD_Restart, Atm_block, & + call FV3GFS_restart_write (GFS_data, GFS_restart_var, Atm_block, & GFS_control, Atmos%domain) endif @@ -894,7 +898,7 @@ subroutine atmos_model_restart(Atmos, timestamp) character(len=*), intent(in) :: timestamp call atmosphere_restart(timestamp) - call FV3GFS_restart_write (GFS_data, IPD_Restart, Atm_block, & + call FV3GFS_restart_write (GFS_data, GFS_restart_var, Atm_block, & GFS_control, Atmos%domain, timestamp) end subroutine atmos_model_restart @@ -1516,10 +1520,10 @@ subroutine assign_importdata(rc) type(ESMF_TypeKind_Flag) :: datatype real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: datar42d real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: datar82d - real(kind=IPD_kind_phys), dimension(:,:), pointer :: datar8 - real(kind=IPD_kind_phys) :: tem, ofrac + real(kind=GFS_kind_phys), dimension(:,:), pointer :: datar8 + real(kind=GFS_kind_phys) :: tem, ofrac logical found, isFieldCreated, lcpl_fice - real (kind=IPD_kind_phys), parameter :: z0ice=1.1 ! (in cm) + real (kind=GFS_kind_phys), parameter :: z0ice=1.1 ! (in cm) ! !------------------------------------------------------------------------------ ! @@ -1600,12 +1604,12 @@ subroutine assign_importdata(rc) nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero .and. datar8(i,j) > zorlmin) then - tem = 100.0_IPD_kind_phys * min(0.1_IPD_kind_phys, datar8(i,j)) + tem = 100.0_GFS_kind_phys * min(0.1_GFS_kind_phys, datar8(i,j)) ! GFS_data(nb)%Coupling%zorlwav_cpl(ix) = tem GFS_data(nb)%Sfcprop%zorlo(ix) = tem GFS_data(nb)%Sfcprop%zorlw(ix) = tem else - GFS_data(nb)%Sfcprop%zorlw(ix) = -999.0_IPD_kind_phys + GFS_data(nb)%Sfcprop%zorlw(ix) = -999.0_GFS_kind_phys endif enddo @@ -1673,9 +1677,9 @@ subroutine assign_importdata(rc) GFS_data(nb)%Sfcprop%fice(ix) = max(zero, min(one, datar8(i,j)/ofrac)) !LHS: ice frac wrt water area if (GFS_data(nb)%Sfcprop%fice(ix) >= GFS_control%min_seaice) then if (GFS_data(nb)%Sfcprop%fice(ix) > one-epsln) GFS_data(nb)%Sfcprop%fice(ix) = one - if (abs(one-ofrac) < epsln) GFS_data(nb)%Sfcprop%slmsk(ix) = 2.0_IPD_kind_phys !slmsk=2 crashes in gcycle on partial land points -! GFS_data(nb)%Sfcprop%slmsk(ix) = 2.0_IPD_kind_phys - GFS_data(nb)%Coupling%slimskin_cpl(ix) = 4.0_IPD_kind_phys + if (abs(one-ofrac) < epsln) GFS_data(nb)%Sfcprop%slmsk(ix) = 2.0_GFS_kind_phys !slmsk=2 crashes in gcycle on partial land points +! GFS_data(nb)%Sfcprop%slmsk(ix) = 2.0_GFS_kind_phys + GFS_data(nb)%Coupling%slimskin_cpl(ix) = 4.0_GFS_kind_phys else GFS_data(nb)%Sfcprop%fice(ix) = zero if (abs(one-ofrac) < epsln) then @@ -1862,8 +1866,8 @@ subroutine assign_importdata(rc) ! GFS_data(nb)%Sfcprop%snowd(ix) = GFS_data(nb)%Coupling%hsnoin_cpl(ix) GFS_data(nb)%Coupling%hsnoin_cpl(ix) = GFS_data(nb)%Coupling%hsnoin_cpl(ix) & - / max(0.01_IPD_kind_phys, GFS_data(nb)%Sfcprop%fice(ix)) -! / max(0.01_IPD_kind_phys, GFS_data(nb)%Coupling%ficein_cpl(ix)) + / max(0.01_GFS_kind_phys, GFS_data(nb)%Sfcprop%fice(ix)) +! / max(0.01_GFS_kind_phys, GFS_data(nb)%Coupling%ficein_cpl(ix)) GFS_data(nb)%Sfcprop%zorli(ix) = z0ice else ! GFS_data(nb)%Sfcprop%tisfc(ix) = GFS_data(nb)%Coupling%tseain_cpl(ix) @@ -1927,7 +1931,7 @@ subroutine setup_exportdata (rc) !--- local variables integer :: j, i, ix, nb, isc, iec, jsc, jec, idx - real(IPD_kind_phys) :: rtime, rtimek + real(GFS_kind_phys) :: rtime, rtimek ! if (mpp_pe() == mpp_root_pe()) print *,'enter setup_exportdata' diff --git a/gfsphysics/CMakeLists.txt b/gfsphysics/CMakeLists.txt index e7ea245b2..49feaec4c 100644 --- a/gfsphysics/CMakeLists.txt +++ b/gfsphysics/CMakeLists.txt @@ -19,7 +19,6 @@ set(CCPP_SOURCES CCPP_layer/CCPP_data.F90 ${CMAKE_BINARY_DIR}/FV3/ccpp/physics/ccpp_static_api.F90 - GFS_layer/GFS_abstraction_layer.F90 GFS_layer/GFS_diagnostics.F90 GFS_layer/GFS_driver.F90 GFS_layer/GFS_restart.F90 diff --git a/io/CMakeLists.txt b/io/CMakeLists.txt index bbb079236..b04a29521 100644 --- a/io/CMakeLists.txt +++ b/io/CMakeLists.txt @@ -32,8 +32,7 @@ target_compile_definitions(io PRIVATE "${_io_defs_private}") target_include_directories(io PUBLIC $) target_link_libraries(io PRIVATE fms - gfsphysics - ipd) + gfsphysics) if(INLINE_POST) target_link_libraries(io PRIVATE upp::upp) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 78afa4ec7..92c18507e 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -48,14 +48,11 @@ module FV3GFS_io_mod ! !--- GFS_typedefs -!rab use GFS_typedefs, only: GFS_sfcprop_type, GFS_diag_type, & -!rab GFS_cldprop_type, GFS_grid_type - use GFS_typedefs, only: GFS_sfcprop_type -! -!--- IPD typdefs - use IPD_typedefs, only: IPD_control_type, IPD_data_type, & - IPD_restart_type, IPD_diag_type, & - kind_phys => IPD_kind_phys + use GFS_typedefs, only: GFS_sfcprop_type, GFS_control_type, & + GFS_data_type, kind_phys + use GFS_restart, only: GFS_restart_type + use GFS_diagnostics, only: GFS_externaldiag_type + ! !----------------------------------------------------------------------- implicit none @@ -63,7 +60,7 @@ module FV3GFS_io_mod !--- public interfaces --- public FV3GFS_restart_read, FV3GFS_restart_write - public FV3GFS_IPD_checksum + public FV3GFS_GFS_checksum public fv3gfs_diag_register, fv3gfs_diag_output #ifdef use_WRTCOMP public fv_phys_bundle_setup @@ -128,49 +125,49 @@ module FV3GFS_io_mod !-------------------- ! FV3GFS_restart_read !-------------------- - subroutine FV3GFS_restart_read (IPD_Data, IPD_Restart, Atm_block, Model, fv_domain, warm_start) - type(IPD_data_type), intent(inout) :: IPD_Data(:) - type(IPD_restart_type), intent(inout) :: IPD_Restart + subroutine FV3GFS_restart_read (GFS_Data, GFS_Restart, Atm_block, Model, fv_domain, warm_start) + type(GFS_data_type), intent(inout) :: GFS_Data(:) + type(GFS_restart_type), intent(inout) :: GFS_Restart type(block_control_type), intent(in) :: Atm_block - type(IPD_control_type), intent(inout) :: Model + type(GFS_control_type), intent(inout) :: Model type(domain2d), intent(in) :: fv_domain logical, intent(in) :: warm_start !--- read in surface data from chgres - call sfc_prop_restart_read (IPD_Data%Sfcprop, Atm_block, Model, fv_domain, warm_start) + call sfc_prop_restart_read (GFS_Data%Sfcprop, Atm_block, Model, fv_domain, warm_start) !--- read in physics restart data - call phys_restart_read (IPD_Restart, Atm_block, Model, fv_domain) + call phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain) end subroutine FV3GFS_restart_read !--------------------- ! FV3GFS_restart_write !--------------------- - subroutine FV3GFS_restart_write (IPD_Data, IPD_Restart, Atm_block, Model, fv_domain, timestamp) - type(IPD_data_type), intent(inout) :: IPD_Data(:) - type(IPD_restart_type), intent(inout) :: IPD_Restart + subroutine FV3GFS_restart_write (GFS_Data, GFS_Restart, Atm_block, Model, fv_domain, timestamp) + type(GFS_data_type), intent(inout) :: GFS_Data(:) + type(GFS_restart_type), intent(inout) :: GFS_Restart type(block_control_type), intent(in) :: Atm_block - type(IPD_control_type), intent(in) :: Model + type(GFS_control_type), intent(in) :: Model type(domain2d), intent(in) :: fv_domain character(len=32), optional, intent(in) :: timestamp !--- write surface data from chgres - call sfc_prop_restart_write (IPD_Data%Sfcprop, Atm_block, Model, fv_domain, timestamp) + call sfc_prop_restart_write (GFS_Data%Sfcprop, Atm_block, Model, fv_domain, timestamp) !--- write physics restart data - call phys_restart_write (IPD_Restart, Atm_block, Model, fv_domain, timestamp) + call phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timestamp) end subroutine FV3GFS_restart_write !-------------------- -! FV3GFS_IPD_checksum +! FV3GFS_GFS_checksum !-------------------- - subroutine FV3GFS_IPD_checksum (Model, IPD_Data, Atm_block) + subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) !--- interface variables - type(IPD_control_type), intent(in) :: Model - type(IPD_data_type), intent(in) :: IPD_Data(:) + type(GFS_control_type), intent(in) :: Model + type(GFS_data_type), intent(in) :: GFS_Data(:) type (block_control_type), intent(in) :: Atm_block !--- local variables integer :: outunit, j, i, ix, nb, isc, iec, jsc, jec, lev, ct, l, ntr @@ -186,7 +183,7 @@ subroutine FV3GFS_IPD_checksum (Model, IPD_Data, Atm_block) jec = Model%jsc+Model%ny-1 lev = Model%levs - ntr = size(IPD_Data(1)%Statein%qgrs,3) + ntr = size(GFS_Data(1)%Statein%qgrs,3) if(Model%lsm == Model%lsm_noahmp) then nsfcprop2d = 151 @@ -207,222 +204,222 @@ subroutine FV3GFS_IPD_checksum (Model, IPD_Data, Atm_block) nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) !--- statein pressure - temp2d(i,j, 1) = IPD_Data(nb)%Statein%pgr(ix) - temp2d(i,j, 2) = IPD_Data(nb)%Sfcprop%slmsk(ix) - temp2d(i,j, 3) = IPD_Data(nb)%Sfcprop%tsfc(ix) - temp2d(i,j, 4) = IPD_Data(nb)%Sfcprop%tisfc(ix) - temp2d(i,j, 5) = IPD_Data(nb)%Sfcprop%snowd(ix) - temp2d(i,j, 6) = IPD_Data(nb)%Sfcprop%zorl(ix) - temp2d(i,j, 7) = IPD_Data(nb)%Sfcprop%fice(ix) - temp2d(i,j, 8) = IPD_Data(nb)%Sfcprop%hprime(ix,1) - temp2d(i,j, 9) = IPD_Data(nb)%Sfcprop%sncovr(ix) - temp2d(i,j,10) = IPD_Data(nb)%Sfcprop%snoalb(ix) - temp2d(i,j,11) = IPD_Data(nb)%Sfcprop%alvsf(ix) - temp2d(i,j,12) = IPD_Data(nb)%Sfcprop%alnsf(ix) - temp2d(i,j,13) = IPD_Data(nb)%Sfcprop%alvwf(ix) - temp2d(i,j,14) = IPD_Data(nb)%Sfcprop%alnwf(ix) - temp2d(i,j,15) = IPD_Data(nb)%Sfcprop%facsf(ix) - temp2d(i,j,16) = IPD_Data(nb)%Sfcprop%facwf(ix) - temp2d(i,j,17) = IPD_Data(nb)%Sfcprop%slope(ix) - temp2d(i,j,18) = IPD_Data(nb)%Sfcprop%shdmin(ix) - temp2d(i,j,19) = IPD_Data(nb)%Sfcprop%shdmax(ix) - temp2d(i,j,20) = IPD_Data(nb)%Sfcprop%tg3(ix) - temp2d(i,j,21) = IPD_Data(nb)%Sfcprop%vfrac(ix) - temp2d(i,j,22) = IPD_Data(nb)%Sfcprop%vtype(ix) - temp2d(i,j,23) = IPD_Data(nb)%Sfcprop%stype(ix) - temp2d(i,j,24) = IPD_Data(nb)%Sfcprop%uustar(ix) - temp2d(i,j,25) = IPD_Data(nb)%Sfcprop%oro(ix) - temp2d(i,j,26) = IPD_Data(nb)%Sfcprop%oro_uf(ix) - temp2d(i,j,27) = IPD_Data(nb)%Sfcprop%hice(ix) - temp2d(i,j,28) = IPD_Data(nb)%Sfcprop%weasd(ix) - temp2d(i,j,29) = IPD_Data(nb)%Sfcprop%canopy(ix) - temp2d(i,j,30) = IPD_Data(nb)%Sfcprop%ffmm(ix) - temp2d(i,j,31) = IPD_Data(nb)%Sfcprop%ffhh(ix) - temp2d(i,j,32) = IPD_Data(nb)%Sfcprop%f10m(ix) - temp2d(i,j,33) = IPD_Data(nb)%Sfcprop%tprcp(ix) - temp2d(i,j,34) = IPD_Data(nb)%Sfcprop%srflag(ix) + temp2d(i,j, 1) = GFS_Data(nb)%Statein%pgr(ix) + temp2d(i,j, 2) = GFS_Data(nb)%Sfcprop%slmsk(ix) + temp2d(i,j, 3) = GFS_Data(nb)%Sfcprop%tsfc(ix) + temp2d(i,j, 4) = GFS_Data(nb)%Sfcprop%tisfc(ix) + temp2d(i,j, 5) = GFS_Data(nb)%Sfcprop%snowd(ix) + temp2d(i,j, 6) = GFS_Data(nb)%Sfcprop%zorl(ix) + temp2d(i,j, 7) = GFS_Data(nb)%Sfcprop%fice(ix) + temp2d(i,j, 8) = GFS_Data(nb)%Sfcprop%hprime(ix,1) + temp2d(i,j, 9) = GFS_Data(nb)%Sfcprop%sncovr(ix) + temp2d(i,j,10) = GFS_Data(nb)%Sfcprop%snoalb(ix) + temp2d(i,j,11) = GFS_Data(nb)%Sfcprop%alvsf(ix) + temp2d(i,j,12) = GFS_Data(nb)%Sfcprop%alnsf(ix) + temp2d(i,j,13) = GFS_Data(nb)%Sfcprop%alvwf(ix) + temp2d(i,j,14) = GFS_Data(nb)%Sfcprop%alnwf(ix) + temp2d(i,j,15) = GFS_Data(nb)%Sfcprop%facsf(ix) + temp2d(i,j,16) = GFS_Data(nb)%Sfcprop%facwf(ix) + temp2d(i,j,17) = GFS_Data(nb)%Sfcprop%slope(ix) + temp2d(i,j,18) = GFS_Data(nb)%Sfcprop%shdmin(ix) + temp2d(i,j,19) = GFS_Data(nb)%Sfcprop%shdmax(ix) + temp2d(i,j,20) = GFS_Data(nb)%Sfcprop%tg3(ix) + temp2d(i,j,21) = GFS_Data(nb)%Sfcprop%vfrac(ix) + temp2d(i,j,22) = GFS_Data(nb)%Sfcprop%vtype(ix) + temp2d(i,j,23) = GFS_Data(nb)%Sfcprop%stype(ix) + temp2d(i,j,24) = GFS_Data(nb)%Sfcprop%uustar(ix) + temp2d(i,j,25) = GFS_Data(nb)%Sfcprop%oro(ix) + temp2d(i,j,26) = GFS_Data(nb)%Sfcprop%oro_uf(ix) + temp2d(i,j,27) = GFS_Data(nb)%Sfcprop%hice(ix) + temp2d(i,j,28) = GFS_Data(nb)%Sfcprop%weasd(ix) + temp2d(i,j,29) = GFS_Data(nb)%Sfcprop%canopy(ix) + temp2d(i,j,30) = GFS_Data(nb)%Sfcprop%ffmm(ix) + temp2d(i,j,31) = GFS_Data(nb)%Sfcprop%ffhh(ix) + temp2d(i,j,32) = GFS_Data(nb)%Sfcprop%f10m(ix) + temp2d(i,j,33) = GFS_Data(nb)%Sfcprop%tprcp(ix) + temp2d(i,j,34) = GFS_Data(nb)%Sfcprop%srflag(ix) if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4) then - temp2d(i,j,35) = IPD_Data(nb)%Sfcprop%slc(ix,1) - temp2d(i,j,36) = IPD_Data(nb)%Sfcprop%slc(ix,2) - temp2d(i,j,37) = IPD_Data(nb)%Sfcprop%slc(ix,3) - temp2d(i,j,38) = IPD_Data(nb)%Sfcprop%slc(ix,4) - temp2d(i,j,39) = IPD_Data(nb)%Sfcprop%smc(ix,1) - temp2d(i,j,40) = IPD_Data(nb)%Sfcprop%smc(ix,2) - temp2d(i,j,41) = IPD_Data(nb)%Sfcprop%smc(ix,3) - temp2d(i,j,42) = IPD_Data(nb)%Sfcprop%smc(ix,4) - temp2d(i,j,43) = IPD_Data(nb)%Sfcprop%stc(ix,1) - temp2d(i,j,44) = IPD_Data(nb)%Sfcprop%stc(ix,2) - temp2d(i,j,45) = IPD_Data(nb)%Sfcprop%stc(ix,3) - temp2d(i,j,46) = IPD_Data(nb)%Sfcprop%stc(ix,4) + temp2d(i,j,35) = GFS_Data(nb)%Sfcprop%slc(ix,1) + temp2d(i,j,36) = GFS_Data(nb)%Sfcprop%slc(ix,2) + temp2d(i,j,37) = GFS_Data(nb)%Sfcprop%slc(ix,3) + temp2d(i,j,38) = GFS_Data(nb)%Sfcprop%slc(ix,4) + temp2d(i,j,39) = GFS_Data(nb)%Sfcprop%smc(ix,1) + temp2d(i,j,40) = GFS_Data(nb)%Sfcprop%smc(ix,2) + temp2d(i,j,41) = GFS_Data(nb)%Sfcprop%smc(ix,3) + temp2d(i,j,42) = GFS_Data(nb)%Sfcprop%smc(ix,4) + temp2d(i,j,43) = GFS_Data(nb)%Sfcprop%stc(ix,1) + temp2d(i,j,44) = GFS_Data(nb)%Sfcprop%stc(ix,2) + temp2d(i,j,45) = GFS_Data(nb)%Sfcprop%stc(ix,3) + temp2d(i,j,46) = GFS_Data(nb)%Sfcprop%stc(ix,4) elseif (Model%lsm == Model%lsm_ruc) then - temp2d(i,j,35) = IPD_Data(nb)%Sfcprop%sh2o(ix,1) - temp2d(i,j,36) = IPD_Data(nb)%Sfcprop%sh2o(ix,2) - temp2d(i,j,37) = IPD_Data(nb)%Sfcprop%sh2o(ix,3) + temp2d(i,j,35) = GFS_Data(nb)%Sfcprop%sh2o(ix,1) + temp2d(i,j,36) = GFS_Data(nb)%Sfcprop%sh2o(ix,2) + temp2d(i,j,37) = GFS_Data(nb)%Sfcprop%sh2o(ix,3) ! Combine levels 4 to lsoil_lsm (9 for RUC) into one - temp2d(i,j,38) = sum(IPD_Data(nb)%Sfcprop%sh2o(ix,4:Model%lsoil_lsm)) - temp2d(i,j,39) = IPD_Data(nb)%Sfcprop%smois(ix,1) - temp2d(i,j,40) = IPD_Data(nb)%Sfcprop%smois(ix,2) - temp2d(i,j,41) = IPD_Data(nb)%Sfcprop%smois(ix,3) + temp2d(i,j,38) = sum(GFS_Data(nb)%Sfcprop%sh2o(ix,4:Model%lsoil_lsm)) + temp2d(i,j,39) = GFS_Data(nb)%Sfcprop%smois(ix,1) + temp2d(i,j,40) = GFS_Data(nb)%Sfcprop%smois(ix,2) + temp2d(i,j,41) = GFS_Data(nb)%Sfcprop%smois(ix,3) ! Combine levels 4 to lsoil_lsm (9 for RUC) into one - temp2d(i,j,42) = sum(IPD_Data(nb)%Sfcprop%smois(ix,4:Model%lsoil_lsm)) - temp2d(i,j,43) = IPD_Data(nb)%Sfcprop%tslb(ix,1) - temp2d(i,j,44) = IPD_Data(nb)%Sfcprop%tslb(ix,2) - temp2d(i,j,45) = IPD_Data(nb)%Sfcprop%tslb(ix,3) + temp2d(i,j,42) = sum(GFS_Data(nb)%Sfcprop%smois(ix,4:Model%lsoil_lsm)) + temp2d(i,j,43) = GFS_Data(nb)%Sfcprop%tslb(ix,1) + temp2d(i,j,44) = GFS_Data(nb)%Sfcprop%tslb(ix,2) + temp2d(i,j,45) = GFS_Data(nb)%Sfcprop%tslb(ix,3) ! Combine levels 4 to lsoil_lsm (9 for RUC) into one - temp2d(i,j,46) = sum(IPD_Data(nb)%Sfcprop%tslb(ix,4:Model%lsoil_lsm)) + temp2d(i,j,46) = sum(GFS_Data(nb)%Sfcprop%tslb(ix,4:Model%lsoil_lsm)) endif ! LSM choice - temp2d(i,j,47) = IPD_Data(nb)%Sfcprop%t2m(ix) - temp2d(i,j,48) = IPD_Data(nb)%Sfcprop%q2m(ix) - temp2d(i,j,49) = IPD_Data(nb)%Coupling%nirbmdi(ix) - temp2d(i,j,50) = IPD_Data(nb)%Coupling%nirdfdi(ix) - temp2d(i,j,51) = IPD_Data(nb)%Coupling%visbmdi(ix) - temp2d(i,j,52) = IPD_Data(nb)%Coupling%visdfdi(ix) - temp2d(i,j,53) = IPD_Data(nb)%Coupling%nirbmui(ix) - temp2d(i,j,54) = IPD_Data(nb)%Coupling%nirdfui(ix) - temp2d(i,j,55) = IPD_Data(nb)%Coupling%visbmui(ix) - temp2d(i,j,56) = IPD_Data(nb)%Coupling%visdfui(ix) - temp2d(i,j,57) = IPD_Data(nb)%Coupling%sfcdsw(ix) - temp2d(i,j,58) = IPD_Data(nb)%Coupling%sfcnsw(ix) - temp2d(i,j,59) = IPD_Data(nb)%Coupling%sfcdlw(ix) - temp2d(i,j,60) = IPD_Data(nb)%Grid%xlon(ix) - temp2d(i,j,61) = IPD_Data(nb)%Grid%xlat(ix) - temp2d(i,j,62) = IPD_Data(nb)%Grid%xlat_d(ix) - temp2d(i,j,63) = IPD_Data(nb)%Grid%sinlat(ix) - temp2d(i,j,64) = IPD_Data(nb)%Grid%coslat(ix) - temp2d(i,j,65) = IPD_Data(nb)%Grid%area(ix) - temp2d(i,j,66) = IPD_Data(nb)%Grid%dx(ix) + temp2d(i,j,47) = GFS_Data(nb)%Sfcprop%t2m(ix) + temp2d(i,j,48) = GFS_Data(nb)%Sfcprop%q2m(ix) + temp2d(i,j,49) = GFS_Data(nb)%Coupling%nirbmdi(ix) + temp2d(i,j,50) = GFS_Data(nb)%Coupling%nirdfdi(ix) + temp2d(i,j,51) = GFS_Data(nb)%Coupling%visbmdi(ix) + temp2d(i,j,52) = GFS_Data(nb)%Coupling%visdfdi(ix) + temp2d(i,j,53) = GFS_Data(nb)%Coupling%nirbmui(ix) + temp2d(i,j,54) = GFS_Data(nb)%Coupling%nirdfui(ix) + temp2d(i,j,55) = GFS_Data(nb)%Coupling%visbmui(ix) + temp2d(i,j,56) = GFS_Data(nb)%Coupling%visdfui(ix) + temp2d(i,j,57) = GFS_Data(nb)%Coupling%sfcdsw(ix) + temp2d(i,j,58) = GFS_Data(nb)%Coupling%sfcnsw(ix) + temp2d(i,j,59) = GFS_Data(nb)%Coupling%sfcdlw(ix) + temp2d(i,j,60) = GFS_Data(nb)%Grid%xlon(ix) + temp2d(i,j,61) = GFS_Data(nb)%Grid%xlat(ix) + temp2d(i,j,62) = GFS_Data(nb)%Grid%xlat_d(ix) + temp2d(i,j,63) = GFS_Data(nb)%Grid%sinlat(ix) + temp2d(i,j,64) = GFS_Data(nb)%Grid%coslat(ix) + temp2d(i,j,65) = GFS_Data(nb)%Grid%area(ix) + temp2d(i,j,66) = GFS_Data(nb)%Grid%dx(ix) if (Model%ntoz > 0) then - temp2d(i,j,67) = IPD_Data(nb)%Grid%ddy_o3(ix) + temp2d(i,j,67) = GFS_Data(nb)%Grid%ddy_o3(ix) endif if (Model%h2o_phys) then - temp2d(i,j,68) = IPD_Data(nb)%Grid%ddy_h(ix) + temp2d(i,j,68) = GFS_Data(nb)%Grid%ddy_h(ix) endif - temp2d(i,j,69) = IPD_Data(nb)%Cldprop%cv(ix) - temp2d(i,j,70) = IPD_Data(nb)%Cldprop%cvt(ix) - temp2d(i,j,71) = IPD_Data(nb)%Cldprop%cvb(ix) - temp2d(i,j,72) = IPD_Data(nb)%Radtend%sfalb(ix) - temp2d(i,j,73) = IPD_Data(nb)%Radtend%coszen(ix) - temp2d(i,j,74) = IPD_Data(nb)%Radtend%tsflw(ix) - temp2d(i,j,75) = IPD_Data(nb)%Radtend%semis(ix) - temp2d(i,j,76) = IPD_Data(nb)%Radtend%coszdg(ix) - temp2d(i,j,77) = IPD_Data(nb)%Radtend%sfcfsw(ix)%upfxc - temp2d(i,j,78) = IPD_Data(nb)%Radtend%sfcfsw(ix)%upfx0 - temp2d(i,j,79) = IPD_Data(nb)%Radtend%sfcfsw(ix)%dnfxc - temp2d(i,j,80) = IPD_Data(nb)%Radtend%sfcfsw(ix)%dnfx0 - temp2d(i,j,81) = IPD_Data(nb)%Radtend%sfcflw(ix)%upfxc - temp2d(i,j,82) = IPD_Data(nb)%Radtend%sfcflw(ix)%upfx0 - temp2d(i,j,83) = IPD_Data(nb)%Radtend%sfcflw(ix)%dnfxc - temp2d(i,j,84) = IPD_Data(nb)%Radtend%sfcflw(ix)%dnfx0 - temp2d(i,j,85) = IPD_Data(nb)%Sfcprop%tiice(ix,1) - temp2d(i,j,86) = IPD_Data(nb)%Sfcprop%tiice(ix,2) + temp2d(i,j,69) = GFS_Data(nb)%Cldprop%cv(ix) + temp2d(i,j,70) = GFS_Data(nb)%Cldprop%cvt(ix) + temp2d(i,j,71) = GFS_Data(nb)%Cldprop%cvb(ix) + temp2d(i,j,72) = GFS_Data(nb)%Radtend%sfalb(ix) + temp2d(i,j,73) = GFS_Data(nb)%Radtend%coszen(ix) + temp2d(i,j,74) = GFS_Data(nb)%Radtend%tsflw(ix) + temp2d(i,j,75) = GFS_Data(nb)%Radtend%semis(ix) + temp2d(i,j,76) = GFS_Data(nb)%Radtend%coszdg(ix) + temp2d(i,j,77) = GFS_Data(nb)%Radtend%sfcfsw(ix)%upfxc + temp2d(i,j,78) = GFS_Data(nb)%Radtend%sfcfsw(ix)%upfx0 + temp2d(i,j,79) = GFS_Data(nb)%Radtend%sfcfsw(ix)%dnfxc + temp2d(i,j,80) = GFS_Data(nb)%Radtend%sfcfsw(ix)%dnfx0 + temp2d(i,j,81) = GFS_Data(nb)%Radtend%sfcflw(ix)%upfxc + temp2d(i,j,82) = GFS_Data(nb)%Radtend%sfcflw(ix)%upfx0 + temp2d(i,j,83) = GFS_Data(nb)%Radtend%sfcflw(ix)%dnfxc + temp2d(i,j,84) = GFS_Data(nb)%Radtend%sfcflw(ix)%dnfx0 + temp2d(i,j,85) = GFS_Data(nb)%Sfcprop%tiice(ix,1) + temp2d(i,j,86) = GFS_Data(nb)%Sfcprop%tiice(ix,2) idx_opt = 87 if (Model%lsm == Model%lsm_noahmp) then - temp2d(i,j,idx_opt) = IPD_Data(nb)%Sfcprop%snowxy(ix) - temp2d(i,j,idx_opt+1) = IPD_Data(nb)%Sfcprop%tvxy(ix) - temp2d(i,j,idx_opt+2) = IPD_Data(nb)%Sfcprop%tgxy(ix) - temp2d(i,j,idx_opt+3) = IPD_Data(nb)%Sfcprop%canicexy(ix) - temp2d(i,j,idx_opt+4) = IPD_Data(nb)%Sfcprop%canliqxy(ix) - temp2d(i,j,idx_opt+5) = IPD_Data(nb)%Sfcprop%eahxy(ix) - temp2d(i,j,idx_opt+6) = IPD_Data(nb)%Sfcprop%tahxy(ix) - temp2d(i,j,idx_opt+7) = IPD_Data(nb)%Sfcprop%cmxy(ix) - temp2d(i,j,idx_opt+8) = IPD_Data(nb)%Sfcprop%chxy(ix) - temp2d(i,j,idx_opt+9) = IPD_Data(nb)%Sfcprop%fwetxy(ix) - temp2d(i,j,idx_opt+10) = IPD_Data(nb)%Sfcprop%sneqvoxy(ix) - temp2d(i,j,idx_opt+11) = IPD_Data(nb)%Sfcprop%alboldxy(ix) - temp2d(i,j,idx_opt+12) = IPD_Data(nb)%Sfcprop%qsnowxy(ix) - temp2d(i,j,idx_opt+13) = IPD_Data(nb)%Sfcprop%wslakexy(ix) - temp2d(i,j,idx_opt+14) = IPD_Data(nb)%Sfcprop%zwtxy(ix) - temp2d(i,j,idx_opt+15) = IPD_Data(nb)%Sfcprop%waxy(ix) - temp2d(i,j,idx_opt+16) = IPD_Data(nb)%Sfcprop%wtxy(ix) - temp2d(i,j,idx_opt+17) = IPD_Data(nb)%Sfcprop%lfmassxy(ix) - temp2d(i,j,idx_opt+18) = IPD_Data(nb)%Sfcprop%rtmassxy(ix) - temp2d(i,j,idx_opt+19) = IPD_Data(nb)%Sfcprop%stmassxy(ix) - temp2d(i,j,idx_opt+20) = IPD_Data(nb)%Sfcprop%woodxy(ix) - temp2d(i,j,idx_opt+21) = IPD_Data(nb)%Sfcprop%stblcpxy(ix) - temp2d(i,j,idx_opt+22) = IPD_Data(nb)%Sfcprop%fastcpxy(ix) - temp2d(i,j,idx_opt+23) = IPD_Data(nb)%Sfcprop%xsaixy(ix) - temp2d(i,j,idx_opt+24) = IPD_Data(nb)%Sfcprop%xlaixy(ix) - temp2d(i,j,idx_opt+25) = IPD_Data(nb)%Sfcprop%taussxy(ix) - temp2d(i,j,idx_opt+26) = IPD_Data(nb)%Sfcprop%smcwtdxy(ix) - temp2d(i,j,idx_opt+27) = IPD_Data(nb)%Sfcprop%deeprechxy(ix) - temp2d(i,j,idx_opt+28) = IPD_Data(nb)%Sfcprop%rechxy(ix) - - temp2d(i,j,idx_opt+29) = IPD_Data(nb)%Sfcprop%snicexy(ix,-2) - temp2d(i,j,idx_opt+30) = IPD_Data(nb)%Sfcprop%snicexy(ix,-1) - temp2d(i,j,idx_opt+31) = IPD_Data(nb)%Sfcprop%snicexy(ix,0) - temp2d(i,j,idx_opt+32) = IPD_Data(nb)%Sfcprop%snliqxy(ix,-2) - temp2d(i,j,idx_opt+33) = IPD_Data(nb)%Sfcprop%snliqxy(ix,-1) - temp2d(i,j,idx_opt+34) = IPD_Data(nb)%Sfcprop%snliqxy(ix,0) - temp2d(i,j,idx_opt+35) = IPD_Data(nb)%Sfcprop%tsnoxy(ix,-2) - temp2d(i,j,idx_opt+36) = IPD_Data(nb)%Sfcprop%tsnoxy(ix,-1) - temp2d(i,j,idx_opt+37) = IPD_Data(nb)%Sfcprop%tsnoxy(ix,0) - temp2d(i,j,idx_opt+38) = IPD_Data(nb)%Sfcprop%smoiseq(ix,1) - temp2d(i,j,idx_opt+39) = IPD_Data(nb)%Sfcprop%smoiseq(ix,2) - temp2d(i,j,idx_opt+40) = IPD_Data(nb)%Sfcprop%smoiseq(ix,3) - temp2d(i,j,idx_opt+41) = IPD_Data(nb)%Sfcprop%smoiseq(ix,4) - temp2d(i,j,idx_opt+42) = IPD_Data(nb)%Sfcprop%zsnsoxy(ix,-2) - temp2d(i,j,idx_opt+43) = IPD_Data(nb)%Sfcprop%zsnsoxy(ix,-1) - temp2d(i,j,idx_opt+44) = IPD_Data(nb)%Sfcprop%zsnsoxy(ix,0) - temp2d(i,j,idx_opt+45) = IPD_Data(nb)%Sfcprop%zsnsoxy(ix,1) - temp2d(i,j,idx_opt+46) = IPD_Data(nb)%Sfcprop%zsnsoxy(ix,2) - temp2d(i,j,idx_opt+47) = IPD_Data(nb)%Sfcprop%zsnsoxy(ix,3) - temp2d(i,j,idx_opt+48) = IPD_Data(nb)%Sfcprop%zsnsoxy(ix,4) + temp2d(i,j,idx_opt) = GFS_Data(nb)%Sfcprop%snowxy(ix) + temp2d(i,j,idx_opt+1) = GFS_Data(nb)%Sfcprop%tvxy(ix) + temp2d(i,j,idx_opt+2) = GFS_Data(nb)%Sfcprop%tgxy(ix) + temp2d(i,j,idx_opt+3) = GFS_Data(nb)%Sfcprop%canicexy(ix) + temp2d(i,j,idx_opt+4) = GFS_Data(nb)%Sfcprop%canliqxy(ix) + temp2d(i,j,idx_opt+5) = GFS_Data(nb)%Sfcprop%eahxy(ix) + temp2d(i,j,idx_opt+6) = GFS_Data(nb)%Sfcprop%tahxy(ix) + temp2d(i,j,idx_opt+7) = GFS_Data(nb)%Sfcprop%cmxy(ix) + temp2d(i,j,idx_opt+8) = GFS_Data(nb)%Sfcprop%chxy(ix) + temp2d(i,j,idx_opt+9) = GFS_Data(nb)%Sfcprop%fwetxy(ix) + temp2d(i,j,idx_opt+10) = GFS_Data(nb)%Sfcprop%sneqvoxy(ix) + temp2d(i,j,idx_opt+11) = GFS_Data(nb)%Sfcprop%alboldxy(ix) + temp2d(i,j,idx_opt+12) = GFS_Data(nb)%Sfcprop%qsnowxy(ix) + temp2d(i,j,idx_opt+13) = GFS_Data(nb)%Sfcprop%wslakexy(ix) + temp2d(i,j,idx_opt+14) = GFS_Data(nb)%Sfcprop%zwtxy(ix) + temp2d(i,j,idx_opt+15) = GFS_Data(nb)%Sfcprop%waxy(ix) + temp2d(i,j,idx_opt+16) = GFS_Data(nb)%Sfcprop%wtxy(ix) + temp2d(i,j,idx_opt+17) = GFS_Data(nb)%Sfcprop%lfmassxy(ix) + temp2d(i,j,idx_opt+18) = GFS_Data(nb)%Sfcprop%rtmassxy(ix) + temp2d(i,j,idx_opt+19) = GFS_Data(nb)%Sfcprop%stmassxy(ix) + temp2d(i,j,idx_opt+20) = GFS_Data(nb)%Sfcprop%woodxy(ix) + temp2d(i,j,idx_opt+21) = GFS_Data(nb)%Sfcprop%stblcpxy(ix) + temp2d(i,j,idx_opt+22) = GFS_Data(nb)%Sfcprop%fastcpxy(ix) + temp2d(i,j,idx_opt+23) = GFS_Data(nb)%Sfcprop%xsaixy(ix) + temp2d(i,j,idx_opt+24) = GFS_Data(nb)%Sfcprop%xlaixy(ix) + temp2d(i,j,idx_opt+25) = GFS_Data(nb)%Sfcprop%taussxy(ix) + temp2d(i,j,idx_opt+26) = GFS_Data(nb)%Sfcprop%smcwtdxy(ix) + temp2d(i,j,idx_opt+27) = GFS_Data(nb)%Sfcprop%deeprechxy(ix) + temp2d(i,j,idx_opt+28) = GFS_Data(nb)%Sfcprop%rechxy(ix) + + temp2d(i,j,idx_opt+29) = GFS_Data(nb)%Sfcprop%snicexy(ix,-2) + temp2d(i,j,idx_opt+30) = GFS_Data(nb)%Sfcprop%snicexy(ix,-1) + temp2d(i,j,idx_opt+31) = GFS_Data(nb)%Sfcprop%snicexy(ix,0) + temp2d(i,j,idx_opt+32) = GFS_Data(nb)%Sfcprop%snliqxy(ix,-2) + temp2d(i,j,idx_opt+33) = GFS_Data(nb)%Sfcprop%snliqxy(ix,-1) + temp2d(i,j,idx_opt+34) = GFS_Data(nb)%Sfcprop%snliqxy(ix,0) + temp2d(i,j,idx_opt+35) = GFS_Data(nb)%Sfcprop%tsnoxy(ix,-2) + temp2d(i,j,idx_opt+36) = GFS_Data(nb)%Sfcprop%tsnoxy(ix,-1) + temp2d(i,j,idx_opt+37) = GFS_Data(nb)%Sfcprop%tsnoxy(ix,0) + temp2d(i,j,idx_opt+38) = GFS_Data(nb)%Sfcprop%smoiseq(ix,1) + temp2d(i,j,idx_opt+39) = GFS_Data(nb)%Sfcprop%smoiseq(ix,2) + temp2d(i,j,idx_opt+40) = GFS_Data(nb)%Sfcprop%smoiseq(ix,3) + temp2d(i,j,idx_opt+41) = GFS_Data(nb)%Sfcprop%smoiseq(ix,4) + temp2d(i,j,idx_opt+42) = GFS_Data(nb)%Sfcprop%zsnsoxy(ix,-2) + temp2d(i,j,idx_opt+43) = GFS_Data(nb)%Sfcprop%zsnsoxy(ix,-1) + temp2d(i,j,idx_opt+44) = GFS_Data(nb)%Sfcprop%zsnsoxy(ix,0) + temp2d(i,j,idx_opt+45) = GFS_Data(nb)%Sfcprop%zsnsoxy(ix,1) + temp2d(i,j,idx_opt+46) = GFS_Data(nb)%Sfcprop%zsnsoxy(ix,2) + temp2d(i,j,idx_opt+47) = GFS_Data(nb)%Sfcprop%zsnsoxy(ix,3) + temp2d(i,j,idx_opt+48) = GFS_Data(nb)%Sfcprop%zsnsoxy(ix,4) idx_opt = 136 endif if (Model%nstf_name(1) > 0) then - temp2d(i,j,idx_opt ) = IPD_Data(nb)%Sfcprop%tref(ix) - temp2d(i,j,idx_opt+ 1) = IPD_Data(nb)%Sfcprop%z_c(ix) - temp2d(i,j,idx_opt+ 2) = IPD_Data(nb)%Sfcprop%c_0(ix) - temp2d(i,j,idx_opt+ 3) = IPD_Data(nb)%Sfcprop%c_d(ix) - temp2d(i,j,idx_opt+ 4) = IPD_Data(nb)%Sfcprop%w_0(ix) - temp2d(i,j,idx_opt+ 5) = IPD_Data(nb)%Sfcprop%w_d(ix) - temp2d(i,j,idx_opt+ 6) = IPD_Data(nb)%Sfcprop%xt(ix) - temp2d(i,j,idx_opt+ 7) = IPD_Data(nb)%Sfcprop%xs(ix) - temp2d(i,j,idx_opt+ 8) = IPD_Data(nb)%Sfcprop%xu(ix) - temp2d(i,j,idx_opt+ 9) = IPD_Data(nb)%Sfcprop%xz(ix) - temp2d(i,j,idx_opt+10) = IPD_Data(nb)%Sfcprop%zm(ix) - temp2d(i,j,idx_opt+11) = IPD_Data(nb)%Sfcprop%xtts(ix) - temp2d(i,j,idx_opt+12) = IPD_Data(nb)%Sfcprop%xzts(ix) - temp2d(i,j,idx_opt+13) = IPD_Data(nb)%Sfcprop%ifd(ix) - temp2d(i,j,idx_opt+14) = IPD_Data(nb)%Sfcprop%dt_cool(ix) - temp2d(i,j,idx_opt+15) = IPD_Data(nb)%Sfcprop%qrain(ix) + temp2d(i,j,idx_opt ) = GFS_Data(nb)%Sfcprop%tref(ix) + temp2d(i,j,idx_opt+ 1) = GFS_Data(nb)%Sfcprop%z_c(ix) + temp2d(i,j,idx_opt+ 2) = GFS_Data(nb)%Sfcprop%c_0(ix) + temp2d(i,j,idx_opt+ 3) = GFS_Data(nb)%Sfcprop%c_d(ix) + temp2d(i,j,idx_opt+ 4) = GFS_Data(nb)%Sfcprop%w_0(ix) + temp2d(i,j,idx_opt+ 5) = GFS_Data(nb)%Sfcprop%w_d(ix) + temp2d(i,j,idx_opt+ 6) = GFS_Data(nb)%Sfcprop%xt(ix) + temp2d(i,j,idx_opt+ 7) = GFS_Data(nb)%Sfcprop%xs(ix) + temp2d(i,j,idx_opt+ 8) = GFS_Data(nb)%Sfcprop%xu(ix) + temp2d(i,j,idx_opt+ 9) = GFS_Data(nb)%Sfcprop%xz(ix) + temp2d(i,j,idx_opt+10) = GFS_Data(nb)%Sfcprop%zm(ix) + temp2d(i,j,idx_opt+11) = GFS_Data(nb)%Sfcprop%xtts(ix) + temp2d(i,j,idx_opt+12) = GFS_Data(nb)%Sfcprop%xzts(ix) + temp2d(i,j,idx_opt+13) = GFS_Data(nb)%Sfcprop%ifd(ix) + temp2d(i,j,idx_opt+14) = GFS_Data(nb)%Sfcprop%dt_cool(ix) + temp2d(i,j,idx_opt+15) = GFS_Data(nb)%Sfcprop%qrain(ix) endif do l = 1,Model%ntot2d - temp2d(i,j,nsfcprop2d+l) = IPD_Data(nb)%Tbd%phy_f2d(ix,l) + temp2d(i,j,nsfcprop2d+l) = GFS_Data(nb)%Tbd%phy_f2d(ix,l) enddo do l = 1,Model%nctp - temp2d(i,j,nsfcprop2d+Model%ntot2d+l) = IPD_Data(nb)%Tbd%phy_fctd(ix,l) + temp2d(i,j,nsfcprop2d+Model%ntot2d+l) = GFS_Data(nb)%Tbd%phy_fctd(ix,l) enddo - temp3dlevsp1(i,j,:, 1) = IPD_Data(nb)%Statein%phii(ix,:) - temp3dlevsp1(i,j,:, 2) = IPD_Data(nb)%Statein%prsi(ix,:) - temp3dlevsp1(i,j,:, 3) = IPD_Data(nb)%Statein%prsik(ix,:) - - temp3d(i,j,:, 1) = IPD_Data(nb)%Statein%phil(ix,:) - temp3d(i,j,:, 2) = IPD_Data(nb)%Statein%prsl(ix,:) - temp3d(i,j,:, 3) = IPD_Data(nb)%Statein%prslk(ix,:) - temp3d(i,j,:, 4) = IPD_Data(nb)%Statein%ugrs(ix,:) - temp3d(i,j,:, 5) = IPD_Data(nb)%Statein%vgrs(ix,:) - temp3d(i,j,:, 6) = IPD_Data(nb)%Statein%vvl(ix,:) - temp3d(i,j,:, 7) = IPD_Data(nb)%Statein%tgrs(ix,:) - temp3d(i,j,:, 8) = IPD_Data(nb)%Stateout%gu0(ix,:) - temp3d(i,j,:, 9) = IPD_Data(nb)%Stateout%gv0(ix,:) - temp3d(i,j,:,10) = IPD_Data(nb)%Stateout%gt0(ix,:) - temp3d(i,j,:,11) = IPD_Data(nb)%Radtend%htrsw(ix,:) - temp3d(i,j,:,12) = IPD_Data(nb)%Radtend%htrlw(ix,:) - temp3d(i,j,:,13) = IPD_Data(nb)%Radtend%swhc(ix,:) - temp3d(i,j,:,14) = IPD_Data(nb)%Radtend%lwhc(ix,:) + temp3dlevsp1(i,j,:, 1) = GFS_Data(nb)%Statein%phii(ix,:) + temp3dlevsp1(i,j,:, 2) = GFS_Data(nb)%Statein%prsi(ix,:) + temp3dlevsp1(i,j,:, 3) = GFS_Data(nb)%Statein%prsik(ix,:) + + temp3d(i,j,:, 1) = GFS_Data(nb)%Statein%phil(ix,:) + temp3d(i,j,:, 2) = GFS_Data(nb)%Statein%prsl(ix,:) + temp3d(i,j,:, 3) = GFS_Data(nb)%Statein%prslk(ix,:) + temp3d(i,j,:, 4) = GFS_Data(nb)%Statein%ugrs(ix,:) + temp3d(i,j,:, 5) = GFS_Data(nb)%Statein%vgrs(ix,:) + temp3d(i,j,:, 6) = GFS_Data(nb)%Statein%vvl(ix,:) + temp3d(i,j,:, 7) = GFS_Data(nb)%Statein%tgrs(ix,:) + temp3d(i,j,:, 8) = GFS_Data(nb)%Stateout%gu0(ix,:) + temp3d(i,j,:, 9) = GFS_Data(nb)%Stateout%gv0(ix,:) + temp3d(i,j,:,10) = GFS_Data(nb)%Stateout%gt0(ix,:) + temp3d(i,j,:,11) = GFS_Data(nb)%Radtend%htrsw(ix,:) + temp3d(i,j,:,12) = GFS_Data(nb)%Radtend%htrlw(ix,:) + temp3d(i,j,:,13) = GFS_Data(nb)%Radtend%swhc(ix,:) + temp3d(i,j,:,14) = GFS_Data(nb)%Radtend%lwhc(ix,:) do l = 1,Model%ntot3d - temp3d(i,j,:,14+l) = IPD_Data(nb)%Tbd%phy_f3d(ix,:,l) + temp3d(i,j,:,14+l) = GFS_Data(nb)%Tbd%phy_f3d(ix,:,l) enddo do l = 1,ntr - temp3d(i,j,:,14+Model%ntot3d+l) = IPD_Data(nb)%Statein%qgrs(ix,:,l) - temp3d(i,j,:,14+Model%ntot3d+ntr+l) = IPD_Data(nb)%Stateout%gq0(ix,:,l) + temp3d(i,j,:,14+Model%ntot3d+l) = GFS_Data(nb)%Statein%qgrs(ix,:,l) + temp3d(i,j,:,14+Model%ntot3d+ntr+l) = GFS_Data(nb)%Stateout%gq0(ix,:,l) enddo enddo enddo @@ -445,7 +442,7 @@ subroutine FV3GFS_IPD_checksum (Model, IPD_Data, Atm_block) deallocate(temp2d) deallocate(temp3d) deallocate(temp3dlevsp1) - end subroutine FV3GFS_IPD_checksum + end subroutine FV3GFS_GFS_checksum !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! @@ -470,7 +467,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta !--- interface variable definitions type(GFS_sfcprop_type), intent(inout) :: Sfcprop(:) type (block_control_type), intent(in) :: Atm_block - type(IPD_control_type), intent(inout) :: Model + type(GFS_control_type), intent(inout) :: Model type (domain2d), intent(in) :: fv_domain logical, intent(in) :: warm_start !--- local variables @@ -1625,7 +1622,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta !--- interface variable definitions type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) type(block_control_type), intent(in) :: Atm_block - type(IPD_control_type), intent(in) :: Model + type(GFS_control_type), intent(in) :: Model type(domain2d), intent(in) :: fv_domain character(len=32), optional, intent(in) :: timestamp !--- local variables @@ -2084,11 +2081,11 @@ end subroutine sfc_prop_restart_write ! opens: phys_data.tile?.nc ! !---------------------------------------------------------------------- - subroutine phys_restart_read (IPD_Restart, Atm_block, Model, fv_domain) + subroutine phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain) !--- interface variable definitions - type(IPD_restart_type), intent(in) :: IPD_Restart + type(GFS_restart_type), intent(in) :: GFS_Restart type(block_control_type), intent(in) :: Atm_block - type(IPD_control_type), intent(in) :: Model + type(GFS_control_type), intent(in) :: Model type(domain2d), intent(in) :: fv_domain !--- local variables integer :: i, j, k, nb, ix, num @@ -2107,10 +2104,10 @@ subroutine phys_restart_read (IPD_Restart, Atm_block, Model, fv_domain) npz = Atm_block%npz nx = (iec - isc + 1) ny = (jec - jsc + 1) - nvar2d = IPD_Restart%num2d - nvar3d = IPD_Restart%num3d - fdiag = IPD_Restart%fdiag - ldiag = IPD_Restart%ldiag + nvar2d = GFS_Restart%num2d + nvar3d = GFS_Restart%num3d + fdiag = GFS_Restart%fdiag + ldiag = GFS_Restart%ldiag !--- register the restart fields if (.not. allocated(phy_var2)) then @@ -2121,12 +2118,12 @@ subroutine phys_restart_read (IPD_Restart, Atm_block, Model, fv_domain) do num = 1,nvar2d var2_p => phy_var2(:,:,num) - id_restart = register_restart_field (Phy_restart, fn_phy, trim(IPD_Restart%name2d(num)), & + id_restart = register_restart_field (Phy_restart, fn_phy, trim(GFS_Restart%name2d(num)), & var2_p, domain=fv_domain, mandatory=.false.) enddo do num = 1,nvar3d var3_p => phy_var3(:,:,:,num) - id_restart = register_restart_field (Phy_restart, fn_phy, trim(IPD_restart%name3d(num)), & + id_restart = register_restart_field (Phy_restart, fn_phy, trim(GFS_restart%name3d(num)), & var3_p, domain=fv_domain, mandatory=.false.) enddo nullify(var2_p) @@ -2151,7 +2148,7 @@ subroutine phys_restart_read (IPD_Restart, Atm_block, Model, fv_domain) do ix = 1, Atm_block%blksz(nb) i = Atm_block%index(nb)%ii(ix) - isc + 1 j = Atm_block%index(nb)%jj(ix) - jsc + 1 - IPD_Restart%data(nb,num)%var2p(ix) = phy_var2(i,j,num) + GFS_Restart%data(nb,num)%var2p(ix) = phy_var2(i,j,num) enddo enddo enddo @@ -2163,7 +2160,7 @@ subroutine phys_restart_read (IPD_Restart, Atm_block, Model, fv_domain) do ix = 1, Atm_block%blksz(nb) i = Atm_block%index(nb)%ii(ix) - isc + 1 j = Atm_block%index(nb)%jj(ix) - jsc + 1 - IPD_Restart%data(nb,num)%var2p(ix) = zero + GFS_Restart%data(nb,num)%var2p(ix) = zero enddo enddo enddo @@ -2175,7 +2172,7 @@ subroutine phys_restart_read (IPD_Restart, Atm_block, Model, fv_domain) do ix = 1, Atm_block%blksz(nb) i = Atm_block%index(nb)%ii(ix) - isc + 1 j = Atm_block%index(nb)%jj(ix) - jsc + 1 - IPD_Restart%data(nb,num)%var3p(ix,k) = phy_var3(i,j,k,num) + GFS_Restart%data(nb,num)%var3p(ix,k) = phy_var3(i,j,k,num) enddo enddo enddo @@ -2194,11 +2191,11 @@ end subroutine phys_restart_read ! ! calls: register_restart_field, save_restart !---------------------------------------------------------------------- - subroutine phys_restart_write (IPD_Restart, Atm_block, Model, fv_domain, timestamp) + subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timestamp) !--- interface variable definitions - type(IPD_restart_type), intent(in) :: IPD_Restart + type(GFS_restart_type), intent(in) :: GFS_Restart type(block_control_type), intent(in) :: Atm_block - type(IPD_control_type), intent(in) :: Model + type(GFS_control_type), intent(in) :: Model type(domain2d), intent(in) :: fv_domain character(len=32), optional, intent(in) :: timestamp !--- local variables @@ -2217,8 +2214,8 @@ subroutine phys_restart_write (IPD_Restart, Atm_block, Model, fv_domain, timesta npz = Atm_block%npz nx = (iec - isc + 1) ny = (jec - jsc + 1) - nvar2d = IPD_Restart%num2d - nvar3d = IPD_Restart%num3d + nvar2d = GFS_Restart%num2d + nvar3d = GFS_Restart%num3d !--- register the restart fields if (.not. allocated(phy_var2)) then @@ -2229,12 +2226,12 @@ subroutine phys_restart_write (IPD_Restart, Atm_block, Model, fv_domain, timesta do num = 1,nvar2d var2_p => phy_var2(:,:,num) - id_restart = register_restart_field (Phy_restart, fn_phy, trim(IPD_Restart%name2d(num)), & + id_restart = register_restart_field (Phy_restart, fn_phy, trim(GFS_Restart%name2d(num)), & var2_p, domain=fv_domain, mandatory=.false.) enddo do num = 1,nvar3d var3_p => phy_var3(:,:,:,num) - id_restart = register_restart_field (Phy_restart, fn_phy, trim(IPD_restart%name3d(num)), & + id_restart = register_restart_field (Phy_restart, fn_phy, trim(GFS_restart%name3d(num)), & var3_p, domain=fv_domain, mandatory=.false.) enddo nullify(var2_p) @@ -2248,7 +2245,7 @@ subroutine phys_restart_write (IPD_Restart, Atm_block, Model, fv_domain, timesta do ix = 1, Atm_block%blksz(nb) i = Atm_block%index(nb)%ii(ix) - isc + 1 j = Atm_block%index(nb)%jj(ix) - jsc + 1 - phy_var2(i,j,num) = IPD_Restart%data(nb,num)%var2p(ix) + phy_var2(i,j,num) = GFS_Restart%data(nb,num)%var2p(ix) enddo enddo enddo @@ -2260,7 +2257,7 @@ subroutine phys_restart_write (IPD_Restart, Atm_block, Model, fv_domain, timesta do ix = 1, Atm_block%blksz(nb) i = Atm_block%index(nb)%ii(ix) - isc + 1 j = Atm_block%index(nb)%jj(ix) - jsc + 1 - phy_var3(i,j,k,num) = IPD_Restart%data(nb,num)%var3p(ix,k) + phy_var3(i,j,k,num) = GFS_Restart%data(nb,num)%var3p(ix,k) enddo enddo enddo @@ -2285,10 +2282,10 @@ end subroutine phys_restart_write subroutine fv3gfs_diag_register(Diag, Time, Atm_block, Model, xlon, xlat, axes) use physcons, only: con_g !--- subroutine interface variable definitions - type(IPD_diag_type), intent(inout) :: Diag(:) + type(GFS_externaldiag_type), intent(inout) :: Diag(:) type(time_type), intent(in) :: Time type (block_control_type), intent(in) :: Atm_block - type(IPD_control_type), intent(in) :: Model + type(GFS_control_type), intent(in) :: Model real(kind=kind_phys), intent(in) :: xlon(:,:) real(kind=kind_phys), intent(in) :: xlat(:,:) integer, dimension(4), intent(in) :: axes @@ -2401,7 +2398,7 @@ subroutine fv3gfs_diag_output(time, diag, atm_block, nx, ny, levs, ntcw, ntoz, & dt, time_int, time_intfull, time_radsw, time_radlw) !--- subroutine interface variable definitions type(time_type), intent(in) :: time - type(IPD_diag_type), intent(in) :: diag(:) + type(GFS_externaldiag_type), intent(in) :: diag(:) type (block_control_type), intent(in) :: atm_block integer, intent(in) :: nx, ny, levs, ntcw, ntoz real(kind=kind_phys), intent(in) :: dt @@ -2854,7 +2851,7 @@ subroutine fv_phys_bundle_setup(Diag, axes, phys_bundle, fcst_grid, quilting, nb ! implicit none ! - type(IPD_diag_type),intent(in) :: Diag(:) + type(GFS_externaldiag_type),intent(in) :: Diag(:) integer, intent(in) :: axes(:) type(ESMF_FieldBundle),intent(inout) :: phys_bundle(:) type(ESMF_Grid),intent(inout) :: fcst_grid From 98f5142bbe85a44e15e904728bf5496266be543a Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 7 Jan 2021 09:58:22 -0700 Subject: [PATCH 12/20] Bugfix in atmos_model.F90; add missing call to GFS_externaldiag_populate --- atmos_model.F90 | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 14cf3c812..1b6dc5800 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -84,7 +84,8 @@ module atmos_model_mod use GFS_typedefs, only: GFS_init_type, GFS_kind_phys => kind_phys use GFS_restart, only: GFS_restart_type, GFS_restart_populate -use GFS_diagnostics, only: GFS_externaldiag_type +use GFS_diagnostics, only: GFS_externaldiag_type, & + GFS_externaldiag_populate use CCPP_data, only: ccpp_suite, GFS_control, & GFS_data, GFS_interstitial use GFS_driver, only: GFS_initialize @@ -168,9 +169,8 @@ module atmos_model_mod type(DYCORE_diag_type) :: DYCORE_Diag(25) !---------------- -! IPD containers +! GFS containers !---------------- -! GFS_control and GFS_data are coming from CCPP_data type(GFS_externaldiag_type), target :: GFS_Diag(DIAG_SIZE) type(GFS_restart_type) :: GFS_restart_var @@ -547,6 +547,13 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) GFS_data%Coupling, GFS_data%Grid, GFS_data%Tbd, GFS_data%Cldprop, GFS_data%Radtend, & GFS_data%Intdiag, GFS_interstitial, commglobal, mpp_npes(), Init_parm) + !--- populate/associate the Diag container elements + call GFS_externaldiag_populate (GFS_Diag, GFS_Control, GFS_Data%Statein, GFS_Data%Stateout, & + GFS_Data%Sfcprop, GFS_Data%Coupling, GFS_Data%Grid, & + GFS_Data%Tbd, GFS_Data%Cldprop, GFS_Data%Radtend, & + GFS_Data%Intdiag, Init_parm) + + !--- Initialize stochastic physics pattern generation / cellular automata for first time step call stochastic_physics_wrapper(GFS_control, GFS_data, Atm_block, ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed') From 1918b657191224a291f718414b7bfac10ad1f3d1 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 8 Jan 2021 09:17:38 -0700 Subject: [PATCH 13/20] Move contents of gfsphysics/{CCPP_layer,GFS_layer} to ccpp/{data,driver}, entirely deleted IPD typedefs --- CMakeLists.txt | 16 ++++--- ccpp/config/ccpp_prebuild_config.py | 6 +-- .../CCPP_layer => ccpp/data}/CCPP_data.F90 | 0 .../CCPP_layer => ccpp/data}/CCPP_data.meta | 2 +- .../data}/CCPP_typedefs.F90 | 0 .../data}/CCPP_typedefs.meta | 2 +- ccpp/data/CMakeLists.txt | 43 +++++++++++++++++++ .../GFS_layer => ccpp/data}/GFS_typedefs.F90 | 0 .../GFS_layer => ccpp/data}/GFS_typedefs.meta | 2 +- ccpp/driver/CMakeLists.txt | 25 ++++++++++- .../driver}/GFS_diagnostics.F90 | 0 .../GFS_layer => ccpp/driver}/GFS_driver.F90 | 0 .../GFS_layer => ccpp/driver}/GFS_restart.F90 | 2 +- gfsphysics/CMakeLists.txt | 7 --- io/CMakeLists.txt | 6 ++- 15 files changed, 87 insertions(+), 24 deletions(-) rename {gfsphysics/CCPP_layer => ccpp/data}/CCPP_data.F90 (100%) rename {gfsphysics/CCPP_layer => ccpp/data}/CCPP_data.meta (93%) rename {gfsphysics/CCPP_layer => ccpp/data}/CCPP_typedefs.F90 (100%) rename {gfsphysics/CCPP_layer => ccpp/data}/CCPP_typedefs.meta (99%) create mode 100644 ccpp/data/CMakeLists.txt rename {gfsphysics/GFS_layer => ccpp/data}/GFS_typedefs.F90 (100%) rename {gfsphysics/GFS_layer => ccpp/data}/GFS_typedefs.meta (99%) rename {gfsphysics/GFS_layer => ccpp/driver}/GFS_diagnostics.F90 (100%) rename {gfsphysics/GFS_layer => ccpp/driver}/GFS_driver.F90 (100%) rename {gfsphysics/GFS_layer => ccpp/driver}/GFS_restart.F90 (99%) diff --git a/CMakeLists.txt b/CMakeLists.txt index 409426956..e30d4707b 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -99,7 +99,8 @@ set_property(SOURCE atmos_cubed_sphere/model/fv_mapz.F90 APPEND_STRING PROPERTY set_target_properties(fv3dycore PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/mod) target_compile_definitions(fv3dycore PRIVATE "${_fv3dycore_defs_private}") -target_include_directories(fv3dycore PRIVATE ${CMAKE_CURRENT_SOURCE_DIR}/atmos_cubed_sphere) +target_include_directories(fv3dycore PRIVATE ${CMAKE_CURRENT_SOURCE_DIR}/atmos_cubed_sphere + ${CMAKE_CURRENT_BINARY_DIR}/ccpp/driver/mod) target_include_directories(fv3dycore INTERFACE $ $) @@ -115,10 +116,13 @@ endif() ############################################################################### add_subdirectory(ccpp) +add_subdirectory(ccpp/data) add_subdirectory(ccpp/driver) +add_dependencies(ccppphys ccpp) add_dependencies(gfsphysics ccpp ccppphys) -add_dependencies(ccppdriver ccpp ccppphys) -add_dependencies(ccppphys ccpp) +add_dependencies(ccppdata ccpp ccppphys gfsphysics) +add_dependencies(ccppdriver ccpp ccppphys ccppdata gfsphysics) +add_dependencies(fv3dycore ccppdriver ccpp ccppphys ccppdata gfsphysics) target_include_directories(fv3dycore PRIVATE ${CMAKE_CURRENT_BINARY_DIR}/ccpp/framework/src ${CMAKE_CURRENT_BINARY_DIR}/ccpp/physics ${CMAKE_CURRENT_BINARY_DIR}/ccpp/driver) @@ -153,9 +157,9 @@ target_include_directories(fv3atm INTERFACE $) diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 similarity index 100% rename from gfsphysics/GFS_layer/GFS_typedefs.F90 rename to ccpp/data/GFS_typedefs.F90 diff --git a/gfsphysics/GFS_layer/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta similarity index 99% rename from gfsphysics/GFS_layer/GFS_typedefs.meta rename to ccpp/data/GFS_typedefs.meta index 708f2ef8e..c8a686295 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -10459,7 +10459,7 @@ [ccpp-table-properties] name = GFS_typedefs type = module - relative_path = ../../ccpp/physics/physics + relative_path = ../physics/physics dependencies = machine.F,physcons.F90,radlw_param.f,radsw_param.f,GFDL_parse_tracers.F90 dependencies = rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90 dependencies = rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_rte_config.F90,rte-rrtmgp/rte/mo_source_functions.F90 diff --git a/ccpp/driver/CMakeLists.txt b/ccpp/driver/CMakeLists.txt index 5960d92da..2988e28b8 100644 --- a/ccpp/driver/CMakeLists.txt +++ b/ccpp/driver/CMakeLists.txt @@ -4,24 +4,45 @@ remove_definitions(-DOVERLOAD_R8) remove_definitions(-DOVERLOAD_R4) endif() -message ("Force 64 bits in CCPP_layer") +message ("Force 64 bits in ccpp/driver") if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + if(REPRO) + string (REPLACE "-i4 -real-size 32" "-i4 -real-size 64" CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}") + else() string (REPLACE "-i4 -real-size 32" "-i4 -real-size 64 -no-prec-div -no-prec-sqrt" CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}") + endif() elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fdefault-real-8") endif() +list(APPEND _ccppdriver_defs_private NEMS_GSM + MOIST_CAPPA + USE_COND + INTERNAL_FILE_NML) + +if(MULTI_GASES) + list(APPEND _ccppdriver_defs_private MULTI_GASES) +endif() + add_library( ccppdriver + GFS_diagnostics.F90 + GFS_restart.F90 + GFS_driver.F90 + + ${CMAKE_BINARY_DIR}/FV3/ccpp/physics/ccpp_static_api.F90 CCPP_driver.F90 ) target_link_libraries(ccppdriver gfsphysics) target_link_libraries(ccppdriver ccpp) target_link_libraries(ccppdriver ccppphys) +target_link_libraries(ccppdriver ccppdata) -target_include_directories(ccppdriver PRIVATE ${CMAKE_BINARY_DIR}/FV3/ccpp/framework/src) +target_include_directories(ccppdriver PRIVATE ${CMAKE_BINARY_DIR}/FV3/ccpp/framework/src + ${CMAKE_BINARY_DIR}/FV3/ccpp/physics) set_target_properties(ccppdriver PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/mod) +target_compile_definitions(ccppdata PRIVATE "${_ccppdata_defs_private}") target_include_directories(ccppdriver PUBLIC $) diff --git a/gfsphysics/GFS_layer/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 similarity index 100% rename from gfsphysics/GFS_layer/GFS_diagnostics.F90 rename to ccpp/driver/GFS_diagnostics.F90 diff --git a/gfsphysics/GFS_layer/GFS_driver.F90 b/ccpp/driver/GFS_driver.F90 similarity index 100% rename from gfsphysics/GFS_layer/GFS_driver.F90 rename to ccpp/driver/GFS_driver.F90 diff --git a/gfsphysics/GFS_layer/GFS_restart.F90 b/ccpp/driver/GFS_restart.F90 similarity index 99% rename from gfsphysics/GFS_layer/GFS_restart.F90 rename to ccpp/driver/GFS_restart.F90 index c243c5da1..dcd78eb75 100644 --- a/gfsphysics/GFS_layer/GFS_restart.F90 +++ b/ccpp/driver/GFS_restart.F90 @@ -6,7 +6,7 @@ module GFS_restart GFS_coupling_type, GFS_grid_type, & GFS_tbd_type, GFS_cldprop_type, & GFS_radtend_type, GFS_diag_type, & - GFS_init_type + GFS_init_type use GFS_diagnostics, only: GFS_externaldiag_type type var_subtype diff --git a/gfsphysics/CMakeLists.txt b/gfsphysics/CMakeLists.txt index 49feaec4c..5d6244041 100644 --- a/gfsphysics/CMakeLists.txt +++ b/gfsphysics/CMakeLists.txt @@ -15,13 +15,6 @@ set(CCPP_SOURCES physics/namelist_soilveg.f physics/set_soilveg.f physics/noahmp_tables.f90 - - CCPP_layer/CCPP_data.F90 - ${CMAKE_BINARY_DIR}/FV3/ccpp/physics/ccpp_static_api.F90 - - GFS_layer/GFS_diagnostics.F90 - GFS_layer/GFS_driver.F90 - GFS_layer/GFS_restart.F90 ) list(APPEND _gfsphysics_defs_private NEMS_GSM diff --git a/io/CMakeLists.txt b/io/CMakeLists.txt index b04a29521..88dab6c09 100644 --- a/io/CMakeLists.txt +++ b/io/CMakeLists.txt @@ -32,14 +32,16 @@ target_compile_definitions(io PRIVATE "${_io_defs_private}") target_include_directories(io PUBLIC $) target_link_libraries(io PRIVATE fms - gfsphysics) + gfsphysics + ccppdriver) if(INLINE_POST) target_link_libraries(io PRIVATE upp::upp) endif() target_include_directories(io PRIVATE ${CMAKE_BINARY_DIR}/FV3/ccpp/framework/src - ${CMAKE_BINARY_DIR}/FV3/ccpp/physics) + ${CMAKE_BINARY_DIR}/FV3/ccpp/physics + ${CMAKE_BINARY_DIR}/FV3/ccpp/driver/mod) target_link_libraries(io PRIVATE nemsio::nemsio esmf) From a7b9b03f371bad7d4eab6efd7467d234566ea538 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 8 Jan 2021 12:44:54 -0700 Subject: [PATCH 14/20] Rename module GFS_driver to GFS_init --- atmos_model.F90 | 2 +- ccpp/data/GFS_typedefs.F90 | 4 ++++ ccpp/driver/CMakeLists.txt | 2 +- ccpp/driver/{GFS_driver.F90 => GFS_init.F90} | 11 ++--------- 4 files changed, 8 insertions(+), 11 deletions(-) rename ccpp/driver/{GFS_driver.F90 => GFS_init.F90} (95%) diff --git a/atmos_model.F90 b/atmos_model.F90 index 1b6dc5800..8e5761926 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -88,7 +88,7 @@ module atmos_model_mod GFS_externaldiag_populate use CCPP_data, only: ccpp_suite, GFS_control, & GFS_data, GFS_interstitial -use GFS_driver, only: GFS_initialize +use GFS_init, only: GFS_initialize use CCPP_driver, only: CCPP_step, non_uniform_blocks use stochastic_physics_wrapper_mod, only: stochastic_physics_wrapper,stochastic_physics_wrapper_end diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 3ba65a454..5cc2e2333 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -3616,6 +3616,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- integrated dynamics through earth's atmosphere Model%lsidea = lsidea + if (Model%lsidea) then + print *,' LSIDEA is active but needs to be reworked for FV3 - shutting down' + stop + endif !--- calendars and time parameters and activation triggers Model%dtp = dt_phys diff --git a/ccpp/driver/CMakeLists.txt b/ccpp/driver/CMakeLists.txt index 2988e28b8..e1324e214 100644 --- a/ccpp/driver/CMakeLists.txt +++ b/ccpp/driver/CMakeLists.txt @@ -29,7 +29,7 @@ add_library( GFS_diagnostics.F90 GFS_restart.F90 - GFS_driver.F90 + GFS_init.F90 ${CMAKE_BINARY_DIR}/FV3/ccpp/physics/ccpp_static_api.F90 CCPP_driver.F90 diff --git a/ccpp/driver/GFS_driver.F90 b/ccpp/driver/GFS_init.F90 similarity index 95% rename from ccpp/driver/GFS_driver.F90 rename to ccpp/driver/GFS_init.F90 index 782badbed..38cb95d33 100644 --- a/ccpp/driver/GFS_driver.F90 +++ b/ccpp/driver/GFS_init.F90 @@ -1,4 +1,4 @@ -module GFS_driver +module GFS_init use machine, only: kind_phys use GFS_typedefs, only: GFS_init_type, & @@ -134,13 +134,6 @@ subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, & call set_soilveg(Model%me, Model%isot, Model%ivegsrc, Model%nlunit) ! *DH - !--- lsidea initialization - if (Model%lsidea) then - print *,' LSIDEA is active but needs to be reworked for FV3 - shutting down' - stop - !--- NEED TO get the logic from the old phys/gloopb.f initialization area - endif - end subroutine GFS_initialize !------------------ @@ -184,4 +177,4 @@ subroutine GFS_grid_populate (Grid, xlon, xlat, area) end subroutine GFS_grid_populate -end module GFS_driver +end module GFS_init From e62a882d037ac1f7a16ce25519ec451c3b3fe742 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 12 Jan 2021 14:03:14 -0700 Subject: [PATCH 15/20] Fix indentation in ccpp/data/CMakeLists.txt and ccpp/driver/CMakeLists.txt --- ccpp/data/CMakeLists.txt | 6 +++--- ccpp/driver/CMakeLists.txt | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/ccpp/data/CMakeLists.txt b/ccpp/data/CMakeLists.txt index bfd80275e..71ba6311d 100644 --- a/ccpp/data/CMakeLists.txt +++ b/ccpp/data/CMakeLists.txt @@ -1,7 +1,7 @@ if(NOT DYN32) -remove_definitions(-DOVERLOAD_R8) -remove_definitions(-DOVERLOAD_R4) + remove_definitions(-DOVERLOAD_R8) + remove_definitions(-DOVERLOAD_R4) endif() message ("Force 64 bits in ccpp/data") @@ -12,7 +12,7 @@ if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") string (REPLACE "-i4 -real-size 32" "-i4 -real-size 64 -no-prec-div -no-prec-sqrt" CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}") endif() elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fdefault-real-8") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fdefault-real-8") endif() list(APPEND _ccppdata_defs_private NEMS_GSM diff --git a/ccpp/driver/CMakeLists.txt b/ccpp/driver/CMakeLists.txt index e1324e214..b404ce95b 100644 --- a/ccpp/driver/CMakeLists.txt +++ b/ccpp/driver/CMakeLists.txt @@ -1,7 +1,7 @@ if(NOT DYN32) -remove_definitions(-DOVERLOAD_R8) -remove_definitions(-DOVERLOAD_R4) + remove_definitions(-DOVERLOAD_R8) + remove_definitions(-DOVERLOAD_R4) endif() message ("Force 64 bits in ccpp/driver") @@ -12,7 +12,7 @@ if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") string (REPLACE "-i4 -real-size 32" "-i4 -real-size 64 -no-prec-div -no-prec-sqrt" CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}") endif() elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fdefault-real-8") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fdefault-real-8") endif() list(APPEND _ccppdriver_defs_private NEMS_GSM From 7111b4bf53643009191ee1e0625decc788aba21b Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 12 Jan 2021 14:07:13 -0700 Subject: [PATCH 16/20] Add logic to set DYN32 depending on 32BIT setting --- CMakeLists.txt | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index e30d4707b..6568ee594 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -83,8 +83,11 @@ if(MULTI_GASES) endif() if(32BIT) + set(DYN32 ON CACHE BOOL "Enable support for 32bit fast physics in CCPP") list(APPEND _fv3dycore_defs_private OVERLOAD_R4 OVERLOAD_R8) +else() + set(DYN32 OFF CACHE BOOL "Disable support for 32bit fast physics in CCPP") endif() list(APPEND _fv3dycore_defs_private CCPP) From 52a46523da6e709f6973ff79e5b7f56ada0a9e63 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 13 Jan 2021 07:46:19 -0700 Subject: [PATCH 17/20] Pass preprocessor directive GFS_TYPES to dycore to enable use of GFS data types --- CMakeLists.txt | 1 + atmos_cubed_sphere | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 6568ee594..6022f41f0 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -74,6 +74,7 @@ add_library(fv3dycore ${_fv3dycore_srcs}) list(APPEND _fv3dycore_defs_private SPMD use_WRTCOMP GFS_PHYS + GFS_TYPES USE_GFSL63 MOIST_CAPPA USE_COND) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index e88ea4426..0e59620e5 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit e88ea44266678ed9205a234ac4ef6d4d17b2509f +Subproject commit 0e59620e5b8df78cb8e64efb3b889c3ca9616b11 From 418be6997c8803c12371a54315d9b226ac296dc3 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 13 Jan 2021 08:41:32 -0700 Subject: [PATCH 18/20] Update submodule pointer for GFDL_atmos_cubed_sphere --- atmos_cubed_sphere | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 0e59620e5..6497d5a2d 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 0e59620e5b8df78cb8e64efb3b889c3ca9616b11 +Subproject commit 6497d5a2d570b703ef113d9f7ade2510baf76bdd From f84a2201dc22313b31d1aa86f42fd504c776becf Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 13 Jan 2021 14:46:31 -0700 Subject: [PATCH 19/20] Compile GFS_diagnostics.F90 without optimization, this leads to out of memory errors on wcoss_dell_p3 --- ccpp/driver/CMakeLists.txt | 3 +++ 1 file changed, 3 insertions(+) diff --git a/ccpp/driver/CMakeLists.txt b/ccpp/driver/CMakeLists.txt index b404ce95b..41bad2626 100644 --- a/ccpp/driver/CMakeLists.txt +++ b/ccpp/driver/CMakeLists.txt @@ -35,6 +35,9 @@ add_library( CCPP_driver.F90 ) +# Compile GFS_diagnostics.F90 without optimization, this leads to out of memory errors on wcoss_dell_p3 +set_property(SOURCE GFS_diagnostics.F90 APPEND_STRING PROPERTY COMPILE_FLAGS "-O0") + target_link_libraries(ccppdriver gfsphysics) target_link_libraries(ccppdriver ccpp) target_link_libraries(ccppdriver ccppphys) From 19638f8d143aa78789ca48f14f1c4e4d701cd59a Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 14 Jan 2021 11:59:21 -0700 Subject: [PATCH 20/20] Revert change to .gitmodules and update submodule pointers for GFDL_atmos_cubed_sphere and ccpp-physics --- .gitmodules | 12 ++++-------- atmos_cubed_sphere | 2 +- ccpp/physics | 2 +- 3 files changed, 6 insertions(+), 10 deletions(-) diff --git a/.gitmodules b/.gitmodules index 72a60f47b..d253f6966 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,16 +1,12 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - #url = https://github.com/NOAA-EMC/GFDL_atmos_cubed_sphere - #branch = dev/emc - url = https://github.com/climbfuji/GFDL_atmos_cubed_sphere - branch = remove_ipd_step3_and_5 + url = https://github.com/NOAA-EMC/GFDL_atmos_cubed_sphere + branch = dev/emc [submodule "ccpp/framework"] path = ccpp/framework url = https://github.com/NCAR/ccpp-framework branch = master [submodule "ccpp/physics"] path = ccpp/physics - #url = https://github.com/NCAR/ccpp-physics - #branch = master - url = https://github.com/climbfuji/ccpp-physics - branch = remove_ipd_step3_and_5 + url = https://github.com/NCAR/ccpp-physics + branch = master diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 6497d5a2d..00397ef24 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 6497d5a2d570b703ef113d9f7ade2510baf76bdd +Subproject commit 00397ef249aac0377026a733b3e698b74a43ee8f diff --git a/ccpp/physics b/ccpp/physics index 06c1c1f74..143d7f041 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 06c1c1f74da7f53b40bebb70ebcf24b99c9167c9 +Subproject commit 143d7f041529b693e19040e25cd0ea5d5e922eeb