From 71a5baeccbe5f7bacbf04328b571f7625d70ede0 Mon Sep 17 00:00:00 2001 From: michalakes Date: Tue, 28 Feb 2023 14:41:53 -0800 Subject: [PATCH 1/2] On branch jm-pr-multiple-instances-of-ccpp-physics Changes to add an instance index to CCPP physics Changes to be committed: modified: physics/GFS_phys_time_vary.fv3.F90 modified: physics/GFS_phys_time_vary.fv3.meta modified: physics/h2ointerp.f90 modified: physics/mp_thompson.F90 modified: physics/mp_thompson.meta modified: physics/ozinterp.f90 --- physics/GFS_phys_time_vary.fv3.F90 | 27 ++++++++++++++++----------- physics/GFS_phys_time_vary.fv3.meta | 28 ++++++++++++++++++++++++++++ physics/h2ointerp.f90 | 9 +++++++-- physics/mp_thompson.F90 | 24 ++++++++++++++++-------- physics/mp_thompson.meta | 21 +++++++++++++++++++++ physics/ozinterp.f90 | 9 +++++++-- 6 files changed, 95 insertions(+), 23 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 42f2bbc15..7b56d3f72 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -48,7 +48,7 @@ module GFS_phys_time_vary public GFS_phys_time_vary_init, GFS_phys_time_vary_timestep_init, GFS_phys_time_vary_timestep_finalize, GFS_phys_time_vary_finalize - logical :: is_initialized = .false. + logical, dimension(200) :: is_initialized = .false. ! why 200? real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys @@ -80,7 +80,7 @@ subroutine GFS_phys_time_vary_init ( zwtxy, xlaixy, xsaixy, lfmassxy, stmassxy, rtmassxy, woodxy, stblcpxy, fastcpxy, & smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, snliqxy, tsnoxy , smoiseq, zsnsoxy, & slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, lsm_cold_start, nthrds, & - errmsg, errflg) + instance, errmsg, errflg) implicit none @@ -170,6 +170,7 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(in) :: con_t0c integer, intent(in) :: nthrds + integer, intent(in) :: instance character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -189,7 +190,7 @@ subroutine GFS_phys_time_vary_init ( errmsg = '' errflg = 0 - if (is_initialized) return + if (is_initialized(instance)) return iamin=999 iamax=-999 jamin=999 @@ -197,7 +198,7 @@ subroutine GFS_phys_time_vary_init ( !$OMP parallel num_threads(nthrds) default(none) & !$OMP shared (me,master,ntoz,h2o_phys,im,nx,ny,levs,idate) & -!$OMP shared (xlat_d,xlon_d,imap,jmap,errmsg,errflg) & +!$OMP shared (xlat_d,xlon_d,imap,jmap,instance,errmsg,errflg) & !$OMP shared (levozp,oz_coeff,oz_pres,ozpl) & !$OMP shared (levh2o,h2o_coeff,h2o_pres,h2opl) & !$OMP shared (iamin, iamax, jamin, jamax) & @@ -670,7 +671,7 @@ subroutine GFS_phys_time_vary_init ( endif noahmp_init endif lsm_init - is_initialized = .true. + is_initialized(instance) = .true. contains @@ -718,7 +719,8 @@ subroutine GFS_phys_time_vary_timestep_init ( tsfc, tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, zorli, zorll, & zorlo, weasd, slope, snoalb, canopy, vfrac, vtype, stype, shdmin, shdmax, snowd, & cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, landfrac, & - do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, tau_amf, errmsg, errflg) + do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, tau_amf, & + instance, errmsg, errflg) implicit none @@ -765,6 +767,7 @@ subroutine GFS_phys_time_vary_timestep_init ( snowd(:), cv(:), cvb(:), cvt(:), oro(:), oro_uf(:), slmsk(:) integer, intent(inout) :: vtype(:), stype(:), slope(:) + integer, intent(in) :: instance character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -779,7 +782,7 @@ subroutine GFS_phys_time_vary_timestep_init ( errflg = 0 ! Check initialization status - if (.not.is_initialized) then + if (.not.is_initialized(instance)) then write(errmsg,'(*(a))') "Logic error: GFS_phys_time_vary_timestep_init called before GFS_phys_time_vary_init" errflg = 1 return @@ -912,13 +915,14 @@ end subroutine GFS_phys_time_vary_timestep_init !! !>\section gen_GFS_phys_time_vary_timestep_finalize GFS_phys_time_vary_timestep_finalize General Algorithm !> @{ - subroutine GFS_phys_time_vary_timestep_finalize (errmsg, errflg) + subroutine GFS_phys_time_vary_timestep_finalize (instance, errmsg, errflg) implicit none ! Interface variables character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + integer, intent(in) :: instance ! Initialize CCPP error handling variables errmsg = '' @@ -930,19 +934,20 @@ end subroutine GFS_phys_time_vary_timestep_finalize !> \section arg_table_GFS_phys_time_vary_finalize Argument Table !! \htmlinclude GFS_phys_time_vary_finalize.html !! - subroutine GFS_phys_time_vary_finalize(errmsg, errflg) + subroutine GFS_phys_time_vary_finalize(instance, errmsg, errflg) implicit none ! Interface variables character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + integer, intent(in) :: instance ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (.not.is_initialized) return + if (.not.is_initialized(instance)) return ! Deallocate ozone arrays if (allocated(oz_lat) ) deallocate(oz_lat) @@ -970,7 +975,7 @@ subroutine GFS_phys_time_vary_finalize(errmsg, errflg) if (allocated(tau_limb )) deallocate(tau_limb) if (allocated(days_limb )) deallocate(days_limb) - is_initialized = .false. + is_initialized(instance) = .false. end subroutine GFS_phys_time_vary_finalize diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index ce8c6c54b..dcf1706ca 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -902,6 +902,13 @@ dimensions = () type = integer intent = in +[instance] + standard_name = ccpp_instance + long_name = argument so package knows which instance it is + units = index + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -922,6 +929,13 @@ [ccpp-arg-table] name = GFS_phys_time_vary_finalize type = scheme +[instance] + standard_name = ccpp_instance + long_name = argument so package knows which instance it is + units = index + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -1868,6 +1882,13 @@ type = real kind = kind_phys intent = inout +[instance] + standard_name = ccpp_instance + long_name = argument so package knows which instance it is + units = index + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -1888,6 +1909,13 @@ [ccpp-arg-table] name = GFS_phys_time_vary_timestep_finalize type = scheme +[instance] + standard_name = ccpp_instance + long_name = argument so package knows which instance it is + units = index + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/h2ointerp.f90 b/physics/h2ointerp.f90 index c4fb355fc..f78b1b05c 100644 --- a/physics/h2ointerp.f90 +++ b/physics/h2ointerp.f90 @@ -54,7 +54,12 @@ subroutine read_h2odata (h2o_phys, me, master) !--- h2o_pres - vertical pressure level (mb) !--- h2o_time - time coordinate (days) !--- - allocate (h2o_lat(latsh2o), h2o_pres(levh2o),h2o_time(timeh2o+1)) +! NOTE: If there are multiple instances of CCPP physics, only the first instance +! allocates these. All instances must use the same number of identical ozone values +! jm 20230228 + if ( .not.allocated(h2o_lat) ) allocate (h2o_lat(latsh2o)) + if ( .not.allocated(h2o_pres)) allocate (h2o_pres(levh2o)) + if ( .not.allocated(h2o_time)) allocate (h2o_time(timeh2o+1)) allocate (h2o_lat4(latsh2o), h2o_pres4(levh2o),h2o_time4(timeh2o+1)) rewind (kh2opltc) read (kh2opltc) h2o_coeff, latsh2o, levh2o, timeh2o, h2o_lat4, h2o_pres4, h2o_time4 @@ -69,7 +74,7 @@ subroutine read_h2odata (h2o_phys, me, master) !--- assume latitudes is on a uniform gaussian grid !--- allocate (tempin(latsh2o)) - allocate (h2oplin(latsh2o,levh2o,h2o_coeff,timeh2o)) + if (.not.allocated(h2oplin)) allocate (h2oplin(latsh2o,levh2o,h2o_coeff,timeh2o)) DO i=1,timeh2o do n=1,h2o_coeff DO k=1,levh2o diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 727098a05..6354c5158 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -20,7 +20,7 @@ module mp_thompson private - logical :: is_initialized = .False. + logical, dimension(100) :: is_initialized = .False. integer, parameter :: ext_ndiag3d = 37 @@ -39,6 +39,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & nwfa, nifa, tgrs, prsl, phil, area, & aerfld, mpicomm, mpirank, mpiroot, & threads, ext_diag, diag3d, & + instance, & errmsg, errflg) implicit none @@ -83,6 +84,8 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & ! Extended diagnostics logical, intent(in ) :: ext_diag real(kind_phys), intent(in ) :: diag3d(:,:,:) + ! Which instance + integer, intent(in ) :: instance ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg @@ -101,7 +104,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & errmsg = '' errflg = 0 - if (is_initialized) return + if (is_initialized(instance)) return ! Consistency checks if (imp_physics/=imp_physics_thompson) then @@ -133,7 +136,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & ! For restart runs, the init is done here if (restart) then - is_initialized = .true. + is_initialized(instance) = .true. return end if @@ -304,7 +307,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & end if end if - is_initialized = .true. + is_initialized(instance) = .true. end subroutine mp_thompson_init @@ -334,6 +337,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & spp_prt_list, spp_var_list, & spp_stddev_cutoff, & cplchm, pfi_lsan, pfl_lsan, & + instance, & errmsg, errflg) implicit none @@ -397,6 +401,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & logical, intent(in) :: ext_diag real(kind_phys), target, intent(inout) :: diag3d(:,:,:) logical, intent(in) :: reset_diag3d + ! Which instance + integer, intent(in ) :: instance ! CCPP error handling character(len=*), intent( out) :: errmsg @@ -501,7 +507,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & if (first_time_step .and. istep==1 .and. blkno==1) then ! Check initialization state - if (.not.is_initialized) then + if (.not.is_initialized(instance)) then write(errmsg, fmt='((a))') 'mp_thompson_run called before mp_thompson_init' errflg = 1 return @@ -861,10 +867,12 @@ end subroutine mp_thompson_run !> \section arg_table_mp_thompson_finalize Argument Table !! \htmlinclude mp_thompson_finalize.html !! - subroutine mp_thompson_finalize(errmsg, errflg) + subroutine mp_thompson_finalize(instance,errmsg, errflg) implicit none + ! Which instance + integer, intent(in ) :: instance character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg @@ -872,11 +880,11 @@ subroutine mp_thompson_finalize(errmsg, errflg) errmsg = '' errflg = 0 - if (.not.is_initialized) return + if (.not.is_initialized(instance)) return call thompson_finalize() - is_initialized = .false. + is_initialized(instance) = .false. end subroutine mp_thompson_finalize diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 1f459bb88..52512c15d 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -274,6 +274,13 @@ type = real kind = kind_phys intent = in +[instance] + standard_name = ccpp_instance + long_name = argument to thompson mp so it knows which instance it is + units = index + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -750,6 +757,13 @@ type = real kind = kind_phys intent = inout +[instance] + standard_name = ccpp_instance + long_name = argument to thompson mp so it knows which instance it is + units = index + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -770,6 +784,13 @@ [ccpp-arg-table] name = mp_thompson_finalize type = scheme +[instance] + standard_name = ccpp_instance + long_name = argument to thompson mp so it knows which instance it is + units = index + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/ozinterp.f90 b/physics/ozinterp.f90 index 5b3149d61..1a648a076 100644 --- a/physics/ozinterp.f90 +++ b/physics/ozinterp.f90 @@ -63,7 +63,12 @@ SUBROUTINE read_o3data (ntoz, me, master) !--- oz_pres - vertical pressure level (mb) !--- oz_time - time coordinate (days) !--- - allocate (oz_lat(latsozp), oz_pres(levozp),oz_time(timeoz+1)) +! NOTE: If there are multiple instances of CCPP physics, only the first instance +! allocates these. All instances must use the same number of identical ozone values +! jm 20230228 + if ( .not. allocated(oz_lat) ) allocate(oz_lat(latsozp)) + if ( .not. allocated(oz_pres) ) allocate(oz_pres(levozp)) + if ( .not. allocated(oz_time) ) allocate(oz_time(timeoz+1)) allocate (oz_lat4(latsozp), oz_pres4(levozp),oz_time4(timeoz+1)) rewind (kozpl) read (kozpl) oz_coeff, latsozp, levozp, timeoz, oz_lat4, oz_pres4, oz_time4 @@ -78,7 +83,7 @@ SUBROUTINE read_o3data (ntoz, me, master) !--- assume latitudes is on a uniform gaussian grid !--- allocate (tempin(latsozp)) - allocate (ozplin(latsozp,levozp,oz_coeff,timeoz)) + if ( .not. allocated(ozplin) ) allocate (ozplin(latsozp,levozp,oz_coeff,timeoz)) DO i=1,timeoz DO n=1,oz_coeff DO k=1,levozp From d90e5fe161268d323578e5f40bec17d4a9ea95f0 Mon Sep 17 00:00:00 2001 From: michalakes Date: Wed, 1 Mar 2023 08:45:23 -0800 Subject: [PATCH 2/2] On branch jm-pr-multiple-instances-of-ccpp-physics Bump up dimension of is_initialized array to match other instances and add comment Changes to be committed: modified: physics/mp_thompson.F90 --- physics/mp_thompson.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 6354c5158..74d969e4a 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -20,7 +20,7 @@ module mp_thompson private - logical, dimension(100) :: is_initialized = .False. + logical, dimension(200) :: is_initialized = .False. ! why 200? integer, parameter :: ext_ndiag3d = 37