From c18c6d49c635198cf4bd1b3cddf9c8d4848090d6 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Mon, 30 Jan 2023 13:18:03 -0700 Subject: [PATCH 01/22] CCPP scheme simulator. --- physics/ccpp_scheme_simultator.F90 | 593 ++++++++++++++++++++++++++++ physics/ccpp_scheme_simultator.meta | 266 +++++++++++++ 2 files changed, 859 insertions(+) create mode 100644 physics/ccpp_scheme_simultator.F90 create mode 100644 physics/ccpp_scheme_simultator.meta diff --git a/physics/ccpp_scheme_simultator.F90 b/physics/ccpp_scheme_simultator.F90 new file mode 100644 index 000000000..4d53c8860 --- /dev/null +++ b/physics/ccpp_scheme_simultator.F90 @@ -0,0 +1,593 @@ +! ######################################################################################## +! +! CCPP scheme to replace physics schemes with simulated data tendencies. +! +! ######################################################################################## +module ccpp_scheme_simultator + use machine, only: kind_phys + use netcdf + implicit none + + ! + ! Data driven phsyics tendencies + ! + real(kind_phys), allocatable, dimension(:) :: time_data + real(kind_phys), allocatable, dimension(:,:) :: dTdt_LWRAD_data, dTdt_SWRAD_data, & + dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, dudt_GWD_data, & + dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, dTdt_DCNV_data, & + dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data + real(kind_phys), allocatable, dimension(:,:,:) :: dqdt_PBL_data, dqdt_SCNV_data, & + dqdt_DCNV_data, dqdt_cldMP_data + + ! + ! Logical switches for CCPP scheme simulator(s) + ! + logical :: use_RAD_scheme_sim = .false., & + use_PBL_scheme_sim = .false., & + use_GWD_scheme_sim = .false., & + use_SCNV_scheme_sim = .false., & + use_DCNV_scheme_sim = .false., & + use_cldMP_scheme_sim = .false. + logical :: have_dTdt_LWRAD_data = .false., & + have_dTdt_SWRAD_data = .false., & + have_dTdt_PBL_data = .false., & + have_dqdt_PBL_data = .false., & + have_dudt_PBL_data = .false., & + have_dvdt_PBL_data = .false., & + have_dTdt_GWD_data = .false., & + have_dudt_GWD_data = .false., & + have_dvdt_GWD_data = .false., & + have_dTdt_SCNV_data = .false., & + have_dudt_SCNV_data = .false., & + have_dvdt_SCNV_data = .false., & + have_dqdt_SCNV_data = .false., & + have_dTdt_DCNV_data = .false., & + have_dudt_DCNV_data = .false., & + have_dvdt_DCNV_data = .false., & + have_dqdt_DCNV_data = .false., & + have_dTdt_cldMP_data = .false., & + have_dqdt_cldMP_data = .false. + logical :: do_ccpp_scheme_simulator = .false. + + ! Host-model initial time information + integer :: init_year, init_month, init_day, init_hour, init_min, init_sec + + public ccpp_scheme_simultator_init, ccpp_scheme_simultator_run +contains + + ! ###################################################################################### + ! + ! SUBROUTINE ccpp_scheme_simultator_init + ! + ! ###################################################################################### +!! \section arg_table_ccpp_scheme_simultator_init +!! \htmlinclude ccpp_scheme_simultator_init.html +!! + subroutine ccpp_scheme_simultator_init(me, master, nlunit, nml_file, idat, errmsg, errflg) + + ! Inputs + integer, intent (in) :: me, master, nlunit + character(len=*), intent (in) :: nml_file + integer, intent (in), dimension(8) :: idat + + ! Outputs + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: ncid, dimID, varID, status, nlon, nlat, nlev, ntime, ios + character(len=256) :: fileIN + logical :: exists + integer,parameter :: nTrc = 1 ! Only specific humodty for now, but preserve 3 dimensionality + + ! Namelist + namelist / scm_data_nml / & + fileIN, use_RAD_scheme_sim, use_PBL_scheme_sim, use_GWD_scheme_sim, use_SCNV_scheme_sim, & + use_DCNV_scheme_sim, use_cldMP_scheme_sim + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Store model initialization time. + init_year = idat(1) + init_month = idat(2) + init_day = idat(3) + init_hour = idat(5) + init_min = idat(6) + init_sec = idat(7) + + ! Read in namelist + inquire (file = trim (nml_file), exist = exists) + if (.not. exists) then + errmsg = 'SCM data tendency :: namelist file: '//trim(nml_file)//' does not exist' + errflg = 1 + return + else + open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) + endif + rewind (nlunit) + read (nlunit, nml = scm_data_nml) + close (nlunit) + + ! Only proceed if scheme simulator requested. + if (use_RAD_scheme_sim .or. use_PBL_scheme_sim .or. use_GWD_scheme_sim .or. & + use_SCNV_scheme_sim .or. use_DCNV_scheme_sim .or. use_cldMP_scheme_sim) then + do_ccpp_scheme_simulator = .true. + else + return + endif + + ! Check that input data file exists + inquire (file = trim (fileIN), exist = exists) + if (.not. exists) then + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not exist' + errflg = 1 + return + endif + + ! Open file (required) + status = nf90_open(trim(fileIN), NF90_NOWRITE, ncid) + if (status /= nf90_noerr) then + errmsg = 'Error reading in SCM data tendency file: '//trim(fileIN) + errflg = 1 + return + endif + + ! Get dimensions (required) + status = nf90_inq_dimid(ncid, 'time', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = ntime) + else + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain time dimension' + errflg = 1 + return + endif + ! + status = nf90_inq_dimid(ncid, 'lev', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = nlev) + else + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain lev dimension' + errflg = 1 + return + endif + + ! Temporal info (required) + status = nf90_inq_varid(ncid, 'times', varID) + if (status == nf90_noerr) then + allocate(time_data(ntime)) + status = nf90_get_var( ncid, varID, time_data) + else + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain times variable' + errflg = 1 + return + endif + + ! Read in physics data tendencies (optional) + status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) + if (status == nf90_noerr) then + allocate(dTdt_LWRAD_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) + have_dTdt_LWRAD_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) + if (status == nf90_noerr) then + allocate(dTdt_SWRAD_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) + have_dTdt_SWRAD_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) + if (status == nf90_noerr) then + allocate(dTdt_PBL_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dTdt_PBL_data) + have_dTdt_PBL_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) + if (status == nf90_noerr) then + allocate(dqdt_PBL_data(nlev, ntime, nTrc)) + status = nf90_get_var( ncid, varID, dqdt_PBL_data) + have_dqdt_PBL_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) + if (status == nf90_noerr) then + allocate(dudt_PBL_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dudt_PBL_data) + have_dudt_PBL_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) + if (status == nf90_noerr) then + allocate(dvdt_PBL_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dvdt_PBL_data) + have_dvdt_PBL_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) + if (status == nf90_noerr) then + allocate(dTdt_GWD_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dTdt_GWD_data) + have_dTdt_GWD_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) + if (status == nf90_noerr) then + allocate(dudt_GWD_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dudt_GWD_data) + have_dudt_GWD_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) + if (status == nf90_noerr) then + allocate(dvdt_GWD_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dvdt_GWD_data) + have_dvdt_GWD_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) + if (status == nf90_noerr) then + allocate(dTdt_SCNV_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dTdt_SCNV_data) + have_dTdt_SCNV_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) + if (status == nf90_noerr) then + allocate(dudt_SCNV_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dudt_SCNV_data) + have_dudt_SCNV_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) + if (status == nf90_noerr) then + allocate(dvdt_SCNV_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dvdt_SCNV_data) + have_dvdt_SCNV_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) + if (status == nf90_noerr) then + allocate(dqdt_SCNV_data(nlev, ntime, nTrc)) + status = nf90_get_var( ncid, varID, dqdt_SCNV_data) + have_dqdt_SCNV_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) + if (status == nf90_noerr) then + allocate(dTdt_DCNV_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dTdt_DCNV_data) + have_dTdt_DCNV_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) + if (status == nf90_noerr) then + allocate(dudt_DCNV_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dudt_DCNV_data) + have_dudt_DCNV_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) + if (status == nf90_noerr) then + allocate(dvdt_DCNV_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dvdt_DCNV_data) + have_dvdt_DCNV_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) + if (status == nf90_noerr) then + allocate(dqdt_DCNV_data(nlev, ntime, nTrc)) + status = nf90_get_var( ncid, varID, dqdt_DCNV_data) + have_dqdt_DCNV_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) + if (status == nf90_noerr) then + allocate(dTdt_cldMP_data(nlev, ntime)) + status = nf90_get_var( ncid, varID, dTdt_cldMP_data) + have_dTdt_cldMP_data = .true. + endif + ! + status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) + if (status == nf90_noerr) then + allocate(dqdt_cldMP_data(nlev, ntime, nTrc)) + status = nf90_get_var( ncid, varID, dqdt_cldMP_data) + have_dqdt_cldMP_data = .true. + endif + + ! + if (me == 0) then + print*, "--- Using SCM data tendencies ---" + print*, "---------------------------------" + print*, " " + print*, "use_RAD_scheme_sim: ", use_RAD_scheme_sim + print*, " dTdt_LWRAD_data: ", have_dTdt_LWRAD_data + print*, " dTdt_SWRAD_data: ", have_dTdt_SWRAD_data + print*, "use_PBL_scheme_sim: ", use_PBL_scheme_sim + print*, " dTdt_PBL_data: ", have_dTdt_PBL_data + print*, " dqdt_PBL_data: ", have_dqdt_PBL_data + print*, " dudt_PBL_data: ", have_dudt_PBL_data + print*, " dvdt_PBL_data: ", have_dvdt_PBL_data + print*, "use_GWD_scheme_sim: ", use_GWD_scheme_sim + print*, " dTdt_gwd_data: ", have_dTdt_GWD_data + print*, " dudt_gwd_data: ", have_dudt_GWD_data + print*, " dvdt_gwd_data: ", have_dvdt_GWD_data + print*, "use_SCNV_scheme_sim: ", use_SCNV_scheme_sim + print*, " dTdt_SCNV_data: ", have_dTdt_SCNV_data + print*, " dudt_SCNV_data: ", have_dudt_SCNV_data + print*, " dvdt_SCNV_data: ", have_dvdt_SCNV_data + print*, " dqdt_SCNV_data: ", have_dqdt_SCNV_data + print*, "use_DCNV_scheme_sim: ", use_DCNV_scheme_sim + print*, " dTdt_DCNV_data: ", have_dTdt_DCNV_data + print*, " dudt_DCNV_data: ", have_dudt_DCNV_data + print*, " dvdt_DCNV_data: ", have_dvdt_DCNV_data + print*, " dqdt_DCNV_data: ", have_dqdt_DCNV_data + print*, "use_cldMP_scheme_sim: ", use_cldMP_scheme_sim + print*, " dTdt_cldMP_data: ", have_dTdt_cldMP_data + print*, " dqdt_cldMP_data: ", have_dqdt_cldMP_data + print*, "---------------------------------" + endif + + end subroutine ccpp_scheme_simultator_init + + ! ###################################################################################### + ! + ! SUBROUTINE ccpp_scheme_simultator_run + ! + ! ###################################################################################### +!! \section arg_table_ccpp_scheme_simultator_run +!! \htmlinclude ccpp_scheme_simultator_run.html +!! + subroutine ccpp_scheme_simultator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dtidx, & + dtend, index_of_process_dcnv, index_of_process_longwave, & + index_of_process_shortwave, index_of_process_scnv, & + index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & + index_of_temperature, index_of_x_wind, index_of_y_wind, ntqv, gt0, gu0, gv0, gq0, & + errmsg, errflg) + + ! Inputs + integer, intent(in ) :: kdt + integer, intent (in), dimension(8) :: jdat + real(kind_phys), intent(in ) :: dtp, solhr + real(kind_phys), intent(in ), dimension(:,:) :: tgrs, ugrs, vgrs + real(kind=kind_phys), dimension(:,:,:), intent(in) :: qgrs, dtend + integer, intent(in) :: dtidx(:,:), index_of_process_dcnv, index_of_process_longwave, & + index_of_process_shortwave, index_of_process_scnv, & + index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & + index_of_temperature, index_of_x_wind, index_of_y_wind, ntqv + + ! Outputs + real(kind_phys), intent(inout), dimension(:,:) :: gt0, gu0, gv0 + real(kind_phys), intent(inout), dimension(:,:,:) :: gq0 + character(len=*),intent(out ) :: errmsg + integer, intent(out ) :: errflg + + ! Locals + integer :: iCol, iLay, iTrc, nCol, nLay, nTrc, ti(1), tf(1), idtend, fcst_year, & + fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec + real(kind_phys) :: w1, w2,hrofday + real(kind_phys), dimension(:,:), allocatable :: gt1, gu1, gv1 + real(kind_phys), dimension(:,:,:), allocatable :: gq1 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. do_ccpp_scheme_simulator) return + + ! Current forecast time + fcst_year = jdat(1) + fcst_month = jdat(2) + fcst_day = jdat(3) + fcst_hour = jdat(5) + fcst_min = jdat(6) + fcst_sec = jdat(7) + + ! Dimensions + nCol = size(gq0(:,1,1)) + nLay = size(gq0(1,:,1)) + nTrc = size(gq0(1,1,:)) + + ! Allocate temporaries + allocate(gt1(nCol,nLay), gu1(nCol,nLay), gv1(nCol,nLay), gq1(nCol,nLay,1)) ! *only specific humidity to start (ntrc=1). + + ! Determine temporal interpolation weights for data-tendecies. + ! DJS: The data tendencies have a temporal dimension, to capture the diurnal cycle, + ! which is needed for reasonable solar forcing. + hrofday = fcst_hour*3600. + fcst_min*60. + fcst_sec + ti = findloc(abs(time_data-hrofday),minval(abs(time_data-hrofday))) + if (hrofday - time_data(ti(1)) .le. 0) ti = ti-1 + tf = ti + 1 + w1 = (time_data(tf(1))-hrofday) / (time_data(tf(1)) - time_data(ti(1))) + w2 = 1 - w1 + + do iCol = 1,nCol + ! Set state + gt1(iCol,:) = tgrs(iCol,:) + gu1(iCol,:) = ugrs(iCol,:) + gv1(iCol,:) = vgrs(iCol,:) + gq1(iCol,:,1) = qgrs(iCol,:,1) + + ! ############################################################################### + ! Radiation + ! ############################################################################### + if (use_RAD_scheme_sim) then + if (have_dTdt_LWRAD_data) then + gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_LWRAD_data(:,ti(1)) + w2*dTdt_LWRAD_data(:,tf(1))) * dtp + endif + if (have_dTdt_SWRAD_data) then + gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_SWRAD_data(:,ti(1)) + w2*dTdt_SWRAD_data(:,tf(1))) * dtp + endif + else + idtend = dtidx(index_of_temperature,index_of_process_longwave) + if (idtend >= 1) then + gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(index_of_temperature,index_of_process_shortwave) + if (idtend >=1) then + gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + endif + + ! ############################################################################### + ! PBL + ! ############################################################################### + if (use_PBL_scheme_sim) then + if (have_dTdt_PBL_data) then + gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_PBL_data(:,ti(1)) + w2*(dTdt_PBL_data(:,tf(1)))) * dtp + endif + if (have_dudt_PBL_data) then + gu1(iCol,:) = gu1(iCol,:) + (w1*dudt_PBL_data(:,ti(1)) + w2*(dudt_PBL_data(:,tf(1)))) * dtp + endif + if (have_dvdt_PBL_data) then + gv1(iCol,:) = gv1(iCol,:) + (w1*dvdt_PBL_data(:,ti(1)) + w2*(dvdt_PBL_data(:,tf(1)))) * dtp + endif + if (have_dqdt_PBL_data) then + gq1(iCol,:,1) = gq1(iCol,:,1) + (w1*dqdt_PBL_data(:,ti(1),1) + w2*(dqdt_PBL_data(:,tf(1),1))) * dtp + endif + else + idtend = dtidx(index_of_temperature,index_of_process_pbl) + if (idtend >= 1) then + gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(index_of_x_wind,index_of_process_pbl) + if (idtend >= 1) then + gu1(iCol,:) = gu1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(index_of_y_wind,index_of_process_pbl) + if (idtend >= 1) then + gv1(iCol,:) = gv1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(100+ntqv, index_of_process_pbl) + if (idtend >= 1) then + gq1(iCol,:,1) = gq1(iCol,:,1) + dtend(iCol,:,idtend)! * dtp + endif + endif + + ! ############################################################################### + ! Gravity wave drag + ! ############################################################################### + if (use_GWD_scheme_sim) then + if (have_dTdt_GWD_data) then + gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_GWD_data(:,ti(1)) + w2*(dTdt_GWD_data(:,tf(1)))) * dtp + endif + if (have_dudt_GWD_data) then + gu1(iCol,:) = gu1(iCol,:) + (w1*dudt_GWD_data(:,ti(1)) + w2*(dudt_GWD_data(:,tf(1)))) * dtp + endif + if (have_dvdt_GWD_data) then + gv1(iCol,:) = gv1(iCol,:) + (w1*dvdt_GWD_data(:,ti(1)) + w2*(dvdt_GWD_data(:,tf(1)))) * dtp + endif + else + idtend = dtidx(index_of_temperature,index_of_process_orographic_gwd) + if (idtend >= 1) then + gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd) + if (idtend >= 1) then + gu1(iCol,:) = gu1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(index_of_y_wind,index_of_process_orographic_gwd) + if (idtend >= 1) then + gv1(iCol,:) = gv1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + endif + + ! ############################################################################### + ! Shallow convection + ! ############################################################################### + if (use_SCNV_scheme_sim) then + if (have_dTdt_SCNV_data) then + gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_SCNV_data(:,ti(1)) + w2*(dTdt_SCNV_data(:,tf(1)))) * dtp + endif + if (have_dudt_SCNV_data) then + gu1(iCol,:) = gu1(iCol,:) + (w1*dudt_SCNV_data(:,ti(1)) + w2*(dudt_SCNV_data(:,tf(1)))) * dtp + endif + if (have_dvdt_SCNV_data) then + gv1(iCol,:) = gv1(iCol,:) + (w1*dvdt_SCNV_data(:,ti(1)) + w2*(dvdt_SCNV_data(:,tf(1)))) * dtp + endif + if (have_dqdt_SCNV_data) then + gq1(iCol,:,1) = gq1(iCol,:,1) + (w1*dqdt_SCNV_data(:,ti(1),1) + w2*(dqdt_SCNV_data(:,tf(1),1))) * dtp + endif + else + idtend = dtidx(index_of_temperature,index_of_process_scnv) + if (idtend >= 1) then + gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(index_of_x_wind,index_of_process_scnv) + if (idtend >= 1) then + gu1(iCol,:) = gu1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(index_of_y_wind,index_of_process_scnv) + if (idtend >= 1) then + gv1(iCol,:) = gv1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(100+ntqv,index_of_process_scnv) + if (idtend >= 1) then + gq1(iCol,:,1) = gq1(iCol,:,1) + dtend(iCol,:,idtend)! * dtp + endif + endif + + ! ############################################################################### + ! Deep convection + ! ############################################################################### + if (use_DCNV_scheme_sim) then + if (have_dTdt_DCNV_data) then + gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_DCNV_data(:,ti(1)) + w2*(dTdt_DCNV_data(:,tf(1)) )) * dtp + endif + if (have_dudt_DCNV_data) then + gu1(iCol,:) = gu1(iCol,:) + (w1*dudt_DCNV_data(:,ti(1)) + w2*(dudt_DCNV_data(:,tf(1)))) * dtp + endif + if (have_dvdt_DCNV_data) then + gv1(iCol,:) = gv1(iCol,:) + (w1*dvdt_DCNV_data(:,ti(1)) + w2*(dvdt_DCNV_data(:,tf(1)) )) * dtp + endif + if (have_dqdt_DCNV_data) then + gq1(iCol,:,1) = gq1(iCol,:,1) + (w1*dqdt_DCNV_data(:,ti(1),1) + w2*(dqdt_DCNV_data(:,tf(1),1))) * dtp + endif + else + idtend = dtidx(index_of_temperature,index_of_process_dcnv) + if (idtend >= 1) then + gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(index_of_x_wind,index_of_process_dcnv) + if (idtend >= 1) then + gu1(iCol,:) = gu1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(index_of_y_wind,index_of_process_dcnv) + if (idtend >= 1) then + gv1(iCol,:) = gv1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(100+ntqv,index_of_process_dcnv) + if (idtend >= 1) then + gq1(iCol,:,1) = gq1(iCol,:,1) + dtend(iCol,:,idtend)! * dtp + endif + endif + + ! ############################################################################### + ! Cloud microphysics + ! ############################################################################### + if (use_cldMP_scheme_sim) then + if (have_dTdt_cldMP_data) then + gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_cldMP_data(:,ti(1)) + w2*(dTdt_cldMP_data(:,tf(1)))) * dtp + endif + if (have_dqdt_cldMP_data) then + gq1(iCol,:,1) = gq1(iCol,:,1) + (w1*dqdt_cldMP_data(:,ti(1),1) + w2*(dqdt_cldMP_data(:,tf(1),1))) * dtp + endif + else + idtend = dtidx(index_of_temperature,index_of_process_mp) + if (idtend >= 1) then + gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp + endif + idtend = dtidx(100+ntqv,index_of_process_mp) + if (idtend >= 1) then + gq1(iCol,:,1) = gq1(iCol,:,1) + dtend(iCol,:,idtend)! * dtp + endif + endif + + enddo ! columns + ! + end subroutine ccpp_scheme_simultator_run + +end module ccpp_scheme_simultator diff --git a/physics/ccpp_scheme_simultator.meta b/physics/ccpp_scheme_simultator.meta new file mode 100644 index 000000000..e60248721 --- /dev/null +++ b/physics/ccpp_scheme_simultator.meta @@ -0,0 +1,266 @@ +[ccpp-table-properties] + name = ccpp_scheme_simultator + type = scheme + dependencies = machine.F + +######################################################################## +[ccpp-arg-table] + name = ccpp_scheme_simultator_init + type = scheme +[me] + standard_name = mpi_rank + long_name = MPI rank of current process + units = index + dimensions = () + type = integer + intent = in +[master] + standard_name = mpi_root + long_name = MPI rank of master process + units = index + dimensions = () + type = integer + intent = in +[nlunit] + standard_name = iounit_of_namelist + long_name = fortran unit number for opening nameliust file + units = none + dimensions = () + type = integer + intent = in +[nml_file] + standard_name = filename_of_namelist + long_name = namelist filename + units = none + dimensions = () + type = character + kind = len=* + intent = in +[idat] + standard_name = date_and_time_at_model_initialization_in_iso_order + long_name = initialization date and time + units = none + dimensions = (8) + type = integer + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-arg-table] + name = ccpp_scheme_simultator_run + type = scheme +[solhr] + standard_name = forecast_utc_hour + long_name = time in hours after 00z at the current timestep + units = h + dimensions = () + type = real + kind = kind_phys + intent = in +[kdt] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[jdat] + standard_name = date_and_time_of_forecast_in_united_states_order + long_name = current forecast date and time + units = none + dimensions = (8) + type = integer + intent = in +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ugrs] + standard_name = x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[vgrs] + standard_name = y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[qgrs] + standard_name = tracer_concentration + long_name = model layer mean tracer concentration + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = mixed + dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) + type = real + kind = kind_phys + intent = in +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in +[index_of_process_dcnv] + standard_name = index_of_deep_convection_process_process_in_cumulative_change_index + long_name = index of deep convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_longwave] + standard_name = index_of_longwave_heating_process_in_cumulative_change_index + long_name = index of longwave heating process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_shortwave] + standard_name = index_of_shortwave_heating_process_in_cumulative_change_index + long_name = index of shortwave heating process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_orographic_gwd] + standard_name = index_of_orographic_gravity_wave_drag_process_in_cumulative_change_index + long_name = index of orographic gravity wave drag process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_scnv] + standard_name = index_of_shallow_convection_process_process_in_cumulative_change_index + long_name = index of shallow convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_pbl] + standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index + long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_mp] + standard_name = index_of_microphysics_process_process_in_cumulative_change_index + long_name = index of microphysics transport process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[ntqv] + standard_name = index_of_specific_humidity_in_tracer_concentration_array + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in +[gt0] + standard_name = air_temperature_of_new_state + long_name = temperature updated by physics + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gu0] + standard_name = x_wind_of_new_state + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gv0] + standard_name = y_wind_of_new_state + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gq0] + standard_name = tracer_concentration_of_new_state + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out \ No newline at end of file From f9abb735c0741eff2b79420f49082a5300fe46c9 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Mon, 30 Jan 2023 13:26:48 -0700 Subject: [PATCH 02/22] Fix file rename typo --- ...multator.F90 => ccpp_scheme_simulator.F90} | 26 +++++++++---------- ...ltator.meta => ccpp_scheme_simulator.meta} | 6 ++--- 2 files changed, 16 insertions(+), 16 deletions(-) rename physics/{ccpp_scheme_simultator.F90 => ccpp_scheme_simulator.F90} (96%) rename physics/{ccpp_scheme_simultator.meta => ccpp_scheme_simulator.meta} (98%) diff --git a/physics/ccpp_scheme_simultator.F90 b/physics/ccpp_scheme_simulator.F90 similarity index 96% rename from physics/ccpp_scheme_simultator.F90 rename to physics/ccpp_scheme_simulator.F90 index 4d53c8860..2954e3759 100644 --- a/physics/ccpp_scheme_simultator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -3,7 +3,7 @@ ! CCPP scheme to replace physics schemes with simulated data tendencies. ! ! ######################################################################################## -module ccpp_scheme_simultator +module ccpp_scheme_ccpp_scheme_simulator use machine, only: kind_phys use netcdf implicit none @@ -52,18 +52,18 @@ module ccpp_scheme_simultator ! Host-model initial time information integer :: init_year, init_month, init_day, init_hour, init_min, init_sec - public ccpp_scheme_simultator_init, ccpp_scheme_simultator_run + public ccpp_scheme_ccpp_scheme_simulator_init, ccpp_scheme_ccpp_scheme_simulator_run contains ! ###################################################################################### ! - ! SUBROUTINE ccpp_scheme_simultator_init + ! SUBROUTINE ccpp_scheme_ccpp_scheme_simulator_init ! ! ###################################################################################### -!! \section arg_table_ccpp_scheme_simultator_init -!! \htmlinclude ccpp_scheme_simultator_init.html +!! \section arg_table_ccpp_scheme_ccpp_scheme_simulator_init +!! \htmlinclude ccpp_scheme_ccpp_scheme_simulator_init.html !! - subroutine ccpp_scheme_simultator_init(me, master, nlunit, nml_file, idat, errmsg, errflg) + subroutine ccpp_scheme_ccpp_scheme_simulator_init(me, master, nlunit, nml_file, idat, errmsg, errflg) ! Inputs integer, intent (in) :: me, master, nlunit @@ -331,17 +331,17 @@ subroutine ccpp_scheme_simultator_init(me, master, nlunit, nml_file, idat, errms print*, "---------------------------------" endif - end subroutine ccpp_scheme_simultator_init + end subroutine ccpp_scheme_ccpp_scheme_simulator_init ! ###################################################################################### ! - ! SUBROUTINE ccpp_scheme_simultator_run + ! SUBROUTINE ccpp_scheme_ccpp_scheme_simulator_run ! ! ###################################################################################### -!! \section arg_table_ccpp_scheme_simultator_run -!! \htmlinclude ccpp_scheme_simultator_run.html +!! \section arg_table_ccpp_scheme_ccpp_scheme_simulator_run +!! \htmlinclude ccpp_scheme_ccpp_scheme_simulator_run.html !! - subroutine ccpp_scheme_simultator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dtidx, & + subroutine ccpp_scheme_ccpp_scheme_simulator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dtidx, & dtend, index_of_process_dcnv, index_of_process_longwave, & index_of_process_shortwave, index_of_process_scnv, & index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & @@ -588,6 +588,6 @@ subroutine ccpp_scheme_simultator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, q enddo ! columns ! - end subroutine ccpp_scheme_simultator_run + end subroutine ccpp_scheme_ccpp_scheme_simulator_run -end module ccpp_scheme_simultator +end module ccpp_scheme_ccpp_scheme_simulator diff --git a/physics/ccpp_scheme_simultator.meta b/physics/ccpp_scheme_simulator.meta similarity index 98% rename from physics/ccpp_scheme_simultator.meta rename to physics/ccpp_scheme_simulator.meta index e60248721..cad1bd7ed 100644 --- a/physics/ccpp_scheme_simultator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -1,11 +1,11 @@ [ccpp-table-properties] - name = ccpp_scheme_simultator + name = ccpp_scheme_ccpp_scheme_simulator type = scheme dependencies = machine.F ######################################################################## [ccpp-arg-table] - name = ccpp_scheme_simultator_init + name = ccpp_scheme_ccpp_scheme_simulator_init type = scheme [me] standard_name = mpi_rank @@ -61,7 +61,7 @@ ######################################################################## [ccpp-arg-table] - name = ccpp_scheme_simultator_run + name = ccpp_scheme_ccpp_scheme_simulator_run type = scheme [solhr] standard_name = forecast_utc_hour From ef0d369f607aa78908ac1a3687236ee7468f0fc6 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Tue, 31 Jan 2023 15:02:09 -0700 Subject: [PATCH 03/22] Added MPI commands to ccpp_scheme_simulator --- physics/ccpp_scheme_simulator.F90 | 534 ++++++++++++++++++++--------- physics/ccpp_scheme_simulator.meta | 17 +- 2 files changed, 382 insertions(+), 169 deletions(-) diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index 2954e3759..8289db769 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -3,9 +3,13 @@ ! CCPP scheme to replace physics schemes with simulated data tendencies. ! ! ######################################################################################## -module ccpp_scheme_ccpp_scheme_simulator +module ccpp_scheme_simulator use machine, only: kind_phys use netcdf +#ifdef MPI + use mpi +#endif + implicit none ! @@ -52,21 +56,21 @@ module ccpp_scheme_ccpp_scheme_simulator ! Host-model initial time information integer :: init_year, init_month, init_day, init_hour, init_min, init_sec - public ccpp_scheme_ccpp_scheme_simulator_init, ccpp_scheme_ccpp_scheme_simulator_run + public ccpp_scheme_simulator_init, ccpp_scheme_simulator_run contains ! ###################################################################################### ! - ! SUBROUTINE ccpp_scheme_ccpp_scheme_simulator_init + ! SUBROUTINE ccpp_scheme_simulator_init ! ! ###################################################################################### -!! \section arg_table_ccpp_scheme_ccpp_scheme_simulator_init -!! \htmlinclude ccpp_scheme_ccpp_scheme_simulator_init.html +!! \section arg_table_ccpp_scheme_simulator_init +!! \htmlinclude ccpp_scheme_simulator_init.html !! - subroutine ccpp_scheme_ccpp_scheme_simulator_init(me, master, nlunit, nml_file, idat, errmsg, errflg) + subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_file, idat, errmsg, errflg) ! Inputs - integer, intent (in) :: me, master, nlunit + integer, intent (in) :: mpirank, mpiroot, mpicomm, nlunit character(len=*), intent (in) :: nml_file integer, intent (in), dimension(8) :: idat @@ -75,7 +79,7 @@ subroutine ccpp_scheme_ccpp_scheme_simulator_init(me, master, nlunit, nml_file, integer, intent(out) :: errflg ! Local variables - integer :: ncid, dimID, varID, status, nlon, nlat, nlev, ntime, ios + integer :: ncid, dimID, varID, status, nlon, nlat, nlev_data, ntime_data, ios character(len=256) :: fileIN logical :: exists integer,parameter :: nTrc = 1 ! Only specific humodty for now, but preserve 3 dimensionality @@ -97,7 +101,11 @@ subroutine ccpp_scheme_ccpp_scheme_simulator_init(me, master, nlunit, nml_file, init_min = idat(6) init_sec = idat(7) + ! ###################################################################################### + ! ! Read in namelist + ! + ! ###################################################################################### inquire (file = trim (nml_file), exist = exists) if (.not. exists) then errmsg = 'SCM data tendency :: namelist file: '//trim(nml_file)//' does not exist' @@ -110,6 +118,12 @@ subroutine ccpp_scheme_ccpp_scheme_simulator_init(me, master, nlunit, nml_file, read (nlunit, nml = scm_data_nml) close (nlunit) + + ! ###################################################################################### + ! + ! Error checking + ! + ! ###################################################################################### ! Only proceed if scheme simulator requested. if (use_RAD_scheme_sim .or. use_PBL_scheme_sim .or. use_GWD_scheme_sim .or. & use_SCNV_scheme_sim .or. use_DCNV_scheme_sim .or. use_cldMP_scheme_sim) then @@ -126,180 +140,372 @@ subroutine ccpp_scheme_ccpp_scheme_simulator_init(me, master, nlunit, nml_file, return endif - ! Open file (required) - status = nf90_open(trim(fileIN), NF90_NOWRITE, ncid) - if (status /= nf90_noerr) then - errmsg = 'Error reading in SCM data tendency file: '//trim(fileIN) - errflg = 1 - return - endif + ! ####################################################################################### + ! + ! Read mandatory information from data file... + ! (ONLY master processor(0), if MPI enabled) + ! + ! ####################################################################################### +#ifdef MPI + if (mpirank .eq. mpiroot) then +#endif + + ! Open file (required) + status = nf90_open(trim(fileIN), NF90_NOWRITE, ncid) + if (status /= nf90_noerr) then + errmsg = 'Error reading in SCM data tendency file: '//trim(fileIN) + errflg = 1 + return + endif + + ! Get dimensions (required) + status = nf90_inq_dimid(ncid, 'time', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) + else + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain [time] dimension' + errflg = 1 + return + endif + ! + status = nf90_inq_dimid(ncid, 'lev', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) + else + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain [lev] dimension' + errflg = 1 + return + endif +#ifdef MPI + endif ! On master processor - ! Get dimensions (required) - status = nf90_inq_dimid(ncid, 'time', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = ntime) - else - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain time dimension' - errflg = 1 - return - endif + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + + ! ####################################################################################### ! - status = nf90_inq_dimid(ncid, 'lev', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = nlev) - else - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain lev dimension' - errflg = 1 - return - endif + ! Broadcast dimensions... + ! (ALL processors) + ! + ! ####################################################################################### + call mpi_bcast(ntime_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nlev_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_barrier(mpicomm, mpierr) + + if (mpirank .eq. mpiroot) then +#endif + + ! #################################################################################### + ! + ! What data fields do we have? + ! + ! #################################################################################### + + ! Temporal info (required) + status = nf90_inq_varid(ncid, 'times', varID) + if (status /= nf90_noerr) then + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain times variable' + errflg = 1 + return + endif - ! Temporal info (required) - status = nf90_inq_varid(ncid, 'times', varID) - if (status == nf90_noerr) then - allocate(time_data(ntime)) - status = nf90_get_var( ncid, varID, time_data) - else - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain times variable' - errflg = 1 - return - endif + ! Physics tendencies + status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) + if (status == nf90_noerr) then + have_dTdt_LWRAD_data = .true. + endif + status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) + if (status == nf90_noerr) then + have_dTdt_SWRAD_data = .true. + endif + status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) + if (status == nf90_noerr) then + have_dTdt_PBL_data = .true. + endif + status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) + if (status == nf90_noerr) then + have_dqdt_PBL_data = .true. + endif + status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) + if (status == nf90_noerr) then + have_dudt_PBL_data = .true. + endif + status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) + if (status == nf90_noerr) then + have_dvdt_PBL_data = .true. + endif + status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) + if (status == nf90_noerr) then + have_dTdt_GWD_data = .true. + endif + status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) + if (status == nf90_noerr) then + have_dudt_GWD_data = .true. + endif + status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) + if (status == nf90_noerr) then + have_dvdt_GWD_data = .true. + endif + status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) + if (status == nf90_noerr) then + have_dTdt_SCNV_data = .true. + endif + status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) + if (status == nf90_noerr) then + have_dudt_SCNV_data = .true. + endif + status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) + if (status == nf90_noerr) then + have_dvdt_SCNV_data = .true. + endif + status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) + if (status == nf90_noerr) then + have_dqdt_SCNV_data = .true. + endif + status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) + if (status == nf90_noerr) then + have_dTdt_DCNV_data = .true. + endif + status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) + if (status == nf90_noerr) then + have_dudt_DCNV_data = .true. + endif + status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) + if (status == nf90_noerr) then + have_dvdt_DCNV_data = .true. + endif + status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) + if (status == nf90_noerr) then + have_dqdt_DCNV_data = .true. + endif + status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) + if (status == nf90_noerr) then + have_dTdt_cldMP_data = .true. + endif + status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) + if (status == nf90_noerr) then + have_dqdt_cldMP_data = .true. + endif - ! Read in physics data tendencies (optional) - status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) then - allocate(dTdt_LWRAD_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) - have_dTdt_LWRAD_data = .true. - endif +#ifdef MPI + endif ! Master process +#endif + + ! Allocate space for data + allocate(time_data(ntime_data)) + if (have_dTdt_LWRAD_data) allocate(dTdt_LWRAD_data(nlev_data, ntime_data)) + if (have_dTdt_SWRAD_data) allocate(dTdt_SWRAD_data(nlev_data, ntime_data)) + if (have_dTdt_PBL_data) allocate(dTdt_PBL_data( nlev_data, ntime_data)) + if (have_dqdt_PBL_data) allocate(dqdt_PBL_data( nlev_data, ntime_data, nTrc)) + if (have_dudt_PBL_data) allocate(dudt_PBL_data( nlev_data, ntime_data)) + if (have_dvdt_PBL_data) allocate(dvdt_PBL_data( nlev_data, ntime_data)) + if (have_dTdt_GWD_data) allocate(dTdt_GWD_data( nlev_data, ntime_data)) + if (have_dudt_GWD_data) allocate(dudt_GWD_data( nlev_data, ntime_data)) + if (have_dvdt_GWD_data) allocate(dvdt_GWD_data( nlev_data, ntime_data)) + if (have_dTdt_SCNV_data) allocate(dTdt_SCNV_data( nlev_data, ntime_data)) + if (have_dudt_SCNV_data) allocate(dudt_SCNV_data( nlev_data, ntime_data)) + if (have_dvdt_SCNV_data) allocate(dvdt_SCNV_data( nlev_data, ntime_data)) + if (have_dqdt_SCNV_data) allocate(dqdt_SCNV_data( nlev_data, ntime_data, nTrc)) + if (have_dTdt_DCNV_data) allocate(dTdt_DCNV_data( nlev_data, ntime_data)) + if (have_dudt_DCNV_data) allocate(dudt_DCNV_data( nlev_data, ntime_data)) + if (have_dvdt_DCNV_data) allocate(dvdt_DCNV_data( nlev_data, ntime_data)) + if (have_dqdt_DCNV_data) allocate(dqdt_DCNV_data( nlev_data, ntime_data, nTrc)) + if (have_dTdt_cldMP_data) allocate(dTdt_cldMP_data(nlev_data, ntime_data)) + if (have_dqdt_cldMP_data) allocate(dqdt_cldMP_data(nlev_data, ntime_data, nTrc)) + + ! ####################################################################################### ! - status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) then - allocate(dTdt_SWRAD_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) - have_dTdt_SWRAD_data = .true. - endif + ! Read in data ... + ! (ONLY master processor(0), if MPI enabled) ! - status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) then - allocate(dTdt_PBL_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dTdt_PBL_data) - have_dTdt_PBL_data = .true. - endif + ! ####################################################################################### +#ifdef MPI + if (mpirank .eq. mpiroot) then +#endif + + ! Temporal info (required) + status = nf90_inq_varid(ncid, 'times', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, time_data) + else + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain times variable' + errflg = 1 + return + endif + + ! Read in physics data tendencies (optional) + status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dTdt_PBL_data) + endif + ! + status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dqdt_PBL_data) + endif + ! + status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dudt_PBL_data) + endif + ! + status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dvdt_PBL_data) + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dTdt_GWD_data) + endif + ! + status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dudt_GWD_data) + endif + ! + status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dvdt_GWD_data) + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dTdt_SCNV_data) + endif + ! + status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dudt_SCNV_data) + endif + ! + status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dvdt_SCNV_data) + endif + ! + status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dqdt_SCNV_data) + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dTdt_DCNV_data) + endif + ! + status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dudt_DCNV_data) + endif + ! + status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dvdt_DCNV_data) + endif + ! + status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dqdt_DCNV_data) + endif + ! + status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dTdt_cldMP_data) + endif + ! + status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, dqdt_cldMP_data) + endif + ! + status = nf90_close(ncid) +#ifdef MPI + endif ! Master process + + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + ! ####################################################################################### ! - status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) then - allocate(dqdt_PBL_data(nlev, ntime, nTrc)) - status = nf90_get_var( ncid, varID, dqdt_PBL_data) - have_dqdt_PBL_data = .true. - endif + ! Broadcast data... + ! (ALL processors) ! - status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) then - allocate(dudt_PBL_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dudt_PBL_data) - have_dudt_PBL_data = .true. + ! ####################################################################################### + + if (have_dTdt_LWRAD_data) then + call mpi_bcast(dTdt_LWRAD_data, size(dTdt_LWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) then - allocate(dvdt_PBL_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dvdt_PBL_data) - have_dvdt_PBL_data = .true. + if (have_dTdt_SWRAD_data) then + call mpi_bcast(dTdt_SWRAD_data, size(dTdt_SWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) then - allocate(dTdt_GWD_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dTdt_GWD_data) - have_dTdt_GWD_data = .true. + if (have_dTdt_PBL_data) then + call mpi_bcast(dTdt_PBL_data, size(dTdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) then - allocate(dudt_GWD_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dudt_GWD_data) - have_dudt_GWD_data = .true. + if (have_dqdt_PBL_data) then + call mpi_bcast(dqdt_PBL_data, size(dqdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) then - allocate(dvdt_GWD_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dvdt_GWD_data) - have_dvdt_GWD_data = .true. + if (have_dudt_PBL_data) then + call mpi_bcast(dudt_PBL_data, size(dudt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) then - allocate(dTdt_SCNV_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dTdt_SCNV_data) - have_dTdt_SCNV_data = .true. + if (have_dvdt_PBL_data) then + call mpi_bcast(dvdt_PBL_data, size(dvdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) then - allocate(dudt_SCNV_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dudt_SCNV_data) - have_dudt_SCNV_data = .true. + if (have_dTdt_GWD_data) then + call mpi_bcast(dTdt_GWD_data, size(dTdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) then - allocate(dvdt_SCNV_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dvdt_SCNV_data) - have_dvdt_SCNV_data = .true. + if (have_dudt_GWD_data) then + call mpi_bcast(dudt_GWD_data, size(dudt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) then - allocate(dqdt_SCNV_data(nlev, ntime, nTrc)) - status = nf90_get_var( ncid, varID, dqdt_SCNV_data) - have_dqdt_SCNV_data = .true. + if (have_dvdt_GWD_data) then + call mpi_bcast(dvdt_GWD_data, size(dvdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) then - allocate(dTdt_DCNV_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dTdt_DCNV_data) - have_dTdt_DCNV_data = .true. + if (have_dTdt_SCNV_data) then + call mpi_bcast(dTdt_SCNV_data, size(dTdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) then - allocate(dudt_DCNV_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dudt_DCNV_data) - have_dudt_DCNV_data = .true. + if (have_dudt_SCNV_data) then + call mpi_bcast(dudt_SCNV_data, size(dudt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) then - allocate(dvdt_DCNV_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dvdt_DCNV_data) - have_dvdt_DCNV_data = .true. + if (have_dvdt_SCNV_data) then + call mpi_bcast(dvdt_SCNV_data, size(dvdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) then - allocate(dqdt_DCNV_data(nlev, ntime, nTrc)) - status = nf90_get_var( ncid, varID, dqdt_DCNV_data) - have_dqdt_DCNV_data = .true. + if (have_dqdt_SCNV_data) then + call mpi_bcast(dqdt_SCNV_data, size(dqdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) then - allocate(dTdt_cldMP_data(nlev, ntime)) - status = nf90_get_var( ncid, varID, dTdt_cldMP_data) - have_dTdt_cldMP_data = .true. + if (have_dTdt_DCNV_data) then + call mpi_bcast(dTdt_DCNV_data, size(dTdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! - status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) then - allocate(dqdt_cldMP_data(nlev, ntime, nTrc)) - status = nf90_get_var( ncid, varID, dqdt_cldMP_data) - have_dqdt_cldMP_data = .true. + if (have_dudt_DCNV_data) then + call mpi_bcast(dudt_DCNV_data, size(dudt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dvdt_DCNV_data) then + call mpi_bcast(dvdt_DCNV_data, size(dvdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif + if (have_dqdt_DCNV_data) then + call mpi_bcast(dqdt_DCNV_data, size(dqdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_cldMP_data) then + call mpi_bcast(dTdt_cldMP_data, size(dTdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dqdt_cldMP_data) then + call mpi_bcast(dqdt_cldMP_data, size(dqdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + + ! + call mpi_barrier(mpicomm, mpierr) +#endif ! - if (me == 0) then + if (mpirank .eq. mpiroot) then print*, "--- Using SCM data tendencies ---" print*, "---------------------------------" print*, " " @@ -331,17 +537,17 @@ subroutine ccpp_scheme_ccpp_scheme_simulator_init(me, master, nlunit, nml_file, print*, "---------------------------------" endif - end subroutine ccpp_scheme_ccpp_scheme_simulator_init + end subroutine ccpp_scheme_simulator_init ! ###################################################################################### ! - ! SUBROUTINE ccpp_scheme_ccpp_scheme_simulator_run + ! SUBROUTINE ccpp_scheme_simulator_run ! ! ###################################################################################### -!! \section arg_table_ccpp_scheme_ccpp_scheme_simulator_run -!! \htmlinclude ccpp_scheme_ccpp_scheme_simulator_run.html +!! \section arg_table_ccpp_scheme_simulator_run +!! \htmlinclude ccpp_scheme_simulator_run.html !! - subroutine ccpp_scheme_ccpp_scheme_simulator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dtidx, & + subroutine ccpp_scheme_simulator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dtidx, & dtend, index_of_process_dcnv, index_of_process_longwave, & index_of_process_shortwave, index_of_process_scnv, & index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & @@ -588,6 +794,6 @@ subroutine ccpp_scheme_ccpp_scheme_simulator_run(solhr, kdt, dtp, jdat, tgrs, ug enddo ! columns ! - end subroutine ccpp_scheme_ccpp_scheme_simulator_run + end subroutine ccpp_scheme_simulator_run -end module ccpp_scheme_ccpp_scheme_simulator +end module ccpp_scheme_simulator diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_scheme_simulator.meta index cad1bd7ed..909089bb9 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -1,26 +1,33 @@ [ccpp-table-properties] - name = ccpp_scheme_ccpp_scheme_simulator + name = ccpp_scheme_simulator type = scheme dependencies = machine.F ######################################################################## [ccpp-arg-table] - name = ccpp_scheme_ccpp_scheme_simulator_init + name = ccpp_scheme_simulator_init type = scheme -[me] +[mpirank] standard_name = mpi_rank long_name = MPI rank of current process units = index dimensions = () type = integer intent = in -[master] +[mpiroot] standard_name = mpi_root long_name = MPI rank of master process units = index dimensions = () type = integer intent = in +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in [nlunit] standard_name = iounit_of_namelist long_name = fortran unit number for opening nameliust file @@ -61,7 +68,7 @@ ######################################################################## [ccpp-arg-table] - name = ccpp_scheme_ccpp_scheme_simulator_run + name = ccpp_scheme_simulator_run type = scheme [solhr] standard_name = forecast_utc_hour From fd72b355bc99486bda0aff5d5a1c78f835756938 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Fri, 3 Feb 2023 10:27:05 -0700 Subject: [PATCH 04/22] Work in progress... --- physics/ccpp_scheme_simulator.F90 | 821 +++++++++++++++-------------- physics/ccpp_scheme_simulator.meta | 8 - 2 files changed, 416 insertions(+), 413 deletions(-) diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index 8289db769..258687416 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -2,6 +2,8 @@ ! ! CCPP scheme to replace physics schemes with simulated data tendencies. ! +! Description: +! ! ######################################################################################## module ccpp_scheme_simulator use machine, only: kind_phys @@ -9,50 +11,118 @@ module ccpp_scheme_simulator #ifdef MPI use mpi #endif - implicit none + ! Avaialble physics processes to simulate. + integer,parameter :: & + nPhysProcess = 7 + + ! Type containing physics tendencies for a physics process. + type phys_tend + real(kind_phys), dimension(:,:), pointer :: T + real(kind_phys), dimension(:,:), pointer :: u + real(kind_phys), dimension(:,:), pointer :: v + real(kind_phys), dimension(:,:,:), pointer :: q + end type phys_tend + + ! This type contains the meta information and data for each physics process. + type base_physics_process + character(len=16) :: name + logical :: time_split + logical :: use_sim + integer :: order + type(phys_tend) :: tend + end type base_physics_process + + ! This array contains the governing information on how to advance the physics timestep. + type(base_physics_process),dimension(nPhysProcess) :: & + physics_process + + ! ######################################################################################## + ! + ! Configuration for CCPP scheme simulator. Set in namelist. Used during initialization to + ! populate "physics_processes" type array. + ! + ! ######################################################################################## + + ! Set which schemes to be replaced with simulated tendencies. + logical :: use_LWRAD_scheme_sim = .false., & !< If true, use LongWave RADiation scheme simulator. + !< If false, use tendencies from radiation scheme. + use_SWRAD_scheme_sim = .false., & !< If true, use ShortWave RADiation scheme simulator. + !< If false, use tendencies from radiation scheme. + use_PBL_scheme_sim = .false., & !< If true, use Planetary Boubdary Layer scheme simulator. + !< If false, use tendencies from PBL scheme. + use_GWD_scheme_sim = .false., & !< If true, use Gravity Wave Drag scheme simulator. + !< If false, use tendencies from GWD scheme. + use_SCNV_scheme_sim = .false., & !< If true, use Shallow CoNVection scheme simulator. + !< If false, use tendencies from SCNV scheme. + use_DCNV_scheme_sim = .false., & !< If true, use Deep CoNVection scheme simulator. + !< If false, use tendencies from DCNV scheme. + use_cldMP_scheme_sim = .false. !< If true, use cloud MicroPhysics scheme simulator. + !< If false, use tendencies from cldMP acheme. + + ! Are the processes time-split or process-split? + logical :: time_split_LWRAD = .false., & !< If true, time-split process. Update internal physics state prior to scheme. + !< If false, process-split process. Accumulate tendencies. + time_split_SWRAD = .false., & !< If true, time-split process. Update internal physics state prior to scheme. + !< If false, process-split process. Accumulate tendencies. + time_split_PBL = .false., & !< If true, time-split process. Update internal physics state prior to scheme. + !< If false, process-split process. Accumulate tendencies. + time_split_GWD = .false., & !< If true, time-split process. Update internal physics state prior to scheme. + !< If false, process-split process. Accumulate tendencies. + time_split_SCNV = .true., & !< If true, time-split process. Update internal physics state prior to scheme. + !< If false, process-split process. Accumulate tendencies. + time_split_DCNV = .true., & !< If true, time-split process. Update internal physics state prior to scheme. + !< If false, process-split process. Accumulate tendencies. + time_split_cldMP = .true. !< If true, time-split process. Update internal physics state prior to scheme. + !< If false, process-split process. Accumulate tendencies. + + ! What is physics process ordering? (Important if their are time-split processes in the physics scheme) + integer :: scheme_order_SWRAD = 1, & !< Order of Radiation scheme (shortwave). + scheme_order_LWRAD = 2, & !< Order of Radiation scheme (longwave). + scheme_order_PBL = 3, & !< Order of Planetary Boubdary Layer scheme. + scheme_order_GWD = 4, & !< Order of Gravity Wave Drag scheme. + scheme_order_SCNV = 5, & !< Order of Shallow CoNVection scheme. + scheme_order_DCNV = 6, & !< Order of Deep CoNVection scheme. + scheme_order_cldMP = 7 !< Order of cloud MicroPhysics scheme. ! - ! Data driven phsyics tendencies + ! Locals ! + + ! Activation flag for scheme. + logical :: do_ccpp_scheme_simulator = .false. + + ! Switches for input data + logical :: have_dTdt_LWRAD_data = .false., & !< If true, input file contains LongWave RADiation temperature tendencies. + have_dTdt_SWRAD_data = .false., & !< If true, input file contains ShortWave RADiation temperature tendencies. + have_dTdt_PBL_data = .false., & !< If true, input file contains Planetary Boubdary Layer temperature tendencies. + have_dqdt_PBL_data = .false., & !< If true, input file contains Planetary Boubdary Layer specific-humidity tendencies. + have_dudt_PBL_data = .false., & !< If true, input file contains Planetary Boubdary Layer zonal-wind tendencies. + have_dvdt_PBL_data = .false., & !< If true, input file contains Planetary Boubdary Layer meridional-wind tendencies. + have_dTdt_GWD_data = .false., & !< If true, input file contains Gravity Wave Drag temperature tendencies. + have_dudt_GWD_data = .false., & !< If true, input file contains Gravity Wave Drag zonal-wind tendencies. + have_dvdt_GWD_data = .false., & !< If true, input file contains Gravity Wave Drag meridional-wind tendencies. + have_dTdt_SCNV_data = .false., & !< If true, input file contains Shallow CoNVection temperature tendencies. + have_dudt_SCNV_data = .false., & !< If true, input file contains Shallow CoNVection zonal-wind tendencies. + have_dvdt_SCNV_data = .false., & !< If true, input file contains Shallow CoNVection meridional-wind tendencies. + have_dqdt_SCNV_data = .false., & !< If true, input file contains Shallow CoNVection specific-humidity tendencies. + have_dTdt_DCNV_data = .false., & !< If true, input file contains Deep CoNVection temperature tendencies. + have_dudt_DCNV_data = .false., & !< If true, input file contains Deep CoNVection zonal-wind tendencies. + have_dvdt_DCNV_data = .false., & !< If true, input file contains Deep CoNVection meridional-wind tendencies. + have_dqdt_DCNV_data = .false., & !< If true, input file contains Deep CoNVection specific-humidity tendencies. + have_dTdt_cldMP_data = .false., & !< If true, input file contains cloud MicroPhysics temperature tendencies. + have_dqdt_cldMP_data = .false. !< If true, input file contains cloud MicroPhysics specific-humidity tendencies. + + ! Data driven physics tendencies + integer :: nlev_data, ntime_data real(kind_phys), allocatable, dimension(:) :: time_data - real(kind_phys), allocatable, dimension(:,:) :: dTdt_LWRAD_data, dTdt_SWRAD_data, & + real(kind_phys), allocatable, dimension(:,:),target :: dTdt_LWRAD_data, dTdt_SWRAD_data, & dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, dudt_GWD_data, & dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, dTdt_DCNV_data, & dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data - real(kind_phys), allocatable, dimension(:,:,:) :: dqdt_PBL_data, dqdt_SCNV_data, & + real(kind_phys), allocatable, dimension(:,:,:),target :: dqdt_PBL_data, dqdt_SCNV_data, & dqdt_DCNV_data, dqdt_cldMP_data - ! - ! Logical switches for CCPP scheme simulator(s) - ! - logical :: use_RAD_scheme_sim = .false., & - use_PBL_scheme_sim = .false., & - use_GWD_scheme_sim = .false., & - use_SCNV_scheme_sim = .false., & - use_DCNV_scheme_sim = .false., & - use_cldMP_scheme_sim = .false. - logical :: have_dTdt_LWRAD_data = .false., & - have_dTdt_SWRAD_data = .false., & - have_dTdt_PBL_data = .false., & - have_dqdt_PBL_data = .false., & - have_dudt_PBL_data = .false., & - have_dvdt_PBL_data = .false., & - have_dTdt_GWD_data = .false., & - have_dudt_GWD_data = .false., & - have_dvdt_GWD_data = .false., & - have_dTdt_SCNV_data = .false., & - have_dudt_SCNV_data = .false., & - have_dvdt_SCNV_data = .false., & - have_dqdt_SCNV_data = .false., & - have_dTdt_DCNV_data = .false., & - have_dudt_DCNV_data = .false., & - have_dvdt_DCNV_data = .false., & - have_dqdt_DCNV_data = .false., & - have_dTdt_cldMP_data = .false., & - have_dqdt_cldMP_data = .false. - logical :: do_ccpp_scheme_simulator = .false. - ! Host-model initial time information integer :: init_year, init_month, init_day, init_hour, init_min, init_sec @@ -67,7 +137,8 @@ module ccpp_scheme_simulator !! \section arg_table_ccpp_scheme_simulator_init !! \htmlinclude ccpp_scheme_simulator_init.html !! - subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_file, idat, errmsg, errflg) + subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_file, & + idat, errmsg, errflg) ! Inputs integer, intent (in) :: mpirank, mpiroot, mpicomm, nlunit @@ -79,15 +150,19 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil integer, intent(out) :: errflg ! Local variables - integer :: ncid, dimID, varID, status, nlon, nlat, nlev_data, ntime_data, ios + integer :: ncid, dimID, varID, status, nlon, nlat, ios, iprc character(len=256) :: fileIN logical :: exists integer,parameter :: nTrc = 1 ! Only specific humodty for now, but preserve 3 dimensionality ! Namelist - namelist / scm_data_nml / & - fileIN, use_RAD_scheme_sim, use_PBL_scheme_sim, use_GWD_scheme_sim, use_SCNV_scheme_sim, & - use_DCNV_scheme_sim, use_cldMP_scheme_sim + namelist / scm_data_nml / fileIN, & + use_SWRAD_scheme_sim, use_LWRAD_scheme_sim, use_PBL_scheme_sim, & + use_GWD_scheme_sim, use_SCNV_scheme_sim, use_DCNV_scheme_sim, & + use_cldMP_scheme_sim, scheme_order_SWRAD, scheme_order_LWRAD, scheme_order_PBL, & + scheme_order_GWD, scheme_order_SCNV, scheme_order_DCNV, scheme_order_cldMP, & + time_split_SWRAD, time_split_LWRAD, time_split_PBL, time_split_GWD, & + time_split_SCNV, time_split_DCNV, time_split_cldMP ! Initialize CCPP error handling variables errmsg = '' @@ -118,27 +193,27 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil read (nlunit, nml = scm_data_nml) close (nlunit) - ! ###################################################################################### ! ! Error checking ! ! ###################################################################################### ! Only proceed if scheme simulator requested. - if (use_RAD_scheme_sim .or. use_PBL_scheme_sim .or. use_GWD_scheme_sim .or. & - use_SCNV_scheme_sim .or. use_DCNV_scheme_sim .or. use_cldMP_scheme_sim) then + if (use_SWRAD_scheme_sim .or. use_LWRAD_scheme_sim .or. use_PBL_scheme_sim .or. & + use_GWD_scheme_sim .or. use_SCNV_scheme_sim .or. use_DCNV_scheme_sim .or. & + use_cldMP_scheme_sim) then do_ccpp_scheme_simulator = .true. else return endif - + ! Check that input data file exists inquire (file = trim (fileIN), exist = exists) if (.not. exists) then - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not exist' - errflg = 1 - return - endif + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not exist' + errflg = 1 + return + endif ! ####################################################################################### ! @@ -201,91 +276,63 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil ! ! #################################################################################### - ! Temporal info (required) - status = nf90_inq_varid(ncid, 'times', varID) - if (status /= nf90_noerr) then - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain times variable' - errflg = 1 - return - endif - - ! Physics tendencies + ! status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) then - have_dTdt_LWRAD_data = .true. - endif + if (status == nf90_noerr) have_dTdt_LWRAD_data = .true. + ! status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) then - have_dTdt_SWRAD_data = .true. - endif + if (status == nf90_noerr) have_dTdt_SWRAD_data = .true. + ! status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) then - have_dTdt_PBL_data = .true. - endif + if (status == nf90_noerr) have_dTdt_PBL_data = .true. + ! status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) then - have_dqdt_PBL_data = .true. - endif + if (status == nf90_noerr) have_dqdt_PBL_data = .true. + ! status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) then - have_dudt_PBL_data = .true. - endif + if (status == nf90_noerr) have_dudt_PBL_data = .true. + ! status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) then - have_dvdt_PBL_data = .true. - endif + if (status == nf90_noerr) have_dvdt_PBL_data = .true. + ! status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) then - have_dTdt_GWD_data = .true. - endif + if (status == nf90_noerr) have_dTdt_GWD_data = .true. + ! status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) then - have_dudt_GWD_data = .true. - endif + if (status == nf90_noerr) have_dudt_GWD_data = .true. + ! status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) then - have_dvdt_GWD_data = .true. - endif + if (status == nf90_noerr) have_dvdt_GWD_data = .true. + ! status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) then - have_dTdt_SCNV_data = .true. - endif + if (status == nf90_noerr) have_dTdt_SCNV_data = .true. + ! status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) then - have_dudt_SCNV_data = .true. - endif + if (status == nf90_noerr) have_dudt_SCNV_data = .true. + ! status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) then - have_dvdt_SCNV_data = .true. - endif + if (status == nf90_noerr) have_dvdt_SCNV_data = .true. + ! status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) then - have_dqdt_SCNV_data = .true. - endif + if (status == nf90_noerr) have_dqdt_SCNV_data = .true. + ! status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) then - have_dTdt_DCNV_data = .true. - endif + if (status == nf90_noerr) have_dTdt_DCNV_data = .true. + ! status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) then - have_dudt_DCNV_data = .true. - endif + if (status == nf90_noerr) have_dudt_DCNV_data = .true. + ! status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) then - have_dvdt_DCNV_data = .true. - endif + if (status == nf90_noerr) have_dvdt_DCNV_data = .true. + ! status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) then - have_dqdt_DCNV_data = .true. - endif + if (status == nf90_noerr) have_dqdt_DCNV_data = .true. + ! status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) then - have_dTdt_cldMP_data = .true. - endif + if (status == nf90_noerr) have_dTdt_cldMP_data = .true. + ! status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) then - have_dqdt_cldMP_data = .true. - endif + if (status == nf90_noerr) have_dqdt_cldMP_data = .true. #ifdef MPI endif ! Master process @@ -335,101 +382,64 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil ! Read in physics data tendencies (optional) status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) ! status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) ! status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dTdt_PBL_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_PBL_data) ! status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dqdt_PBL_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_PBL_data) ! status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dudt_PBL_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_PBL_data) ! status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dvdt_PBL_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_PBL_data) ! status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dTdt_GWD_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_GWD_data) ! status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dudt_GWD_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_GWD_data) ! status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dvdt_GWD_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_GWD_data) ! status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dTdt_SCNV_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SCNV_data) ! status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dudt_SCNV_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_SCNV_data) ! status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dvdt_SCNV_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_SCNV_data) ! status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dqdt_SCNV_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_SCNV_data) ! status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dTdt_DCNV_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_DCNV_data) ! status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dudt_DCNV_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_DCNV_data) ! status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dvdt_DCNV_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_DCNV_data) ! status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dqdt_DCNV_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_DCNV_data) ! status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dTdt_cldMP_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_cldMP_data) ! status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, dqdt_cldMP_data) - endif + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_cldMP_data) ! status = nf90_close(ncid) + #ifdef MPI endif ! Master process @@ -449,49 +459,49 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil call mpi_bcast(dTdt_SWRAD_data, size(dTdt_SWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dTdt_PBL_data) then - call mpi_bcast(dTdt_PBL_data, size(dTdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dTdt_PBL_data, size(dTdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dqdt_PBL_data) then - call mpi_bcast(dqdt_PBL_data, size(dqdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dqdt_PBL_data, size(dqdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dudt_PBL_data) then - call mpi_bcast(dudt_PBL_data, size(dudt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dudt_PBL_data, size(dudt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dvdt_PBL_data) then - call mpi_bcast(dvdt_PBL_data, size(dvdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dvdt_PBL_data, size(dvdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dTdt_GWD_data) then - call mpi_bcast(dTdt_GWD_data, size(dTdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dTdt_GWD_data, size(dTdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dudt_GWD_data) then - call mpi_bcast(dudt_GWD_data, size(dudt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dudt_GWD_data, size(dudt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dvdt_GWD_data) then - call mpi_bcast(dvdt_GWD_data, size(dvdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dvdt_GWD_data, size(dvdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dTdt_SCNV_data) then - call mpi_bcast(dTdt_SCNV_data, size(dTdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dTdt_SCNV_data, size(dTdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dudt_SCNV_data) then - call mpi_bcast(dudt_SCNV_data, size(dudt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dudt_SCNV_data, size(dudt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dvdt_SCNV_data) then - call mpi_bcast(dvdt_SCNV_data, size(dvdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dvdt_SCNV_data, size(dvdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dqdt_SCNV_data) then - call mpi_bcast(dqdt_SCNV_data, size(dqdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dqdt_SCNV_data, size(dqdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dTdt_DCNV_data) then - call mpi_bcast(dTdt_DCNV_data, size(dTdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dTdt_DCNV_data, size(dTdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dudt_DCNV_data) then - call mpi_bcast(dudt_DCNV_data, size(dudt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dudt_DCNV_data, size(dudt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dvdt_DCNV_data) then - call mpi_bcast(dvdt_DCNV_data, size(dvdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dvdt_DCNV_data, size(dvdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dqdt_DCNV_data) then - call mpi_bcast(dqdt_DCNV_data, size(dqdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(dqdt_DCNV_data, size(dqdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif if (have_dTdt_cldMP_data) then call mpi_bcast(dTdt_cldMP_data, size(dTdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) @@ -499,41 +509,94 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil if (have_dqdt_cldMP_data) then call mpi_bcast(dqdt_cldMP_data, size(dqdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) endif - ! call mpi_barrier(mpicomm, mpierr) #endif + ! ####################################################################################### + ! + ! Populate physics_process type. + ! + ! ####################################################################################### + + ! Metadata + do iprc = 1,nPhysProcess + if (iprc == scheme_order_SWRAD) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "SWRAD" + physics_process(iprc)%use_sim = use_SWRAD_scheme_sim + physics_process(iprc)%time_split = time_split_SWRAD + endif + if (iprc == scheme_order_LWRAD) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "LWRAD" + physics_process(iprc)%use_sim = use_LWRAD_scheme_sim + physics_process(iprc)%time_split = time_split_LWRAD + endif + if (iprc == scheme_order_GWD) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "GWD" + physics_process(iprc)%use_sim = use_GWD_scheme_sim + physics_process(iprc)%time_split = time_split_GWD + endif + if (iprc == scheme_order_PBL) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "PBL" + physics_process(iprc)%use_sim = use_PBL_scheme_sim + physics_process(iprc)%time_split = time_split_PBL + endif + if (iprc == scheme_order_SCNV) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "SCNV" + physics_process(iprc)%use_sim = use_SCNV_scheme_sim + physics_process(iprc)%time_split = time_split_SCNV + endif + if (iprc == scheme_order_DCNV) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "DCNV" + physics_process(iprc)%use_sim = use_DCNV_scheme_sim + physics_process(iprc)%time_split = time_split_DCNV + endif + if (iprc == scheme_order_cldMP) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "cldMP" + physics_process(iprc)%use_sim = use_cldMP_scheme_sim + physics_process(iprc)%time_split = time_split_cldMP + endif + enddo + + ! Data + if (have_dTdt_LWRAD_data) physics_process(scheme_order_LWRAD)%tend%T => dTdt_LWRAD_data + if (have_dTdt_SWRAD_data) physics_process(scheme_order_SWRAD)%tend%T => dTdt_SWRAD_data + if (have_dTdt_PBL_data) physics_process(scheme_order_PBL)%tend%T => dTdt_PBL_data + if (have_dudt_PBL_data) physics_process(scheme_order_PBL)%tend%u => dudt_PBL_data + if (have_dvdt_PBL_data) physics_process(scheme_order_PBL)%tend%v => dvdt_PBL_data + if (have_dqdt_PBL_data) physics_process(scheme_order_PBL)%tend%q => dqdt_PBL_data + if (have_dTdt_GWD_data) physics_process(scheme_order_GWD)%tend%T => dTdt_GWD_data + if (have_dudt_GWD_data) physics_process(scheme_order_GWD)%tend%u => dudt_GWD_data + if (have_dvdt_GWD_data) physics_process(scheme_order_GWD)%tend%v => dvdt_GWD_data + if (have_dTdt_SCNV_data) physics_process(scheme_order_SCNV)%tend%T => dTdt_SCNV_data + if (have_dudt_SCNV_data) physics_process(scheme_order_SCNV)%tend%u => dudt_SCNV_data + if (have_dvdt_SCNV_data) physics_process(scheme_order_SCNV)%tend%v => dvdt_SCNV_data + if (have_dqdt_SCNV_data) physics_process(scheme_order_SCNV)%tend%q => dqdt_SCNV_data + if (have_dTdt_DCNV_data) physics_process(scheme_order_DCNV)%tend%T => dTdt_DCNV_data + if (have_dudt_DCNV_data) physics_process(scheme_order_DCNV)%tend%u => dudt_DCNV_data + if (have_dvdt_DCNV_data) physics_process(scheme_order_DCNV)%tend%v => dvdt_DCNV_data + if (have_dqdt_DCNV_data) physics_process(scheme_order_DCNV)%tend%q => dqdt_DCNV_data + if (have_dTdt_cldMP_data) physics_process(scheme_order_cldMP)%tend%T => dTdt_cldMP_data + if (have_dqdt_cldMP_data) physics_process(scheme_order_cldMP)%tend%q => dqdt_cldMP_data + ! if (mpirank .eq. mpiroot) then - print*, "--- Using SCM data tendencies ---" + print*, "--- Using CCPP data tendencies ---" print*, "---------------------------------" print*, " " - print*, "use_RAD_scheme_sim: ", use_RAD_scheme_sim - print*, " dTdt_LWRAD_data: ", have_dTdt_LWRAD_data - print*, " dTdt_SWRAD_data: ", have_dTdt_SWRAD_data - print*, "use_PBL_scheme_sim: ", use_PBL_scheme_sim - print*, " dTdt_PBL_data: ", have_dTdt_PBL_data - print*, " dqdt_PBL_data: ", have_dqdt_PBL_data - print*, " dudt_PBL_data: ", have_dudt_PBL_data - print*, " dvdt_PBL_data: ", have_dvdt_PBL_data - print*, "use_GWD_scheme_sim: ", use_GWD_scheme_sim - print*, " dTdt_gwd_data: ", have_dTdt_GWD_data - print*, " dudt_gwd_data: ", have_dudt_GWD_data - print*, " dvdt_gwd_data: ", have_dvdt_GWD_data - print*, "use_SCNV_scheme_sim: ", use_SCNV_scheme_sim - print*, " dTdt_SCNV_data: ", have_dTdt_SCNV_data - print*, " dudt_SCNV_data: ", have_dudt_SCNV_data - print*, " dvdt_SCNV_data: ", have_dvdt_SCNV_data - print*, " dqdt_SCNV_data: ", have_dqdt_SCNV_data - print*, "use_DCNV_scheme_sim: ", use_DCNV_scheme_sim - print*, " dTdt_DCNV_data: ", have_dTdt_DCNV_data - print*, " dudt_DCNV_data: ", have_dudt_DCNV_data - print*, " dvdt_DCNV_data: ", have_dvdt_DCNV_data - print*, " dqdt_DCNV_data: ", have_dqdt_DCNV_data - print*, "use_cldMP_scheme_sim: ", use_cldMP_scheme_sim - print*, " dTdt_cldMP_data: ", have_dTdt_cldMP_data - print*, " dqdt_cldMP_data: ", have_dqdt_cldMP_data + do iprc = 1,nPhysProcess + print*,"Process : ", trim(physics_process(iprc)%name) + print*," order : ", physics_process(iprc)%order + print*," use_sim : ", physics_process(iprc)%use_sim + print*," time_split : ", physics_process(iprc)%time_split + enddo print*, "---------------------------------" endif @@ -547,7 +610,7 @@ end subroutine ccpp_scheme_simulator_init !! \section arg_table_ccpp_scheme_simulator_run !! \htmlinclude ccpp_scheme_simulator_run.html !! - subroutine ccpp_scheme_simulator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dtidx, & + subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dtidx, & dtend, index_of_process_dcnv, index_of_process_longwave, & index_of_process_shortwave, index_of_process_scnv, & index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & @@ -555,28 +618,29 @@ subroutine ccpp_scheme_simulator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, qg errmsg, errflg) ! Inputs - integer, intent(in ) :: kdt - integer, intent (in), dimension(8) :: jdat - real(kind_phys), intent(in ) :: dtp, solhr - real(kind_phys), intent(in ), dimension(:,:) :: tgrs, ugrs, vgrs - real(kind=kind_phys), dimension(:,:,:), intent(in) :: qgrs, dtend - integer, intent(in) :: dtidx(:,:), index_of_process_dcnv, index_of_process_longwave, & - index_of_process_shortwave, index_of_process_scnv, & + integer, intent(in) :: kdt, ntqv, index_of_process_dcnv, & + index_of_process_longwave, index_of_process_shortwave, index_of_process_scnv, & index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & - index_of_temperature, index_of_x_wind, index_of_y_wind, ntqv + index_of_temperature, index_of_x_wind, index_of_y_wind + integer, intent(in), dimension(8) :: jdat + integer, intent(in), dimension(:,:) :: dtidx + real(kind_phys), intent(in) :: dtp + real(kind_phys), intent(in), dimension(:,:) :: tgrs, ugrs, vgrs + real(kind_phys), intent(in), dimension(:,:,:) :: qgrs, dtend ! Outputs real(kind_phys), intent(inout), dimension(:,:) :: gt0, gu0, gv0 real(kind_phys), intent(inout), dimension(:,:,:) :: gq0 - character(len=*),intent(out ) :: errmsg - integer, intent(out ) :: errflg + character(len=*),intent(out) :: errmsg + integer, intent(out) :: errflg ! Locals integer :: iCol, iLay, iTrc, nCol, nLay, nTrc, ti(1), tf(1), idtend, fcst_year, & - fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec + fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, iprc, index_of_process real(kind_phys) :: w1, w2,hrofday - real(kind_phys), dimension(:,:), allocatable :: gt1, gu1, gv1 - real(kind_phys), dimension(:,:,:), allocatable :: gq1 + real(kind_phys), dimension(:), allocatable :: dT, du, dv, dq + real(kind_phys), dimension(:,:), allocatable :: gt1, gu1, gv1, dTdt, dudt, dvdt + real(kind_phys), dimension(:,:,:), allocatable :: gq1, dqdt ! Initialize CCPP error handling variables errmsg = '' @@ -596,9 +660,11 @@ subroutine ccpp_scheme_simulator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, qg nCol = size(gq0(:,1,1)) nLay = size(gq0(1,:,1)) nTrc = size(gq0(1,1,:)) - + ! Allocate temporaries allocate(gt1(nCol,nLay), gu1(nCol,nLay), gv1(nCol,nLay), gq1(nCol,nLay,1)) ! *only specific humidity to start (ntrc=1). + allocate(dTdt(nCol,nLay), dudt(nCol,nLay), dvdt(nCol,nLay), dqdt(nCol,nLay,1)) + allocate(dT(nLay), du(nLay), dv(nLay), dq(nLay)) ! Determine temporal interpolation weights for data-tendecies. ! DJS: The data tendencies have a temporal dimension, to capture the diurnal cycle, @@ -610,190 +676,135 @@ subroutine ccpp_scheme_simulator_run(solhr, kdt, dtp, jdat, tgrs, ugrs, vgrs, qg w1 = (time_data(tf(1))-hrofday) / (time_data(tf(1)) - time_data(ti(1))) w2 = 1 - w1 - do iCol = 1,nCol - ! Set state - gt1(iCol,:) = tgrs(iCol,:) - gu1(iCol,:) = ugrs(iCol,:) - gv1(iCol,:) = vgrs(iCol,:) - gq1(iCol,:,1) = qgrs(iCol,:,1) - - ! ############################################################################### - ! Radiation - ! ############################################################################### - if (use_RAD_scheme_sim) then - if (have_dTdt_LWRAD_data) then - gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_LWRAD_data(:,ti(1)) + w2*dTdt_LWRAD_data(:,tf(1))) * dtp - endif - if (have_dTdt_SWRAD_data) then - gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_SWRAD_data(:,ti(1)) + w2*dTdt_SWRAD_data(:,tf(1))) * dtp - endif - else - idtend = dtidx(index_of_temperature,index_of_process_longwave) - if (idtend >= 1) then - gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(index_of_temperature,index_of_process_shortwave) - if (idtend >=1) then - gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - endif + ! + ! DJS BEGIN: This section will, eventually, replace the icol loop below, using the physics_process type. + ! - ! ############################################################################### - ! PBL - ! ############################################################################### - if (use_PBL_scheme_sim) then - if (have_dTdt_PBL_data) then - gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_PBL_data(:,ti(1)) + w2*(dTdt_PBL_data(:,tf(1)))) * dtp - endif - if (have_dudt_PBL_data) then - gu1(iCol,:) = gu1(iCol,:) + (w1*dudt_PBL_data(:,ti(1)) + w2*(dudt_PBL_data(:,tf(1)))) * dtp - endif - if (have_dvdt_PBL_data) then - gv1(iCol,:) = gv1(iCol,:) + (w1*dvdt_PBL_data(:,ti(1)) + w2*(dvdt_PBL_data(:,tf(1)))) * dtp - endif - if (have_dqdt_PBL_data) then - gq1(iCol,:,1) = gq1(iCol,:,1) + (w1*dqdt_PBL_data(:,ti(1),1) + w2*(dqdt_PBL_data(:,tf(1),1))) * dtp - endif - else - idtend = dtidx(index_of_temperature,index_of_process_pbl) - if (idtend >= 1) then - gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(index_of_x_wind,index_of_process_pbl) - if (idtend >= 1) then - gu1(iCol,:) = gu1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(index_of_y_wind,index_of_process_pbl) - if (idtend >= 1) then - gv1(iCol,:) = gv1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(100+ntqv, index_of_process_pbl) - if (idtend >= 1) then - gq1(iCol,:,1) = gq1(iCol,:,1) + dtend(iCol,:,idtend)! * dtp + ! Set state + gt1(:,:) = tgrs(:,:) + gu1(:,:) = ugrs(:,:) + gv1(:,:) = vgrs(:,:) + gq1(:,:,1) = qgrs(:,:,1) + dTdt(:,:) = 0. + dudt(:,:) = 0. + dvdt(:,:) = 0. + dqdt(:,:,1)= 0. + do iCol = 1,nCol + do iprc = 1,nPhysProcess + + ! Using scheme simulator + if (physics_process(iprc)%use_sim) then + print*,"Using CCPP scheme simulator for ",trim(physics_process(iprc)%name) + + ! Temperature + if (associated(physics_process(iprc)%tend%T)) then + call interp_data_tend("T", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dT) + endif + + ! Zonal-wind + if (associated(physics_process(iprc)%tend%u)) then + call interp_data_tend("u", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, du) + endif + + ! Meridional-wind + if (associated(physics_process(iprc)%tend%v)) then + call interp_data_tend("v", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dv) + endif + + ! Specific-humidity + if (associated(physics_process(iprc)%tend%q)) then + call interp_data_tend("q", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dq) + endif + + ! Using data tendency from "active" scheme(s). + else + print*,"ACTIVE PHYSICS SCHEME: ",trim(physics_process(iprc)%name) + if (physics_process(iprc)%name == "LWRAD") index_of_process = index_of_process_longwave + if (physics_process(iprc)%name == "SWRAD") index_of_process = index_of_process_shortwave + if (physics_process(iprc)%name == "PBL") index_of_process = index_of_process_pbl + if (physics_process(iprc)%name == "GWD") index_of_process = index_of_process_orographic_gwd + if (physics_process(iprc)%name == "SCNV") index_of_process = index_of_process_scnv + if (physics_process(iprc)%name == "DCNV") index_of_process = index_of_process_dcnv + if (physics_process(iprc)%name == "cldMP") index_of_process = index_of_process_mp + ! + idtend = dtidx(index_of_temperature,index_of_process) + if (idtend >= 1) dT = dtend(iCol,:,idtend) + ! + idtend = dtidx(index_of_x_wind,index_of_process) + if (idtend >= 1) du = dtend(iCol,:,idtend) + ! + idtend = dtidx(index_of_y_wind,index_of_process) + if (idtend >= 1) dv = dtend(iCol,:,idtend) + ! + idtend = dtidx(100+ntqv,index_of_process) + if (idtend >= 1) dq = dtend(iCol,:,idtend) endif - endif + + ! Update state now? + if (physics_process(iprc)%time_split) then + gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + dT)*dtp + gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + du)*dtp + gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + dv)*dtp + gq1(iCol,:,1) = gq1(iCol,:,1) + (dqdt(iCol,:,1) + dq)*dtp + dTdt(iCol,:) = 0. + dudt(iCol,:) = 0. + dvdt(iCol,:) = 0. + dqdt(iCol,:,1) = 0. + ! Accumulate tendencies, update later? + else + dTdt(iCol,:) = dTdt(iCol,:) + dT + dudt(iCol,:) = dudt(iCol,:) + du + dvdt(iCol,:) = dvdt(iCol,:) + dv + dqdt(iCol,:,1) = dqdt(iCol,:,1) + dq + endif + enddo + ! + gt0(iCol,:) = gt1(iCol,:) + dTdt(iCol,:)*dtp + gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp + gv0(iCol,:) = gv1(iCol,:) + dvdt(iCol,:)*dtp + gq0(iCol,:,1) = gq1(iCol,:,1) + dqdt(iCol,:,1)*dtp + enddo + ! + end subroutine ccpp_scheme_simulator_run - ! ############################################################################### - ! Gravity wave drag - ! ############################################################################### - if (use_GWD_scheme_sim) then - if (have_dTdt_GWD_data) then - gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_GWD_data(:,ti(1)) + w2*(dTdt_GWD_data(:,tf(1)))) * dtp - endif - if (have_dudt_GWD_data) then - gu1(iCol,:) = gu1(iCol,:) + (w1*dudt_GWD_data(:,ti(1)) + w2*(dudt_GWD_data(:,tf(1)))) * dtp - endif - if (have_dvdt_GWD_data) then - gv1(iCol,:) = gv1(iCol,:) + (w1*dvdt_GWD_data(:,ti(1)) + w2*(dvdt_GWD_data(:,tf(1)))) * dtp - endif - else - idtend = dtidx(index_of_temperature,index_of_process_orographic_gwd) - if (idtend >= 1) then - gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd) - if (idtend >= 1) then - gu1(iCol,:) = gu1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(index_of_y_wind,index_of_process_orographic_gwd) - if (idtend >= 1) then - gv1(iCol,:) = gv1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - endif + ! #################################################################################### + ! Utility functions/routines + ! #################################################################################### + subroutine interp_data_tend(var_name, process_name, iprc, year, month, day, hour, minute, & + second, var_out) + ! Inputs + character(len=*), intent(in) :: var_name, process_name + integer, intent(in) :: year, month, day, hour, minute, second, iprc + + ! Outputs + real(kind_phys),dimension(:),intent(out) :: var_out - ! ############################################################################### - ! Shallow convection - ! ############################################################################### - if (use_SCNV_scheme_sim) then - if (have_dTdt_SCNV_data) then - gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_SCNV_data(:,ti(1)) + w2*(dTdt_SCNV_data(:,tf(1)))) * dtp - endif - if (have_dudt_SCNV_data) then - gu1(iCol,:) = gu1(iCol,:) + (w1*dudt_SCNV_data(:,ti(1)) + w2*(dudt_SCNV_data(:,tf(1)))) * dtp - endif - if (have_dvdt_SCNV_data) then - gv1(iCol,:) = gv1(iCol,:) + (w1*dvdt_SCNV_data(:,ti(1)) + w2*(dvdt_SCNV_data(:,tf(1)))) * dtp - endif - if (have_dqdt_SCNV_data) then - gq1(iCol,:,1) = gq1(iCol,:,1) + (w1*dqdt_SCNV_data(:,ti(1),1) + w2*(dqdt_SCNV_data(:,tf(1),1))) * dtp - endif - else - idtend = dtidx(index_of_temperature,index_of_process_scnv) - if (idtend >= 1) then - gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(index_of_x_wind,index_of_process_scnv) - if (idtend >= 1) then - gu1(iCol,:) = gu1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(index_of_y_wind,index_of_process_scnv) - if (idtend >= 1) then - gv1(iCol,:) = gv1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(100+ntqv,index_of_process_scnv) - if (idtend >= 1) then - gq1(iCol,:,1) = gq1(iCol,:,1) + dtend(iCol,:,idtend)! * dtp - endif - endif + ! Locals + integer :: ti(1), tf(1) + real(kind_phys) :: w1, w2, hrofday - ! ############################################################################### - ! Deep convection - ! ############################################################################### - if (use_DCNV_scheme_sim) then - if (have_dTdt_DCNV_data) then - gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_DCNV_data(:,ti(1)) + w2*(dTdt_DCNV_data(:,tf(1)) )) * dtp - endif - if (have_dudt_DCNV_data) then - gu1(iCol,:) = gu1(iCol,:) + (w1*dudt_DCNV_data(:,ti(1)) + w2*(dudt_DCNV_data(:,tf(1)))) * dtp - endif - if (have_dvdt_DCNV_data) then - gv1(iCol,:) = gv1(iCol,:) + (w1*dvdt_DCNV_data(:,ti(1)) + w2*(dvdt_DCNV_data(:,tf(1)) )) * dtp - endif - if (have_dqdt_DCNV_data) then - gq1(iCol,:,1) = gq1(iCol,:,1) + (w1*dqdt_DCNV_data(:,ti(1),1) + w2*(dqdt_DCNV_data(:,tf(1),1))) * dtp - endif - else - idtend = dtidx(index_of_temperature,index_of_process_dcnv) - if (idtend >= 1) then - gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(index_of_x_wind,index_of_process_dcnv) - if (idtend >= 1) then - gu1(iCol,:) = gu1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(index_of_y_wind,index_of_process_dcnv) - if (idtend >= 1) then - gv1(iCol,:) = gv1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(100+ntqv,index_of_process_dcnv) - if (idtend >= 1) then - gq1(iCol,:,1) = gq1(iCol,:,1) + dtend(iCol,:,idtend)! * dtp - endif - endif + hrofday = hour*3600. + minute*60. + second + ti = findloc(abs(time_data-hrofday),minval(abs(time_data-hrofday))) + if (hrofday - time_data(ti(1)) .le. 0) ti = ti-1 + tf = ti + 1 + w1 = (time_data(tf(1))-hrofday) / (time_data(tf(1)) - time_data(ti(1))) + w2 = 1 - w1 - ! ############################################################################### - ! Cloud microphysics - ! ############################################################################### - if (use_cldMP_scheme_sim) then - if (have_dTdt_cldMP_data) then - gt1(iCol,:) = gt1(iCol,:) + (w1*dTdt_cldMP_data(:,ti(1)) + w2*(dTdt_cldMP_data(:,tf(1)))) * dtp - endif - if (have_dqdt_cldMP_data) then - gq1(iCol,:,1) = gq1(iCol,:,1) + (w1*dqdt_cldMP_data(:,ti(1),1) + w2*(dqdt_cldMP_data(:,tf(1),1))) * dtp - endif - else - idtend = dtidx(index_of_temperature,index_of_process_mp) - if (idtend >= 1) then - gt1(iCol,:) = gt1(iCol,:) + dtend(iCol,:,idtend)! * dtp - endif - idtend = dtidx(100+ntqv,index_of_process_mp) - if (idtend >= 1) then - gq1(iCol,:,1) = gq1(iCol,:,1) + dtend(iCol,:,idtend)! * dtp - endif - endif + if (var_name == "T") then + var_out = w1*physics_process(iprc)%tend%T(:,ti(1)) + w2*physics_process(iprc)%tend%T(:,tf(1)) + endif - enddo ! columns - ! - end subroutine ccpp_scheme_simulator_run + if (var_name == "u") then + var_out = w1*physics_process(iprc)%tend%u(:,ti(1)) + w2*physics_process(iprc)%tend%u(:,tf(1)) + endif + + if (var_name == "v") then + var_out = w1*physics_process(iprc)%tend%v(:,ti(1)) + w2*physics_process(iprc)%tend%v(:,tf(1)) + endif + + if (var_name == "q") then + var_out = w1*physics_process(iprc)%tend%q(:,ti(1),1) + w2*physics_process(iprc)%tend%q(:,tf(1),1) + endif + end subroutine interp_data_tend end module ccpp_scheme_simulator diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_scheme_simulator.meta index 909089bb9..92e39ff61 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -70,14 +70,6 @@ [ccpp-arg-table] name = ccpp_scheme_simulator_run type = scheme -[solhr] - standard_name = forecast_utc_hour - long_name = time in hours after 00z at the current timestep - units = h - dimensions = () - type = real - kind = kind_phys - intent = in [kdt] standard_name = index_of_timestep long_name = current forecast iteration From ffd26ab39759091969c23995dfc051c077b330c6 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Mon, 6 Feb 2023 10:55:30 -0700 Subject: [PATCH 05/22] Some changes --- physics/ccpp_scheme_simulator.F90 | 42 +++++++++++++++---------------- 1 file changed, 20 insertions(+), 22 deletions(-) diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index 258687416..be7ad03f9 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -666,20 +666,6 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti allocate(dTdt(nCol,nLay), dudt(nCol,nLay), dvdt(nCol,nLay), dqdt(nCol,nLay,1)) allocate(dT(nLay), du(nLay), dv(nLay), dq(nLay)) - ! Determine temporal interpolation weights for data-tendecies. - ! DJS: The data tendencies have a temporal dimension, to capture the diurnal cycle, - ! which is needed for reasonable solar forcing. - hrofday = fcst_hour*3600. + fcst_min*60. + fcst_sec - ti = findloc(abs(time_data-hrofday),minval(abs(time_data-hrofday))) - if (hrofday - time_data(ti(1)) .le. 0) ti = ti-1 - tf = ti + 1 - w1 = (time_data(tf(1))-hrofday) / (time_data(tf(1)) - time_data(ti(1))) - w2 = 1 - w1 - - ! - ! DJS BEGIN: This section will, eventually, replace the icol loop below, using the physics_process type. - ! - ! Set state gt1(:,:) = tgrs(:,:) gu1(:,:) = ugrs(:,:) @@ -689,8 +675,13 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti dudt(:,:) = 0. dvdt(:,:) = 0. dqdt(:,:,1)= 0. - do iCol = 1,nCol - do iprc = 1,nPhysProcess + do iprc = 1,nPhysProcess + do iCol = 1,nCol + ! + dT = 0. + du = 0. + dv = 0. + dq = 0. ! Using scheme simulator if (physics_process(iprc)%use_sim) then @@ -728,18 +719,18 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti if (physics_process(iprc)%name == "cldMP") index_of_process = index_of_process_mp ! idtend = dtidx(index_of_temperature,index_of_process) - if (idtend >= 1) dT = dtend(iCol,:,idtend) + if (idtend >= 1) dT = dtend(iCol,:,idtend)/dtp ! idtend = dtidx(index_of_x_wind,index_of_process) - if (idtend >= 1) du = dtend(iCol,:,idtend) + if (idtend >= 1) du = dtend(iCol,:,idtend)/dtp ! idtend = dtidx(index_of_y_wind,index_of_process) - if (idtend >= 1) dv = dtend(iCol,:,idtend) + if (idtend >= 1) dv = dtend(iCol,:,idtend)/dtp ! idtend = dtidx(100+ntqv,index_of_process) - if (idtend >= 1) dq = dtend(iCol,:,idtend) + if (idtend >= 1) dq = dtend(iCol,:,idtend)/dtp endif - + ! Update state now? if (physics_process(iprc)%time_split) then gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + dT)*dtp @@ -750,7 +741,7 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti dudt(iCol,:) = 0. dvdt(iCol,:) = 0. dqdt(iCol,:,1) = 0. - ! Accumulate tendencies, update later? + ! Accumulate tendencies, update later? else dTdt(iCol,:) = dTdt(iCol,:) + dT dudt(iCol,:) = dudt(iCol,:) + du @@ -765,6 +756,13 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti gq0(iCol,:,1) = gq1(iCol,:,1) + dqdt(iCol,:,1)*dtp enddo ! + + do iCol=1,size(gq0(:,1,1)) + do iLay=1,size(gq0(1,:,1)) + write(*,'(i5,4f8.3)') iLay,tgrs(iCol,iLay),gt0(iCol,iLay),gt1(iCol,iLay),gt0(iCol,iLay)-gt1(iCol,iLay) + enddo + enddo + end subroutine ccpp_scheme_simulator_run ! #################################################################################### From 112ac895f62c3d4034dac67ec73b0d126b78098f Mon Sep 17 00:00:00 2001 From: dustinswales Date: Tue, 7 Feb 2023 12:36:11 -0700 Subject: [PATCH 06/22] Some small cleanup --- physics/ccpp_scheme_simulator.F90 | 103 +++++++++++------------------ physics/ccpp_scheme_simulator.meta | 7 -- 2 files changed, 39 insertions(+), 71 deletions(-) diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index be7ad03f9..b3075e36a 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -116,15 +116,12 @@ module ccpp_scheme_simulator ! Data driven physics tendencies integer :: nlev_data, ntime_data real(kind_phys), allocatable, dimension(:) :: time_data - real(kind_phys), allocatable, dimension(:,:),target :: dTdt_LWRAD_data, dTdt_SWRAD_data, & - dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, dudt_GWD_data, & - dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, dTdt_DCNV_data, & - dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data - real(kind_phys), allocatable, dimension(:,:,:),target :: dqdt_PBL_data, dqdt_SCNV_data, & - dqdt_DCNV_data, dqdt_cldMP_data - - ! Host-model initial time information - integer :: init_year, init_month, init_day, init_hour, init_min, init_sec + real(kind_phys), allocatable, dimension(:,:), target :: dTdt_LWRAD_data, & + dTdt_SWRAD_data, dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, & + dudt_GWD_data, dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, & + dTdt_DCNV_data, dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data + real(kind_phys), allocatable, dimension(:,:,:), target :: dqdt_PBL_data, & + dqdt_SCNV_data, dqdt_DCNV_data, dqdt_cldMP_data public ccpp_scheme_simulator_init, ccpp_scheme_simulator_run contains @@ -138,12 +135,11 @@ module ccpp_scheme_simulator !! \htmlinclude ccpp_scheme_simulator_init.html !! subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_file, & - idat, errmsg, errflg) + errmsg, errflg) ! Inputs integer, intent (in) :: mpirank, mpiroot, mpicomm, nlunit character(len=*), intent (in) :: nml_file - integer, intent (in), dimension(8) :: idat ! Outputs character(len=*), intent(out) :: errmsg @@ -168,14 +164,6 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil errmsg = '' errflg = 0 - ! Store model initialization time. - init_year = idat(1) - init_month = idat(2) - init_day = idat(3) - init_hour = idat(5) - init_min = idat(6) - init_sec = idat(7) - ! ###################################################################################### ! ! Read in namelist @@ -592,10 +580,12 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil print*, "---------------------------------" print*, " " do iprc = 1,nPhysProcess - print*,"Process : ", trim(physics_process(iprc)%name) - print*," order : ", physics_process(iprc)%order - print*," use_sim : ", physics_process(iprc)%use_sim - print*," time_split : ", physics_process(iprc)%time_split + if (physics_process(iprc)%use_sim) then + print*,"Process : ", trim(physics_process(iprc)%name) + print*," order : ", physics_process(iprc)%order + print*," use_sim : ", physics_process(iprc)%use_sim + print*," time_split : ", physics_process(iprc)%time_split + endif enddo print*, "---------------------------------" endif @@ -662,7 +652,7 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti nTrc = size(gq0(1,1,:)) ! Allocate temporaries - allocate(gt1(nCol,nLay), gu1(nCol,nLay), gv1(nCol,nLay), gq1(nCol,nLay,1)) ! *only specific humidity to start (ntrc=1). + allocate(gt1(nCol,nLay), gu1(nCol,nLay), gv1(nCol,nLay), gq1(nCol,nLay,1)) allocate(dTdt(nCol,nLay), dudt(nCol,nLay), dvdt(nCol,nLay), dqdt(nCol,nLay,1)) allocate(dT(nLay), du(nLay), dv(nLay), dq(nLay)) @@ -675,6 +665,8 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti dudt(:,:) = 0. dvdt(:,:) = 0. dqdt(:,:,1)= 0. + + ! Model internal physics timestep evolution of "state". do iprc = 1,nPhysProcess do iCol = 1,nCol ! @@ -685,31 +677,21 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti ! Using scheme simulator if (physics_process(iprc)%use_sim) then - print*,"Using CCPP scheme simulator for ",trim(physics_process(iprc)%name) - - ! Temperature if (associated(physics_process(iprc)%tend%T)) then - call interp_data_tend("T", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dT) + call linterp_data_tend("T", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dT) endif - - ! Zonal-wind if (associated(physics_process(iprc)%tend%u)) then - call interp_data_tend("u", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, du) + call linterp_data_tend("u", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, du) endif - - ! Meridional-wind if (associated(physics_process(iprc)%tend%v)) then - call interp_data_tend("v", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dv) + call linterp_data_tend("v", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dv) endif - - ! Specific-humidity if (associated(physics_process(iprc)%tend%q)) then - call interp_data_tend("q", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dq) + call linterp_data_tend("q", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dq) endif ! Using data tendency from "active" scheme(s). else - print*,"ACTIVE PHYSICS SCHEME: ",trim(physics_process(iprc)%name) if (physics_process(iprc)%name == "LWRAD") index_of_process = index_of_process_longwave if (physics_process(iprc)%name == "SWRAD") index_of_process = index_of_process_shortwave if (physics_process(iprc)%name == "PBL") index_of_process = index_of_process_pbl @@ -730,7 +712,7 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti idtend = dtidx(100+ntqv,index_of_process) if (idtend >= 1) dq = dtend(iCol,:,idtend)/dtp endif - + ! Update state now? if (physics_process(iprc)%time_split) then gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + dT)*dtp @@ -754,22 +736,17 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp gv0(iCol,:) = gv1(iCol,:) + dvdt(iCol,:)*dtp gq0(iCol,:,1) = gq1(iCol,:,1) + dqdt(iCol,:,1)*dtp - enddo - ! - do iCol=1,size(gq0(:,1,1)) - do iLay=1,size(gq0(1,:,1)) - write(*,'(i5,4f8.3)') iLay,tgrs(iCol,iLay),gt0(iCol,iLay),gt1(iCol,iLay),gt0(iCol,iLay)-gt1(iCol,iLay) - enddo enddo - + ! end subroutine ccpp_scheme_simulator_run ! #################################################################################### ! Utility functions/routines ! #################################################################################### - subroutine interp_data_tend(var_name, process_name, iprc, year, month, day, hour, minute, & - second, var_out) + ! The routine interpolates the data-tendencies + subroutine linterp_data_tend(var_name, process_name, iprc, year, month, day, hour, & + minute, second, var_out) ! Inputs character(len=*), intent(in) :: var_name, process_name integer, intent(in) :: year, month, day, hour, minute, second, iprc @@ -781,6 +758,7 @@ subroutine interp_data_tend(var_name, process_name, iprc, year, month, day, hour integer :: ti(1), tf(1) real(kind_phys) :: w1, w2, hrofday + ! Linear interpolation weights hrofday = hour*3600. + minute*60. + second ti = findloc(abs(time_data-hrofday),minval(abs(time_data-hrofday))) if (hrofday - time_data(ti(1)) .le. 0) ti = ti-1 @@ -788,21 +766,18 @@ subroutine interp_data_tend(var_name, process_name, iprc, year, month, day, hour w1 = (time_data(tf(1))-hrofday) / (time_data(tf(1)) - time_data(ti(1))) w2 = 1 - w1 - if (var_name == "T") then - var_out = w1*physics_process(iprc)%tend%T(:,ti(1)) + w2*physics_process(iprc)%tend%T(:,tf(1)) - endif - - if (var_name == "u") then - var_out = w1*physics_process(iprc)%tend%u(:,ti(1)) + w2*physics_process(iprc)%tend%u(:,tf(1)) - endif - - if (var_name == "v") then - var_out = w1*physics_process(iprc)%tend%v(:,ti(1)) + w2*physics_process(iprc)%tend%v(:,tf(1)) - endif - - if (var_name == "q") then - var_out = w1*physics_process(iprc)%tend%q(:,ti(1),1) + w2*physics_process(iprc)%tend%q(:,tf(1),1) - endif - end subroutine interp_data_tend + ! + select case(var_name) + case("T") + var_out = w1*physics_process(iprc)%tend%T(:,ti(1)) + w2*physics_process(iprc)%tend%T(:,tf(1)) + case("u") + var_out = w1*physics_process(iprc)%tend%u(:,ti(1)) + w2*physics_process(iprc)%tend%u(:,tf(1)) + case("v") + var_out = w1*physics_process(iprc)%tend%v(:,ti(1)) + w2*physics_process(iprc)%tend%v(:,tf(1)) + case("q") + var_out = w1*physics_process(iprc)%tend%q(:,ti(1),1) + w2*physics_process(iprc)%tend%q(:,tf(1),1) + end select + + end subroutine linterp_data_tend end module ccpp_scheme_simulator diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_scheme_simulator.meta index 92e39ff61..80f898ed2 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -43,13 +43,6 @@ type = character kind = len=* intent = in -[idat] - standard_name = date_and_time_at_model_initialization_in_iso_order - long_name = initialization date and time - units = none - dimensions = (8) - type = integer - intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 6a4c4b17c94130955de38b5dff5fc7e284d77dce Mon Sep 17 00:00:00 2001 From: dustinswales Date: Thu, 9 Feb 2023 15:04:23 -0700 Subject: [PATCH 07/22] More OO changes. Will split into load_data and ccpp_scheme components soon. --- physics/ccpp_scheme_simulator.F90 | 274 ++++++++++++++++-------------- 1 file changed, 143 insertions(+), 131 deletions(-) diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index b3075e36a..3c82fe094 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -13,10 +13,6 @@ module ccpp_scheme_simulator #endif implicit none - ! Avaialble physics processes to simulate. - integer,parameter :: & - nPhysProcess = 7 - ! Type containing physics tendencies for a physics process. type phys_tend real(kind_phys), dimension(:,:), pointer :: T @@ -28,16 +24,18 @@ module ccpp_scheme_simulator ! This type contains the meta information and data for each physics process. type base_physics_process character(len=16) :: name - logical :: time_split - logical :: use_sim + logical :: time_split = .false. + logical :: use_sim = .false. integer :: order type(phys_tend) :: tend end type base_physics_process ! This array contains the governing information on how to advance the physics timestep. - type(base_physics_process),dimension(nPhysProcess) :: & + type(base_physics_process),dimension(:), allocatable :: & physics_process + integer :: nPhysProcess + ! ######################################################################################## ! ! Configuration for CCPP scheme simulator. Set in namelist. Used during initialization to @@ -45,74 +43,20 @@ module ccpp_scheme_simulator ! ! ######################################################################################## - ! Set which schemes to be replaced with simulated tendencies. - logical :: use_LWRAD_scheme_sim = .false., & !< If true, use LongWave RADiation scheme simulator. - !< If false, use tendencies from radiation scheme. - use_SWRAD_scheme_sim = .false., & !< If true, use ShortWave RADiation scheme simulator. - !< If false, use tendencies from radiation scheme. - use_PBL_scheme_sim = .false., & !< If true, use Planetary Boubdary Layer scheme simulator. - !< If false, use tendencies from PBL scheme. - use_GWD_scheme_sim = .false., & !< If true, use Gravity Wave Drag scheme simulator. - !< If false, use tendencies from GWD scheme. - use_SCNV_scheme_sim = .false., & !< If true, use Shallow CoNVection scheme simulator. - !< If false, use tendencies from SCNV scheme. - use_DCNV_scheme_sim = .false., & !< If true, use Deep CoNVection scheme simulator. - !< If false, use tendencies from DCNV scheme. - use_cldMP_scheme_sim = .false. !< If true, use cloud MicroPhysics scheme simulator. - !< If false, use tendencies from cldMP acheme. - - ! Are the processes time-split or process-split? - logical :: time_split_LWRAD = .false., & !< If true, time-split process. Update internal physics state prior to scheme. - !< If false, process-split process. Accumulate tendencies. - time_split_SWRAD = .false., & !< If true, time-split process. Update internal physics state prior to scheme. - !< If false, process-split process. Accumulate tendencies. - time_split_PBL = .false., & !< If true, time-split process. Update internal physics state prior to scheme. - !< If false, process-split process. Accumulate tendencies. - time_split_GWD = .false., & !< If true, time-split process. Update internal physics state prior to scheme. - !< If false, process-split process. Accumulate tendencies. - time_split_SCNV = .true., & !< If true, time-split process. Update internal physics state prior to scheme. - !< If false, process-split process. Accumulate tendencies. - time_split_DCNV = .true., & !< If true, time-split process. Update internal physics state prior to scheme. - !< If false, process-split process. Accumulate tendencies. - time_split_cldMP = .true. !< If true, time-split process. Update internal physics state prior to scheme. - !< If false, process-split process. Accumulate tendencies. - - ! What is physics process ordering? (Important if their are time-split processes in the physics scheme) - integer :: scheme_order_SWRAD = 1, & !< Order of Radiation scheme (shortwave). - scheme_order_LWRAD = 2, & !< Order of Radiation scheme (longwave). - scheme_order_PBL = 3, & !< Order of Planetary Boubdary Layer scheme. - scheme_order_GWD = 4, & !< Order of Gravity Wave Drag scheme. - scheme_order_SCNV = 5, & !< Order of Shallow CoNVection scheme. - scheme_order_DCNV = 6, & !< Order of Deep CoNVection scheme. - scheme_order_cldMP = 7 !< Order of cloud MicroPhysics scheme. - ! - ! Locals - ! + ! For each process there is a corresponding namelist entry, which is constructed as follows: + ! {use_scheme_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} + integer, dimension(3) :: & + proc_LWRAD_config = (/0,0,0/), & + proc_SWRAD_config = (/0,0,0/), & + proc_PBL_config = (/0,0,0/), & + proc_GWD_config = (/0,0,0/), & + proc_SCNV_config = (/0,0,0/), & + proc_DCNV_config = (/0,0,0/), & + proc_cldMP_config = (/0,0,0/) ! Activation flag for scheme. logical :: do_ccpp_scheme_simulator = .false. - ! Switches for input data - logical :: have_dTdt_LWRAD_data = .false., & !< If true, input file contains LongWave RADiation temperature tendencies. - have_dTdt_SWRAD_data = .false., & !< If true, input file contains ShortWave RADiation temperature tendencies. - have_dTdt_PBL_data = .false., & !< If true, input file contains Planetary Boubdary Layer temperature tendencies. - have_dqdt_PBL_data = .false., & !< If true, input file contains Planetary Boubdary Layer specific-humidity tendencies. - have_dudt_PBL_data = .false., & !< If true, input file contains Planetary Boubdary Layer zonal-wind tendencies. - have_dvdt_PBL_data = .false., & !< If true, input file contains Planetary Boubdary Layer meridional-wind tendencies. - have_dTdt_GWD_data = .false., & !< If true, input file contains Gravity Wave Drag temperature tendencies. - have_dudt_GWD_data = .false., & !< If true, input file contains Gravity Wave Drag zonal-wind tendencies. - have_dvdt_GWD_data = .false., & !< If true, input file contains Gravity Wave Drag meridional-wind tendencies. - have_dTdt_SCNV_data = .false., & !< If true, input file contains Shallow CoNVection temperature tendencies. - have_dudt_SCNV_data = .false., & !< If true, input file contains Shallow CoNVection zonal-wind tendencies. - have_dvdt_SCNV_data = .false., & !< If true, input file contains Shallow CoNVection meridional-wind tendencies. - have_dqdt_SCNV_data = .false., & !< If true, input file contains Shallow CoNVection specific-humidity tendencies. - have_dTdt_DCNV_data = .false., & !< If true, input file contains Deep CoNVection temperature tendencies. - have_dudt_DCNV_data = .false., & !< If true, input file contains Deep CoNVection zonal-wind tendencies. - have_dvdt_DCNV_data = .false., & !< If true, input file contains Deep CoNVection meridional-wind tendencies. - have_dqdt_DCNV_data = .false., & !< If true, input file contains Deep CoNVection specific-humidity tendencies. - have_dTdt_cldMP_data = .false., & !< If true, input file contains cloud MicroPhysics temperature tendencies. - have_dqdt_cldMP_data = .false. !< If true, input file contains cloud MicroPhysics specific-humidity tendencies. - ! Data driven physics tendencies integer :: nlev_data, ntime_data real(kind_phys), allocatable, dimension(:) :: time_data @@ -123,6 +67,12 @@ module ccpp_scheme_simulator real(kind_phys), allocatable, dimension(:,:,:), target :: dqdt_PBL_data, & dqdt_SCNV_data, dqdt_DCNV_data, dqdt_cldMP_data + ! Scheme initialization flag. + logical :: module_initialized = .false. + + ! Order in process loop for "active" physics process. + integer :: iactive_scheme + public ccpp_scheme_simulator_init, ccpp_scheme_simulator_run contains @@ -151,19 +101,39 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil logical :: exists integer,parameter :: nTrc = 1 ! Only specific humodty for now, but preserve 3 dimensionality + ! Switches for input data + logical :: have_dTdt_LWRAD_data = .false., & + have_dTdt_SWRAD_data = .false., & + have_dTdt_PBL_data = .false., & + have_dqdt_PBL_data = .false., & + have_dudt_PBL_data = .false., & + have_dvdt_PBL_data = .false., & + have_dTdt_GWD_data = .false., & + have_dudt_GWD_data = .false., & + have_dvdt_GWD_data = .false., & + have_dTdt_SCNV_data = .false., & + have_dudt_SCNV_data = .false., & + have_dvdt_SCNV_data = .false., & + have_dqdt_SCNV_data = .false., & + have_dTdt_DCNV_data = .false., & + have_dudt_DCNV_data = .false., & + have_dvdt_DCNV_data = .false., & + have_dqdt_DCNV_data = .false., & + have_dTdt_cldMP_data = .false., & + have_dqdt_cldMP_data = .false. + ! Namelist - namelist / scm_data_nml / fileIN, & - use_SWRAD_scheme_sim, use_LWRAD_scheme_sim, use_PBL_scheme_sim, & - use_GWD_scheme_sim, use_SCNV_scheme_sim, use_DCNV_scheme_sim, & - use_cldMP_scheme_sim, scheme_order_SWRAD, scheme_order_LWRAD, scheme_order_PBL, & - scheme_order_GWD, scheme_order_SCNV, scheme_order_DCNV, scheme_order_cldMP, & - time_split_SWRAD, time_split_LWRAD, time_split_PBL, time_split_GWD, & - time_split_SCNV, time_split_DCNV, time_split_cldMP + namelist / scm_data_nml / fileIN, nPhysProcess, proc_LWRAD_config, proc_SWRAD_config, & + proc_PBL_config, proc_GWD_config, proc_SCNV_config, proc_DCNV_config, & + proc_cldMP_config ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + if (module_initialized) return + module_initialized = .true. + ! ###################################################################################### ! ! Read in namelist @@ -187,9 +157,9 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil ! ! ###################################################################################### ! Only proceed if scheme simulator requested. - if (use_SWRAD_scheme_sim .or. use_LWRAD_scheme_sim .or. use_PBL_scheme_sim .or. & - use_GWD_scheme_sim .or. use_SCNV_scheme_sim .or. use_DCNV_scheme_sim .or. & - use_cldMP_scheme_sim) then + if (proc_SWRAD_config(1) .or. proc_LWRAD_config(1) .or. proc_PBL_config(1) .or. & + proc_GWD_config(1) .or. proc_SCNV_config(1) .or. proc_DCNV_config(1) .or. & + proc_cldMP_config(1)) then do_ccpp_scheme_simulator = .true. else return @@ -507,87 +477,128 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil ! ! ####################################################################################### + ! Allocate + allocate(physics_process(nPhysProcess)) + ! Metadata do iprc = 1,nPhysProcess - if (iprc == scheme_order_SWRAD) then + if (iprc == proc_SWRAD_config(3)) then physics_process(iprc)%order = iprc physics_process(iprc)%name = "SWRAD" - physics_process(iprc)%use_sim = use_SWRAD_scheme_sim - physics_process(iprc)%time_split = time_split_SWRAD + if (proc_SWRAD_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_SWRAD_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif endif - if (iprc == scheme_order_LWRAD) then + if (iprc == proc_LWRAD_config(3)) then physics_process(iprc)%order = iprc physics_process(iprc)%name = "LWRAD" - physics_process(iprc)%use_sim = use_LWRAD_scheme_sim - physics_process(iprc)%time_split = time_split_LWRAD + if (proc_LWRAD_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_LWRAD_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif endif - if (iprc == scheme_order_GWD) then + if (iprc == proc_GWD_config(3)) then physics_process(iprc)%order = iprc physics_process(iprc)%name = "GWD" - physics_process(iprc)%use_sim = use_GWD_scheme_sim - physics_process(iprc)%time_split = time_split_GWD + if (proc_GWD_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_GWD_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif endif - if (iprc == scheme_order_PBL) then + if (iprc == proc_PBL_config(3)) then physics_process(iprc)%order = iprc physics_process(iprc)%name = "PBL" - physics_process(iprc)%use_sim = use_PBL_scheme_sim - physics_process(iprc)%time_split = time_split_PBL + if (proc_PBL_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_PBL_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif endif - if (iprc == scheme_order_SCNV) then + if (iprc == proc_SCNV_config(3)) then physics_process(iprc)%order = iprc physics_process(iprc)%name = "SCNV" - physics_process(iprc)%use_sim = use_SCNV_scheme_sim - physics_process(iprc)%time_split = time_split_SCNV + if (proc_SCNV_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_SCNV_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif endif - if (iprc == scheme_order_DCNV) then + if (iprc == proc_DCNV_config(3)) then physics_process(iprc)%order = iprc physics_process(iprc)%name = "DCNV" - physics_process(iprc)%use_sim = use_DCNV_scheme_sim - physics_process(iprc)%time_split = time_split_DCNV + if (proc_DCNV_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_DCNV_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif endif - if (iprc == scheme_order_cldMP) then + if (iprc == proc_cldMP_config(3)) then physics_process(iprc)%order = iprc physics_process(iprc)%name = "cldMP" - physics_process(iprc)%use_sim = use_cldMP_scheme_sim - physics_process(iprc)%time_split = time_split_cldMP + if (proc_cldMP_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_cldMP_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif endif enddo - ! Data - if (have_dTdt_LWRAD_data) physics_process(scheme_order_LWRAD)%tend%T => dTdt_LWRAD_data - if (have_dTdt_SWRAD_data) physics_process(scheme_order_SWRAD)%tend%T => dTdt_SWRAD_data - if (have_dTdt_PBL_data) physics_process(scheme_order_PBL)%tend%T => dTdt_PBL_data - if (have_dudt_PBL_data) physics_process(scheme_order_PBL)%tend%u => dudt_PBL_data - if (have_dvdt_PBL_data) physics_process(scheme_order_PBL)%tend%v => dvdt_PBL_data - if (have_dqdt_PBL_data) physics_process(scheme_order_PBL)%tend%q => dqdt_PBL_data - if (have_dTdt_GWD_data) physics_process(scheme_order_GWD)%tend%T => dTdt_GWD_data - if (have_dudt_GWD_data) physics_process(scheme_order_GWD)%tend%u => dudt_GWD_data - if (have_dvdt_GWD_data) physics_process(scheme_order_GWD)%tend%v => dvdt_GWD_data - if (have_dTdt_SCNV_data) physics_process(scheme_order_SCNV)%tend%T => dTdt_SCNV_data - if (have_dudt_SCNV_data) physics_process(scheme_order_SCNV)%tend%u => dudt_SCNV_data - if (have_dvdt_SCNV_data) physics_process(scheme_order_SCNV)%tend%v => dvdt_SCNV_data - if (have_dqdt_SCNV_data) physics_process(scheme_order_SCNV)%tend%q => dqdt_SCNV_data - if (have_dTdt_DCNV_data) physics_process(scheme_order_DCNV)%tend%T => dTdt_DCNV_data - if (have_dudt_DCNV_data) physics_process(scheme_order_DCNV)%tend%u => dudt_DCNV_data - if (have_dvdt_DCNV_data) physics_process(scheme_order_DCNV)%tend%v => dvdt_DCNV_data - if (have_dqdt_DCNV_data) physics_process(scheme_order_DCNV)%tend%q => dqdt_DCNV_data - if (have_dTdt_cldMP_data) physics_process(scheme_order_cldMP)%tend%T => dTdt_cldMP_data - if (have_dqdt_cldMP_data) physics_process(scheme_order_cldMP)%tend%q => dqdt_cldMP_data + ! Load data + if (have_dTdt_LWRAD_data) physics_process(proc_SWRAD_config(3))%tend%T => dTdt_LWRAD_data + if (have_dTdt_SWRAD_data) physics_process(proc_LWRAD_config(3))%tend%T => dTdt_SWRAD_data + if (have_dTdt_PBL_data) physics_process(proc_PBL_config(3))%tend%T => dTdt_PBL_data + if (have_dudt_PBL_data) physics_process(proc_PBL_config(3))%tend%u => dudt_PBL_data + if (have_dvdt_PBL_data) physics_process(proc_PBL_config(3))%tend%v => dvdt_PBL_data + if (have_dqdt_PBL_data) physics_process(proc_PBL_config(3))%tend%q => dqdt_PBL_data + if (have_dTdt_GWD_data) physics_process(proc_GWD_config(3))%tend%T => dTdt_GWD_data + if (have_dudt_GWD_data) physics_process(proc_GWD_config(3))%tend%u => dudt_GWD_data + if (have_dvdt_GWD_data) physics_process(proc_GWD_config(3))%tend%v => dvdt_GWD_data + if (have_dTdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend%T => dTdt_SCNV_data + if (have_dudt_SCNV_data) physics_process(proc_SCNV_config(3))%tend%u => dudt_SCNV_data + if (have_dvdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend%v => dvdt_SCNV_data + if (have_dqdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend%q => dqdt_SCNV_data + if (have_dTdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend%T => dTdt_DCNV_data + if (have_dudt_DCNV_data) physics_process(proc_DCNV_config(3))%tend%u => dudt_DCNV_data + if (have_dvdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend%v => dvdt_DCNV_data + if (have_dqdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend%q => dqdt_DCNV_data + if (have_dTdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend%T => dTdt_cldMP_data + if (have_dqdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend%q => dqdt_cldMP_data + + ! Which process-scheme is "Active"? + do iprc = 1,nPhysProcess + if (.not. physics_process(iprc)%use_sim) then + iactive_scheme = iprc + endif + enddo ! if (mpirank .eq. mpiroot) then + print*, "----------------------------------" print*, "--- Using CCPP data tendencies ---" - print*, "---------------------------------" - print*, " " + print*, "----------------------------------" do iprc = 1,nPhysProcess if (physics_process(iprc)%use_sim) then - print*,"Process : ", trim(physics_process(iprc)%name) - print*," order : ", physics_process(iprc)%order - print*," use_sim : ", physics_process(iprc)%use_sim - print*," time_split : ", physics_process(iprc)%time_split + print*," simulate_scheme: ", trim(physics_process(iprc)%name) + print*," order: ", physics_process(iprc)%order + print*," time_split: ", physics_process(iprc)%time_split endif enddo - print*, "---------------------------------" + print*, " active_scheme: ", trim(physics_process(iactive_scheme)%name) + print*, " order: ", physics_process(iactive_scheme)%order + print*, " time_split : ", physics_process(iactive_scheme)%time_split + print*, "----------------------------------" + print*, "----------------------------------" endif end subroutine ccpp_scheme_simulator_init @@ -675,7 +686,7 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti dv = 0. dq = 0. - ! Using scheme simulator + ! Using scheme simulator (very simple, interpolate data tendency to local time) if (physics_process(iprc)%use_sim) then if (associated(physics_process(iprc)%tend%T)) then call linterp_data_tend("T", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dT) @@ -691,6 +702,7 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti endif ! Using data tendency from "active" scheme(s). + ! DJS2023: This block is very ufs specific. Need to tidy this up. else if (physics_process(iprc)%name == "LWRAD") index_of_process = index_of_process_longwave if (physics_process(iprc)%name == "SWRAD") index_of_process = index_of_process_shortwave @@ -745,7 +757,7 @@ end subroutine ccpp_scheme_simulator_run ! Utility functions/routines ! #################################################################################### ! The routine interpolates the data-tendencies - subroutine linterp_data_tend(var_name, process_name, iprc, year, month, day, hour, & + subroutine linterp_data_tend(var_name, process_name, iprc, year, month, day, hour, & minute, second, var_out) ! Inputs character(len=*), intent(in) :: var_name, process_name From be4cc2e5acb11c99794d465496503833a4842a45 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Thu, 9 Feb 2023 19:25:45 -0700 Subject: [PATCH 08/22] More OO changes --- physics/ccpp_scheme_simulator.F90 | 134 +++++++++++++++++------------- 1 file changed, 75 insertions(+), 59 deletions(-) diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index 3c82fe094..f8f040be2 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -13,27 +13,41 @@ module ccpp_scheme_simulator #endif implicit none - ! Type containing physics tendencies for a physics process. - type phys_tend + ! Type containing 1D (instantaneous) physics tendencies + type tend_inst + real(kind_phys), dimension(:), pointer :: dT + real(kind_phys), dimension(:), pointer :: du + real(kind_phys), dimension(:), pointer :: dv + real(kind_phys), dimension(:), pointer :: dq + end type tend_inst + + ! Type containing 2D data physics tendencies. + type phys_tend_2d + real(kind_phys), dimension(:), pointer :: time real(kind_phys), dimension(:,:), pointer :: T real(kind_phys), dimension(:,:), pointer :: u real(kind_phys), dimension(:,:), pointer :: v real(kind_phys), dimension(:,:,:), pointer :: q - end type phys_tend + end type phys_tend_2d ! This type contains the meta information and data for each physics process. type base_physics_process - character(len=16) :: name - logical :: time_split = .false. - logical :: use_sim = .false. - integer :: order - type(phys_tend) :: tend + character(len=16) :: name + logical :: time_split = .false. + logical :: use_sim = .false. + integer :: order + type(phys_tend_2d) :: tend + type(tend_inst) :: itend + contains + generic, public :: linterp => linterp_1D + procedure, private :: linterp_1D end type base_physics_process ! This array contains the governing information on how to advance the physics timestep. type(base_physics_process),dimension(:), allocatable :: & physics_process + ! Number of physics process (set in namelist) integer :: nPhysProcess ! ######################################################################################## @@ -59,7 +73,7 @@ module ccpp_scheme_simulator ! Data driven physics tendencies integer :: nlev_data, ntime_data - real(kind_phys), allocatable, dimension(:) :: time_data + real(kind_phys), allocatable, dimension(:), target :: time_data real(kind_phys), allocatable, dimension(:,:), target :: dTdt_LWRAD_data, & dTdt_SWRAD_data, dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, & dudt_GWD_data, dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, & @@ -482,6 +496,10 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil ! Metadata do iprc = 1,nPhysProcess + allocate(physics_process(iprc)%itend%dT(nlev_data)) + allocate(physics_process(iprc)%itend%du(nlev_data)) + allocate(physics_process(iprc)%itend%dv(nlev_data)) + allocate(physics_process(iprc)%itend%dq(nlev_data)) if (iprc == proc_SWRAD_config(3)) then physics_process(iprc)%order = iprc physics_process(iprc)%name = "SWRAD" @@ -555,6 +573,13 @@ subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_fil enddo ! Load data + physics_process(proc_LWRAD_config(3))%tend%time => time_data + physics_process(proc_SWRAD_config(3))%tend%time => time_data + physics_process(proc_PBL_config(3))%tend%time => time_data + physics_process(proc_GWD_config(3))%tend%time => time_data + physics_process(proc_DCNV_config(3))%tend%time => time_data + physics_process(proc_SCNV_config(3))%tend%time => time_data + physics_process(proc_cldMP_config(3))%tend%time => time_data if (have_dTdt_LWRAD_data) physics_process(proc_SWRAD_config(3))%tend%T => dTdt_LWRAD_data if (have_dTdt_SWRAD_data) physics_process(proc_LWRAD_config(3))%tend%T => dTdt_SWRAD_data if (have_dTdt_PBL_data) physics_process(proc_PBL_config(3))%tend%T => dTdt_PBL_data @@ -639,7 +664,6 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti integer :: iCol, iLay, iTrc, nCol, nLay, nTrc, ti(1), tf(1), idtend, fcst_year, & fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, iprc, index_of_process real(kind_phys) :: w1, w2,hrofday - real(kind_phys), dimension(:), allocatable :: dT, du, dv, dq real(kind_phys), dimension(:,:), allocatable :: gt1, gu1, gv1, dTdt, dudt, dvdt real(kind_phys), dimension(:,:,:), allocatable :: gq1, dqdt @@ -649,7 +673,7 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti if (.not. do_ccpp_scheme_simulator) return - ! Current forecast time + ! Current forecast time (Data-format specific) fcst_year = jdat(1) fcst_month = jdat(2) fcst_day = jdat(3) @@ -665,7 +689,6 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti ! Allocate temporaries allocate(gt1(nCol,nLay), gu1(nCol,nLay), gv1(nCol,nLay), gq1(nCol,nLay,1)) allocate(dTdt(nCol,nLay), dudt(nCol,nLay), dvdt(nCol,nLay), dqdt(nCol,nLay,1)) - allocate(dT(nLay), du(nLay), dv(nLay), dq(nLay)) ! Set state gt1(:,:) = tgrs(:,:) @@ -680,25 +703,25 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti ! Model internal physics timestep evolution of "state". do iprc = 1,nPhysProcess do iCol = 1,nCol - ! - dT = 0. - du = 0. - dv = 0. - dq = 0. + ! Reset locals + physics_process(iprc)%itend%dT(:) = 0. + physics_process(iprc)%itend%du(:) = 0. + physics_process(iprc)%itend%dv(:) = 0. + physics_process(iprc)%itend%dq(:) = 0. ! Using scheme simulator (very simple, interpolate data tendency to local time) if (physics_process(iprc)%use_sim) then if (associated(physics_process(iprc)%tend%T)) then - call linterp_data_tend("T", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dT) + errmsg = physics_process(iprc)%linterp("T", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) endif if (associated(physics_process(iprc)%tend%u)) then - call linterp_data_tend("u", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, du) + errmsg = physics_process(iprc)%linterp("u", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) endif if (associated(physics_process(iprc)%tend%v)) then - call linterp_data_tend("v", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dv) + errmsg = physics_process(iprc)%linterp("v", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) endif if (associated(physics_process(iprc)%tend%q)) then - call linterp_data_tend("q", physics_process(iprc)%name, iprc, fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, dq) + errmsg = physics_process(iprc)%linterp("q", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) endif ! Using data tendency from "active" scheme(s). @@ -713,34 +736,34 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti if (physics_process(iprc)%name == "cldMP") index_of_process = index_of_process_mp ! idtend = dtidx(index_of_temperature,index_of_process) - if (idtend >= 1) dT = dtend(iCol,:,idtend)/dtp + if (idtend >= 1) physics_process(iprc)%itend%dT = dtend(iCol,:,idtend)/dtp ! idtend = dtidx(index_of_x_wind,index_of_process) - if (idtend >= 1) du = dtend(iCol,:,idtend)/dtp + if (idtend >= 1) physics_process(iprc)%itend%du = dtend(iCol,:,idtend)/dtp ! idtend = dtidx(index_of_y_wind,index_of_process) - if (idtend >= 1) dv = dtend(iCol,:,idtend)/dtp + if (idtend >= 1) physics_process(iprc)%itend%dv = dtend(iCol,:,idtend)/dtp ! idtend = dtidx(100+ntqv,index_of_process) - if (idtend >= 1) dq = dtend(iCol,:,idtend)/dtp + if (idtend >= 1) physics_process(iprc)%itend%dq = dtend(iCol,:,idtend)/dtp endif ! Update state now? if (physics_process(iprc)%time_split) then - gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + dT)*dtp - gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + du)*dtp - gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + dv)*dtp - gq1(iCol,:,1) = gq1(iCol,:,1) + (dqdt(iCol,:,1) + dq)*dtp + gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%itend%dT)*dtp + gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%itend%du)*dtp + gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%itend%dv)*dtp + gq1(iCol,:,1) = gq1(iCol,:,1) + (dqdt(iCol,:,1) + physics_process(iprc)%itend%dq)*dtp dTdt(iCol,:) = 0. dudt(iCol,:) = 0. dvdt(iCol,:) = 0. dqdt(iCol,:,1) = 0. ! Accumulate tendencies, update later? else - dTdt(iCol,:) = dTdt(iCol,:) + dT - dudt(iCol,:) = dudt(iCol,:) + du - dvdt(iCol,:) = dvdt(iCol,:) + dv - dqdt(iCol,:,1) = dqdt(iCol,:,1) + dq + dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%itend%dT + dudt(iCol,:) = dudt(iCol,:) + physics_process(iprc)%itend%du + dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%itend%dv + dqdt(iCol,:,1) = dqdt(iCol,:,1) + physics_process(iprc)%itend%dq endif enddo ! @@ -756,40 +779,33 @@ end subroutine ccpp_scheme_simulator_run ! #################################################################################### ! Utility functions/routines ! #################################################################################### - ! The routine interpolates the data-tendencies - subroutine linterp_data_tend(var_name, process_name, iprc, year, month, day, hour, & - minute, second, var_out) - ! Inputs - character(len=*), intent(in) :: var_name, process_name - integer, intent(in) :: year, month, day, hour, minute, second, iprc - - ! Outputs - real(kind_phys),dimension(:),intent(out) :: var_out - - ! Locals + function linterp_1D(this, var_name, year, month, day, hour, minute, second) result(err_message) + class(base_physics_process), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer, intent(in) :: year, month, day, hour, minute, second + character(len=128) :: err_message integer :: ti(1), tf(1) real(kind_phys) :: w1, w2, hrofday - ! Linear interpolation weights + ! Interpolation weights hrofday = hour*3600. + minute*60. + second - ti = findloc(abs(time_data-hrofday),minval(abs(time_data-hrofday))) - if (hrofday - time_data(ti(1)) .le. 0) ti = ti-1 + ti = findloc(abs(this%tend%time-hrofday),minval(abs(this%tend%time-hrofday))) + if (hrofday - this%tend%time(ti(1)) .le. 0) ti = ti-1 tf = ti + 1 - w1 = (time_data(tf(1))-hrofday) / (time_data(tf(1)) - time_data(ti(1))) + w1 = (this%tend%time(tf(1))-hrofday) / (this%tend%time(tf(1)) - this%tend%time(ti(1))) w2 = 1 - w1 - ! select case(var_name) - case("T") - var_out = w1*physics_process(iprc)%tend%T(:,ti(1)) + w2*physics_process(iprc)%tend%T(:,tf(1)) - case("u") - var_out = w1*physics_process(iprc)%tend%u(:,ti(1)) + w2*physics_process(iprc)%tend%u(:,tf(1)) - case("v") - var_out = w1*physics_process(iprc)%tend%v(:,ti(1)) + w2*physics_process(iprc)%tend%v(:,tf(1)) - case("q") - var_out = w1*physics_process(iprc)%tend%q(:,ti(1),1) + w2*physics_process(iprc)%tend%q(:,tf(1),1) + case("T") + this%itend%dT = w1*this%tend%T(:,ti(1)) + w2*this%tend%T(:,tf(1)) + case("u") + this%itend%du = w1*this%tend%u(:,ti(1)) + w2*this%tend%u(:,tf(1)) + case("v") + this%itend%dv = w1*this%tend%v(:,ti(1)) + w2*this%tend%v(:,tf(1)) + case("q") + this%itend%dq = w1*this%tend%q(:,ti(1),1) + w2*this%tend%q(:,tf(1),1) end select - end subroutine linterp_data_tend - + end function linterp_1D + end module ccpp_scheme_simulator From 7001ef9134859977e1c92c2d1b4f54a1c697183c Mon Sep 17 00:00:00 2001 From: dustinswales Date: Mon, 13 Feb 2023 09:50:59 -0700 Subject: [PATCH 09/22] Split scheme into load and simulator components. --- physics/ccpp_scheme_simulator.F90 | 837 +++++++---------------------- physics/ccpp_scheme_simulator.meta | 56 -- physics/load_ccpp_scheme_sim.F90 | 577 ++++++++++++++++++++ physics/load_ccpp_scheme_sim.meta | 60 +++ 4 files changed, 830 insertions(+), 700 deletions(-) create mode 100644 physics/load_ccpp_scheme_sim.F90 create mode 100644 physics/load_ccpp_scheme_sim.meta diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index f8f040be2..3b478844f 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -7,21 +7,21 @@ ! ######################################################################################## module ccpp_scheme_simulator use machine, only: kind_phys - use netcdf -#ifdef MPI - use mpi -#endif - implicit none - ! Type containing 1D (instantaneous) physics tendencies - type tend_inst - real(kind_phys), dimension(:), pointer :: dT - real(kind_phys), dimension(:), pointer :: du - real(kind_phys), dimension(:), pointer :: dv - real(kind_phys), dimension(:), pointer :: dq - end type tend_inst + implicit none - ! Type containing 2D data physics tendencies. + ! ######################################################################################## + ! Types used by the scheme simulator + ! ######################################################################################## + ! Type containing 1D (time) physics tendencies. + type phys_tend_1d + real(kind_phys), dimension(:), pointer :: T + real(kind_phys), dimension(:), pointer :: u + real(kind_phys), dimension(:), pointer :: v + real(kind_phys), dimension(:,:), pointer :: q + end type phys_tend_1d + + ! Type containing 2D (lev,time) physics tendencies. type phys_tend_2d real(kind_phys), dimension(:), pointer :: time real(kind_phys), dimension(:,:), pointer :: T @@ -30,603 +30,65 @@ module ccpp_scheme_simulator real(kind_phys), dimension(:,:,:), pointer :: q end type phys_tend_2d + ! Type containing 3D (loc,lev,time) physics tendencies. + type phys_tend_3d + real(kind_phys), dimension(:), pointer :: time + real(kind_phys), dimension(:), pointer :: lon + real(kind_phys), dimension(:), pointer :: lat + real(kind_phys), dimension(:,:,:), pointer :: T + real(kind_phys), dimension(:,:,:), pointer :: u + real(kind_phys), dimension(:,:,:), pointer :: v + real(kind_phys), dimension(:,:,:,:), pointer :: q + end type phys_tend_3d + + ! Type containing 4D (lon, lat,lev,time) physics tendencies. + type phys_tend_4d + real(kind_phys), dimension(:), pointer :: time + real(kind_phys), dimension(:,:), pointer :: lon + real(kind_phys), dimension(:,:), pointer :: lat + real(kind_phys), dimension(:,:,:,:), pointer :: T + real(kind_phys), dimension(:,:,:,:), pointer :: u + real(kind_phys), dimension(:,:,:,:), pointer :: v + real(kind_phys), dimension(:,:,:,:,:), pointer :: q + end type phys_tend_4d + ! This type contains the meta information and data for each physics process. type base_physics_process character(len=16) :: name logical :: time_split = .false. logical :: use_sim = .false. integer :: order - type(phys_tend_2d) :: tend - type(tend_inst) :: itend + type(phys_tend_1d) :: tend1d + type(phys_tend_2d) :: tend2d + type(phys_tend_3d) :: tend3d + type(phys_tend_4d) :: tend4d contains - generic, public :: linterp => linterp_1D + generic, public :: linterp => linterp_1D, linterp_2D procedure, private :: linterp_1D + procedure, private :: linterp_2D + procedure, public :: find_nearest_loc_2d_1d + procedure, public :: cmp_time_wts end type base_physics_process ! This array contains the governing information on how to advance the physics timestep. - type(base_physics_process),dimension(:), allocatable :: & + type(base_physics_process), dimension(:), allocatable :: & physics_process - ! Number of physics process (set in namelist) - integer :: nPhysProcess - - ! ######################################################################################## - ! - ! Configuration for CCPP scheme simulator. Set in namelist. Used during initialization to - ! populate "physics_processes" type array. - ! - ! ######################################################################################## - - ! For each process there is a corresponding namelist entry, which is constructed as follows: - ! {use_scheme_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} - integer, dimension(3) :: & - proc_LWRAD_config = (/0,0,0/), & - proc_SWRAD_config = (/0,0,0/), & - proc_PBL_config = (/0,0,0/), & - proc_GWD_config = (/0,0,0/), & - proc_SCNV_config = (/0,0,0/), & - proc_DCNV_config = (/0,0,0/), & - proc_cldMP_config = (/0,0,0/) - - ! Activation flag for scheme. - logical :: do_ccpp_scheme_simulator = .false. - - ! Data driven physics tendencies - integer :: nlev_data, ntime_data - real(kind_phys), allocatable, dimension(:), target :: time_data - real(kind_phys), allocatable, dimension(:,:), target :: dTdt_LWRAD_data, & - dTdt_SWRAD_data, dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, & - dudt_GWD_data, dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, & - dTdt_DCNV_data, dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data - real(kind_phys), allocatable, dimension(:,:,:), target :: dqdt_PBL_data, & - dqdt_SCNV_data, dqdt_DCNV_data, dqdt_cldMP_data - - ! Scheme initialization flag. - logical :: module_initialized = .false. - - ! Order in process loop for "active" physics process. + ! For time-split physics process we need to call this scheme twice in the SDF, once + ! before the "active" scheme is called, and once after. This is because the active + ! scheme uses an internal physics state that has been advanced forward by a subsequent + ! physics process(es). + character(len=16) :: active_name integer :: iactive_scheme + integer :: proc_start, proc_end + logical :: active_time_split_process=.false. - public ccpp_scheme_simulator_init, ccpp_scheme_simulator_run -contains - - ! ###################################################################################### - ! - ! SUBROUTINE ccpp_scheme_simulator_init - ! - ! ###################################################################################### -!! \section arg_table_ccpp_scheme_simulator_init -!! \htmlinclude ccpp_scheme_simulator_init.html -!! - subroutine ccpp_scheme_simulator_init(mpirank, mpiroot, mpicomm, nlunit, nml_file, & - errmsg, errflg) - - ! Inputs - integer, intent (in) :: mpirank, mpiroot, mpicomm, nlunit - character(len=*), intent (in) :: nml_file - - ! Outputs - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Local variables - integer :: ncid, dimID, varID, status, nlon, nlat, ios, iprc - character(len=256) :: fileIN - logical :: exists - integer,parameter :: nTrc = 1 ! Only specific humodty for now, but preserve 3 dimensionality - - ! Switches for input data - logical :: have_dTdt_LWRAD_data = .false., & - have_dTdt_SWRAD_data = .false., & - have_dTdt_PBL_data = .false., & - have_dqdt_PBL_data = .false., & - have_dudt_PBL_data = .false., & - have_dvdt_PBL_data = .false., & - have_dTdt_GWD_data = .false., & - have_dudt_GWD_data = .false., & - have_dvdt_GWD_data = .false., & - have_dTdt_SCNV_data = .false., & - have_dudt_SCNV_data = .false., & - have_dvdt_SCNV_data = .false., & - have_dqdt_SCNV_data = .false., & - have_dTdt_DCNV_data = .false., & - have_dudt_DCNV_data = .false., & - have_dvdt_DCNV_data = .false., & - have_dqdt_DCNV_data = .false., & - have_dTdt_cldMP_data = .false., & - have_dqdt_cldMP_data = .false. - - ! Namelist - namelist / scm_data_nml / fileIN, nPhysProcess, proc_LWRAD_config, proc_SWRAD_config, & - proc_PBL_config, proc_GWD_config, proc_SCNV_config, proc_DCNV_config, & - proc_cldMP_config - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (module_initialized) return - module_initialized = .true. - - ! ###################################################################################### - ! - ! Read in namelist - ! - ! ###################################################################################### - inquire (file = trim (nml_file), exist = exists) - if (.not. exists) then - errmsg = 'SCM data tendency :: namelist file: '//trim(nml_file)//' does not exist' - errflg = 1 - return - else - open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) - endif - rewind (nlunit) - read (nlunit, nml = scm_data_nml) - close (nlunit) - - ! ###################################################################################### - ! - ! Error checking - ! - ! ###################################################################################### - ! Only proceed if scheme simulator requested. - if (proc_SWRAD_config(1) .or. proc_LWRAD_config(1) .or. proc_PBL_config(1) .or. & - proc_GWD_config(1) .or. proc_SCNV_config(1) .or. proc_DCNV_config(1) .or. & - proc_cldMP_config(1)) then - do_ccpp_scheme_simulator = .true. - else - return - endif - - ! Check that input data file exists - inquire (file = trim (fileIN), exist = exists) - if (.not. exists) then - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not exist' - errflg = 1 - return - endif - - ! ####################################################################################### - ! - ! Read mandatory information from data file... - ! (ONLY master processor(0), if MPI enabled) - ! - ! ####################################################################################### -#ifdef MPI - if (mpirank .eq. mpiroot) then -#endif - - ! Open file (required) - status = nf90_open(trim(fileIN), NF90_NOWRITE, ncid) - if (status /= nf90_noerr) then - errmsg = 'Error reading in SCM data tendency file: '//trim(fileIN) - errflg = 1 - return - endif - - ! Get dimensions (required) - status = nf90_inq_dimid(ncid, 'time', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) - else - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain [time] dimension' - errflg = 1 - return - endif - ! - status = nf90_inq_dimid(ncid, 'lev', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) - else - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain [lev] dimension' - errflg = 1 - return - endif -#ifdef MPI - endif ! On master processor - - ! Other processors waiting... - call mpi_barrier(mpicomm, mpierr) - - ! ####################################################################################### - ! - ! Broadcast dimensions... - ! (ALL processors) - ! - ! ####################################################################################### - call mpi_bcast(ntime_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call mpi_bcast(nlev_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call mpi_barrier(mpicomm, mpierr) - - if (mpirank .eq. mpiroot) then -#endif - - ! #################################################################################### - ! - ! What data fields do we have? - ! - ! #################################################################################### - - ! - status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) have_dTdt_LWRAD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) have_dTdt_SWRAD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) have_dTdt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) have_dqdt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) have_dudt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) have_dvdt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) have_dTdt_GWD_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) have_dudt_GWD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) have_dvdt_GWD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) have_dTdt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) have_dudt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) have_dvdt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) have_dqdt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) have_dTdt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) have_dudt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) have_dvdt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) have_dqdt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) have_dTdt_cldMP_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) have_dqdt_cldMP_data = .true. - -#ifdef MPI - endif ! Master process -#endif - - ! Allocate space for data - allocate(time_data(ntime_data)) - if (have_dTdt_LWRAD_data) allocate(dTdt_LWRAD_data(nlev_data, ntime_data)) - if (have_dTdt_SWRAD_data) allocate(dTdt_SWRAD_data(nlev_data, ntime_data)) - if (have_dTdt_PBL_data) allocate(dTdt_PBL_data( nlev_data, ntime_data)) - if (have_dqdt_PBL_data) allocate(dqdt_PBL_data( nlev_data, ntime_data, nTrc)) - if (have_dudt_PBL_data) allocate(dudt_PBL_data( nlev_data, ntime_data)) - if (have_dvdt_PBL_data) allocate(dvdt_PBL_data( nlev_data, ntime_data)) - if (have_dTdt_GWD_data) allocate(dTdt_GWD_data( nlev_data, ntime_data)) - if (have_dudt_GWD_data) allocate(dudt_GWD_data( nlev_data, ntime_data)) - if (have_dvdt_GWD_data) allocate(dvdt_GWD_data( nlev_data, ntime_data)) - if (have_dTdt_SCNV_data) allocate(dTdt_SCNV_data( nlev_data, ntime_data)) - if (have_dudt_SCNV_data) allocate(dudt_SCNV_data( nlev_data, ntime_data)) - if (have_dvdt_SCNV_data) allocate(dvdt_SCNV_data( nlev_data, ntime_data)) - if (have_dqdt_SCNV_data) allocate(dqdt_SCNV_data( nlev_data, ntime_data, nTrc)) - if (have_dTdt_DCNV_data) allocate(dTdt_DCNV_data( nlev_data, ntime_data)) - if (have_dudt_DCNV_data) allocate(dudt_DCNV_data( nlev_data, ntime_data)) - if (have_dvdt_DCNV_data) allocate(dvdt_DCNV_data( nlev_data, ntime_data)) - if (have_dqdt_DCNV_data) allocate(dqdt_DCNV_data( nlev_data, ntime_data, nTrc)) - if (have_dTdt_cldMP_data) allocate(dTdt_cldMP_data(nlev_data, ntime_data)) - if (have_dqdt_cldMP_data) allocate(dqdt_cldMP_data(nlev_data, ntime_data, nTrc)) - - ! ####################################################################################### - ! - ! Read in data ... - ! (ONLY master processor(0), if MPI enabled) - ! - ! ####################################################################################### -#ifdef MPI - if (mpirank .eq. mpiroot) then -#endif - - ! Temporal info (required) - status = nf90_inq_varid(ncid, 'times', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, time_data) - else - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain times variable' - errflg = 1 - return - endif - - ! Read in physics data tendencies (optional) - status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_GWD_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_GWD_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_GWD_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_cldMP_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_cldMP_data) - ! - status = nf90_close(ncid) + ! Set to true in data was loaded into "physics_process" + logical :: do_ccpp_scheme_simulator=.false. -#ifdef MPI - endif ! Master process + public ccpp_scheme_simulator_run - ! Other processors waiting... - call mpi_barrier(mpicomm, mpierr) - ! ####################################################################################### - ! - ! Broadcast data... - ! (ALL processors) - ! - ! ####################################################################################### - - if (have_dTdt_LWRAD_data) then - call mpi_bcast(dTdt_LWRAD_data, size(dTdt_LWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_SWRAD_data) then - call mpi_bcast(dTdt_SWRAD_data, size(dTdt_SWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_PBL_data) then - call mpi_bcast(dTdt_PBL_data, size(dTdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_PBL_data) then - call mpi_bcast(dqdt_PBL_data, size(dqdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_PBL_data) then - call mpi_bcast(dudt_PBL_data, size(dudt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_PBL_data) then - call mpi_bcast(dvdt_PBL_data, size(dvdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_GWD_data) then - call mpi_bcast(dTdt_GWD_data, size(dTdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_GWD_data) then - call mpi_bcast(dudt_GWD_data, size(dudt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_GWD_data) then - call mpi_bcast(dvdt_GWD_data, size(dvdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_SCNV_data) then - call mpi_bcast(dTdt_SCNV_data, size(dTdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_SCNV_data) then - call mpi_bcast(dudt_SCNV_data, size(dudt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_SCNV_data) then - call mpi_bcast(dvdt_SCNV_data, size(dvdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_SCNV_data) then - call mpi_bcast(dqdt_SCNV_data, size(dqdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_DCNV_data) then - call mpi_bcast(dTdt_DCNV_data, size(dTdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_DCNV_data) then - call mpi_bcast(dudt_DCNV_data, size(dudt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_DCNV_data) then - call mpi_bcast(dvdt_DCNV_data, size(dvdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_DCNV_data) then - call mpi_bcast(dqdt_DCNV_data, size(dqdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_cldMP_data) then - call mpi_bcast(dTdt_cldMP_data, size(dTdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_cldMP_data) then - call mpi_bcast(dqdt_cldMP_data, size(dqdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - ! - call mpi_barrier(mpicomm, mpierr) -#endif - - ! ####################################################################################### - ! - ! Populate physics_process type. - ! - ! ####################################################################################### - - ! Allocate - allocate(physics_process(nPhysProcess)) - - ! Metadata - do iprc = 1,nPhysProcess - allocate(physics_process(iprc)%itend%dT(nlev_data)) - allocate(physics_process(iprc)%itend%du(nlev_data)) - allocate(physics_process(iprc)%itend%dv(nlev_data)) - allocate(physics_process(iprc)%itend%dq(nlev_data)) - if (iprc == proc_SWRAD_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "SWRAD" - if (proc_SWRAD_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_SWRAD_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_LWRAD_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "LWRAD" - if (proc_LWRAD_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_LWRAD_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_GWD_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "GWD" - if (proc_GWD_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_GWD_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_PBL_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "PBL" - if (proc_PBL_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_PBL_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_SCNV_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "SCNV" - if (proc_SCNV_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_SCNV_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_DCNV_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "DCNV" - if (proc_DCNV_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_DCNV_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_cldMP_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "cldMP" - if (proc_cldMP_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_cldMP_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - enddo - - ! Load data - physics_process(proc_LWRAD_config(3))%tend%time => time_data - physics_process(proc_SWRAD_config(3))%tend%time => time_data - physics_process(proc_PBL_config(3))%tend%time => time_data - physics_process(proc_GWD_config(3))%tend%time => time_data - physics_process(proc_DCNV_config(3))%tend%time => time_data - physics_process(proc_SCNV_config(3))%tend%time => time_data - physics_process(proc_cldMP_config(3))%tend%time => time_data - if (have_dTdt_LWRAD_data) physics_process(proc_SWRAD_config(3))%tend%T => dTdt_LWRAD_data - if (have_dTdt_SWRAD_data) physics_process(proc_LWRAD_config(3))%tend%T => dTdt_SWRAD_data - if (have_dTdt_PBL_data) physics_process(proc_PBL_config(3))%tend%T => dTdt_PBL_data - if (have_dudt_PBL_data) physics_process(proc_PBL_config(3))%tend%u => dudt_PBL_data - if (have_dvdt_PBL_data) physics_process(proc_PBL_config(3))%tend%v => dvdt_PBL_data - if (have_dqdt_PBL_data) physics_process(proc_PBL_config(3))%tend%q => dqdt_PBL_data - if (have_dTdt_GWD_data) physics_process(proc_GWD_config(3))%tend%T => dTdt_GWD_data - if (have_dudt_GWD_data) physics_process(proc_GWD_config(3))%tend%u => dudt_GWD_data - if (have_dvdt_GWD_data) physics_process(proc_GWD_config(3))%tend%v => dvdt_GWD_data - if (have_dTdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend%T => dTdt_SCNV_data - if (have_dudt_SCNV_data) physics_process(proc_SCNV_config(3))%tend%u => dudt_SCNV_data - if (have_dvdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend%v => dvdt_SCNV_data - if (have_dqdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend%q => dqdt_SCNV_data - if (have_dTdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend%T => dTdt_DCNV_data - if (have_dudt_DCNV_data) physics_process(proc_DCNV_config(3))%tend%u => dudt_DCNV_data - if (have_dvdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend%v => dvdt_DCNV_data - if (have_dqdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend%q => dqdt_DCNV_data - if (have_dTdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend%T => dTdt_cldMP_data - if (have_dqdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend%q => dqdt_cldMP_data - - ! Which process-scheme is "Active"? - do iprc = 1,nPhysProcess - if (.not. physics_process(iprc)%use_sim) then - iactive_scheme = iprc - endif - enddo - - ! - if (mpirank .eq. mpiroot) then - print*, "----------------------------------" - print*, "--- Using CCPP data tendencies ---" - print*, "----------------------------------" - do iprc = 1,nPhysProcess - if (physics_process(iprc)%use_sim) then - print*," simulate_scheme: ", trim(physics_process(iprc)%name) - print*," order: ", physics_process(iprc)%order - print*," time_split: ", physics_process(iprc)%time_split - endif - enddo - print*, " active_scheme: ", trim(physics_process(iactive_scheme)%name) - print*, " order: ", physics_process(iactive_scheme)%order - print*, " time_split : ", physics_process(iactive_scheme)%time_split - print*, "----------------------------------" - print*, "----------------------------------" - endif - - end subroutine ccpp_scheme_simulator_init +contains ! ###################################################################################### ! @@ -662,7 +124,7 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti ! Locals integer :: iCol, iLay, iTrc, nCol, nLay, nTrc, ti(1), tf(1), idtend, fcst_year, & - fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, iprc, index_of_process + fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, iprc, index_of_active_process real(kind_phys) :: w1, w2,hrofday real(kind_phys), dimension(:,:), allocatable :: gt1, gu1, gv1, dTdt, dudt, dvdt real(kind_phys), dimension(:,:,:), allocatable :: gq1, dqdt @@ -690,7 +152,27 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti allocate(gt1(nCol,nLay), gu1(nCol,nLay), gv1(nCol,nLay), gq1(nCol,nLay,1)) allocate(dTdt(nCol,nLay), dudt(nCol,nLay), dvdt(nCol,nLay), dqdt(nCol,nLay,1)) - ! Set state + ! Get tendency for "active" process. + ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional + ! array, CCPP standard_name = cumulative_change_of_state_variables. + ! These are not the instantaneous physics tendencies that are applied to the state by the + ! physics schemes. Not all schemes output physics tendencies... + ! Rather these are intended for diagnostic puposes and are accumulated over some interval. + ! In the UFS/SCM this is controlled by the diagnostic bucket interval, namelist option "fhzero". + ! For this to work, you need to clear the diagnostic buckets after each physics timestep when + ! running in the UFS/SCM. + ! In the SCM this is done by adding the following runtime options: + ! --n_itt_out 1 --n_itt_diag 1 + ! + if (active_name == "LWRAD") index_of_active_process = index_of_process_longwave + if (active_name == "SWRAD") index_of_active_process = index_of_process_shortwave + if (active_name == "PBL") index_of_active_process = index_of_process_pbl + if (active_name == "GWD") index_of_active_process = index_of_process_orographic_gwd + if (active_name == "SCNV") index_of_active_process = index_of_process_scnv + if (active_name == "DCNV") index_of_active_process = index_of_process_dcnv + if (active_name == "cldMP") index_of_active_process = index_of_process_mp + + ! Set state at beginning of the physics timestep. gt1(:,:) = tgrs(:,:) gu1(:,:) = ugrs(:,:) gv1(:,:) = vgrs(:,:) @@ -700,70 +182,67 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti dvdt(:,:) = 0. dqdt(:,:,1)= 0. - ! Model internal physics timestep evolution of "state". - do iprc = 1,nPhysProcess + ! Internal physics timestep evolution. + do iprc = proc_start,proc_end + if (iprc == iactive_scheme .and. active_time_split_process) then + proc_start = iactive_scheme + exit + endif + do iCol = 1,nCol ! Reset locals - physics_process(iprc)%itend%dT(:) = 0. - physics_process(iprc)%itend%du(:) = 0. - physics_process(iprc)%itend%dv(:) = 0. - physics_process(iprc)%itend%dq(:) = 0. + physics_process(iprc)%tend1d%T(:) = 0. + physics_process(iprc)%tend1d%u(:) = 0. + physics_process(iprc)%tend1d%v(:) = 0. + physics_process(iprc)%tend1d%q(:,1) = 0. ! Using scheme simulator (very simple, interpolate data tendency to local time) if (physics_process(iprc)%use_sim) then - if (associated(physics_process(iprc)%tend%T)) then + if (associated(physics_process(iprc)%tend2d%T)) then errmsg = physics_process(iprc)%linterp("T", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) endif - if (associated(physics_process(iprc)%tend%u)) then + if (associated(physics_process(iprc)%tend2d%u)) then errmsg = physics_process(iprc)%linterp("u", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) endif - if (associated(physics_process(iprc)%tend%v)) then + if (associated(physics_process(iprc)%tend2d%v)) then errmsg = physics_process(iprc)%linterp("v", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) endif - if (associated(physics_process(iprc)%tend%q)) then + if (associated(physics_process(iprc)%tend2d%q)) then errmsg = physics_process(iprc)%linterp("q", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) endif ! Using data tendency from "active" scheme(s). - ! DJS2023: This block is very ufs specific. Need to tidy this up. + ! DJS2023: This block is very ufs specific. See Note Above. else - if (physics_process(iprc)%name == "LWRAD") index_of_process = index_of_process_longwave - if (physics_process(iprc)%name == "SWRAD") index_of_process = index_of_process_shortwave - if (physics_process(iprc)%name == "PBL") index_of_process = index_of_process_pbl - if (physics_process(iprc)%name == "GWD") index_of_process = index_of_process_orographic_gwd - if (physics_process(iprc)%name == "SCNV") index_of_process = index_of_process_scnv - if (physics_process(iprc)%name == "DCNV") index_of_process = index_of_process_dcnv - if (physics_process(iprc)%name == "cldMP") index_of_process = index_of_process_mp - ! - idtend = dtidx(index_of_temperature,index_of_process) - if (idtend >= 1) physics_process(iprc)%itend%dT = dtend(iCol,:,idtend)/dtp + idtend = dtidx(index_of_temperature,index_of_active_process) + if (idtend >= 1) physics_process(iprc)%tend1d%T = dtend(iCol,:,idtend)/dtp ! - idtend = dtidx(index_of_x_wind,index_of_process) - if (idtend >= 1) physics_process(iprc)%itend%du = dtend(iCol,:,idtend)/dtp + idtend = dtidx(index_of_x_wind,index_of_active_process) + if (idtend >= 1) physics_process(iprc)%tend1d%u = dtend(iCol,:,idtend)/dtp ! - idtend = dtidx(index_of_y_wind,index_of_process) - if (idtend >= 1) physics_process(iprc)%itend%dv = dtend(iCol,:,idtend)/dtp + idtend = dtidx(index_of_y_wind,index_of_active_process) + if (idtend >= 1) physics_process(iprc)%tend1d%v = dtend(iCol,:,idtend)/dtp ! - idtend = dtidx(100+ntqv,index_of_process) - if (idtend >= 1) physics_process(iprc)%itend%dq = dtend(iCol,:,idtend)/dtp + idtend = dtidx(100+ntqv,index_of_active_process) + if (idtend >= 1) physics_process(iprc)%tend1d%q(:,1) = dtend(iCol,:,idtend)/dtp endif ! Update state now? if (physics_process(iprc)%time_split) then - gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%itend%dT)*dtp - gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%itend%du)*dtp - gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%itend%dv)*dtp - gq1(iCol,:,1) = gq1(iCol,:,1) + (dqdt(iCol,:,1) + physics_process(iprc)%itend%dq)*dtp + gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%tend1d%T)*dtp + gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp + gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp + gq1(iCol,:,1) = gq1(iCol,:,1) + (dqdt(iCol,:,1) + physics_process(iprc)%tend1d%q(:,1))*dtp dTdt(iCol,:) = 0. dudt(iCol,:) = 0. dvdt(iCol,:) = 0. dqdt(iCol,:,1) = 0. ! Accumulate tendencies, update later? else - dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%itend%dT - dudt(iCol,:) = dudt(iCol,:) + physics_process(iprc)%itend%du - dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%itend%dv - dqdt(iCol,:,1) = dqdt(iCol,:,1) + physics_process(iprc)%itend%dq + dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%tend1d%T + dudt(iCol,:) = dudt(iCol,:) + physics_process(iprc)%tend1d%u + dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%tend1d%v + dqdt(iCol,:,1) = dqdt(iCol,:,1) + physics_process(iprc)%tend1d%q(:,1) endif enddo ! @@ -771,13 +250,18 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp gv0(iCol,:) = gv1(iCol,:) + dvdt(iCol,:)*dtp gq0(iCol,:,1) = gq1(iCol,:,1) + dqdt(iCol,:,1)*dtp - enddo + + if (iprc == proc_end) then + proc_start = 1 + endif ! end subroutine ccpp_scheme_simulator_run ! #################################################################################### - ! Utility functions/routines + ! Type-bound procedure to compute tendency profile for time-of-day. + ! + ! For use with 1D data (level, time) tendencies with diurnal (24-hr) forcing. ! #################################################################################### function linterp_1D(this, var_name, year, month, day, hour, minute, second) result(err_message) class(base_physics_process), intent(inout) :: this @@ -785,27 +269,92 @@ function linterp_1D(this, var_name, year, month, day, hour, minute, second) resu integer, intent(in) :: year, month, day, hour, minute, second character(len=128) :: err_message integer :: ti(1), tf(1) - real(kind_phys) :: w1, w2, hrofday + real(kind_phys) :: w1, w2 ! Interpolation weights - hrofday = hour*3600. + minute*60. + second - ti = findloc(abs(this%tend%time-hrofday),minval(abs(this%tend%time-hrofday))) - if (hrofday - this%tend%time(ti(1)) .le. 0) ti = ti-1 - tf = ti + 1 - w1 = (this%tend%time(tf(1))-hrofday) / (this%tend%time(tf(1)) - this%tend%time(ti(1))) - w2 = 1 - w1 + call this%cmp_time_wts(year, month, day, hour, minute, second, w1, w2, ti, tf) select case(var_name) case("T") - this%itend%dT = w1*this%tend%T(:,ti(1)) + w2*this%tend%T(:,tf(1)) + this%tend1d%T = w1*this%tend2d%T(:,ti(1)) + w2*this%tend2d%T(:,tf(1)) case("u") - this%itend%du = w1*this%tend%u(:,ti(1)) + w2*this%tend%u(:,tf(1)) + this%tend1d%u = w1*this%tend2d%u(:,ti(1)) + w2*this%tend2d%u(:,tf(1)) case("v") - this%itend%dv = w1*this%tend%v(:,ti(1)) + w2*this%tend%v(:,tf(1)) + this%tend1d%v = w1*this%tend2d%v(:,ti(1)) + w2*this%tend2d%v(:,tf(1)) case("q") - this%itend%dq = w1*this%tend%q(:,ti(1),1) + w2*this%tend%q(:,tf(1),1) + this%tend1d%q(:,1) = w1*this%tend2d%q(:,ti(1),1) + w2*this%tend2d%q(:,tf(1),1) end select end function linterp_1D - + + ! #################################################################################### + ! Type-bound procedure to compute tendency profile for time-of-day. + ! + ! For use with 2D data (location, level, time) tendencies with diurnal (24-hr) forcing. + ! This assumes that the location dimension has a [longitude, latitude] associated with + ! each location. + ! #################################################################################### + function linterp_2D(this, var_name, lon, lat, year, month, day, hour, minute, second) result(err_message) + class(base_physics_process), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer, intent(in) :: year, month, day, hour, minute, second + real(kind_phys), intent(in) :: lon, lat + character(len=128) :: err_message + integer :: ti(1), tf(1), iNearest + real(kind_phys) :: w1, w2 + + ! Interpolation weights (temporal) + call this%cmp_time_wts(year, month, day, hour, minute, second, w1, w2, ti, tf) + + ! Grab data tendency closest to column [lon,lat] + iNearest = this%find_nearest_loc_2d_1d(lon,lat) + + select case(var_name) + case("T") + this%tend1d%T = w1*this%tend3d%T(iNearest,:,ti(1)) + w2*this%tend3d%T(iNearest,:,tf(1)) + case("u") + this%tend1d%u = w1*this%tend3d%u(iNearest,:,ti(1)) + w2*this%tend3d%u(iNearest,:,tf(1)) + case("v") + this%tend1d%v = w1*this%tend3d%v(iNearest,:,ti(1)) + w2*this%tend3d%v(iNearest,:,tf(1)) + case("q") + this%tend1d%q(:,1) = w1*this%tend3d%q(iNearest,:,ti(1),1) + w2*this%tend3d%q(iNearest,:,tf(1),1) + end select + end function linterp_2D + + ! #################################################################################### + ! Type-bound procedure to find nearest location. + ! + ! For use with linterp_2D, NOT YET IMPLEMENTED. + ! #################################################################################### + pure function find_nearest_loc_2d_1d(this, lon, lat) + class(base_physics_process), intent(in) :: this + real(kind_phys), intent(in) :: lon, lat + integer :: find_nearest_loc_2d_1d + + find_nearest_loc_2d_1d = 1 + end function find_nearest_loc_2d_1d + + ! #################################################################################### + ! Type-bound procedure to compute linear interpolation weights for a diurnal (24-hour) + ! forcing. + ! #################################################################################### + subroutine cmp_time_wts(this, year, month, day, hour, minute, second, w1, w2, ti, tf) + ! Inputs + class(base_physics_process), intent(in) :: this + integer, intent(in) :: year, month, day, hour, minute, second + ! Outputs + integer,intent(out) :: ti(1), tf(1) + real(kind_phys),intent(out) :: w1, w2 + ! Locals + real(kind_phys) :: hrofday + + hrofday = hour*3600. + minute*60. + second + ti = findloc(abs(this%tend2d%time-hrofday),minval(abs(this%tend2d%time-hrofday))) + if (hrofday - this%tend2d%time(ti(1)) .le. 0) ti = ti-1 + tf = ti + 1 + w1 = (this%tend2d%time(tf(1))-hrofday) / (this%tend2d%time(tf(1)) - this%tend2d%time(ti(1))) + w2 = 1 - w1 + + end subroutine cmp_time_wts + end module ccpp_scheme_simulator diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_scheme_simulator.meta index 80f898ed2..02bf17285 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -3,62 +3,6 @@ type = scheme dependencies = machine.F -######################################################################## -[ccpp-arg-table] - name = ccpp_scheme_simulator_init - type = scheme -[mpirank] - standard_name = mpi_rank - long_name = MPI rank of current process - units = index - dimensions = () - type = integer - intent = in -[mpiroot] - standard_name = mpi_root - long_name = MPI rank of master process - units = index - dimensions = () - type = integer - intent = in -[mpicomm] - standard_name = mpi_communicator - long_name = MPI communicator - units = index - dimensions = () - type = integer - intent = in -[nlunit] - standard_name = iounit_of_namelist - long_name = fortran unit number for opening nameliust file - units = none - dimensions = () - type = integer - intent = in -[nml_file] - standard_name = filename_of_namelist - long_name = namelist filename - units = none - dimensions = () - type = character - kind = len=* - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - ######################################################################## [ccpp-arg-table] name = ccpp_scheme_simulator_run diff --git a/physics/load_ccpp_scheme_sim.F90 b/physics/load_ccpp_scheme_sim.F90 new file mode 100644 index 000000000..1041e113c --- /dev/null +++ b/physics/load_ccpp_scheme_sim.F90 @@ -0,0 +1,577 @@ +! ######################################################################################## +! +! CCPP scheme to read and load data for ccpp_scheme_simulator +! +! ######################################################################################## +module load_ccpp_scheme_sim + use machine, only: kind_phys + use netcdf + use ccpp_scheme_simulator, only: do_ccpp_scheme_simulator, physics_process, active_name,& + iactive_scheme, proc_start, proc_end, active_time_split_process +#ifdef MPI + use mpi +#endif + implicit none + + ! ######################################################################################## + ! + ! Configuration for CCPP scheme simulator. Set in namelist. Used during initialization to + ! populate "physics_process" type array, defined in ccpp_scheme_simulator.F90 + ! + ! ######################################################################################## + + ! Number of physics process (set in namelist) + integer :: nPhysProcess + + ! For each process there is a corresponding namelist entry, which is constructed as follows: + ! {use_scheme_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} + integer, dimension(3) :: & + proc_LWRAD_config = (/0,0,0/), & + proc_SWRAD_config = (/0,0,0/), & + proc_PBL_config = (/0,0,0/), & + proc_GWD_config = (/0,0,0/), & + proc_SCNV_config = (/0,0,0/), & + proc_DCNV_config = (/0,0,0/), & + proc_cldMP_config = (/0,0,0/) + + ! Activation flag for scheme. + logical :: do_load_ccpp_scheme = .false. + + ! Data driven physics tendencies + integer :: nlev_data, ntime_data + real(kind_phys), allocatable, dimension(:), target :: time_data + real(kind_phys), allocatable, dimension(:,:), target :: dTdt_LWRAD_data, & + dTdt_SWRAD_data, dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, & + dudt_GWD_data, dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, & + dTdt_DCNV_data, dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data + real(kind_phys), allocatable, dimension(:,:,:), target :: dqdt_PBL_data, & + dqdt_SCNV_data, dqdt_DCNV_data, dqdt_cldMP_data + + ! Scheme initialization flag. + logical :: module_initialized = .false. + + public load_ccpp_scheme_sim_init +contains + + ! ###################################################################################### + ! + ! SUBROUTINE load_ccpp_scheme_sim_init + ! + ! ###################################################################################### +!! \section arg_table_load_ccpp_scheme_sim_init +!! \htmlinclude load_ccpp_scheme_sim_init.html +!! + subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file, & + errmsg, errflg) + + ! Inputs + integer, intent (in) :: mpirank, mpiroot, mpicomm, nlunit + character(len=*), intent (in) :: nml_file + + ! Outputs + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: ncid, dimID, varID, status, nlon, nlat, ios, iprc + character(len=256) :: fileIN + logical :: exists + integer,parameter :: nTrc = 1 ! Only specific humodty for now, but preserve 3 dimensionality + + ! Switches for input data + logical :: have_dTdt_LWRAD_data = .false., & + have_dTdt_SWRAD_data = .false., & + have_dTdt_PBL_data = .false., & + have_dqdt_PBL_data = .false., & + have_dudt_PBL_data = .false., & + have_dvdt_PBL_data = .false., & + have_dTdt_GWD_data = .false., & + have_dudt_GWD_data = .false., & + have_dvdt_GWD_data = .false., & + have_dTdt_SCNV_data = .false., & + have_dudt_SCNV_data = .false., & + have_dvdt_SCNV_data = .false., & + have_dqdt_SCNV_data = .false., & + have_dTdt_DCNV_data = .false., & + have_dudt_DCNV_data = .false., & + have_dvdt_DCNV_data = .false., & + have_dqdt_DCNV_data = .false., & + have_dTdt_cldMP_data = .false., & + have_dqdt_cldMP_data = .false. + + ! Namelist + namelist / scm_data_nml / fileIN, nPhysProcess, proc_LWRAD_config, proc_SWRAD_config, & + proc_PBL_config, proc_GWD_config, proc_SCNV_config, proc_DCNV_config, & + proc_cldMP_config + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (module_initialized) return + module_initialized = .true. + + ! ###################################################################################### + ! + ! Part A) Read in namelist and data. + ! + ! ###################################################################################### + + ! Read in namelist + inquire (file = trim (nml_file), exist = exists) + if (.not. exists) then + errmsg = 'SCM data tendency :: namelist file: '//trim(nml_file)//' does not exist' + errflg = 1 + return + else + open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) + endif + rewind (nlunit) + read (nlunit, nml = scm_data_nml) + close (nlunit) + + ! Only proceed if scheme simulator requested. + if (proc_SWRAD_config(1) .or. proc_LWRAD_config(1) .or. proc_PBL_config(1) .or. & + proc_GWD_config(1) .or. proc_SCNV_config(1) .or. proc_DCNV_config(1) .or. & + proc_cldMP_config(1)) then + do_ccpp_scheme_simulator = .true. + else + return + endif + + ! Check that input data file exists + inquire (file = trim (fileIN), exist = exists) + if (.not. exists) then + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not exist' + errflg = 1 + return + endif + + ! Read mandatory information from data file... + ! (ONLY master processor(0), if MPI enabled) +#ifdef MPI + if (mpirank .eq. mpiroot) then +#endif + + ! Open file (required) + status = nf90_open(trim(fileIN), NF90_NOWRITE, ncid) + if (status /= nf90_noerr) then + errmsg = 'Error reading in SCM data tendency file: '//trim(fileIN) + errflg = 1 + return + endif + + ! Get dimensions (required) + status = nf90_inq_dimid(ncid, 'time', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) + else + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain [time] dimension' + errflg = 1 + return + endif + ! + status = nf90_inq_dimid(ncid, 'lev', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) + else + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain [lev] dimension' + errflg = 1 + return + endif +#ifdef MPI + endif ! On master processor + + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + + ! Broadcast dimensions... + ! (ALL processors) + call mpi_bcast(ntime_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nlev_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_barrier(mpicomm, mpierr) + + if (mpirank .eq. mpiroot) then +#endif + + ! + ! What data fields do we have? + status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) + if (status == nf90_noerr) have_dTdt_LWRAD_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) + if (status == nf90_noerr) have_dTdt_SWRAD_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) + if (status == nf90_noerr) have_dTdt_PBL_data = .true. + ! + status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) + if (status == nf90_noerr) have_dqdt_PBL_data = .true. + ! + status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) + if (status == nf90_noerr) have_dudt_PBL_data = .true. + ! + status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) + if (status == nf90_noerr) have_dvdt_PBL_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) + if (status == nf90_noerr) have_dTdt_GWD_data = .true. + ! + status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) + if (status == nf90_noerr) have_dudt_GWD_data = .true. + ! + status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) + if (status == nf90_noerr) have_dvdt_GWD_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) + if (status == nf90_noerr) have_dTdt_SCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) + if (status == nf90_noerr) have_dudt_SCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) + if (status == nf90_noerr) have_dvdt_SCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) + if (status == nf90_noerr) have_dqdt_SCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) + if (status == nf90_noerr) have_dTdt_DCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) + if (status == nf90_noerr) have_dudt_DCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) + if (status == nf90_noerr) have_dvdt_DCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) + if (status == nf90_noerr) have_dqdt_DCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) + if (status == nf90_noerr) have_dTdt_cldMP_data = .true. + ! + status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) + if (status == nf90_noerr) have_dqdt_cldMP_data = .true. + +#ifdef MPI + endif ! Master process +#endif + + ! Allocate space for data + allocate(time_data(ntime_data)) + if (have_dTdt_LWRAD_data) allocate(dTdt_LWRAD_data(nlev_data, ntime_data)) + if (have_dTdt_SWRAD_data) allocate(dTdt_SWRAD_data(nlev_data, ntime_data)) + if (have_dTdt_PBL_data) allocate(dTdt_PBL_data( nlev_data, ntime_data)) + if (have_dqdt_PBL_data) allocate(dqdt_PBL_data( nlev_data, ntime_data, nTrc)) + if (have_dudt_PBL_data) allocate(dudt_PBL_data( nlev_data, ntime_data)) + if (have_dvdt_PBL_data) allocate(dvdt_PBL_data( nlev_data, ntime_data)) + if (have_dTdt_GWD_data) allocate(dTdt_GWD_data( nlev_data, ntime_data)) + if (have_dudt_GWD_data) allocate(dudt_GWD_data( nlev_data, ntime_data)) + if (have_dvdt_GWD_data) allocate(dvdt_GWD_data( nlev_data, ntime_data)) + if (have_dTdt_SCNV_data) allocate(dTdt_SCNV_data( nlev_data, ntime_data)) + if (have_dudt_SCNV_data) allocate(dudt_SCNV_data( nlev_data, ntime_data)) + if (have_dvdt_SCNV_data) allocate(dvdt_SCNV_data( nlev_data, ntime_data)) + if (have_dqdt_SCNV_data) allocate(dqdt_SCNV_data( nlev_data, ntime_data, nTrc)) + if (have_dTdt_DCNV_data) allocate(dTdt_DCNV_data( nlev_data, ntime_data)) + if (have_dudt_DCNV_data) allocate(dudt_DCNV_data( nlev_data, ntime_data)) + if (have_dvdt_DCNV_data) allocate(dvdt_DCNV_data( nlev_data, ntime_data)) + if (have_dqdt_DCNV_data) allocate(dqdt_DCNV_data( nlev_data, ntime_data, nTrc)) + if (have_dTdt_cldMP_data) allocate(dTdt_cldMP_data(nlev_data, ntime_data)) + if (have_dqdt_cldMP_data) allocate(dqdt_cldMP_data(nlev_data, ntime_data, nTrc)) + + ! Read in data ... + ! (ONLY master processor(0), if MPI enabled) +#ifdef MPI + if (mpirank .eq. mpiroot) then +#endif + + ! Temporal info (required) + status = nf90_inq_varid(ncid, 'times', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, time_data) + else + errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain times variable' + errflg = 1 + return + endif + + ! Read in physics data tendencies (optional) + status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_PBL_data) + ! + status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_PBL_data) + ! + status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_PBL_data) + ! + status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_PBL_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_GWD_data) + ! + status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_GWD_data) + ! + status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_GWD_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SCNV_data) + ! + status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_SCNV_data) + ! + status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_SCNV_data) + ! + status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_SCNV_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_DCNV_data) + ! + status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_DCNV_data) + ! + status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_DCNV_data) + ! + status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_DCNV_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_cldMP_data) + ! + status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_cldMP_data) + ! + status = nf90_close(ncid) + +#ifdef MPI + endif ! Master process + + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + + ! Broadcast data... + ! (ALL processors) + if (have_dTdt_LWRAD_data) then + call mpi_bcast(dTdt_LWRAD_data, size(dTdt_LWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_SWRAD_data) then + call mpi_bcast(dTdt_SWRAD_data, size(dTdt_SWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_PBL_data) then + call mpi_bcast(dTdt_PBL_data, size(dTdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dqdt_PBL_data) then + call mpi_bcast(dqdt_PBL_data, size(dqdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dudt_PBL_data) then + call mpi_bcast(dudt_PBL_data, size(dudt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dvdt_PBL_data) then + call mpi_bcast(dvdt_PBL_data, size(dvdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_GWD_data) then + call mpi_bcast(dTdt_GWD_data, size(dTdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dudt_GWD_data) then + call mpi_bcast(dudt_GWD_data, size(dudt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dvdt_GWD_data) then + call mpi_bcast(dvdt_GWD_data, size(dvdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_SCNV_data) then + call mpi_bcast(dTdt_SCNV_data, size(dTdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dudt_SCNV_data) then + call mpi_bcast(dudt_SCNV_data, size(dudt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dvdt_SCNV_data) then + call mpi_bcast(dvdt_SCNV_data, size(dvdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dqdt_SCNV_data) then + call mpi_bcast(dqdt_SCNV_data, size(dqdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_DCNV_data) then + call mpi_bcast(dTdt_DCNV_data, size(dTdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dudt_DCNV_data) then + call mpi_bcast(dudt_DCNV_data, size(dudt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dvdt_DCNV_data) then + call mpi_bcast(dvdt_DCNV_data, size(dvdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dqdt_DCNV_data) then + call mpi_bcast(dqdt_DCNV_data, size(dqdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_cldMP_data) then + call mpi_bcast(dTdt_cldMP_data, size(dTdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dqdt_cldMP_data) then + call mpi_bcast(dqdt_cldMP_data, size(dqdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + ! + call mpi_barrier(mpicomm, mpierr) +#endif + + ! ####################################################################################### + ! + ! Part B) Populate physics_process type. + ! + ! ####################################################################################### + ! Default process extent (no time-split physics processes) + proc_start = 1 + proc_end = nPhysProcess + + ! Allocate + allocate(physics_process(nPhysProcess)) + + ! Metadata + do iprc = 1,nPhysProcess + allocate(physics_process(iprc)%tend1d%T(nlev_data)) + allocate(physics_process(iprc)%tend1d%u(nlev_data)) + allocate(physics_process(iprc)%tend1d%v(nlev_data)) + allocate(physics_process(iprc)%tend1d%q(nlev_data,1)) + if (iprc == proc_SWRAD_config(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "SWRAD" + if (proc_SWRAD_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_SWRAD_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == proc_LWRAD_config(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "LWRAD" + if (proc_LWRAD_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_LWRAD_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == proc_GWD_config(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "GWD" + if (proc_GWD_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_GWD_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == proc_PBL_config(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "PBL" + if (proc_PBL_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_PBL_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == proc_SCNV_config(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "SCNV" + if (proc_SCNV_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_SCNV_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == proc_DCNV_config(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "DCNV" + if (proc_DCNV_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_DCNV_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == proc_cldMP_config(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "cldMP" + if (proc_cldMP_config(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (proc_cldMP_config(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + enddo + + ! Load data + physics_process(proc_LWRAD_config(3))%tend2d%time => time_data + physics_process(proc_SWRAD_config(3))%tend2d%time => time_data + physics_process(proc_PBL_config(3))%tend2d%time => time_data + physics_process(proc_GWD_config(3))%tend2d%time => time_data + physics_process(proc_DCNV_config(3))%tend2d%time => time_data + physics_process(proc_SCNV_config(3))%tend2d%time => time_data + physics_process(proc_cldMP_config(3))%tend2d%time => time_data + if (have_dTdt_LWRAD_data) physics_process(proc_SWRAD_config(3))%tend2d%T => dTdt_LWRAD_data + if (have_dTdt_SWRAD_data) physics_process(proc_LWRAD_config(3))%tend2d%T => dTdt_SWRAD_data + if (have_dTdt_PBL_data) physics_process(proc_PBL_config(3))%tend2d%T => dTdt_PBL_data + if (have_dudt_PBL_data) physics_process(proc_PBL_config(3))%tend2d%u => dudt_PBL_data + if (have_dvdt_PBL_data) physics_process(proc_PBL_config(3))%tend2d%v => dvdt_PBL_data + if (have_dqdt_PBL_data) physics_process(proc_PBL_config(3))%tend2d%q => dqdt_PBL_data + if (have_dTdt_GWD_data) physics_process(proc_GWD_config(3))%tend2d%T => dTdt_GWD_data + if (have_dudt_GWD_data) physics_process(proc_GWD_config(3))%tend2d%u => dudt_GWD_data + if (have_dvdt_GWD_data) physics_process(proc_GWD_config(3))%tend2d%v => dvdt_GWD_data + if (have_dTdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend2d%T => dTdt_SCNV_data + if (have_dudt_SCNV_data) physics_process(proc_SCNV_config(3))%tend2d%u => dudt_SCNV_data + if (have_dvdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend2d%v => dvdt_SCNV_data + if (have_dqdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend2d%q => dqdt_SCNV_data + if (have_dTdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend2d%T => dTdt_DCNV_data + if (have_dudt_DCNV_data) physics_process(proc_DCNV_config(3))%tend2d%u => dudt_DCNV_data + if (have_dvdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend2d%v => dvdt_DCNV_data + if (have_dqdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend2d%q => dqdt_DCNV_data + if (have_dTdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend2d%T => dTdt_cldMP_data + if (have_dqdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend2d%q => dqdt_cldMP_data + + ! Which process-scheme is "Active"? Is it a time-split process? + do iprc = 1,nPhysProcess + if (.not. physics_process(iprc)%use_sim) then + iactive_scheme = iprc + active_name = physics_process(iprc)%name + if (physics_process(iprc)%time_split) then + active_time_split_process = .true. + endif + endif + enddo + + ! + if (mpirank .eq. mpiroot) then + print*, "-----------------------------------" + print*, "--- Using CCPP scheme simulator ---" + print*, "-----------------------------------" + do iprc = 1,nPhysProcess + if (physics_process(iprc)%use_sim) then + print*," simulate_scheme: ", trim(physics_process(iprc)%name) + print*," order: ", physics_process(iprc)%order + print*," time_split: ", physics_process(iprc)%time_split + endif + enddo + print*, " active_scheme: ", trim(active_name) + print*, " order: ", physics_process(iactive_scheme)%order + print*, " time_split : ", active_time_split_process + print*, "-----------------------------------" + print*, "-----------------------------------" + endif + + end subroutine load_ccpp_scheme_sim_init + +end module load_ccpp_scheme_sim diff --git a/physics/load_ccpp_scheme_sim.meta b/physics/load_ccpp_scheme_sim.meta new file mode 100644 index 000000000..6e0aea925 --- /dev/null +++ b/physics/load_ccpp_scheme_sim.meta @@ -0,0 +1,60 @@ +[ccpp-table-properties] + name = load_ccpp_scheme_sim + type = scheme + dependencies = machine.F,ccpp_scheme_simulator.F90 + +######################################################################## +[ccpp-arg-table] + name = load_ccpp_scheme_sim_init + type = scheme +[mpirank] + standard_name = mpi_rank + long_name = MPI rank of current process + units = index + dimensions = () + type = integer + intent = in +[mpiroot] + standard_name = mpi_root + long_name = MPI rank of master process + units = index + dimensions = () + type = integer + intent = in +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in +[nlunit] + standard_name = iounit_of_namelist + long_name = fortran unit number for opening nameliust file + units = none + dimensions = () + type = integer + intent = in +[nml_file] + standard_name = filename_of_namelist + long_name = namelist filename + units = none + dimensions = () + type = character + kind = len=* + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out From 8bc8ec909ea493714aa9c8325cd5bb93ef204225 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Mon, 13 Feb 2023 11:15:06 -0700 Subject: [PATCH 10/22] Small bug fix to nml --- physics/load_ccpp_scheme_sim.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/load_ccpp_scheme_sim.F90 b/physics/load_ccpp_scheme_sim.F90 index 1041e113c..db2181cf3 100644 --- a/physics/load_ccpp_scheme_sim.F90 +++ b/physics/load_ccpp_scheme_sim.F90 @@ -127,7 +127,7 @@ subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) endif rewind (nlunit) - read (nlunit, nml = scm_data_nml) + read (nlunit, nml = scm_data_nml, iostat=status) close (nlunit) ! Only proceed if scheme simulator requested. From 6db4af5baeb306f24466bc601b0b42e787f6cb0c Mon Sep 17 00:00:00 2001 From: dustinswales Date: Mon, 13 Feb 2023 16:52:20 -0700 Subject: [PATCH 11/22] Remove dimension for tracer, handle tracers individualy, not with stacked array --- physics/ccpp_scheme_simulator.F90 | 126 +++++++++++++++-------------- physics/ccpp_scheme_simulator.meta | 4 +- physics/load_ccpp_scheme_sim.F90 | 13 +-- 3 files changed, 74 insertions(+), 69 deletions(-) diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index 3b478844f..4fffc8bb5 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -15,41 +15,41 @@ module ccpp_scheme_simulator ! ######################################################################################## ! Type containing 1D (time) physics tendencies. type phys_tend_1d - real(kind_phys), dimension(:), pointer :: T - real(kind_phys), dimension(:), pointer :: u - real(kind_phys), dimension(:), pointer :: v - real(kind_phys), dimension(:,:), pointer :: q + real(kind_phys), dimension(:), pointer :: T + real(kind_phys), dimension(:), pointer :: u + real(kind_phys), dimension(:), pointer :: v + real(kind_phys), dimension(:), pointer :: q end type phys_tend_1d ! Type containing 2D (lev,time) physics tendencies. type phys_tend_2d - real(kind_phys), dimension(:), pointer :: time - real(kind_phys), dimension(:,:), pointer :: T - real(kind_phys), dimension(:,:), pointer :: u - real(kind_phys), dimension(:,:), pointer :: v - real(kind_phys), dimension(:,:,:), pointer :: q + real(kind_phys), dimension(:), pointer :: time + real(kind_phys), dimension(:,:), pointer :: T + real(kind_phys), dimension(:,:), pointer :: u + real(kind_phys), dimension(:,:), pointer :: v + real(kind_phys), dimension(:,:), pointer :: q end type phys_tend_2d ! Type containing 3D (loc,lev,time) physics tendencies. type phys_tend_3d - real(kind_phys), dimension(:), pointer :: time - real(kind_phys), dimension(:), pointer :: lon - real(kind_phys), dimension(:), pointer :: lat - real(kind_phys), dimension(:,:,:), pointer :: T - real(kind_phys), dimension(:,:,:), pointer :: u - real(kind_phys), dimension(:,:,:), pointer :: v - real(kind_phys), dimension(:,:,:,:), pointer :: q + real(kind_phys), dimension(:), pointer :: time + real(kind_phys), dimension(:), pointer :: lon + real(kind_phys), dimension(:), pointer :: lat + real(kind_phys), dimension(:,:,:), pointer :: T + real(kind_phys), dimension(:,:,:), pointer :: u + real(kind_phys), dimension(:,:,:), pointer :: v + real(kind_phys), dimension(:,:,:), pointer :: q end type phys_tend_3d ! Type containing 4D (lon, lat,lev,time) physics tendencies. type phys_tend_4d - real(kind_phys), dimension(:), pointer :: time - real(kind_phys), dimension(:,:), pointer :: lon - real(kind_phys), dimension(:,:), pointer :: lat - real(kind_phys), dimension(:,:,:,:), pointer :: T - real(kind_phys), dimension(:,:,:,:), pointer :: u - real(kind_phys), dimension(:,:,:,:), pointer :: v - real(kind_phys), dimension(:,:,:,:,:), pointer :: q + real(kind_phys), dimension(:), pointer :: time + real(kind_phys), dimension(:,:), pointer :: lon + real(kind_phys), dimension(:,:), pointer :: lat + real(kind_phys), dimension(:,:,:,:), pointer :: T + real(kind_phys), dimension(:,:,:,:), pointer :: u + real(kind_phys), dimension(:,:,:,:), pointer :: v + real(kind_phys), dimension(:,:,:,:), pointer :: q end type phys_tend_4d ! This type contains the meta information and data for each physics process. @@ -118,16 +118,16 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti ! Outputs real(kind_phys), intent(inout), dimension(:,:) :: gt0, gu0, gv0 - real(kind_phys), intent(inout), dimension(:,:,:) :: gq0 + real(kind_phys), intent(inout), dimension(:,:) :: gq0 character(len=*),intent(out) :: errmsg integer, intent(out) :: errflg ! Locals - integer :: iCol, iLay, iTrc, nCol, nLay, nTrc, ti(1), tf(1), idtend, fcst_year, & - fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec, iprc, index_of_active_process + integer :: iCol, iLay, nCol, nLay, idtend, fcst_year, fcst_month, fcst_day, & + fcst_hour, fcst_min, fcst_sec, iprc, index_of_active_process real(kind_phys) :: w1, w2,hrofday - real(kind_phys), dimension(:,:), allocatable :: gt1, gu1, gv1, dTdt, dudt, dvdt - real(kind_phys), dimension(:,:,:), allocatable :: gq1, dqdt + real(kind_phys), dimension(:,:), allocatable :: gt1, gu1, gv1, dTdt, dudt, dvdt + real(kind_phys), dimension(:,:), allocatable :: gq1, dqdt ! Initialize CCPP error handling variables errmsg = '' @@ -144,13 +144,12 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti fcst_sec = jdat(7) ! Dimensions - nCol = size(gq0(:,1,1)) - nLay = size(gq0(1,:,1)) - nTrc = size(gq0(1,1,:)) + nCol = size(gq0(:,1)) + nLay = size(gq0(1,:)) ! Allocate temporaries - allocate(gt1(nCol,nLay), gu1(nCol,nLay), gv1(nCol,nLay), gq1(nCol,nLay,1)) - allocate(dTdt(nCol,nLay), dudt(nCol,nLay), dvdt(nCol,nLay), dqdt(nCol,nLay,1)) + allocate(gt1(nCol,nLay), gu1(nCol,nLay), gv1(nCol,nLay), gq1(nCol,nLay)) + allocate(dTdt(nCol,nLay), dudt(nCol,nLay), dvdt(nCol,nLay), dqdt(nCol,nLay)) ! Get tendency for "active" process. ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional @@ -173,14 +172,14 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti if (active_name == "cldMP") index_of_active_process = index_of_process_mp ! Set state at beginning of the physics timestep. - gt1(:,:) = tgrs(:,:) - gu1(:,:) = ugrs(:,:) - gv1(:,:) = vgrs(:,:) - gq1(:,:,1) = qgrs(:,:,1) - dTdt(:,:) = 0. - dudt(:,:) = 0. - dvdt(:,:) = 0. - dqdt(:,:,1)= 0. + gt1(:,:) = tgrs(:,:) + gu1(:,:) = ugrs(:,:) + gv1(:,:) = vgrs(:,:) + gq1(:,:) = qgrs(:,:,1) + dTdt(:,:) = 0. + dudt(:,:) = 0. + dvdt(:,:) = 0. + dqdt(:,:) = 0. ! Internal physics timestep evolution. do iprc = proc_start,proc_end @@ -188,13 +187,14 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti proc_start = iactive_scheme exit endif + print*,'Simulating ',iprc,' of ',proc_end do iCol = 1,nCol ! Reset locals physics_process(iprc)%tend1d%T(:) = 0. physics_process(iprc)%tend1d%u(:) = 0. physics_process(iprc)%tend1d%v(:) = 0. - physics_process(iprc)%tend1d%q(:,1) = 0. + physics_process(iprc)%tend1d%q(:) = 0. ! Using scheme simulator (very simple, interpolate data tendency to local time) if (physics_process(iprc)%use_sim) then @@ -224,32 +224,35 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti if (idtend >= 1) physics_process(iprc)%tend1d%v = dtend(iCol,:,idtend)/dtp ! idtend = dtidx(100+ntqv,index_of_active_process) - if (idtend >= 1) physics_process(iprc)%tend1d%q(:,1) = dtend(iCol,:,idtend)/dtp + if (idtend >= 1) physics_process(iprc)%tend1d%q = dtend(iCol,:,idtend)/dtp endif ! Update state now? if (physics_process(iprc)%time_split) then - gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%tend1d%T)*dtp - gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp - gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp - gq1(iCol,:,1) = gq1(iCol,:,1) + (dqdt(iCol,:,1) + physics_process(iprc)%tend1d%q(:,1))*dtp - dTdt(iCol,:) = 0. - dudt(iCol,:) = 0. - dvdt(iCol,:) = 0. - dqdt(iCol,:,1) = 0. + gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%tend1d%T)*dtp + gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp + gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp + gq1(iCol,:) = gq1(iCol,:) + (dqdt(iCol,:) + physics_process(iprc)%tend1d%q)*dtp + dTdt(iCol,:) = 0. + dudt(iCol,:) = 0. + dvdt(iCol,:) = 0. + dqdt(iCol,:) = 0. ! Accumulate tendencies, update later? else - dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%tend1d%T - dudt(iCol,:) = dudt(iCol,:) + physics_process(iprc)%tend1d%u - dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%tend1d%v - dqdt(iCol,:,1) = dqdt(iCol,:,1) + physics_process(iprc)%tend1d%q(:,1) + dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%tend1d%T + dudt(iCol,:) = dudt(iCol,:) + physics_process(iprc)%tend1d%u + dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%tend1d%v + dqdt(iCol,:) = dqdt(iCol,:) + physics_process(iprc)%tend1d%q endif enddo ! - gt0(iCol,:) = gt1(iCol,:) + dTdt(iCol,:)*dtp - gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp - gv0(iCol,:) = gv1(iCol,:) + dvdt(iCol,:)*dtp - gq0(iCol,:,1) = gq1(iCol,:,1) + dqdt(iCol,:,1)*dtp + do iLay=1,nLay + write(*,'(i3,6f13.6)') ilay, gt0(iCol,iLay) , gt1(iCol,iLay) , dTdt(iCol,iLay)*dtp,physics_process(iprc)%tend1d%T(iLay),physics_process(iprc)%tend2d%T(iLay,3),physics_process(iprc)%tend2d%T(iLay,4) + enddo + gt0(iCol,:) = gt1(iCol,:) + dTdt(iCol,:)*dtp + gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp + gv0(iCol,:) = gv1(iCol,:) + dvdt(iCol,:)*dtp + gq0(iCol,:) = gq1(iCol,:) + dqdt(iCol,:)*dtp enddo if (iprc == proc_end) then @@ -273,6 +276,7 @@ function linterp_1D(this, var_name, year, month, day, hour, minute, second) resu ! Interpolation weights call this%cmp_time_wts(year, month, day, hour, minute, second, w1, w2, ti, tf) + print*,w1,w2,ti,tf select case(var_name) case("T") @@ -282,7 +286,7 @@ function linterp_1D(this, var_name, year, month, day, hour, minute, second) resu case("v") this%tend1d%v = w1*this%tend2d%v(:,ti(1)) + w2*this%tend2d%v(:,tf(1)) case("q") - this%tend1d%q(:,1) = w1*this%tend2d%q(:,ti(1),1) + w2*this%tend2d%q(:,tf(1),1) + this%tend1d%q = w1*this%tend2d%q(:,ti(1)) + w2*this%tend2d%q(:,tf(1)) end select end function linterp_1D @@ -317,7 +321,7 @@ function linterp_2D(this, var_name, lon, lat, year, month, day, hour, minute, se case("v") this%tend1d%v = w1*this%tend3d%v(iNearest,:,ti(1)) + w2*this%tend3d%v(iNearest,:,tf(1)) case("q") - this%tend1d%q(:,1) = w1*this%tend3d%q(iNearest,:,ti(1),1) + w2*this%tend3d%q(iNearest,:,tf(1),1) + this%tend1d%q = w1*this%tend3d%q(iNearest,:,ti(1)) + w2*this%tend3d%q(iNearest,:,tf(1)) end select end function linterp_2D diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_scheme_simulator.meta index 02bf17285..c0dc2f172 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -178,10 +178,10 @@ kind = kind_phys intent = inout [gq0] - standard_name = tracer_concentration_of_new_state + standard_name = specific_humidity_of_new_state long_name = tracer concentration updated by physics units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/load_ccpp_scheme_sim.F90 b/physics/load_ccpp_scheme_sim.F90 index db2181cf3..b23c15839 100644 --- a/physics/load_ccpp_scheme_sim.F90 +++ b/physics/load_ccpp_scheme_sim.F90 @@ -44,7 +44,7 @@ module load_ccpp_scheme_sim dTdt_SWRAD_data, dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, & dudt_GWD_data, dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, & dTdt_DCNV_data, dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data - real(kind_phys), allocatable, dimension(:,:,:), target :: dqdt_PBL_data, & + real(kind_phys), allocatable, dimension(:,:), target :: dqdt_PBL_data, & dqdt_SCNV_data, dqdt_DCNV_data, dqdt_cldMP_data ! Scheme initialization flag. @@ -262,7 +262,7 @@ subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file if (have_dTdt_LWRAD_data) allocate(dTdt_LWRAD_data(nlev_data, ntime_data)) if (have_dTdt_SWRAD_data) allocate(dTdt_SWRAD_data(nlev_data, ntime_data)) if (have_dTdt_PBL_data) allocate(dTdt_PBL_data( nlev_data, ntime_data)) - if (have_dqdt_PBL_data) allocate(dqdt_PBL_data( nlev_data, ntime_data, nTrc)) + if (have_dqdt_PBL_data) allocate(dqdt_PBL_data( nlev_data, ntime_data)) if (have_dudt_PBL_data) allocate(dudt_PBL_data( nlev_data, ntime_data)) if (have_dvdt_PBL_data) allocate(dvdt_PBL_data( nlev_data, ntime_data)) if (have_dTdt_GWD_data) allocate(dTdt_GWD_data( nlev_data, ntime_data)) @@ -271,13 +271,13 @@ subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file if (have_dTdt_SCNV_data) allocate(dTdt_SCNV_data( nlev_data, ntime_data)) if (have_dudt_SCNV_data) allocate(dudt_SCNV_data( nlev_data, ntime_data)) if (have_dvdt_SCNV_data) allocate(dvdt_SCNV_data( nlev_data, ntime_data)) - if (have_dqdt_SCNV_data) allocate(dqdt_SCNV_data( nlev_data, ntime_data, nTrc)) + if (have_dqdt_SCNV_data) allocate(dqdt_SCNV_data( nlev_data, ntime_data)) if (have_dTdt_DCNV_data) allocate(dTdt_DCNV_data( nlev_data, ntime_data)) if (have_dudt_DCNV_data) allocate(dudt_DCNV_data( nlev_data, ntime_data)) if (have_dvdt_DCNV_data) allocate(dvdt_DCNV_data( nlev_data, ntime_data)) - if (have_dqdt_DCNV_data) allocate(dqdt_DCNV_data( nlev_data, ntime_data, nTrc)) + if (have_dqdt_DCNV_data) allocate(dqdt_DCNV_data( nlev_data, ntime_data)) if (have_dTdt_cldMP_data) allocate(dTdt_cldMP_data(nlev_data, ntime_data)) - if (have_dqdt_cldMP_data) allocate(dqdt_cldMP_data(nlev_data, ntime_data, nTrc)) + if (have_dqdt_cldMP_data) allocate(dqdt_cldMP_data(nlev_data, ntime_data)) ! Read in data ... ! (ONLY master processor(0), if MPI enabled) @@ -301,6 +301,7 @@ subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file ! status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) + print*,'dTdt_SWRAD_data: ',dTdt_SWRAD_data ! status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_PBL_data) @@ -441,7 +442,7 @@ subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file allocate(physics_process(iprc)%tend1d%T(nlev_data)) allocate(physics_process(iprc)%tend1d%u(nlev_data)) allocate(physics_process(iprc)%tend1d%v(nlev_data)) - allocate(physics_process(iprc)%tend1d%q(nlev_data,1)) + allocate(physics_process(iprc)%tend1d%q(nlev_data)) if (iprc == proc_SWRAD_config(3)) then physics_process(iprc)%order = iprc physics_process(iprc)%name = "SWRAD" From 147cbac00de18dbf4d705d235ec90fcde9dd4ba3 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Mon, 13 Feb 2023 21:33:15 -0700 Subject: [PATCH 12/22] Fixed bug in interpolation routine. --- physics/ccpp_scheme_simulator.F90 | 57 +++++++++++++++++++++--------- physics/ccpp_scheme_simulator.meta | 16 +++++++++ physics/load_ccpp_scheme_sim.F90 | 5 +-- 3 files changed, 57 insertions(+), 21 deletions(-) diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index 4fffc8bb5..957a97862 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -82,6 +82,8 @@ module ccpp_scheme_simulator integer :: iactive_scheme integer :: proc_start, proc_end logical :: active_time_split_process=.false. + logical :: in_pre_active = .true. + logical :: in_post_active = .false. ! Set to true in data was loaded into "physics_process" logical :: do_ccpp_scheme_simulator=.false. @@ -103,7 +105,7 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti index_of_process_shortwave, index_of_process_scnv, & index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & index_of_temperature, index_of_x_wind, index_of_y_wind, ntqv, gt0, gu0, gv0, gq0, & - errmsg, errflg) + dtdq_pbl, dtdq_mp, errmsg, errflg) ! Inputs integer, intent(in) :: kdt, ntqv, index_of_process_dcnv, & @@ -118,7 +120,7 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti ! Outputs real(kind_phys), intent(inout), dimension(:,:) :: gt0, gu0, gv0 - real(kind_phys), intent(inout), dimension(:,:) :: gq0 + real(kind_phys), intent(inout), dimension(:,:) :: gq0, dtdq_pbl, dtdq_mp character(len=*),intent(out) :: errmsg integer, intent(out) :: errflg @@ -181,13 +183,22 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti dvdt(:,:) = 0. dqdt(:,:) = 0. + if (in_pre_active) then + proc_start = 1 + proc_end = iactive_scheme-1 + endif + if (in_post_active) then + proc_start = iactive_scheme + proc_end = size(physics_process) + endif + ! Internal physics timestep evolution. do iprc = proc_start,proc_end if (iprc == iactive_scheme .and. active_time_split_process) then - proc_start = iactive_scheme - exit + print*,'Reached active process. ', iprc + else + print*,'Simulating ',iprc,' of ',proc_end endif - print*,'Simulating ',iprc,' of ',proc_end do iCol = 1,nCol ! Reset locals @@ -233,10 +244,10 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp gq1(iCol,:) = gq1(iCol,:) + (dqdt(iCol,:) + physics_process(iprc)%tend1d%q)*dtp - dTdt(iCol,:) = 0. - dudt(iCol,:) = 0. - dvdt(iCol,:) = 0. - dqdt(iCol,:) = 0. + !dTdt(iCol,:) = 0. + !dudt(iCol,:) = 0. + !dvdt(iCol,:) = 0. + !dqdt(iCol,:) = 0. ! Accumulate tendencies, update later? else dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%tend1d%T @@ -244,10 +255,17 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%tend1d%v dqdt(iCol,:) = dqdt(iCol,:) + physics_process(iprc)%tend1d%q endif + ! These are needed by samfshalcnv + if (trim(physics_process(iprc)%name) == "PBL") then + dtdq_pbl(iCol,:) = physics_process(iprc)%tend1d%q + endif + if (trim(physics_process(iprc)%name) == "cldMP") then + dtdq_mp(iCol,:) = physics_process(iprc)%tend1d%q + endif enddo ! do iLay=1,nLay - write(*,'(i3,6f13.6)') ilay, gt0(iCol,iLay) , gt1(iCol,iLay) , dTdt(iCol,iLay)*dtp,physics_process(iprc)%tend1d%T(iLay),physics_process(iprc)%tend2d%T(iLay,3),physics_process(iprc)%tend2d%T(iLay,4) + !write(*,'(i3,4f13.6)') ilay, gq0(iCol,iLay) , gq1(iCol,iLay) , dqdt(iCol,iLay)*dtp, physics_process(iprc)%tend1d%q(iLay)*dtp enddo gt0(iCol,:) = gt1(iCol,:) + dTdt(iCol,:)*dtp gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp @@ -255,9 +273,16 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti gq0(iCol,:) = gq1(iCol,:) + dqdt(iCol,:)*dtp enddo - if (iprc == proc_end) then - proc_start = 1 + if (in_pre_active) then + in_pre_active = .false. + in_post_active = .true. endif + + if (size(physics_process)+1 == iprc) then + in_pre_active = .true. + in_post_active = .false. + endif + ! end subroutine ccpp_scheme_simulator_run @@ -276,7 +301,6 @@ function linterp_1D(this, var_name, year, month, day, hour, minute, second) resu ! Interpolation weights call this%cmp_time_wts(year, month, day, hour, minute, second, w1, w2, ti, tf) - print*,w1,w2,ti,tf select case(var_name) case("T") @@ -353,10 +377,9 @@ subroutine cmp_time_wts(this, year, month, day, hour, minute, second, w1, w2, ti real(kind_phys) :: hrofday hrofday = hour*3600. + minute*60. + second - ti = findloc(abs(this%tend2d%time-hrofday),minval(abs(this%tend2d%time-hrofday))) - if (hrofday - this%tend2d%time(ti(1)) .le. 0) ti = ti-1 - tf = ti + 1 - w1 = (this%tend2d%time(tf(1))-hrofday) / (this%tend2d%time(tf(1)) - this%tend2d%time(ti(1))) + ti = max(hour,1) + tf = min(ti + 1,24) + w1 = ((hour+1)*3600 - hrofday)/3600 w2 = 1 - w1 end subroutine cmp_time_wts diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_scheme_simulator.meta index c0dc2f172..888ba2f8d 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -185,6 +185,22 @@ type = real kind = kind_phys intent = inout +[dtdq_pbl] + standard_name = instantaneous_tendency_of_specific_humidity_due_to_PBL + long_name = instantaneous_tendency_of_specific_humidity_due_to_PBL + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dtdq_mp] + standard_name = instantaneous_tendency_of_specific_humidity_due_to_microphysics + long_name = moisture tendency due to microphysics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/load_ccpp_scheme_sim.F90 b/physics/load_ccpp_scheme_sim.F90 index b23c15839..8f4c7ee57 100644 --- a/physics/load_ccpp_scheme_sim.F90 +++ b/physics/load_ccpp_scheme_sim.F90 @@ -7,7 +7,7 @@ module load_ccpp_scheme_sim use machine, only: kind_phys use netcdf use ccpp_scheme_simulator, only: do_ccpp_scheme_simulator, physics_process, active_name,& - iactive_scheme, proc_start, proc_end, active_time_split_process + iactive_scheme, active_time_split_process #ifdef MPI use mpi #endif @@ -430,9 +430,6 @@ subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file ! Part B) Populate physics_process type. ! ! ####################################################################################### - ! Default process extent (no time-split physics processes) - proc_start = 1 - proc_end = nPhysProcess ! Allocate allocate(physics_process(nPhysProcess)) From a29638959bf2202d3132b8e5ae57db7774213f1d Mon Sep 17 00:00:00 2001 From: dustinswales Date: Thu, 16 Feb 2023 21:02:27 -0700 Subject: [PATCH 13/22] Moew changes --- physics/ccpp_scheme_simulator.F90 | 230 +++++++++++++++++++++++------- physics/load_ccpp_scheme_sim.F90 | 31 ++-- 2 files changed, 203 insertions(+), 58 deletions(-) diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index 957a97862..f75580fb9 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -74,14 +74,18 @@ module ccpp_scheme_simulator type(base_physics_process), dimension(:), allocatable :: & physics_process + ! Do not change these! ! For time-split physics process we need to call this scheme twice in the SDF, once ! before the "active" scheme is called, and once after. This is because the active ! scheme uses an internal physics state that has been advanced forward by a subsequent ! physics process(es). - character(len=16) :: active_name - integer :: iactive_scheme + integer :: nactive_proc + character(len=16),allocatable,dimension(:) :: active_name + integer,allocatable,dimension(:) :: iactive_scheme + logical,allocatable,dimension(:) :: active_time_split_process + integer :: iactive_scheme_inloop = 1 + integer :: proc_start, proc_end - logical :: active_time_split_process=.false. logical :: in_pre_active = .true. logical :: in_post_active = .false. @@ -125,8 +129,8 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti integer, intent(out) :: errflg ! Locals - integer :: iCol, iLay, nCol, nLay, idtend, fcst_year, fcst_month, fcst_day, & - fcst_hour, fcst_min, fcst_sec, iprc, index_of_active_process + integer :: iCol, iLay, nCol, nLay, idtend, year, month, day, hour, min, sec, iprc, & + index_of_active_process real(kind_phys) :: w1, w2,hrofday real(kind_phys), dimension(:,:), allocatable :: gt1, gu1, gv1, dTdt, dudt, dvdt real(kind_phys), dimension(:,:), allocatable :: gq1, dqdt @@ -138,12 +142,12 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti if (.not. do_ccpp_scheme_simulator) return ! Current forecast time (Data-format specific) - fcst_year = jdat(1) - fcst_month = jdat(2) - fcst_day = jdat(3) - fcst_hour = jdat(5) - fcst_min = jdat(6) - fcst_sec = jdat(7) + year = jdat(1) + month = jdat(2) + day = jdat(3) + hour = jdat(5) + min = jdat(6) + sec = jdat(7) ! Dimensions nCol = size(gq0(:,1)) @@ -165,13 +169,13 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti ! In the SCM this is done by adding the following runtime options: ! --n_itt_out 1 --n_itt_diag 1 ! - if (active_name == "LWRAD") index_of_active_process = index_of_process_longwave - if (active_name == "SWRAD") index_of_active_process = index_of_process_shortwave - if (active_name == "PBL") index_of_active_process = index_of_process_pbl - if (active_name == "GWD") index_of_active_process = index_of_process_orographic_gwd - if (active_name == "SCNV") index_of_active_process = index_of_process_scnv - if (active_name == "DCNV") index_of_active_process = index_of_process_dcnv - if (active_name == "cldMP") index_of_active_process = index_of_process_mp + if (active_name(iactive_scheme_inloop) == "LWRAD") index_of_active_process = index_of_process_longwave + if (active_name(iactive_scheme_inloop) == "SWRAD") index_of_active_process = index_of_process_shortwave + if (active_name(iactive_scheme_inloop) == "PBL") index_of_active_process = index_of_process_pbl + if (active_name(iactive_scheme_inloop) == "GWD") index_of_active_process = index_of_process_orographic_gwd + if (active_name(iactive_scheme_inloop) == "SCNV") index_of_active_process = index_of_process_scnv + if (active_name(iactive_scheme_inloop) == "DCNV") index_of_active_process = index_of_process_dcnv + if (active_name(iactive_scheme_inloop) == "cldMP") index_of_active_process = index_of_process_mp ! Set state at beginning of the physics timestep. gt1(:,:) = tgrs(:,:) @@ -185,16 +189,16 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti if (in_pre_active) then proc_start = 1 - proc_end = iactive_scheme-1 + proc_end = max(1,iactive_scheme(iactive_scheme_inloop)-1) endif if (in_post_active) then - proc_start = iactive_scheme + proc_start = iactive_scheme(iactive_scheme_inloop) proc_end = size(physics_process) endif ! Internal physics timestep evolution. do iprc = proc_start,proc_end - if (iprc == iactive_scheme .and. active_time_split_process) then + if (iprc == iactive_scheme(iactive_scheme_inloop)) then print*,'Reached active process. ', iprc else print*,'Simulating ',iprc,' of ',proc_end @@ -209,17 +213,26 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti ! Using scheme simulator (very simple, interpolate data tendency to local time) if (physics_process(iprc)%use_sim) then - if (associated(physics_process(iprc)%tend2d%T)) then - errmsg = physics_process(iprc)%linterp("T", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) + if (physics_process(iprc)%name == "LWRAD") then + call sim_LWRAD(year, month, day, hour, min, sec, physics_process(iprc)) + endif + if (physics_process(iprc)%name == "SWRAD")then + call sim_SWRAD(year, month, day, hour, min, sec, physics_process(iprc)) + endif + if (physics_process(iprc)%name == "GWD")then + call sim_GWD(year, month, day, hour, min, sec, physics_process(iprc)) + endif + if (physics_process(iprc)%name == "PBL")then + call sim_PBL(year, month, day, hour, min, sec, physics_process(iprc)) endif - if (associated(physics_process(iprc)%tend2d%u)) then - errmsg = physics_process(iprc)%linterp("u", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) + if (physics_process(iprc)%name == "SCNV")then + call sim_SCNV(year, month, day, hour, min, sec, physics_process(iprc)) endif - if (associated(physics_process(iprc)%tend2d%v)) then - errmsg = physics_process(iprc)%linterp("v", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) + if (physics_process(iprc)%name == "DCNV")then + call sim_DCNV(year, month, day, hour, min, sec, physics_process(iprc)) endif - if (associated(physics_process(iprc)%tend2d%q)) then - errmsg = physics_process(iprc)%linterp("q", fcst_year, fcst_month, fcst_day, fcst_hour, fcst_min, fcst_sec) + if (physics_process(iprc)%name == "cldMP")then + call sim_cldMP(year, month, day, hour, min, sec, physics_process(iprc)) endif ! Using data tendency from "active" scheme(s). @@ -240,28 +253,23 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti ! Update state now? if (physics_process(iprc)%time_split) then + print*,' time-split scheme...' gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%tend1d%T)*dtp gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp gq1(iCol,:) = gq1(iCol,:) + (dqdt(iCol,:) + physics_process(iprc)%tend1d%q)*dtp - !dTdt(iCol,:) = 0. - !dudt(iCol,:) = 0. - !dvdt(iCol,:) = 0. - !dqdt(iCol,:) = 0. + dTdt(iCol,:) = 0. + dudt(iCol,:) = 0. + dvdt(iCol,:) = 0. + dqdt(iCol,:) = 0. ! Accumulate tendencies, update later? else + print*,' process-split scheme...' dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%tend1d%T dudt(iCol,:) = dudt(iCol,:) + physics_process(iprc)%tend1d%u dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%tend1d%v dqdt(iCol,:) = dqdt(iCol,:) + physics_process(iprc)%tend1d%q endif - ! These are needed by samfshalcnv - if (trim(physics_process(iprc)%name) == "PBL") then - dtdq_pbl(iCol,:) = physics_process(iprc)%tend1d%q - endif - if (trim(physics_process(iprc)%name) == "cldMP") then - dtdq_mp(iCol,:) = physics_process(iprc)%tend1d%q - endif enddo ! do iLay=1,nLay @@ -281,6 +289,11 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti if (size(physics_process)+1 == iprc) then in_pre_active = .true. in_post_active = .false. + iactive_scheme_inloop = 1 + endif + + if (iactive_scheme_inloop < nactive_proc) then + iactive_scheme_inloop = iactive_scheme_inloop + 1 endif ! @@ -291,16 +304,16 @@ end subroutine ccpp_scheme_simulator_run ! ! For use with 1D data (level, time) tendencies with diurnal (24-hr) forcing. ! #################################################################################### - function linterp_1D(this, var_name, year, month, day, hour, minute, second) result(err_message) + function linterp_1D(this, var_name, year, month, day, hour, min, sec) result(err_message) class(base_physics_process), intent(inout) :: this character(len=*), intent(in) :: var_name - integer, intent(in) :: year, month, day, hour, minute, second + integer, intent(in) :: year, month, day, hour, min, sec character(len=128) :: err_message integer :: ti(1), tf(1) real(kind_phys) :: w1, w2 ! Interpolation weights - call this%cmp_time_wts(year, month, day, hour, minute, second, w1, w2, ti, tf) + call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) select case(var_name) case("T") @@ -322,17 +335,17 @@ end function linterp_1D ! This assumes that the location dimension has a [longitude, latitude] associated with ! each location. ! #################################################################################### - function linterp_2D(this, var_name, lon, lat, year, month, day, hour, minute, second) result(err_message) + function linterp_2D(this, var_name, lon, lat, year, month, day, hour, min, sec) result(err_message) class(base_physics_process), intent(inout) :: this character(len=*), intent(in) :: var_name - integer, intent(in) :: year, month, day, hour, minute, second + integer, intent(in) :: year, month, day, hour, min, sec real(kind_phys), intent(in) :: lon, lat character(len=128) :: err_message integer :: ti(1), tf(1), iNearest real(kind_phys) :: w1, w2 ! Interpolation weights (temporal) - call this%cmp_time_wts(year, month, day, hour, minute, second, w1, w2, ti, tf) + call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) ! Grab data tendency closest to column [lon,lat] iNearest = this%find_nearest_loc_2d_1d(lon,lat) @@ -366,17 +379,17 @@ end function find_nearest_loc_2d_1d ! Type-bound procedure to compute linear interpolation weights for a diurnal (24-hour) ! forcing. ! #################################################################################### - subroutine cmp_time_wts(this, year, month, day, hour, minute, second, w1, w2, ti, tf) + subroutine cmp_time_wts(this, year, month, day, hour, minute, sec, w1, w2, ti, tf) ! Inputs class(base_physics_process), intent(in) :: this - integer, intent(in) :: year, month, day, hour, minute, second + integer, intent(in) :: year, month, day, hour, minute, sec ! Outputs integer,intent(out) :: ti(1), tf(1) real(kind_phys),intent(out) :: w1, w2 ! Locals real(kind_phys) :: hrofday - hrofday = hour*3600. + minute*60. + second + hrofday = hour*3600. + minute*60. + sec ti = max(hour,1) tf = min(ti + 1,24) w1 = ((hour+1)*3600 - hrofday)/3600 @@ -384,4 +397,123 @@ subroutine cmp_time_wts(this, year, month, day, hour, minute, second, w1, w2, ti end subroutine cmp_time_wts + ! #################################################################################### + subroutine sim_LWRAD( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + + end subroutine sim_LWRAD + + ! #################################################################################### + subroutine sim_SWRAD( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + + end subroutine sim_SWRAD + + ! #################################################################################### + subroutine sim_GWD( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + + end subroutine sim_GWD + + ! #################################################################################### + subroutine sim_PBL( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + + end subroutine sim_PBL + + ! #################################################################################### + subroutine sim_DCNV( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + + end subroutine sim_DCNV + + ! #################################################################################### + subroutine sim_SCNV( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + + end subroutine sim_SCNV + + ! #################################################################################### + subroutine sim_cldMP( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + end subroutine sim_cldMP + end module ccpp_scheme_simulator diff --git a/physics/load_ccpp_scheme_sim.F90 b/physics/load_ccpp_scheme_sim.F90 index 8f4c7ee57..1fb3dc983 100644 --- a/physics/load_ccpp_scheme_sim.F90 +++ b/physics/load_ccpp_scheme_sim.F90 @@ -7,7 +7,7 @@ module load_ccpp_scheme_sim use machine, only: kind_phys use netcdf use ccpp_scheme_simulator, only: do_ccpp_scheme_simulator, physics_process, active_name,& - iactive_scheme, active_time_split_process + iactive_scheme, active_time_split_process, nactive_proc #ifdef MPI use mpi #endif @@ -73,7 +73,7 @@ subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file integer, intent(out) :: errflg ! Local variables - integer :: ncid, dimID, varID, status, nlon, nlat, ios, iprc + integer :: ncid, dimID, varID, status, nlon, nlat, ios, iprc, iactive character(len=256) :: fileIN logical :: exists integer,parameter :: nTrc = 1 ! Only specific humodty for now, but preserve 3 dimensionality @@ -540,13 +540,23 @@ subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file if (have_dTdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend2d%T => dTdt_cldMP_data if (have_dqdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend2d%q => dqdt_cldMP_data - ! Which process-scheme is "Active"? Is it a time-split process? + ! How many active schemes are there? + nactive_proc = 0 + iactive = 0 + do iprc = 1,nPhysProcess + if (.not. physics_process(iprc)%use_sim) nactive_proc = nactive_proc + 1 + enddo + allocate(iactive_scheme(nactive_proc),active_name(nactive_proc),active_time_split_process(nactive_proc)) + + ! Which process-scheme(s) is(are) "Active"? Are they time-split process? + active_time_split_process(:) = .false. do iprc = 1,nPhysProcess if (.not. physics_process(iprc)%use_sim) then - iactive_scheme = iprc - active_name = physics_process(iprc)%name + iactive = iactive + 1 + iactive_scheme(iactive) = iprc + active_name(iactive) = physics_process(iprc)%name if (physics_process(iprc)%time_split) then - active_time_split_process = .true. + active_time_split_process(iactive) = .true. endif endif enddo @@ -556,16 +566,19 @@ subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file print*, "-----------------------------------" print*, "--- Using CCPP scheme simulator ---" print*, "-----------------------------------" + iactive = 1 do iprc = 1,nPhysProcess if (physics_process(iprc)%use_sim) then print*," simulate_scheme: ", trim(physics_process(iprc)%name) print*," order: ", physics_process(iprc)%order print*," time_split: ", physics_process(iprc)%time_split + else + print*, " active_scheme: ", trim(active_name(iactive)) + print*, " order: ", physics_process(iactive_scheme(iactive))%order + print*, " time_split : ", active_time_split_process(iactive) + iactive = iactive + 1 endif enddo - print*, " active_scheme: ", trim(active_name) - print*, " order: ", physics_process(iactive_scheme)%order - print*, " time_split : ", active_time_split_process print*, "-----------------------------------" print*, "-----------------------------------" endif From a3933a549c7ced2ae9f9c7b30b42090cfa2134ca Mon Sep 17 00:00:00 2001 From: dustinswales Date: Thu, 4 May 2023 11:20:02 -0600 Subject: [PATCH 14/22] CCPP scheme simulator --- physics/GFS_ccpp_scheme_sim_pre.F90 | 603 ++++++++++++++++++++++ physics/GFS_ccpp_scheme_sim_pre.meta | 295 +++++++++++ physics/ccpp_scheme_simulator.F90 | 450 +++------------- physics/ccpp_scheme_simulator.meta | 187 +++---- physics/module_ccpp_scheme_simulator.F90 | 302 +++++++++++ physics/module_ccpp_scheme_simulator.meta | 24 + 6 files changed, 1382 insertions(+), 479 deletions(-) create mode 100644 physics/GFS_ccpp_scheme_sim_pre.F90 create mode 100644 physics/GFS_ccpp_scheme_sim_pre.meta create mode 100644 physics/module_ccpp_scheme_simulator.F90 create mode 100644 physics/module_ccpp_scheme_simulator.meta diff --git a/physics/GFS_ccpp_scheme_sim_pre.F90 b/physics/GFS_ccpp_scheme_sim_pre.F90 new file mode 100644 index 000000000..acd0c6692 --- /dev/null +++ b/physics/GFS_ccpp_scheme_sim_pre.F90 @@ -0,0 +1,603 @@ +! ######################################################################################## +! +! Interstitial CCPP scheme to couple UFS physics to ccpp_scheme_simulator. +! ) _init: read and load data into type used by ccpp_scheme_simulator +! ) _run: prepare GFS diagnostic physics tendencies for ccpp_scheme_simulator +! +! ######################################################################################## +module GFS_ccpp_scheme_sim_pre + use machine, only: kind_phys + use netcdf + use module_ccpp_scheme_simulator, only: base_physics_process +#ifdef MPI + use mpi +#endif + implicit none + + public GFS_ccpp_scheme_sim_pre_init, GFS_ccpp_scheme_sim_pre_run +contains + + ! ###################################################################################### + ! + ! SUBROUTINE GFS_ccpp_scheme_sim_pre_init + ! + ! ###################################################################################### +!! \section arg_table_GFS_ccpp_scheme_sim_pre_init +!! \htmlinclude GFS_ccpp_scheme_sim_pre_init.html +!! + subroutine GFS_ccpp_scheme_sim_pre_init(mpirank, mpiroot, mpicomm, do_ccpp_scheme_sim, & + scheme_sim_data, nprg_active, nprc_sim, prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg,& + prc_GWD_cfg, prc_SCNV_cfg, prc_DCNV_cfg, prc_cldMP_cfg, active_name, & + iactive_scheme, active_time_split_process, physics_process, errmsg, errflg) + + ! Inputs + integer, intent (in) :: mpirank, mpiroot, mpicomm, nprg_active, nprc_sim + logical, intent (in) :: do_ccpp_scheme_sim + character(len=256), intent (in) :: scheme_sim_data + integer, dimension(3), intent (in) :: prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg, & + prc_GWD_cfg, prc_SCNV_cfg, prc_DCNV_cfg, prc_cldMP_cfg + + ! Outputs + type(base_physics_process),intent(inout) :: physics_process(:) + character(len=16),intent(inout) :: active_name(:) + integer, intent(inout) :: iactive_scheme(:) + logical, intent(inout) :: active_time_split_process(:) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: ncid, dimID, varID, status, nlon, nlat, ios, iprc, iactive + logical :: exists + + ! Switches for input data + logical :: have_dTdt_LWRAD_data = .false., & + have_dTdt_SWRAD_data = .false., & + have_dTdt_PBL_data = .false., & + have_dqdt_PBL_data = .false., & + have_dudt_PBL_data = .false., & + have_dvdt_PBL_data = .false., & + have_dTdt_GWD_data = .false., & + have_dudt_GWD_data = .false., & + have_dvdt_GWD_data = .false., & + have_dTdt_SCNV_data = .false., & + have_dudt_SCNV_data = .false., & + have_dvdt_SCNV_data = .false., & + have_dqdt_SCNV_data = .false., & + have_dTdt_DCNV_data = .false., & + have_dudt_DCNV_data = .false., & + have_dvdt_DCNV_data = .false., & + have_dqdt_DCNV_data = .false., & + have_dTdt_cldMP_data = .false., & + have_dqdt_cldMP_data = .false. + + ! Data driven physics tendencies + integer :: nlev_data, ntime_data + real(kind_phys), allocatable, dimension(:), target :: time_data + real(kind_phys), allocatable, dimension(:,:), target :: dTdt_LWRAD_data, & + dTdt_SWRAD_data, dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, & + dudt_GWD_data, dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, & + dTdt_DCNV_data, dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data + real(kind_phys), allocatable, dimension(:,:), target :: dqdt_PBL_data, & + dqdt_SCNV_data, dqdt_DCNV_data, dqdt_cldMP_data + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. do_ccpp_scheme_sim) return + + ! ###################################################################################### + ! + ! Part A) Read in data. + ! + ! ###################################################################################### + + ! Check that input data file exists + inquire (file = trim (scheme_sim_data), exist = exists) + if (.not. exists) then + errmsg = 'SCM data tendency file: '//trim(scheme_sim_data)//' does not exist' + errflg = 1 + return + endif + + ! Read mandatory information from data file... + ! (ONLY master processor(0), if MPI enabled) +#ifdef MPI + if (mpirank .eq. mpiroot) then +#endif + + ! Open file (required) + status = nf90_open(trim(scheme_sim_data), NF90_NOWRITE, ncid) + if (status /= nf90_noerr) then + errmsg = 'Error reading in SCM data tendency file: '//trim(scheme_sim_data) + errflg = 1 + return + endif + + ! Get dimensions (required) + status = nf90_inq_dimid(ncid, 'time', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) + else + errmsg = 'SCM data tendency file: '//trim(scheme_sim_data)//' does not contain [time] dimension' + errflg = 1 + return + endif + ! + status = nf90_inq_dimid(ncid, 'lev', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) + else + errmsg = 'SCM data tendency file: '//trim(scheme_sim_data)//' does not contain [lev] dimension' + errflg = 1 + return + endif +#ifdef MPI + endif ! On master processor + + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + + ! Broadcast dimensions... + ! (ALL processors) + call mpi_bcast(ntime_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nlev_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_barrier(mpicomm, mpierr) + + if (mpirank .eq. mpiroot) then +#endif + + ! + ! What data fields do we have? + status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) + if (status == nf90_noerr) have_dTdt_LWRAD_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) + if (status == nf90_noerr) have_dTdt_SWRAD_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) + if (status == nf90_noerr) have_dTdt_PBL_data = .true. + ! + status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) + if (status == nf90_noerr) have_dqdt_PBL_data = .true. + ! + status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) + if (status == nf90_noerr) have_dudt_PBL_data = .true. + ! + status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) + if (status == nf90_noerr) have_dvdt_PBL_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) + if (status == nf90_noerr) have_dTdt_GWD_data = .true. + ! + status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) + if (status == nf90_noerr) have_dudt_GWD_data = .true. + ! + status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) + if (status == nf90_noerr) have_dvdt_GWD_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) + if (status == nf90_noerr) have_dTdt_SCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) + if (status == nf90_noerr) have_dudt_SCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) + if (status == nf90_noerr) have_dvdt_SCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) + if (status == nf90_noerr) have_dqdt_SCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) + if (status == nf90_noerr) have_dTdt_DCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) + if (status == nf90_noerr) have_dudt_DCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) + if (status == nf90_noerr) have_dvdt_DCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) + if (status == nf90_noerr) have_dqdt_DCNV_data = .true. + ! + status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) + if (status == nf90_noerr) have_dTdt_cldMP_data = .true. + ! + status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) + if (status == nf90_noerr) have_dqdt_cldMP_data = .true. + +#ifdef MPI + endif ! Master process +#endif + + ! Allocate space for data + allocate(time_data(ntime_data)) + if (have_dTdt_LWRAD_data) allocate(dTdt_LWRAD_data(nlev_data, ntime_data)) + if (have_dTdt_SWRAD_data) allocate(dTdt_SWRAD_data(nlev_data, ntime_data)) + if (have_dTdt_PBL_data) allocate(dTdt_PBL_data( nlev_data, ntime_data)) + if (have_dqdt_PBL_data) allocate(dqdt_PBL_data( nlev_data, ntime_data)) + if (have_dudt_PBL_data) allocate(dudt_PBL_data( nlev_data, ntime_data)) + if (have_dvdt_PBL_data) allocate(dvdt_PBL_data( nlev_data, ntime_data)) + if (have_dTdt_GWD_data) allocate(dTdt_GWD_data( nlev_data, ntime_data)) + if (have_dudt_GWD_data) allocate(dudt_GWD_data( nlev_data, ntime_data)) + if (have_dvdt_GWD_data) allocate(dvdt_GWD_data( nlev_data, ntime_data)) + if (have_dTdt_SCNV_data) allocate(dTdt_SCNV_data( nlev_data, ntime_data)) + if (have_dudt_SCNV_data) allocate(dudt_SCNV_data( nlev_data, ntime_data)) + if (have_dvdt_SCNV_data) allocate(dvdt_SCNV_data( nlev_data, ntime_data)) + if (have_dqdt_SCNV_data) allocate(dqdt_SCNV_data( nlev_data, ntime_data)) + if (have_dTdt_DCNV_data) allocate(dTdt_DCNV_data( nlev_data, ntime_data)) + if (have_dudt_DCNV_data) allocate(dudt_DCNV_data( nlev_data, ntime_data)) + if (have_dvdt_DCNV_data) allocate(dvdt_DCNV_data( nlev_data, ntime_data)) + if (have_dqdt_DCNV_data) allocate(dqdt_DCNV_data( nlev_data, ntime_data)) + if (have_dTdt_cldMP_data) allocate(dTdt_cldMP_data(nlev_data, ntime_data)) + if (have_dqdt_cldMP_data) allocate(dqdt_cldMP_data(nlev_data, ntime_data)) + + ! Read in data ... + ! (ONLY master processor(0), if MPI enabled) +#ifdef MPI + if (mpirank .eq. mpiroot) then +#endif + + ! Temporal info (required) + status = nf90_inq_varid(ncid, 'times', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, time_data) + else + errmsg = 'SCM data tendency file: '//trim(scheme_sim_data)//' does not contain times variable' + errflg = 1 + return + endif + + ! Read in physics data tendencies (optional) + status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_PBL_data) + ! + status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_PBL_data) + ! + status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_PBL_data) + ! + status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_PBL_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_GWD_data) + ! + status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_GWD_data) + ! + status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_GWD_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SCNV_data) + ! + status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_SCNV_data) + ! + status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_SCNV_data) + ! + status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_SCNV_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_DCNV_data) + ! + status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_DCNV_data) + ! + status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_DCNV_data) + ! + status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_DCNV_data) + ! + status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_cldMP_data) + ! + status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_cldMP_data) + ! + status = nf90_close(ncid) + +#ifdef MPI + endif ! Master process + + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + + ! Broadcast data... + ! (ALL processors) + if (have_dTdt_LWRAD_data) then + call mpi_bcast(dTdt_LWRAD_data, size(dTdt_LWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_SWRAD_data) then + call mpi_bcast(dTdt_SWRAD_data, size(dTdt_SWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_PBL_data) then + call mpi_bcast(dTdt_PBL_data, size(dTdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dqdt_PBL_data) then + call mpi_bcast(dqdt_PBL_data, size(dqdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dudt_PBL_data) then + call mpi_bcast(dudt_PBL_data, size(dudt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dvdt_PBL_data) then + call mpi_bcast(dvdt_PBL_data, size(dvdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_GWD_data) then + call mpi_bcast(dTdt_GWD_data, size(dTdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dudt_GWD_data) then + call mpi_bcast(dudt_GWD_data, size(dudt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dvdt_GWD_data) then + call mpi_bcast(dvdt_GWD_data, size(dvdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_SCNV_data) then + call mpi_bcast(dTdt_SCNV_data, size(dTdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dudt_SCNV_data) then + call mpi_bcast(dudt_SCNV_data, size(dudt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dvdt_SCNV_data) then + call mpi_bcast(dvdt_SCNV_data, size(dvdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dqdt_SCNV_data) then + call mpi_bcast(dqdt_SCNV_data, size(dqdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_DCNV_data) then + call mpi_bcast(dTdt_DCNV_data, size(dTdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dudt_DCNV_data) then + call mpi_bcast(dudt_DCNV_data, size(dudt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dvdt_DCNV_data) then + call mpi_bcast(dvdt_DCNV_data, size(dvdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dqdt_DCNV_data) then + call mpi_bcast(dqdt_DCNV_data, size(dqdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dTdt_cldMP_data) then + call mpi_bcast(dTdt_cldMP_data, size(dTdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (have_dqdt_cldMP_data) then + call mpi_bcast(dqdt_cldMP_data, size(dqdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + ! + call mpi_barrier(mpicomm, mpierr) +#endif + + ! ####################################################################################### + ! + ! Part B) Populate physics_process type. + ! + ! ####################################################################################### + + ! Metadata + do iprc = 1,nprc_sim + if (iprc == prc_SWRAD_cfg(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "SWRAD" + if (prc_SWRAD_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (prc_SWRAD_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == prc_LWRAD_cfg(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "LWRAD" + if (prc_LWRAD_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (prc_LWRAD_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == prc_GWD_cfg(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "GWD" + if (prc_GWD_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (prc_GWD_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == prc_PBL_cfg(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "PBL" + if (prc_PBL_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (prc_PBL_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == prc_SCNV_cfg(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "SCNV" + if (prc_SCNV_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (prc_SCNV_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == prc_DCNV_cfg(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "DCNV" + if (prc_DCNV_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (prc_DCNV_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + if (iprc == prc_cldMP_cfg(3)) then + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "cldMP" + if (prc_cldMP_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + endif + if (prc_cldMP_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + endif + enddo + + ! Load data + physics_process(prc_LWRAD_cfg(3))%tend2d%time => time_data + physics_process(prc_SWRAD_cfg(3))%tend2d%time => time_data + physics_process(prc_PBL_cfg(3))%tend2d%time => time_data + physics_process(prc_GWD_cfg(3))%tend2d%time => time_data + physics_process(prc_DCNV_cfg(3))%tend2d%time => time_data + physics_process(prc_SCNV_cfg(3))%tend2d%time => time_data + physics_process(prc_cldMP_cfg(3))%tend2d%time => time_data + if (have_dTdt_LWRAD_data) physics_process(prc_SWRAD_cfg(3))%tend2d%T => dTdt_LWRAD_data + if (have_dTdt_SWRAD_data) physics_process(prc_LWRAD_cfg(3))%tend2d%T => dTdt_SWRAD_data + if (have_dTdt_PBL_data) physics_process(prc_PBL_cfg(3))%tend2d%T => dTdt_PBL_data + if (have_dudt_PBL_data) physics_process(prc_PBL_cfg(3))%tend2d%u => dudt_PBL_data + if (have_dvdt_PBL_data) physics_process(prc_PBL_cfg(3))%tend2d%v => dvdt_PBL_data + if (have_dqdt_PBL_data) physics_process(prc_PBL_cfg(3))%tend2d%q => dqdt_PBL_data + if (have_dTdt_GWD_data) physics_process(prc_GWD_cfg(3))%tend2d%T => dTdt_GWD_data + if (have_dudt_GWD_data) physics_process(prc_GWD_cfg(3))%tend2d%u => dudt_GWD_data + if (have_dvdt_GWD_data) physics_process(prc_GWD_cfg(3))%tend2d%v => dvdt_GWD_data + if (have_dTdt_SCNV_data) physics_process(prc_SCNV_cfg(3))%tend2d%T => dTdt_SCNV_data + if (have_dudt_SCNV_data) physics_process(prc_SCNV_cfg(3))%tend2d%u => dudt_SCNV_data + if (have_dvdt_SCNV_data) physics_process(prc_SCNV_cfg(3))%tend2d%v => dvdt_SCNV_data + if (have_dqdt_SCNV_data) physics_process(prc_SCNV_cfg(3))%tend2d%q => dqdt_SCNV_data + if (have_dTdt_DCNV_data) physics_process(prc_DCNV_cfg(3))%tend2d%T => dTdt_DCNV_data + if (have_dudt_DCNV_data) physics_process(prc_DCNV_cfg(3))%tend2d%u => dudt_DCNV_data + if (have_dvdt_DCNV_data) physics_process(prc_DCNV_cfg(3))%tend2d%v => dvdt_DCNV_data + if (have_dqdt_DCNV_data) physics_process(prc_DCNV_cfg(3))%tend2d%q => dqdt_DCNV_data + if (have_dTdt_cldMP_data) physics_process(prc_cldMP_cfg(3))%tend2d%T => dTdt_cldMP_data + if (have_dqdt_cldMP_data) physics_process(prc_cldMP_cfg(3))%tend2d%q => dqdt_cldMP_data + + ! Which process-scheme(s) is(are) "Active"? Are they time-split process? + iactive = 0 + active_time_split_process(:) = .false. + do iprc = 1,nprc_sim + if (.not. physics_process(iprc)%use_sim) then + iactive = iactive + 1 + iactive_scheme(iactive) = iprc + active_name(iactive) = physics_process(iprc)%name + if (physics_process(iprc)%time_split) then + active_time_split_process(iactive) = .true. + endif + endif + enddo + + ! + if (mpirank .eq. mpiroot) then + print*, "-----------------------------------" + print*, "--- Using CCPP scheme simulator ---" + print*, "-----------------------------------" + iactive = 1 + do iprc = 1,nprc_sim + if (physics_process(iprc)%use_sim) then + print*," simulate_scheme: ", trim(physics_process(iprc)%name) + print*," order: ", physics_process(iprc)%order + print*," time_split: ", physics_process(iprc)%time_split + else + print*, " active_scheme: ", trim(active_name(iactive)) + print*, " order: ", physics_process(iactive_scheme(iactive))%order + print*, " time_split : ", active_time_split_process(iactive) + iactive = iactive + 1 + endif + enddo + print*, "-----------------------------------" + print*, "-----------------------------------" + endif + + end subroutine GFS_ccpp_scheme_sim_pre_init + + ! ###################################################################################### + ! + ! SUBROUTINE GFS_ccpp_scheme_sim_pre_run + ! + ! ###################################################################################### +!! \section arg_table_GFS_ccpp_scheme_sim_pre_run +!! \htmlinclude GFS_ccpp_scheme_sim_pre_run.html +!! + subroutine GFS_ccpp_scheme_sim_pre_run(dtend, ntqv, dtidx, dtp, index_of_process_dcnv, & + index_of_process_longwave, index_of_process_shortwave, index_of_process_scnv, & + index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & + index_of_temperature, index_of_x_wind, index_of_y_wind, & + active_name, iactive_scheme_inloop, active_phys_tend, errmsg, errflg) + + ! Inputs + integer, intent(in) :: ntqv, index_of_process_dcnv, index_of_process_longwave, & + index_of_process_shortwave, index_of_process_scnv, & + index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & + index_of_temperature, index_of_x_wind, index_of_y_wind, iactive_scheme_inloop + integer, intent(in), dimension(:,:) :: dtidx + real(kind_phys), intent(in) :: dtp + real(kind_phys), intent(in), dimension(:,:,:) :: dtend + character(len=16),intent(in), dimension(:) :: active_name + + ! Outputs + real(kind_phys), intent(out) :: active_phys_tend(:,:,:) + character(len=*),intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Locals + integer :: idtend, iactive + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Get tendency for "active" process. + + ! ###################################################################################### + ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional + ! array, CCPP standard_name = cumulative_change_of_state_variables. + ! These are not the instantaneous physics tendencies that are applied to the state by + ! the physics schemes. Not all schemes output physics tendencies... + ! Rather these are intended for diagnostic puposes and are accumulated over some + ! interval. + ! In the UFS/SCM this is controlled by the diagnostic bucket interval, namelist option + ! "fhzero". For this to work, you need to clear the diagnostic buckets after each + ! physics timestep when running in the UFS/SCM. + ! + ! In the SCM this is done by adding the following runtime options: + ! --n_itt_out 1 --n_itt_diag 1 + ! + ! ###################################################################################### + if (active_name(iactive_scheme_inloop) == "LWRAD") iactive = index_of_process_longwave + if (active_name(iactive_scheme_inloop) == "SWRAD") iactive = index_of_process_shortwave + if (active_name(iactive_scheme_inloop) == "PBL") iactive = index_of_process_pbl + if (active_name(iactive_scheme_inloop) == "GWD") iactive = index_of_process_orographic_gwd + if (active_name(iactive_scheme_inloop) == "SCNV") iactive = index_of_process_scnv + if (active_name(iactive_scheme_inloop) == "DCNV") iactive = index_of_process_dcnv + if (active_name(iactive_scheme_inloop) == "cldMP") iactive = index_of_process_mp + + ! Heat + idtend = dtidx(index_of_temperature,iactive) + if (idtend >= 1) active_phys_tend(:,:,1) = dtend(:,:,idtend)/dtp + ! u-wind + idtend = dtidx(index_of_x_wind,iactive) + if (idtend >= 1) active_phys_tend(:,:,2) = dtend(:,:,idtend)/dtp + ! v-wind + idtend = dtidx(index_of_y_wind,iactive) + if (idtend >= 1) active_phys_tend(:,:,3) = dtend(:,:,idtend)/dtp + ! Moisture + idtend = dtidx(100+ntqv,iactive) + if (idtend >= 1) active_phys_tend(:,:,4) = dtend(:,:,idtend)/dtp + + + end subroutine GFS_ccpp_scheme_sim_pre_run + +end module GFS_ccpp_scheme_sim_pre diff --git a/physics/GFS_ccpp_scheme_sim_pre.meta b/physics/GFS_ccpp_scheme_sim_pre.meta new file mode 100644 index 000000000..cf7678fe6 --- /dev/null +++ b/physics/GFS_ccpp_scheme_sim_pre.meta @@ -0,0 +1,295 @@ +[ccpp-table-properties] + name = GFS_ccpp_scheme_sim_pre + type = scheme + dependencies = machine.F,module_ccpp_scheme_simulator.F90 + +######################################################################## +[ccpp-arg-table] + name = GFS_ccpp_scheme_sim_pre_init + type = scheme +[mpirank] + standard_name = mpi_rank + long_name = MPI rank of current process + units = index + dimensions = () + type = integer + intent = in +[mpiroot] + standard_name = mpi_root + long_name = MPI rank of master process + units = index + dimensions = () + type = integer + intent = in +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in +[prc_LWRAD_cfg] + standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_LWRAD + long_name = configuration for physics process in CCPP scheme simulator LWRAD + units = flag + dimensions = (3) + type = integer + intent = in +[prc_SWRAD_cfg] + standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_SWRAD + long_name = configuration for physics process in CCPP scheme simulator SWRAD + units = flag + dimensions = (3) + type = integer + intent = in +[prc_PBL_cfg] + standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_PBL + long_name = configuration for physics process in CCPP scheme simulator PBL + units = flag + dimensions = (3) + type = integer + intent = in +[prc_GWD_cfg] + standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_GWD + long_name = configuration for physics process in CCPP scheme simulator GWD + units = flag + dimensions = (3) + type = integer + intent = in +[prc_SCNV_cfg] + standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_SCNV + long_name = configuration for physics process in CCPP scheme simulator SCNV + units = flag + dimensions = (3) + type = integer + intent = in +[prc_DCNV_cfg] + standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_DCNV + long_name = configuration for physics process in CCPP scheme simulator DCNV + units = flag + dimensions = (3) + type = integer + intent = in +[prc_cldMP_cfg] + standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_cldMP + long_name = configuration for physics process in CCPP scheme simulator cldMP + units = flag + dimensions = (3) + type = integer + intent = in +[nprg_active] + standard_name = number_of_prognostics_varaibles_in_CCPP_scheme_simulator + long_name = number of prognostic variables used in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[do_ccpp_scheme_sim] + standard_name = flag_for_ccpp_scheme_simulator + long_name = flag for ccpp scheme simulator + units = flag + dimensions = () + type = logical + intent = in +[scheme_sim_data] + standard_name = filename_for_ccpp_scheme_simulator_data_file + long_name = filename for cccpp scheme simulator data file + units = none + dimensions = () + type = character + kind = len=256 + intent = in +[nprc_sim] + standard_name = number_of_physics_process_in_CCPP_scheme_simulator + long_name = number of physics process in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[active_name] + standard_name = name_of_active_physics_schemes_in_CCPP_scheme_simulator + long_name = name of active physics schemes in CCPP scheme simulator + units = + dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) + type = character + kind = len=16 + intent = inout +[iactive_scheme] + standard_name = index_of_active_physics_schemes_in_CCPP_scheme_simulator + long_name = index of active physics schemes in CCPP scheme simulator + units = count + dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) + type = integer + intent = inout +[active_time_split_process] + standard_name = flag_to_indicate_process_type_in_CCPP_scheme_simulator + long_name = flag to indicate if active physics schemes are time-split process + units = flag + dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) + type = logical + intent = inout +[physics_process] + standard_name = physics_process_type_for_CCPP_scheme_simulator + long_name = physics process type for CCPP scheme simulator + units = mixed + dimensions = (number_of_physics_process_in_CCPP_scheme_simulator) + type = base_physics_process + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-arg-table] + name = GFS_ccpp_scheme_sim_pre_run + type = scheme +[iactive_scheme_inloop] + standard_name = count_for_active_scheme_in_CCPP_scheme_simulator + long_name = count for active physics scheme in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[active_name] + standard_name = name_of_active_physics_schemes_in_CCPP_scheme_simulator + long_name = name of active physics schemes in CCPP scheme simulator + units = + dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) + type = character + kind = len=16 + intent = in +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = mixed + dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) + type = real + kind = kind_phys + intent = in +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[index_of_process_dcnv] + standard_name = index_of_deep_convection_process_process_in_cumulative_change_index + long_name = index of deep convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_longwave] + standard_name = index_of_longwave_heating_process_in_cumulative_change_index + long_name = index of longwave heating process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_shortwave] + standard_name = index_of_shortwave_heating_process_in_cumulative_change_index + long_name = index of shortwave heating process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_orographic_gwd] + standard_name = index_of_orographic_gravity_wave_drag_process_in_cumulative_change_index + long_name = index of orographic gravity wave drag process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_scnv] + standard_name = index_of_shallow_convection_process_process_in_cumulative_change_index + long_name = index of shallow convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_pbl] + standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index + long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_mp] + standard_name = index_of_microphysics_process_process_in_cumulative_change_index + long_name = index of microphysics transport process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[ntqv] + standard_name = index_of_specific_humidity_in_tracer_concentration_array + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in +[active_phys_tend] + standard_name = tendencies_for_active_process_in_ccpp_scheme_simulator + long_name = tendencies for active physics process in ccpp scheme simulator + units = mixed + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_scheme_simulator) + type = real + kind = kind_phys + intent = out +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out \ No newline at end of file diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index f75580fb9..21f7bfde9 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -7,93 +7,10 @@ ! ######################################################################################## module ccpp_scheme_simulator use machine, only: kind_phys - + use module_ccpp_scheme_simulator, only: base_physics_process, sim_LWRAD, sim_SWRAD, & + sim_PBL, sim_GWD, sim_DCNV, sim_SCNV, sim_cldMP implicit none - - ! ######################################################################################## - ! Types used by the scheme simulator - ! ######################################################################################## - ! Type containing 1D (time) physics tendencies. - type phys_tend_1d - real(kind_phys), dimension(:), pointer :: T - real(kind_phys), dimension(:), pointer :: u - real(kind_phys), dimension(:), pointer :: v - real(kind_phys), dimension(:), pointer :: q - end type phys_tend_1d - - ! Type containing 2D (lev,time) physics tendencies. - type phys_tend_2d - real(kind_phys), dimension(:), pointer :: time - real(kind_phys), dimension(:,:), pointer :: T - real(kind_phys), dimension(:,:), pointer :: u - real(kind_phys), dimension(:,:), pointer :: v - real(kind_phys), dimension(:,:), pointer :: q - end type phys_tend_2d - - ! Type containing 3D (loc,lev,time) physics tendencies. - type phys_tend_3d - real(kind_phys), dimension(:), pointer :: time - real(kind_phys), dimension(:), pointer :: lon - real(kind_phys), dimension(:), pointer :: lat - real(kind_phys), dimension(:,:,:), pointer :: T - real(kind_phys), dimension(:,:,:), pointer :: u - real(kind_phys), dimension(:,:,:), pointer :: v - real(kind_phys), dimension(:,:,:), pointer :: q - end type phys_tend_3d - - ! Type containing 4D (lon, lat,lev,time) physics tendencies. - type phys_tend_4d - real(kind_phys), dimension(:), pointer :: time - real(kind_phys), dimension(:,:), pointer :: lon - real(kind_phys), dimension(:,:), pointer :: lat - real(kind_phys), dimension(:,:,:,:), pointer :: T - real(kind_phys), dimension(:,:,:,:), pointer :: u - real(kind_phys), dimension(:,:,:,:), pointer :: v - real(kind_phys), dimension(:,:,:,:), pointer :: q - end type phys_tend_4d - - ! This type contains the meta information and data for each physics process. - type base_physics_process - character(len=16) :: name - logical :: time_split = .false. - logical :: use_sim = .false. - integer :: order - type(phys_tend_1d) :: tend1d - type(phys_tend_2d) :: tend2d - type(phys_tend_3d) :: tend3d - type(phys_tend_4d) :: tend4d - contains - generic, public :: linterp => linterp_1D, linterp_2D - procedure, private :: linterp_1D - procedure, private :: linterp_2D - procedure, public :: find_nearest_loc_2d_1d - procedure, public :: cmp_time_wts - end type base_physics_process - - ! This array contains the governing information on how to advance the physics timestep. - type(base_physics_process), dimension(:), allocatable :: & - physics_process - - ! Do not change these! - ! For time-split physics process we need to call this scheme twice in the SDF, once - ! before the "active" scheme is called, and once after. This is because the active - ! scheme uses an internal physics state that has been advanced forward by a subsequent - ! physics process(es). - integer :: nactive_proc - character(len=16),allocatable,dimension(:) :: active_name - integer,allocatable,dimension(:) :: iactive_scheme - logical,allocatable,dimension(:) :: active_time_split_process - integer :: iactive_scheme_inloop = 1 - - integer :: proc_start, proc_end - logical :: in_pre_active = .true. - logical :: in_post_active = .false. - - ! Set to true in data was loaded into "physics_process" - logical :: do_ccpp_scheme_simulator=.false. - public ccpp_scheme_simulator_run - contains ! ###################################################################################### @@ -104,42 +21,38 @@ module ccpp_scheme_simulator !! \section arg_table_ccpp_scheme_simulator_run !! \htmlinclude ccpp_scheme_simulator_run.html !! - subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dtidx, & - dtend, index_of_process_dcnv, index_of_process_longwave, & - index_of_process_shortwave, index_of_process_scnv, & - index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & - index_of_temperature, index_of_x_wind, index_of_y_wind, ntqv, gt0, gu0, gv0, gq0, & - dtdq_pbl, dtdq_mp, errmsg, errflg) + subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, jdat, & + nactive_proc, proc_start, proc_end, active_name, iactive_scheme, physics_process, & + active_time_split_process, iactive_scheme_inloop, in_pre_active, in_post_active, & + tgrs, ugrs, vgrs, qgrs, active_phys_tend, gt0, gu0, gv0, gq0, dtdq_pbl, dtdq_mp, & + errmsg, errflg) ! Inputs - integer, intent(in) :: kdt, ntqv, index_of_process_dcnv, & - index_of_process_longwave, index_of_process_shortwave, index_of_process_scnv, & - index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & - index_of_temperature, index_of_x_wind, index_of_y_wind - integer, intent(in), dimension(8) :: jdat - integer, intent(in), dimension(:,:) :: dtidx - real(kind_phys), intent(in) :: dtp - real(kind_phys), intent(in), dimension(:,:) :: tgrs, ugrs, vgrs - real(kind_phys), intent(in), dimension(:,:,:) :: qgrs, dtend + logical, intent(in) :: do_ccpp_scheme_sim, active_time_split_process(:) + integer, intent(in) :: kdt, nCol, nLay, nactive_proc, jdat(8), & + iactive_scheme(:) + real(kind_phys), intent(in) :: dtp, tgrs(:,:), ugrs(:,:), vgrs(:,:), qgrs(:,:,:), & + active_phys_tend(:,:,:) + character(len=16), intent(in) :: active_name(:) ! Outputs - real(kind_phys), intent(inout), dimension(:,:) :: gt0, gu0, gv0 - real(kind_phys), intent(inout), dimension(:,:) :: gq0, dtdq_pbl, dtdq_mp - character(len=*),intent(out) :: errmsg - integer, intent(out) :: errflg + type(base_physics_process),intent(inout) :: physics_process(:) + real(kind_phys), intent(inout) :: gt0(:,:), gu0(:,:), gv0(:,:), gq0(:,:), & + dtdq_pbl(:,:), dtdq_mp(:,:) + character(len=*),intent(out) :: errmsg + integer, intent(out) :: errflg + integer, intent(inout) :: proc_start, proc_end, iactive_scheme_inloop + logical, intent(inout) :: in_pre_active, in_post_active ! Locals - integer :: iCol, iLay, nCol, nLay, idtend, year, month, day, hour, min, sec, iprc, & - index_of_active_process - real(kind_phys) :: w1, w2,hrofday - real(kind_phys), dimension(:,:), allocatable :: gt1, gu1, gv1, dTdt, dudt, dvdt - real(kind_phys), dimension(:,:), allocatable :: gq1, dqdt + integer :: iCol, year, month, day, hour, min, sec, iprc + real(kind_phys), dimension(nCol,nLay) :: gt1, gu1, gv1, dTdt, dudt, dvdt, gq1, dqdt ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (.not. do_ccpp_scheme_simulator) return + if (.not. do_ccpp_scheme_sim) return ! Current forecast time (Data-format specific) year = jdat(1) @@ -149,34 +62,6 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti min = jdat(6) sec = jdat(7) - ! Dimensions - nCol = size(gq0(:,1)) - nLay = size(gq0(1,:)) - - ! Allocate temporaries - allocate(gt1(nCol,nLay), gu1(nCol,nLay), gv1(nCol,nLay), gq1(nCol,nLay)) - allocate(dTdt(nCol,nLay), dudt(nCol,nLay), dvdt(nCol,nLay), dqdt(nCol,nLay)) - - ! Get tendency for "active" process. - ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional - ! array, CCPP standard_name = cumulative_change_of_state_variables. - ! These are not the instantaneous physics tendencies that are applied to the state by the - ! physics schemes. Not all schemes output physics tendencies... - ! Rather these are intended for diagnostic puposes and are accumulated over some interval. - ! In the UFS/SCM this is controlled by the diagnostic bucket interval, namelist option "fhzero". - ! For this to work, you need to clear the diagnostic buckets after each physics timestep when - ! running in the UFS/SCM. - ! In the SCM this is done by adding the following runtime options: - ! --n_itt_out 1 --n_itt_diag 1 - ! - if (active_name(iactive_scheme_inloop) == "LWRAD") index_of_active_process = index_of_process_longwave - if (active_name(iactive_scheme_inloop) == "SWRAD") index_of_active_process = index_of_process_shortwave - if (active_name(iactive_scheme_inloop) == "PBL") index_of_active_process = index_of_process_pbl - if (active_name(iactive_scheme_inloop) == "GWD") index_of_active_process = index_of_process_orographic_gwd - if (active_name(iactive_scheme_inloop) == "SCNV") index_of_active_process = index_of_process_scnv - if (active_name(iactive_scheme_inloop) == "DCNV") index_of_active_process = index_of_process_dcnv - if (active_name(iactive_scheme_inloop) == "cldMP") index_of_active_process = index_of_process_mp - ! Set state at beginning of the physics timestep. gt1(:,:) = tgrs(:,:) gu1(:,:) = ugrs(:,:) @@ -187,6 +72,9 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti dvdt(:,:) = 0. dqdt(:,:) = 0. + ! + ! Set bookeeping indices + ! if (in_pre_active) then proc_start = 1 proc_end = max(1,iactive_scheme(iactive_scheme_inloop)-1) @@ -196,22 +84,27 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti proc_end = size(physics_process) endif - ! Internal physics timestep evolution. + ! + ! Simulate internal physics timestep evolution. + ! do iprc = proc_start,proc_end - if (iprc == iactive_scheme(iactive_scheme_inloop)) then - print*,'Reached active process. ', iprc - else - print*,'Simulating ',iprc,' of ',proc_end - endif - do iCol = 1,nCol + ! Reset locals physics_process(iprc)%tend1d%T(:) = 0. physics_process(iprc)%tend1d%u(:) = 0. physics_process(iprc)%tend1d%v(:) = 0. physics_process(iprc)%tend1d%q(:) = 0. - ! Using scheme simulator (very simple, interpolate data tendency to local time) + ! Using scheme simulator + ! Very simple... + ! Interpolate 2D data (time,level) tendency to local time. + ! Here the data is already on the SCM vertical coordinate. + ! + ! In theory the data can be of any dimensionality and the onus falls on the + ! developer to extend the type "base_physics_process" to work with for their + ! application. + ! if (physics_process(iprc)%use_sim) then if (physics_process(iprc)%name == "LWRAD") then call sim_LWRAD(year, month, day, hour, min, sec, physics_process(iprc)) @@ -236,24 +129,15 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti endif ! Using data tendency from "active" scheme(s). - ! DJS2023: This block is very ufs specific. See Note Above. else - idtend = dtidx(index_of_temperature,index_of_active_process) - if (idtend >= 1) physics_process(iprc)%tend1d%T = dtend(iCol,:,idtend)/dtp - ! - idtend = dtidx(index_of_x_wind,index_of_active_process) - if (idtend >= 1) physics_process(iprc)%tend1d%u = dtend(iCol,:,idtend)/dtp - ! - idtend = dtidx(index_of_y_wind,index_of_active_process) - if (idtend >= 1) physics_process(iprc)%tend1d%v = dtend(iCol,:,idtend)/dtp - ! - idtend = dtidx(100+ntqv,index_of_active_process) - if (idtend >= 1) physics_process(iprc)%tend1d%q = dtend(iCol,:,idtend)/dtp + physics_process(iprc)%tend1d%T = active_phys_tend(iCol,:,1) + physics_process(iprc)%tend1d%u = active_phys_tend(iCol,:,2) + physics_process(iprc)%tend1d%v = active_phys_tend(iCol,:,3) + physics_process(iprc)%tend1d%q = active_phys_tend(iCol,:,4) endif - ! Update state now? + ! Update state now? (time-split scheme) if (physics_process(iprc)%time_split) then - print*,' time-split scheme...' gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%tend1d%T)*dtp gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp @@ -262,25 +146,31 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti dudt(iCol,:) = 0. dvdt(iCol,:) = 0. dqdt(iCol,:) = 0. - ! Accumulate tendencies, update later? + ! Accumulate tendencies, update later? (process-split scheme) else - print*,' process-split scheme...' dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%tend1d%T dudt(iCol,:) = dudt(iCol,:) + physics_process(iprc)%tend1d%u dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%tend1d%v dqdt(iCol,:) = dqdt(iCol,:) + physics_process(iprc)%tend1d%q endif + enddo ! END: Loop over columns + enddo ! END: Loop over physics processes + + ! + ! Update state with accumulated tendencies (process-split only) + ! + if (.not. physics_process(iprc)%time_split) then + do iCol = 1,nCol + gt0(iCol,:) = gt1(iCol,:) + dTdt(iCol,:)*dtp + gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp + gv0(iCol,:) = gv1(iCol,:) + dvdt(iCol,:)*dtp + gq0(iCol,:) = gq1(iCol,:) + dqdt(iCol,:)*dtp enddo - ! - do iLay=1,nLay - !write(*,'(i3,4f13.6)') ilay, gq0(iCol,iLay) , gq1(iCol,iLay) , dqdt(iCol,iLay)*dtp, physics_process(iprc)%tend1d%q(iLay)*dtp - enddo - gt0(iCol,:) = gt1(iCol,:) + dTdt(iCol,:)*dtp - gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp - gv0(iCol,:) = gv1(iCol,:) + dvdt(iCol,:)*dtp - gq0(iCol,:) = gq1(iCol,:) + dqdt(iCol,:)*dtp - enddo + endif + ! + ! Update bookeeping indices + ! if (in_pre_active) then in_pre_active = .false. in_post_active = .true. @@ -296,224 +186,6 @@ subroutine ccpp_scheme_simulator_run(kdt, dtp, jdat, tgrs, ugrs, vgrs, qgrs, dti iactive_scheme_inloop = iactive_scheme_inloop + 1 endif - ! end subroutine ccpp_scheme_simulator_run - ! #################################################################################### - ! Type-bound procedure to compute tendency profile for time-of-day. - ! - ! For use with 1D data (level, time) tendencies with diurnal (24-hr) forcing. - ! #################################################################################### - function linterp_1D(this, var_name, year, month, day, hour, min, sec) result(err_message) - class(base_physics_process), intent(inout) :: this - character(len=*), intent(in) :: var_name - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: err_message - integer :: ti(1), tf(1) - real(kind_phys) :: w1, w2 - - ! Interpolation weights - call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) - - select case(var_name) - case("T") - this%tend1d%T = w1*this%tend2d%T(:,ti(1)) + w2*this%tend2d%T(:,tf(1)) - case("u") - this%tend1d%u = w1*this%tend2d%u(:,ti(1)) + w2*this%tend2d%u(:,tf(1)) - case("v") - this%tend1d%v = w1*this%tend2d%v(:,ti(1)) + w2*this%tend2d%v(:,tf(1)) - case("q") - this%tend1d%q = w1*this%tend2d%q(:,ti(1)) + w2*this%tend2d%q(:,tf(1)) - end select - - end function linterp_1D - - ! #################################################################################### - ! Type-bound procedure to compute tendency profile for time-of-day. - ! - ! For use with 2D data (location, level, time) tendencies with diurnal (24-hr) forcing. - ! This assumes that the location dimension has a [longitude, latitude] associated with - ! each location. - ! #################################################################################### - function linterp_2D(this, var_name, lon, lat, year, month, day, hour, min, sec) result(err_message) - class(base_physics_process), intent(inout) :: this - character(len=*), intent(in) :: var_name - integer, intent(in) :: year, month, day, hour, min, sec - real(kind_phys), intent(in) :: lon, lat - character(len=128) :: err_message - integer :: ti(1), tf(1), iNearest - real(kind_phys) :: w1, w2 - - ! Interpolation weights (temporal) - call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) - - ! Grab data tendency closest to column [lon,lat] - iNearest = this%find_nearest_loc_2d_1d(lon,lat) - - select case(var_name) - case("T") - this%tend1d%T = w1*this%tend3d%T(iNearest,:,ti(1)) + w2*this%tend3d%T(iNearest,:,tf(1)) - case("u") - this%tend1d%u = w1*this%tend3d%u(iNearest,:,ti(1)) + w2*this%tend3d%u(iNearest,:,tf(1)) - case("v") - this%tend1d%v = w1*this%tend3d%v(iNearest,:,ti(1)) + w2*this%tend3d%v(iNearest,:,tf(1)) - case("q") - this%tend1d%q = w1*this%tend3d%q(iNearest,:,ti(1)) + w2*this%tend3d%q(iNearest,:,tf(1)) - end select - end function linterp_2D - - ! #################################################################################### - ! Type-bound procedure to find nearest location. - ! - ! For use with linterp_2D, NOT YET IMPLEMENTED. - ! #################################################################################### - pure function find_nearest_loc_2d_1d(this, lon, lat) - class(base_physics_process), intent(in) :: this - real(kind_phys), intent(in) :: lon, lat - integer :: find_nearest_loc_2d_1d - - find_nearest_loc_2d_1d = 1 - end function find_nearest_loc_2d_1d - - ! #################################################################################### - ! Type-bound procedure to compute linear interpolation weights for a diurnal (24-hour) - ! forcing. - ! #################################################################################### - subroutine cmp_time_wts(this, year, month, day, hour, minute, sec, w1, w2, ti, tf) - ! Inputs - class(base_physics_process), intent(in) :: this - integer, intent(in) :: year, month, day, hour, minute, sec - ! Outputs - integer,intent(out) :: ti(1), tf(1) - real(kind_phys),intent(out) :: w1, w2 - ! Locals - real(kind_phys) :: hrofday - - hrofday = hour*3600. + minute*60. + sec - ti = max(hour,1) - tf = min(ti + 1,24) - w1 = ((hour+1)*3600 - hrofday)/3600 - w2 = 1 - w1 - - end subroutine cmp_time_wts - - ! #################################################################################### - subroutine sim_LWRAD( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (associated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - - end subroutine sim_LWRAD - - ! #################################################################################### - subroutine sim_SWRAD( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (associated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - - end subroutine sim_SWRAD - - ! #################################################################################### - subroutine sim_GWD( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (associated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - - end subroutine sim_GWD - - ! #################################################################################### - subroutine sim_PBL( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (associated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - - end subroutine sim_PBL - - ! #################################################################################### - subroutine sim_DCNV( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (associated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - - end subroutine sim_DCNV - - ! #################################################################################### - subroutine sim_SCNV( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (associated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - - end subroutine sim_SCNV - - ! #################################################################################### - subroutine sim_cldMP( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (associated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (associated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - end subroutine sim_cldMP - end module ccpp_scheme_simulator diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_scheme_simulator.meta index 888ba2f8d..777d2248e 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -1,12 +1,18 @@ [ccpp-table-properties] name = ccpp_scheme_simulator type = scheme - dependencies = machine.F + dependencies = machine.F,module_ccpp_scheme_simulator.F90 -######################################################################## [ccpp-arg-table] name = ccpp_scheme_simulator_run type = scheme +[do_ccpp_scheme_sim] + standard_name = flag_for_ccpp_scheme_simulator + long_name = flag for ccpp scheme simulator + units = flag + dimensions = () + type = logical + intent = in [kdt] standard_name = index_of_timestep long_name = current forecast iteration @@ -14,6 +20,20 @@ dimensions = () type = integer intent = in +[nCol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in +[nLay] + standard_name = vertical_layer_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in [dtp] standard_name = timestep_for_physics long_name = physics timestep @@ -29,6 +49,70 @@ dimensions = (8) type = integer intent = in +[nactive_proc] + standard_name = number_of_active_physics_process_in_CCPP_scheme_simulator + long_name = number of active physics process in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[proc_start] + standard_name = index_for_first_physics_process_in_CCPP_scheme_simulator + long_name = index for first physics process in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = inout +[proc_end] + standard_name = index_for_last_physics_process_in_CCPP_scheme_simulator + long_name = index for last physics process in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = inout +[iactive_scheme_inloop] + standard_name = count_for_active_scheme_in_CCPP_scheme_simulator + long_name = count for active physics scheme in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = inout +[in_pre_active] + standard_name = flag_to_indicate_location_in_physics_process_loop_before_active_scheme + long_name = flag to indicate location in physics process loop before active scheme + units = flag + dimensions = () + type = logical + intent = inout +[in_post_active] + standard_name = flag_to_indicate_location_in_physics_process_loop_after_active_scheme + long_name = flag to indicate location in physics process loop after active scheme + units = flag + dimensions = () + type = logical + intent = inout +[active_name] + standard_name = name_of_active_physics_schemes_in_CCPP_scheme_simulator + long_name = name of active physics schemes in CCPP scheme simulator + units = + dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) + type = character + kind = len=16 + intent = in +[iactive_scheme] + standard_name = index_of_active_physics_schemes_in_CCPP_scheme_simulator + long_name = index of active physics schemes in CCPP scheme simulator + units = count + dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) + type = integer + intent = in +[active_time_split_process] + standard_name = flag_to_indicate_process_type_in_CCPP_scheme_simulator + long_name = flag to indicate if active physics schemes are time-split process + units = flag + dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) + type = logical + intent = in [tgrs] standard_name = air_temperature long_name = model layer mean temperature @@ -61,98 +145,14 @@ type = real kind = kind_phys intent = in -[dtend] - standard_name = cumulative_change_of_state_variables - long_name = diagnostic tendencies for state variables +[active_phys_tend] + standard_name = tendencies_for_active_process_in_ccpp_scheme_simulator + long_name = tendencies for active physics process in ccpp scheme simulator units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_scheme_simulator) type = real kind = kind_phys intent = in -[dtidx] - standard_name = cumulative_change_of_state_variables_outer_index - long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index - units = index - dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) - type = integer - intent = in -[index_of_process_dcnv] - standard_name = index_of_deep_convection_process_process_in_cumulative_change_index - long_name = index of deep convection process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_longwave] - standard_name = index_of_longwave_heating_process_in_cumulative_change_index - long_name = index of longwave heating process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_shortwave] - standard_name = index_of_shortwave_heating_process_in_cumulative_change_index - long_name = index of shortwave heating process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_orographic_gwd] - standard_name = index_of_orographic_gravity_wave_drag_process_in_cumulative_change_index - long_name = index of orographic gravity wave drag process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_scnv] - standard_name = index_of_shallow_convection_process_process_in_cumulative_change_index - long_name = index of shallow convection process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_pbl] - standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index - long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_mp] - standard_name = index_of_microphysics_process_process_in_cumulative_change_index - long_name = index of microphysics transport process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_temperature] - standard_name = index_of_temperature_in_cumulative_change_index - long_name = index of temperature in first dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_x_wind] - standard_name = index_of_x_wind_in_cumulative_change_index - long_name = index of x-wind in first dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_y_wind] - standard_name = index_of_y_wind_in_cumulative_change_index - long_name = index of x-wind in first dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[ntqv] - standard_name = index_of_specific_humidity_in_tracer_concentration_array - long_name = tracer index for water vapor (specific humidity) - units = index - dimensions = () - type = integer - intent = in [gt0] standard_name = air_temperature_of_new_state long_name = temperature updated by physics @@ -201,6 +201,13 @@ type = real kind = kind_phys intent = inout +[physics_process] + standard_name = physics_process_type_for_CCPP_scheme_simulator + long_name = physics process type for CCPP scheme simulator + units = mixed + dimensions = (number_of_physics_process_in_CCPP_scheme_simulator) + type = base_physics_process + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/module_ccpp_scheme_simulator.F90 b/physics/module_ccpp_scheme_simulator.F90 new file mode 100644 index 000000000..a0756ab61 --- /dev/null +++ b/physics/module_ccpp_scheme_simulator.F90 @@ -0,0 +1,302 @@ +! ######################################################################################## +! +! This module contains the type, base_physics_process, and supporting subroutines needed +! by the ccpp scheme simulator. +! +! ######################################################################################## +module module_ccpp_scheme_simulator +!> \section arg_table_module_ccpp_scheme_simulator Argument table +!! \htmlinclude module_ccpp_scheme_simulator.html +!! + use machine, only : kind_phys + implicit none + + public base_physics_process + + ! Type containing 1D (time) physics tendencies. + type phys_tend_1d + real(kind_phys), dimension(:), pointer :: T + real(kind_phys), dimension(:), pointer :: u + real(kind_phys), dimension(:), pointer :: v + real(kind_phys), dimension(:), pointer :: q + end type phys_tend_1d + + ! Type containing 2D (lev,time) physics tendencies. + type phys_tend_2d + real(kind_phys), dimension(:), pointer :: time + real(kind_phys), dimension(:,:), pointer :: T + real(kind_phys), dimension(:,:), pointer :: u + real(kind_phys), dimension(:,:), pointer :: v + real(kind_phys), dimension(:,:), pointer :: q + end type phys_tend_2d + + ! Type containing 3D (loc,lev,time) physics tendencies. + type phys_tend_3d + real(kind_phys), dimension(:), pointer :: time + real(kind_phys), dimension(:), pointer :: lon + real(kind_phys), dimension(:), pointer :: lat + real(kind_phys), dimension(:,:,:), pointer :: T + real(kind_phys), dimension(:,:,:), pointer :: u + real(kind_phys), dimension(:,:,:), pointer :: v + real(kind_phys), dimension(:,:,:), pointer :: q + end type phys_tend_3d + + ! Type containing 4D (lon, lat,lev,time) physics tendencies. + type phys_tend_4d + real(kind_phys), dimension(:), pointer :: time + real(kind_phys), dimension(:,:), pointer :: lon + real(kind_phys), dimension(:,:), pointer :: lat + real(kind_phys), dimension(:,:,:,:), pointer :: T + real(kind_phys), dimension(:,:,:,:), pointer :: u + real(kind_phys), dimension(:,:,:,:), pointer :: v + real(kind_phys), dimension(:,:,:,:), pointer :: q + end type phys_tend_4d + +! This type contains the meta information and data for each physics process. + +!> \section arg_table_base_physics_process Argument Table +!! \htmlinclude base_physics_process.html +!! + type base_physics_process + character(len=16) :: name + logical :: time_split = .false. + logical :: use_sim = .false. + integer :: order + type(phys_tend_1d) :: tend1d + type(phys_tend_2d) :: tend2d + type(phys_tend_3d) :: tend3d + type(phys_tend_4d) :: tend4d + contains + generic, public :: linterp => linterp_1D, linterp_2D + procedure, private :: linterp_1D + procedure, private :: linterp_2D + procedure, public :: find_nearest_loc_2d_1d + procedure, public :: cmp_time_wts + end type base_physics_process + +contains + + ! #################################################################################### + ! Type-bound procedure to compute tendency profile for time-of-day. + ! + ! For use with 1D data (level, time) tendencies with diurnal (24-hr) forcing. + ! #################################################################################### + function linterp_1D(this, var_name, year, month, day, hour, min, sec) result(err_message) + class(base_physics_process), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: err_message + integer :: ti(1), tf(1) + real(kind_phys) :: w1, w2 + + ! Interpolation weights + call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) + + select case(var_name) + case("T") + this%tend1d%T = w1*this%tend2d%T(:,ti(1)) + w2*this%tend2d%T(:,tf(1)) + case("u") + this%tend1d%u = w1*this%tend2d%u(:,ti(1)) + w2*this%tend2d%u(:,tf(1)) + case("v") + this%tend1d%v = w1*this%tend2d%v(:,ti(1)) + w2*this%tend2d%v(:,tf(1)) + case("q") + this%tend1d%q = w1*this%tend2d%q(:,ti(1)) + w2*this%tend2d%q(:,tf(1)) + end select + + end function linterp_1D + + ! #################################################################################### + ! Type-bound procedure to compute tendency profile for time-of-day. + ! + ! For use with 2D data (location, level, time) tendencies with diurnal (24-hr) forcing. + ! This assumes that the location dimension has a [longitude, latitude] associated with + ! each location. + ! #################################################################################### + function linterp_2D(this, var_name, lon, lat, year, month, day, hour, min, sec) result(err_message) + class(base_physics_process), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer, intent(in) :: year, month, day, hour, min, sec + real(kind_phys), intent(in) :: lon, lat + character(len=128) :: err_message + integer :: ti(1), tf(1), iNearest + real(kind_phys) :: w1, w2 + + ! Interpolation weights (temporal) + call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) + + ! Grab data tendency closest to column [lon,lat] + iNearest = this%find_nearest_loc_2d_1d(lon,lat) + + select case(var_name) + case("T") + this%tend1d%T = w1*this%tend3d%T(iNearest,:,ti(1)) + w2*this%tend3d%T(iNearest,:,tf(1)) + case("u") + this%tend1d%u = w1*this%tend3d%u(iNearest,:,ti(1)) + w2*this%tend3d%u(iNearest,:,tf(1)) + case("v") + this%tend1d%v = w1*this%tend3d%v(iNearest,:,ti(1)) + w2*this%tend3d%v(iNearest,:,tf(1)) + case("q") + this%tend1d%q = w1*this%tend3d%q(iNearest,:,ti(1)) + w2*this%tend3d%q(iNearest,:,tf(1)) + end select + end function linterp_2D + + ! #################################################################################### + ! Type-bound procedure to find nearest location. + ! For use with linterp_2D, NOT YET IMPLEMENTED. + ! #################################################################################### + pure function find_nearest_loc_2d_1d(this, lon, lat) + class(base_physics_process), intent(in) :: this + real(kind_phys), intent(in) :: lon, lat + integer :: find_nearest_loc_2d_1d + + find_nearest_loc_2d_1d = 1 + end function find_nearest_loc_2d_1d + + ! #################################################################################### + ! Type-bound procedure to compute linear interpolation weights for a diurnal (24-hour) + ! forcing. + ! #################################################################################### + subroutine cmp_time_wts(this, year, month, day, hour, minute, sec, w1, w2, ti, tf) + ! Inputs + class(base_physics_process), intent(in) :: this + integer, intent(in) :: year, month, day, hour, minute, sec + ! Outputs + integer,intent(out) :: ti(1), tf(1) + real(kind_phys),intent(out) :: w1, w2 + ! Locals + real(kind_phys) :: hrofday + + hrofday = hour*3600. + minute*60. + sec + ti = max(hour,1) + tf = min(ti + 1,24) + w1 = ((hour+1)*3600 - hrofday)/3600 + w2 = 1 - w1 + + end subroutine cmp_time_wts + + ! #################################################################################### + ! #################################################################################### + subroutine sim_LWRAD( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + + end subroutine sim_LWRAD + + ! #################################################################################### + ! #################################################################################### + subroutine sim_SWRAD( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + + end subroutine sim_SWRAD + + ! #################################################################################### + ! #################################################################################### + subroutine sim_GWD( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + + end subroutine sim_GWD + + ! #################################################################################### + ! #################################################################################### + subroutine sim_PBL( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + + end subroutine sim_PBL + + ! #################################################################################### + ! #################################################################################### + subroutine sim_DCNV( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + + end subroutine sim_DCNV + + ! #################################################################################### + ! #################################################################################### + subroutine sim_SCNV( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + + end subroutine sim_SCNV + + ! #################################################################################### + ! #################################################################################### + subroutine sim_cldMP( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (associated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (associated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + end subroutine sim_cldMP + +end module module_ccpp_scheme_simulator diff --git a/physics/module_ccpp_scheme_simulator.meta b/physics/module_ccpp_scheme_simulator.meta new file mode 100644 index 000000000..8eefb228c --- /dev/null +++ b/physics/module_ccpp_scheme_simulator.meta @@ -0,0 +1,24 @@ +[ccpp-table-properties] + name = base_physics_process + type = ddt + dependencies = + +[ccpp-arg-table] + name = base_physics_process + type = ddt + +######################################################################## +[ccpp-table-properties] + name = module_ccpp_scheme_simulator + type = module + dependencies = machine.F + +[ccpp-arg-table] + name = module_ccpp_scheme_simulator + type = module +[base_physics_process] + standard_name = base_physics_process + long_name = definition of type base_physics_process + units = DDT + dimensions = () + type = base_physics_process From 5d49f7942f4863441cc2678844a7b744952c9006 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Thu, 1 Jun 2023 13:48:56 -0600 Subject: [PATCH 15/22] Reorganization of scheme simulator. Now stateless. --- physics/GFS_ccpp_scheme_sim_pre.F90 | 745 ++++++++--------------- physics/GFS_ccpp_scheme_sim_pre.meta | 158 +---- physics/ccpp_scheme_simulator.F90 | 26 +- physics/ccpp_scheme_simulator.meta | 52 -- physics/load_ccpp_scheme_sim.F90 | 588 ------------------ physics/load_ccpp_scheme_sim.meta | 60 -- physics/module_ccpp_scheme_simulator.F90 | 111 ++-- 7 files changed, 334 insertions(+), 1406 deletions(-) delete mode 100644 physics/load_ccpp_scheme_sim.F90 delete mode 100644 physics/load_ccpp_scheme_sim.meta diff --git a/physics/GFS_ccpp_scheme_sim_pre.F90 b/physics/GFS_ccpp_scheme_sim_pre.F90 index acd0c6692..31bafff01 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.F90 +++ b/physics/GFS_ccpp_scheme_sim_pre.F90 @@ -1,391 +1,222 @@ ! ######################################################################################## ! ! Interstitial CCPP scheme to couple UFS physics to ccpp_scheme_simulator. -! ) _init: read and load data into type used by ccpp_scheme_simulator -! ) _run: prepare GFS diagnostic physics tendencies for ccpp_scheme_simulator +! ) load: read and load data into type used by ccpp_scheme_simulator +! ) _run: prepare GFS diagnostic physics tendencies for ccpp_scheme_simulator ! ! ######################################################################################## module GFS_ccpp_scheme_sim_pre use machine, only: kind_phys - use netcdf use module_ccpp_scheme_simulator, only: base_physics_process -#ifdef MPI - use mpi -#endif + use netcdf implicit none - - public GFS_ccpp_scheme_sim_pre_init, GFS_ccpp_scheme_sim_pre_run + public GFS_ccpp_scheme_sim_pre_run, load_ccpp_scheme_sim contains ! ###################################################################################### ! - ! SUBROUTINE GFS_ccpp_scheme_sim_pre_init + ! SUBROUTINE GFS_ccpp_scheme_sim_pre_run ! ! ###################################################################################### -!! \section arg_table_GFS_ccpp_scheme_sim_pre_init -!! \htmlinclude GFS_ccpp_scheme_sim_pre_init.html -!! - subroutine GFS_ccpp_scheme_sim_pre_init(mpirank, mpiroot, mpicomm, do_ccpp_scheme_sim, & - scheme_sim_data, nprg_active, nprc_sim, prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg,& - prc_GWD_cfg, prc_SCNV_cfg, prc_DCNV_cfg, prc_cldMP_cfg, active_name, & - iactive_scheme, active_time_split_process, physics_process, errmsg, errflg) +!! \section arg_table_GFS_ccpp_scheme_sim_pre_run +!! \htmlinclude GFS_ccpp_scheme_sim_pre_run.html +!! + subroutine GFS_ccpp_scheme_sim_pre_run(dtend, ntqv, dtidx, dtp, index_of_process_dcnv, & + index_of_process_longwave, index_of_process_shortwave, index_of_process_scnv, & + index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & + index_of_temperature, index_of_x_wind, index_of_y_wind, & + physics_process, active_phys_tend, errmsg, errflg) ! Inputs - integer, intent (in) :: mpirank, mpiroot, mpicomm, nprg_active, nprc_sim - logical, intent (in) :: do_ccpp_scheme_sim - character(len=256), intent (in) :: scheme_sim_data - integer, dimension(3), intent (in) :: prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg, & - prc_GWD_cfg, prc_SCNV_cfg, prc_DCNV_cfg, prc_cldMP_cfg + integer, intent(in) :: ntqv, index_of_process_dcnv, index_of_process_longwave, & + index_of_process_shortwave, index_of_process_scnv, & + index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & + index_of_temperature, index_of_x_wind, index_of_y_wind + integer, intent(in), dimension(:,:) :: dtidx + real(kind_phys), intent(in) :: dtp + real(kind_phys), intent(in), dimension(:,:,:) :: dtend + type(base_physics_process),intent(in) :: physics_process(:) ! Outputs - type(base_physics_process),intent(inout) :: physics_process(:) - character(len=16),intent(inout) :: active_name(:) - integer, intent(inout) :: iactive_scheme(:) - logical, intent(inout) :: active_time_split_process(:) - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + real(kind_phys), intent(out) :: active_phys_tend(:,:,:) + character(len=*),intent(out) :: errmsg + integer, intent(out) :: errflg - ! Local variables - integer :: ncid, dimID, varID, status, nlon, nlat, ios, iprc, iactive - logical :: exists - - ! Switches for input data - logical :: have_dTdt_LWRAD_data = .false., & - have_dTdt_SWRAD_data = .false., & - have_dTdt_PBL_data = .false., & - have_dqdt_PBL_data = .false., & - have_dudt_PBL_data = .false., & - have_dvdt_PBL_data = .false., & - have_dTdt_GWD_data = .false., & - have_dudt_GWD_data = .false., & - have_dvdt_GWD_data = .false., & - have_dTdt_SCNV_data = .false., & - have_dudt_SCNV_data = .false., & - have_dvdt_SCNV_data = .false., & - have_dqdt_SCNV_data = .false., & - have_dTdt_DCNV_data = .false., & - have_dudt_DCNV_data = .false., & - have_dvdt_DCNV_data = .false., & - have_dqdt_DCNV_data = .false., & - have_dTdt_cldMP_data = .false., & - have_dqdt_cldMP_data = .false. - - ! Data driven physics tendencies - integer :: nlev_data, ntime_data - real(kind_phys), allocatable, dimension(:), target :: time_data - real(kind_phys), allocatable, dimension(:,:), target :: dTdt_LWRAD_data, & - dTdt_SWRAD_data, dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, & - dudt_GWD_data, dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, & - dTdt_DCNV_data, dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data - real(kind_phys), allocatable, dimension(:,:), target :: dqdt_PBL_data, & - dqdt_SCNV_data, dqdt_DCNV_data, dqdt_cldMP_data + ! Locals + integer :: idtend, iactive ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (.not. do_ccpp_scheme_sim) return - + ! Get tendency for "active" process. + ! ###################################################################################### + ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional + ! array, CCPP standard_name = cumulative_change_of_state_variables. + ! These are not the instantaneous physics tendencies that are applied to the state by + ! the physics schemes. Not all schemes output physics tendencies... + ! Rather these are intended for diagnostic puposes and are accumulated over some + ! interval. + ! In the UFS/SCM this is controlled by the diagnostic bucket interval, namelist option + ! "fhzero". For this to work, you need to clear the diagnostic buckets after each + ! physics timestep when running in the UFS/SCM. ! - ! Part A) Read in data. + ! In the SCM this is done by adding the following runtime options: + ! --n_itt_out 1 --n_itt_diag 1 ! ! ###################################################################################### - - ! Check that input data file exists - inquire (file = trim (scheme_sim_data), exist = exists) + if (physics_process(1)%active_name == "LWRAD") iactive = index_of_process_longwave + if (physics_process(1)%active_name == "SWRAD") iactive = index_of_process_shortwave + if (physics_process(1)%active_name == "PBL") iactive = index_of_process_pbl + if (physics_process(1)%active_name == "GWD") iactive = index_of_process_orographic_gwd + if (physics_process(1)%active_name == "SCNV") iactive = index_of_process_scnv + if (physics_process(1)%active_name == "DCNV") iactive = index_of_process_dcnv + if (physics_process(1)%active_name == "cldMP") iactive = index_of_process_mp + + ! Heat + idtend = dtidx(index_of_temperature,iactive) + if (idtend >= 1) active_phys_tend(:,:,1) = dtend(:,:,idtend)/dtp + ! u-wind + idtend = dtidx(index_of_x_wind,iactive) + if (idtend >= 1) active_phys_tend(:,:,2) = dtend(:,:,idtend)/dtp + ! v-wind + idtend = dtidx(index_of_y_wind,iactive) + if (idtend >= 1) active_phys_tend(:,:,3) = dtend(:,:,idtend)/dtp + ! Moisture + idtend = dtidx(100+ntqv,iactive) + if (idtend >= 1) active_phys_tend(:,:,4) = dtend(:,:,idtend)/dtp + + + end subroutine GFS_ccpp_scheme_sim_pre_run + + ! ###################################################################################### + subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, & + errmsg, errflg) + + ! Inputs + integer, intent (in) :: nlunit + character(len=*), intent (in) :: nml_file + + ! Outputs + type(base_physics_process),intent(inout),allocatable :: physics_process(:) + integer, intent(out) :: nprg_active + integer, intent(out) :: errflg + character(len=256), intent(out) :: errmsg + + ! Local variables + integer :: ncid, dimID, varID, status, ios, iprc, nlev_data, ntime_data + character(len=256) :: scheme_sim_file + logical :: exists, do_ccpp_scheme_sim + integer :: nprc_sim + + ! For each process there is a corresponding namelist entry, which is constructed as follows: + ! {use_scheme_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} + integer, dimension(3) :: & + prc_LWRAD_cfg = (/0,0,0/), & + prc_SWRAD_cfg = (/0,0,0/), & + prc_PBL_cfg = (/0,0,0/), & + prc_GWD_cfg = (/0,0,0/), & + prc_SCNV_cfg = (/0,0,0/), & + prc_DCNV_cfg = (/0,0,0/), & + prc_cldMP_cfg = (/0,0,0/) + + ! Namelist + namelist / ccpp_scheme_sim_nml / do_ccpp_scheme_sim, scheme_sim_file, nprc_sim, & + prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg, prc_GWD_cfg, prc_SCNV_cfg, & + prc_DCNV_cfg, prc_cldMP_cfg + + errmsg = '' + errflg = 0 + + ! Read in namelist + inquire (file = trim (nml_file), exist = exists) if (.not. exists) then - errmsg = 'SCM data tendency file: '//trim(scheme_sim_data)//' does not exist' + errmsg = 'CCPP scheme simulator namelist file: '//trim(nml_file)//' does not exist.' + errflg = 1 + return + else + open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) + endif + rewind (nlunit) + read (nlunit, nml = ccpp_scheme_sim_nml, iostat=status) + close (nlunit) + + ! Only proceed if scheme simulator requested. + if (prc_SWRAD_cfg(1) .or. prc_LWRAD_cfg(1) .or. prc_PBL_cfg(1) .or. & + prc_GWD_cfg(1) .or. prc_SCNV_cfg(1) .or. prc_DCNV_cfg(1) .or. & + prc_cldMP_cfg(1)) then + else + return + endif + + ! Check that input data file exists. + inquire (file = trim (scheme_sim_file), exist = exists) + if (.not. exists) then + errmsg = 'CCPP scheme simulator file: '//trim(scheme_sim_file)//' does not exist' errflg = 1 return endif - ! Read mandatory information from data file... - ! (ONLY master processor(0), if MPI enabled) -#ifdef MPI - if (mpirank .eq. mpiroot) then -#endif + ! + ! Read data file... + ! - ! Open file (required) - status = nf90_open(trim(scheme_sim_data), NF90_NOWRITE, ncid) - if (status /= nf90_noerr) then - errmsg = 'Error reading in SCM data tendency file: '//trim(scheme_sim_data) - errflg = 1 - return - endif - - ! Get dimensions (required) - status = nf90_inq_dimid(ncid, 'time', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) - else - errmsg = 'SCM data tendency file: '//trim(scheme_sim_data)//' does not contain [time] dimension' - errflg = 1 - return - endif - ! - status = nf90_inq_dimid(ncid, 'lev', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) - else - errmsg = 'SCM data tendency file: '//trim(scheme_sim_data)//' does not contain [lev] dimension' - errflg = 1 - return - endif -#ifdef MPI - endif ! On master processor - - ! Other processors waiting... - call mpi_barrier(mpicomm, mpierr) - - ! Broadcast dimensions... - ! (ALL processors) - call mpi_bcast(ntime_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call mpi_bcast(nlev_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call mpi_barrier(mpicomm, mpierr) - - if (mpirank .eq. mpiroot) then -#endif - - ! - ! What data fields do we have? - status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) have_dTdt_LWRAD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) have_dTdt_SWRAD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) have_dTdt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) have_dqdt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) have_dudt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) have_dvdt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) have_dTdt_GWD_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) have_dudt_GWD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) have_dvdt_GWD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) have_dTdt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) have_dudt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) have_dvdt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) have_dqdt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) have_dTdt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) have_dudt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) have_dvdt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) have_dqdt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) have_dTdt_cldMP_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) have_dqdt_cldMP_data = .true. - -#ifdef MPI - endif ! Master process -#endif - - ! Allocate space for data - allocate(time_data(ntime_data)) - if (have_dTdt_LWRAD_data) allocate(dTdt_LWRAD_data(nlev_data, ntime_data)) - if (have_dTdt_SWRAD_data) allocate(dTdt_SWRAD_data(nlev_data, ntime_data)) - if (have_dTdt_PBL_data) allocate(dTdt_PBL_data( nlev_data, ntime_data)) - if (have_dqdt_PBL_data) allocate(dqdt_PBL_data( nlev_data, ntime_data)) - if (have_dudt_PBL_data) allocate(dudt_PBL_data( nlev_data, ntime_data)) - if (have_dvdt_PBL_data) allocate(dvdt_PBL_data( nlev_data, ntime_data)) - if (have_dTdt_GWD_data) allocate(dTdt_GWD_data( nlev_data, ntime_data)) - if (have_dudt_GWD_data) allocate(dudt_GWD_data( nlev_data, ntime_data)) - if (have_dvdt_GWD_data) allocate(dvdt_GWD_data( nlev_data, ntime_data)) - if (have_dTdt_SCNV_data) allocate(dTdt_SCNV_data( nlev_data, ntime_data)) - if (have_dudt_SCNV_data) allocate(dudt_SCNV_data( nlev_data, ntime_data)) - if (have_dvdt_SCNV_data) allocate(dvdt_SCNV_data( nlev_data, ntime_data)) - if (have_dqdt_SCNV_data) allocate(dqdt_SCNV_data( nlev_data, ntime_data)) - if (have_dTdt_DCNV_data) allocate(dTdt_DCNV_data( nlev_data, ntime_data)) - if (have_dudt_DCNV_data) allocate(dudt_DCNV_data( nlev_data, ntime_data)) - if (have_dvdt_DCNV_data) allocate(dvdt_DCNV_data( nlev_data, ntime_data)) - if (have_dqdt_DCNV_data) allocate(dqdt_DCNV_data( nlev_data, ntime_data)) - if (have_dTdt_cldMP_data) allocate(dTdt_cldMP_data(nlev_data, ntime_data)) - if (have_dqdt_cldMP_data) allocate(dqdt_cldMP_data(nlev_data, ntime_data)) - - ! Read in data ... - ! (ONLY master processor(0), if MPI enabled) -#ifdef MPI - if (mpirank .eq. mpiroot) then -#endif - - ! Temporal info (required) + ! Open file + status = nf90_open(trim(scheme_sim_file), NF90_NOWRITE, ncid) + if (status /= nf90_noerr) then + errmsg = 'Error reading in CCPP scheme simulator file: '//trim(scheme_sim_file) + errflg = 1 + return + endif + + ! Metadata (dimensions) + status = nf90_inq_dimid(ncid, 'time', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) + else + errmsg = 'CCPP scheme simulator file: '//trim(scheme_sim_file)//' does not contain [time] dimension' + errflg = 1 + return + endif + + status = nf90_inq_dimid(ncid, 'lev', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) + else + errmsg = 'CCPP scheme simulator file: '//trim(scheme_sim_file)//' does not contain [lev] dimension' + errflg = 1 + return + endif + + ! Allocate space and read in data + allocate(physics_process(nprc_sim)) + physics_process(1)%active_name = '' + physics_process(1)%iactive_scheme = 0 + physics_process(1)%active_tsp = .false. + do iprc = 1,nprc_sim + allocate(physics_process(iprc)%tend1d%T( nlev_data )) + allocate(physics_process(iprc)%tend1d%u( nlev_data )) + allocate(physics_process(iprc)%tend1d%v( nlev_data )) + allocate(physics_process(iprc)%tend1d%q( nlev_data )) + allocate(physics_process(iprc)%tend2d%time( ntime_data)) + allocate(physics_process(iprc)%tend2d%T( nlev_data, ntime_data)) + allocate(physics_process(iprc)%tend2d%u( nlev_data, ntime_data)) + allocate(physics_process(iprc)%tend2d%v( nlev_data, ntime_data)) + allocate(physics_process(iprc)%tend2d%q( nlev_data, ntime_data)) + + ! Temporal info status = nf90_inq_varid(ncid, 'times', varID) if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, time_data) + status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%time) else - errmsg = 'SCM data tendency file: '//trim(scheme_sim_data)//' does not contain times variable' + errmsg = 'SCM data tendency file: '//trim(scheme_sim_file)//' does not contain times variable' errflg = 1 return endif - - ! Read in physics data tendencies (optional) - status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_GWD_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_GWD_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_GWD_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_cldMP_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_cldMP_data) - ! - status = nf90_close(ncid) - -#ifdef MPI - endif ! Master process - - ! Other processors waiting... - call mpi_barrier(mpicomm, mpierr) - - ! Broadcast data... - ! (ALL processors) - if (have_dTdt_LWRAD_data) then - call mpi_bcast(dTdt_LWRAD_data, size(dTdt_LWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_SWRAD_data) then - call mpi_bcast(dTdt_SWRAD_data, size(dTdt_SWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_PBL_data) then - call mpi_bcast(dTdt_PBL_data, size(dTdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_PBL_data) then - call mpi_bcast(dqdt_PBL_data, size(dqdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_PBL_data) then - call mpi_bcast(dudt_PBL_data, size(dudt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_PBL_data) then - call mpi_bcast(dvdt_PBL_data, size(dvdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_GWD_data) then - call mpi_bcast(dTdt_GWD_data, size(dTdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_GWD_data) then - call mpi_bcast(dudt_GWD_data, size(dudt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_GWD_data) then - call mpi_bcast(dvdt_GWD_data, size(dvdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_SCNV_data) then - call mpi_bcast(dTdt_SCNV_data, size(dTdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_SCNV_data) then - call mpi_bcast(dudt_SCNV_data, size(dudt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_SCNV_data) then - call mpi_bcast(dvdt_SCNV_data, size(dvdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_SCNV_data) then - call mpi_bcast(dqdt_SCNV_data, size(dqdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_DCNV_data) then - call mpi_bcast(dTdt_DCNV_data, size(dTdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_DCNV_data) then - call mpi_bcast(dudt_DCNV_data, size(dudt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_DCNV_data) then - call mpi_bcast(dvdt_DCNV_data, size(dvdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_DCNV_data) then - call mpi_bcast(dqdt_DCNV_data, size(dqdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_cldMP_data) then - call mpi_bcast(dTdt_cldMP_data, size(dTdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_cldMP_data) then - call mpi_bcast(dqdt_cldMP_data, size(dqdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - ! - call mpi_barrier(mpicomm, mpierr) -#endif - - ! ####################################################################################### - ! - ! Part B) Populate physics_process type. - ! - ! ####################################################################################### - ! Metadata - do iprc = 1,nprc_sim if (iprc == prc_SWRAD_cfg(3)) then + ! Metadata physics_process(iprc)%order = iprc physics_process(iprc)%name = "SWRAD" if (prc_SWRAD_cfg(1) == 1) then @@ -394,8 +225,14 @@ subroutine GFS_ccpp_scheme_sim_pre_init(mpirank, mpiroot, mpicomm, do_ccpp_schem if (prc_SWRAD_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + nprg_active = 1 endif + if (iprc == prc_LWRAD_cfg(3)) then + ! Metadata physics_process(iprc)%order = iprc physics_process(iprc)%name = "LWRAD" if (prc_LWRAD_cfg(1) == 1) then @@ -404,8 +241,14 @@ subroutine GFS_ccpp_scheme_sim_pre_init(mpirank, mpiroot, mpicomm, do_ccpp_schem if (prc_LWRAD_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + nprg_active =1 endif + if (iprc == prc_GWD_cfg(3)) then + ! Metadata physics_process(iprc)%order = iprc physics_process(iprc)%name = "GWD" if (prc_GWD_cfg(1) == 1) then @@ -414,8 +257,18 @@ subroutine GFS_ccpp_scheme_sim_pre_init(mpirank, mpiroot, mpicomm, do_ccpp_schem if (prc_GWD_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) + status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) + nprg_active = 3 endif + if (iprc == prc_PBL_cfg(3)) then + ! Metadata physics_process(iprc)%order = iprc physics_process(iprc)%name = "PBL" if (prc_PBL_cfg(1) == 1) then @@ -424,8 +277,20 @@ subroutine GFS_ccpp_scheme_sim_pre_init(mpirank, mpiroot, mpicomm, do_ccpp_schem if (prc_PBL_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) + status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) + status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) + nprg_active = 4 endif + if (iprc == prc_SCNV_cfg(3)) then + ! Metadata physics_process(iprc)%order = iprc physics_process(iprc)%name = "SCNV" if (prc_SCNV_cfg(1) == 1) then @@ -434,8 +299,20 @@ subroutine GFS_ccpp_scheme_sim_pre_init(mpirank, mpiroot, mpicomm, do_ccpp_schem if (prc_SCNV_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) + status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) + status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) + nprg_active = 4 endif + if (iprc == prc_DCNV_cfg(3)) then + ! Metadata physics_process(iprc)%order = iprc physics_process(iprc)%name = "DCNV" if (prc_DCNV_cfg(1) == 1) then @@ -444,8 +321,20 @@ subroutine GFS_ccpp_scheme_sim_pre_init(mpirank, mpiroot, mpicomm, do_ccpp_schem if (prc_DCNV_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) + status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) + status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) + nprg_active = 4 endif + if (iprc == prc_cldMP_cfg(3)) then + ! Metadata physics_process(iprc)%order = iprc physics_process(iprc)%name = "cldMP" if (prc_cldMP_cfg(1) == 1) then @@ -454,150 +343,48 @@ subroutine GFS_ccpp_scheme_sim_pre_init(mpirank, mpiroot, mpicomm, do_ccpp_schem if (prc_cldMP_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) + nprg_active = 2 endif - enddo - ! Load data - physics_process(prc_LWRAD_cfg(3))%tend2d%time => time_data - physics_process(prc_SWRAD_cfg(3))%tend2d%time => time_data - physics_process(prc_PBL_cfg(3))%tend2d%time => time_data - physics_process(prc_GWD_cfg(3))%tend2d%time => time_data - physics_process(prc_DCNV_cfg(3))%tend2d%time => time_data - physics_process(prc_SCNV_cfg(3))%tend2d%time => time_data - physics_process(prc_cldMP_cfg(3))%tend2d%time => time_data - if (have_dTdt_LWRAD_data) physics_process(prc_SWRAD_cfg(3))%tend2d%T => dTdt_LWRAD_data - if (have_dTdt_SWRAD_data) physics_process(prc_LWRAD_cfg(3))%tend2d%T => dTdt_SWRAD_data - if (have_dTdt_PBL_data) physics_process(prc_PBL_cfg(3))%tend2d%T => dTdt_PBL_data - if (have_dudt_PBL_data) physics_process(prc_PBL_cfg(3))%tend2d%u => dudt_PBL_data - if (have_dvdt_PBL_data) physics_process(prc_PBL_cfg(3))%tend2d%v => dvdt_PBL_data - if (have_dqdt_PBL_data) physics_process(prc_PBL_cfg(3))%tend2d%q => dqdt_PBL_data - if (have_dTdt_GWD_data) physics_process(prc_GWD_cfg(3))%tend2d%T => dTdt_GWD_data - if (have_dudt_GWD_data) physics_process(prc_GWD_cfg(3))%tend2d%u => dudt_GWD_data - if (have_dvdt_GWD_data) physics_process(prc_GWD_cfg(3))%tend2d%v => dvdt_GWD_data - if (have_dTdt_SCNV_data) physics_process(prc_SCNV_cfg(3))%tend2d%T => dTdt_SCNV_data - if (have_dudt_SCNV_data) physics_process(prc_SCNV_cfg(3))%tend2d%u => dudt_SCNV_data - if (have_dvdt_SCNV_data) physics_process(prc_SCNV_cfg(3))%tend2d%v => dvdt_SCNV_data - if (have_dqdt_SCNV_data) physics_process(prc_SCNV_cfg(3))%tend2d%q => dqdt_SCNV_data - if (have_dTdt_DCNV_data) physics_process(prc_DCNV_cfg(3))%tend2d%T => dTdt_DCNV_data - if (have_dudt_DCNV_data) physics_process(prc_DCNV_cfg(3))%tend2d%u => dudt_DCNV_data - if (have_dvdt_DCNV_data) physics_process(prc_DCNV_cfg(3))%tend2d%v => dvdt_DCNV_data - if (have_dqdt_DCNV_data) physics_process(prc_DCNV_cfg(3))%tend2d%q => dqdt_DCNV_data - if (have_dTdt_cldMP_data) physics_process(prc_cldMP_cfg(3))%tend2d%T => dTdt_cldMP_data - if (have_dqdt_cldMP_data) physics_process(prc_cldMP_cfg(3))%tend2d%q => dqdt_cldMP_data - - ! Which process-scheme(s) is(are) "Active"? Are they time-split process? - iactive = 0 - active_time_split_process(:) = .false. - do iprc = 1,nprc_sim + ! Which process-scheme is "active"? Is process time-split? if (.not. physics_process(iprc)%use_sim) then - iactive = iactive + 1 - iactive_scheme(iactive) = iprc - active_name(iactive) = physics_process(iprc)%name + physics_process(1)%iactive_scheme = iprc + physics_process(1)%active_name = physics_process(iprc)%name if (physics_process(iprc)%time_split) then - active_time_split_process(iactive) = .true. + physics_process(1)%active_tsp = .true. endif endif + enddo - ! - if (mpirank .eq. mpiroot) then - print*, "-----------------------------------" - print*, "--- Using CCPP scheme simulator ---" - print*, "-----------------------------------" - iactive = 1 - do iprc = 1,nprc_sim - if (physics_process(iprc)%use_sim) then - print*," simulate_scheme: ", trim(physics_process(iprc)%name) - print*," order: ", physics_process(iprc)%order - print*," time_split: ", physics_process(iprc)%time_split - else - print*, " active_scheme: ", trim(active_name(iactive)) - print*, " order: ", physics_process(iactive_scheme(iactive))%order - print*, " time_split : ", active_time_split_process(iactive) - iactive = iactive + 1 - endif - enddo - print*, "-----------------------------------" - print*, "-----------------------------------" + if (physics_process(1)%iactive_scheme == 0) then + errflg = 1 + errmsg = "ERROR: No active scheme set for CCPP scheme simulator" + return endif - end subroutine GFS_ccpp_scheme_sim_pre_init - - ! ###################################################################################### - ! - ! SUBROUTINE GFS_ccpp_scheme_sim_pre_run - ! - ! ###################################################################################### -!! \section arg_table_GFS_ccpp_scheme_sim_pre_run -!! \htmlinclude GFS_ccpp_scheme_sim_pre_run.html -!! - subroutine GFS_ccpp_scheme_sim_pre_run(dtend, ntqv, dtidx, dtp, index_of_process_dcnv, & - index_of_process_longwave, index_of_process_shortwave, index_of_process_scnv, & - index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & - index_of_temperature, index_of_x_wind, index_of_y_wind, & - active_name, iactive_scheme_inloop, active_phys_tend, errmsg, errflg) - - ! Inputs - integer, intent(in) :: ntqv, index_of_process_dcnv, index_of_process_longwave, & - index_of_process_shortwave, index_of_process_scnv, & - index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & - index_of_temperature, index_of_x_wind, index_of_y_wind, iactive_scheme_inloop - integer, intent(in), dimension(:,:) :: dtidx - real(kind_phys), intent(in) :: dtp - real(kind_phys), intent(in), dimension(:,:,:) :: dtend - character(len=16),intent(in), dimension(:) :: active_name - - ! Outputs - real(kind_phys), intent(out) :: active_phys_tend(:,:,:) - character(len=*),intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Locals - integer :: idtend, iactive - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Get tendency for "active" process. - - ! ###################################################################################### - ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional - ! array, CCPP standard_name = cumulative_change_of_state_variables. - ! These are not the instantaneous physics tendencies that are applied to the state by - ! the physics schemes. Not all schemes output physics tendencies... - ! Rather these are intended for diagnostic puposes and are accumulated over some - ! interval. - ! In the UFS/SCM this is controlled by the diagnostic bucket interval, namelist option - ! "fhzero". For this to work, you need to clear the diagnostic buckets after each - ! physics timestep when running in the UFS/SCM. - ! - ! In the SCM this is done by adding the following runtime options: - ! --n_itt_out 1 --n_itt_diag 1 - ! - ! ###################################################################################### - if (active_name(iactive_scheme_inloop) == "LWRAD") iactive = index_of_process_longwave - if (active_name(iactive_scheme_inloop) == "SWRAD") iactive = index_of_process_shortwave - if (active_name(iactive_scheme_inloop) == "PBL") iactive = index_of_process_pbl - if (active_name(iactive_scheme_inloop) == "GWD") iactive = index_of_process_orographic_gwd - if (active_name(iactive_scheme_inloop) == "SCNV") iactive = index_of_process_scnv - if (active_name(iactive_scheme_inloop) == "DCNV") iactive = index_of_process_dcnv - if (active_name(iactive_scheme_inloop) == "cldMP") iactive = index_of_process_mp - - ! Heat - idtend = dtidx(index_of_temperature,iactive) - if (idtend >= 1) active_phys_tend(:,:,1) = dtend(:,:,idtend)/dtp - ! u-wind - idtend = dtidx(index_of_x_wind,iactive) - if (idtend >= 1) active_phys_tend(:,:,2) = dtend(:,:,idtend)/dtp - ! v-wind - idtend = dtidx(index_of_y_wind,iactive) - if (idtend >= 1) active_phys_tend(:,:,3) = dtend(:,:,idtend)/dtp - ! Moisture - idtend = dtidx(100+ntqv,iactive) - if (idtend >= 1) active_phys_tend(:,:,4) = dtend(:,:,idtend)/dtp - + print*, "-----------------------------------" + print*, "--- Using CCPP scheme simulator ---" + print*, "-----------------------------------" + do iprc = 1,nprc_sim + if (physics_process(iprc)%use_sim) then + print*," simulate_scheme: ", trim(physics_process(iprc)%name) + print*," order: ", physics_process(iprc)%order + print*," time_split: ", physics_process(iprc)%time_split + else + print*, " active_scheme: ", trim(physics_process(1)%active_name) + print*, " order: ", physics_process(physics_process(1)%iactive_scheme)%order + print*, " time_split : ", physics_process(1)%active_tsp + endif + enddo + print*, "-----------------------------------" + print*, "-----------------------------------" - end subroutine GFS_ccpp_scheme_sim_pre_run + end subroutine load_ccpp_scheme_sim end module GFS_ccpp_scheme_sim_pre diff --git a/physics/GFS_ccpp_scheme_sim_pre.meta b/physics/GFS_ccpp_scheme_sim_pre.meta index cf7678fe6..e101e4650 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.meta +++ b/physics/GFS_ccpp_scheme_sim_pre.meta @@ -5,170 +5,14 @@ ######################################################################## [ccpp-arg-table] - name = GFS_ccpp_scheme_sim_pre_init + name = GFS_ccpp_scheme_sim_pre_run type = scheme -[mpirank] - standard_name = mpi_rank - long_name = MPI rank of current process - units = index - dimensions = () - type = integer - intent = in -[mpiroot] - standard_name = mpi_root - long_name = MPI rank of master process - units = index - dimensions = () - type = integer - intent = in -[mpicomm] - standard_name = mpi_communicator - long_name = MPI communicator - units = index - dimensions = () - type = integer - intent = in -[prc_LWRAD_cfg] - standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_LWRAD - long_name = configuration for physics process in CCPP scheme simulator LWRAD - units = flag - dimensions = (3) - type = integer - intent = in -[prc_SWRAD_cfg] - standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_SWRAD - long_name = configuration for physics process in CCPP scheme simulator SWRAD - units = flag - dimensions = (3) - type = integer - intent = in -[prc_PBL_cfg] - standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_PBL - long_name = configuration for physics process in CCPP scheme simulator PBL - units = flag - dimensions = (3) - type = integer - intent = in -[prc_GWD_cfg] - standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_GWD - long_name = configuration for physics process in CCPP scheme simulator GWD - units = flag - dimensions = (3) - type = integer - intent = in -[prc_SCNV_cfg] - standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_SCNV - long_name = configuration for physics process in CCPP scheme simulator SCNV - units = flag - dimensions = (3) - type = integer - intent = in -[prc_DCNV_cfg] - standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_DCNV - long_name = configuration for physics process in CCPP scheme simulator DCNV - units = flag - dimensions = (3) - type = integer - intent = in -[prc_cldMP_cfg] - standard_name = configuration_for_physics_process_in_CCPP_scheme_simulator_cldMP - long_name = configuration for physics process in CCPP scheme simulator cldMP - units = flag - dimensions = (3) - type = integer - intent = in -[nprg_active] - standard_name = number_of_prognostics_varaibles_in_CCPP_scheme_simulator - long_name = number of prognostic variables used in CCPP scheme simulator - units = count - dimensions = () - type = integer - intent = in -[do_ccpp_scheme_sim] - standard_name = flag_for_ccpp_scheme_simulator - long_name = flag for ccpp scheme simulator - units = flag - dimensions = () - type = logical - intent = in -[scheme_sim_data] - standard_name = filename_for_ccpp_scheme_simulator_data_file - long_name = filename for cccpp scheme simulator data file - units = none - dimensions = () - type = character - kind = len=256 - intent = in -[nprc_sim] - standard_name = number_of_physics_process_in_CCPP_scheme_simulator - long_name = number of physics process in CCPP scheme simulator - units = count - dimensions = () - type = integer - intent = in -[active_name] - standard_name = name_of_active_physics_schemes_in_CCPP_scheme_simulator - long_name = name of active physics schemes in CCPP scheme simulator - units = - dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) - type = character - kind = len=16 - intent = inout -[iactive_scheme] - standard_name = index_of_active_physics_schemes_in_CCPP_scheme_simulator - long_name = index of active physics schemes in CCPP scheme simulator - units = count - dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) - type = integer - intent = inout -[active_time_split_process] - standard_name = flag_to_indicate_process_type_in_CCPP_scheme_simulator - long_name = flag to indicate if active physics schemes are time-split process - units = flag - dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) - type = logical - intent = inout [physics_process] standard_name = physics_process_type_for_CCPP_scheme_simulator long_name = physics process type for CCPP scheme simulator units = mixed dimensions = (number_of_physics_process_in_CCPP_scheme_simulator) type = base_physics_process - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - -######################################################################## -[ccpp-arg-table] - name = GFS_ccpp_scheme_sim_pre_run - type = scheme -[iactive_scheme_inloop] - standard_name = count_for_active_scheme_in_CCPP_scheme_simulator - long_name = count for active physics scheme in CCPP scheme simulator - units = count - dimensions = () - type = integer - intent = in -[active_name] - standard_name = name_of_active_physics_schemes_in_CCPP_scheme_simulator - long_name = name of active physics schemes in CCPP scheme simulator - units = - dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) - type = character - kind = len=16 intent = in [dtend] standard_name = cumulative_change_of_state_variables diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index 21f7bfde9..e4348599f 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -22,26 +22,21 @@ module ccpp_scheme_simulator !! \htmlinclude ccpp_scheme_simulator_run.html !! subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, jdat, & - nactive_proc, proc_start, proc_end, active_name, iactive_scheme, physics_process, & - active_time_split_process, iactive_scheme_inloop, in_pre_active, in_post_active, & - tgrs, ugrs, vgrs, qgrs, active_phys_tend, gt0, gu0, gv0, gq0, dtdq_pbl, dtdq_mp, & - errmsg, errflg) + proc_start, proc_end, physics_process, in_pre_active, in_post_active, tgrs, ugrs, & + vgrs, qgrs, active_phys_tend, gt0, gu0, gv0, gq0, errmsg, errflg) ! Inputs - logical, intent(in) :: do_ccpp_scheme_sim, active_time_split_process(:) - integer, intent(in) :: kdt, nCol, nLay, nactive_proc, jdat(8), & - iactive_scheme(:) + logical, intent(in) :: do_ccpp_scheme_sim + integer, intent(in) :: kdt, nCol, nLay, jdat(8) real(kind_phys), intent(in) :: dtp, tgrs(:,:), ugrs(:,:), vgrs(:,:), qgrs(:,:,:), & active_phys_tend(:,:,:) - character(len=16), intent(in) :: active_name(:) ! Outputs type(base_physics_process),intent(inout) :: physics_process(:) - real(kind_phys), intent(inout) :: gt0(:,:), gu0(:,:), gv0(:,:), gq0(:,:), & - dtdq_pbl(:,:), dtdq_mp(:,:) + real(kind_phys), intent(inout) :: gt0(:,:), gu0(:,:), gv0(:,:), gq0(:,:) character(len=*),intent(out) :: errmsg integer, intent(out) :: errflg - integer, intent(inout) :: proc_start, proc_end, iactive_scheme_inloop + integer, intent(inout) :: proc_start, proc_end logical, intent(inout) :: in_pre_active, in_post_active ! Locals @@ -77,10 +72,10 @@ subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, j ! if (in_pre_active) then proc_start = 1 - proc_end = max(1,iactive_scheme(iactive_scheme_inloop)-1) + proc_end = max(1,physics_process(1)%iactive_scheme-1) endif if (in_post_active) then - proc_start = iactive_scheme(iactive_scheme_inloop) + proc_start = physics_process(1)%iactive_scheme proc_end = size(physics_process) endif @@ -179,11 +174,6 @@ subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, j if (size(physics_process)+1 == iprc) then in_pre_active = .true. in_post_active = .false. - iactive_scheme_inloop = 1 - endif - - if (iactive_scheme_inloop < nactive_proc) then - iactive_scheme_inloop = iactive_scheme_inloop + 1 endif end subroutine ccpp_scheme_simulator_run diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_scheme_simulator.meta index 777d2248e..8b2618317 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -49,13 +49,6 @@ dimensions = (8) type = integer intent = in -[nactive_proc] - standard_name = number_of_active_physics_process_in_CCPP_scheme_simulator - long_name = number of active physics process in CCPP scheme simulator - units = count - dimensions = () - type = integer - intent = in [proc_start] standard_name = index_for_first_physics_process_in_CCPP_scheme_simulator long_name = index for first physics process in CCPP scheme simulator @@ -70,13 +63,6 @@ dimensions = () type = integer intent = inout -[iactive_scheme_inloop] - standard_name = count_for_active_scheme_in_CCPP_scheme_simulator - long_name = count for active physics scheme in CCPP scheme simulator - units = count - dimensions = () - type = integer - intent = inout [in_pre_active] standard_name = flag_to_indicate_location_in_physics_process_loop_before_active_scheme long_name = flag to indicate location in physics process loop before active scheme @@ -91,28 +77,6 @@ dimensions = () type = logical intent = inout -[active_name] - standard_name = name_of_active_physics_schemes_in_CCPP_scheme_simulator - long_name = name of active physics schemes in CCPP scheme simulator - units = - dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) - type = character - kind = len=16 - intent = in -[iactive_scheme] - standard_name = index_of_active_physics_schemes_in_CCPP_scheme_simulator - long_name = index of active physics schemes in CCPP scheme simulator - units = count - dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) - type = integer - intent = in -[active_time_split_process] - standard_name = flag_to_indicate_process_type_in_CCPP_scheme_simulator - long_name = flag to indicate if active physics schemes are time-split process - units = flag - dimensions = (number_of_active_physics_process_in_CCPP_scheme_simulator) - type = logical - intent = in [tgrs] standard_name = air_temperature long_name = model layer mean temperature @@ -185,22 +149,6 @@ type = real kind = kind_phys intent = inout -[dtdq_pbl] - standard_name = instantaneous_tendency_of_specific_humidity_due_to_PBL - long_name = instantaneous_tendency_of_specific_humidity_due_to_PBL - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dtdq_mp] - standard_name = instantaneous_tendency_of_specific_humidity_due_to_microphysics - long_name = moisture tendency due to microphysics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [physics_process] standard_name = physics_process_type_for_CCPP_scheme_simulator long_name = physics process type for CCPP scheme simulator diff --git a/physics/load_ccpp_scheme_sim.F90 b/physics/load_ccpp_scheme_sim.F90 deleted file mode 100644 index 1fb3dc983..000000000 --- a/physics/load_ccpp_scheme_sim.F90 +++ /dev/null @@ -1,588 +0,0 @@ -! ######################################################################################## -! -! CCPP scheme to read and load data for ccpp_scheme_simulator -! -! ######################################################################################## -module load_ccpp_scheme_sim - use machine, only: kind_phys - use netcdf - use ccpp_scheme_simulator, only: do_ccpp_scheme_simulator, physics_process, active_name,& - iactive_scheme, active_time_split_process, nactive_proc -#ifdef MPI - use mpi -#endif - implicit none - - ! ######################################################################################## - ! - ! Configuration for CCPP scheme simulator. Set in namelist. Used during initialization to - ! populate "physics_process" type array, defined in ccpp_scheme_simulator.F90 - ! - ! ######################################################################################## - - ! Number of physics process (set in namelist) - integer :: nPhysProcess - - ! For each process there is a corresponding namelist entry, which is constructed as follows: - ! {use_scheme_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} - integer, dimension(3) :: & - proc_LWRAD_config = (/0,0,0/), & - proc_SWRAD_config = (/0,0,0/), & - proc_PBL_config = (/0,0,0/), & - proc_GWD_config = (/0,0,0/), & - proc_SCNV_config = (/0,0,0/), & - proc_DCNV_config = (/0,0,0/), & - proc_cldMP_config = (/0,0,0/) - - ! Activation flag for scheme. - logical :: do_load_ccpp_scheme = .false. - - ! Data driven physics tendencies - integer :: nlev_data, ntime_data - real(kind_phys), allocatable, dimension(:), target :: time_data - real(kind_phys), allocatable, dimension(:,:), target :: dTdt_LWRAD_data, & - dTdt_SWRAD_data, dTdt_PBL_data, dudt_PBL_data, dvdt_PBL_data, dTdt_GWD_data, & - dudt_GWD_data, dvdt_GWD_data, dTdt_SCNV_data, dudt_SCNV_data, dvdt_SCNV_data, & - dTdt_DCNV_data, dudt_DCNV_data, dvdt_DCNV_data, dTdt_cldMP_data - real(kind_phys), allocatable, dimension(:,:), target :: dqdt_PBL_data, & - dqdt_SCNV_data, dqdt_DCNV_data, dqdt_cldMP_data - - ! Scheme initialization flag. - logical :: module_initialized = .false. - - public load_ccpp_scheme_sim_init -contains - - ! ###################################################################################### - ! - ! SUBROUTINE load_ccpp_scheme_sim_init - ! - ! ###################################################################################### -!! \section arg_table_load_ccpp_scheme_sim_init -!! \htmlinclude load_ccpp_scheme_sim_init.html -!! - subroutine load_ccpp_scheme_sim_init(mpirank, mpiroot, mpicomm, nlunit, nml_file, & - errmsg, errflg) - - ! Inputs - integer, intent (in) :: mpirank, mpiroot, mpicomm, nlunit - character(len=*), intent (in) :: nml_file - - ! Outputs - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Local variables - integer :: ncid, dimID, varID, status, nlon, nlat, ios, iprc, iactive - character(len=256) :: fileIN - logical :: exists - integer,parameter :: nTrc = 1 ! Only specific humodty for now, but preserve 3 dimensionality - - ! Switches for input data - logical :: have_dTdt_LWRAD_data = .false., & - have_dTdt_SWRAD_data = .false., & - have_dTdt_PBL_data = .false., & - have_dqdt_PBL_data = .false., & - have_dudt_PBL_data = .false., & - have_dvdt_PBL_data = .false., & - have_dTdt_GWD_data = .false., & - have_dudt_GWD_data = .false., & - have_dvdt_GWD_data = .false., & - have_dTdt_SCNV_data = .false., & - have_dudt_SCNV_data = .false., & - have_dvdt_SCNV_data = .false., & - have_dqdt_SCNV_data = .false., & - have_dTdt_DCNV_data = .false., & - have_dudt_DCNV_data = .false., & - have_dvdt_DCNV_data = .false., & - have_dqdt_DCNV_data = .false., & - have_dTdt_cldMP_data = .false., & - have_dqdt_cldMP_data = .false. - - ! Namelist - namelist / scm_data_nml / fileIN, nPhysProcess, proc_LWRAD_config, proc_SWRAD_config, & - proc_PBL_config, proc_GWD_config, proc_SCNV_config, proc_DCNV_config, & - proc_cldMP_config - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (module_initialized) return - module_initialized = .true. - - ! ###################################################################################### - ! - ! Part A) Read in namelist and data. - ! - ! ###################################################################################### - - ! Read in namelist - inquire (file = trim (nml_file), exist = exists) - if (.not. exists) then - errmsg = 'SCM data tendency :: namelist file: '//trim(nml_file)//' does not exist' - errflg = 1 - return - else - open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) - endif - rewind (nlunit) - read (nlunit, nml = scm_data_nml, iostat=status) - close (nlunit) - - ! Only proceed if scheme simulator requested. - if (proc_SWRAD_config(1) .or. proc_LWRAD_config(1) .or. proc_PBL_config(1) .or. & - proc_GWD_config(1) .or. proc_SCNV_config(1) .or. proc_DCNV_config(1) .or. & - proc_cldMP_config(1)) then - do_ccpp_scheme_simulator = .true. - else - return - endif - - ! Check that input data file exists - inquire (file = trim (fileIN), exist = exists) - if (.not. exists) then - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not exist' - errflg = 1 - return - endif - - ! Read mandatory information from data file... - ! (ONLY master processor(0), if MPI enabled) -#ifdef MPI - if (mpirank .eq. mpiroot) then -#endif - - ! Open file (required) - status = nf90_open(trim(fileIN), NF90_NOWRITE, ncid) - if (status /= nf90_noerr) then - errmsg = 'Error reading in SCM data tendency file: '//trim(fileIN) - errflg = 1 - return - endif - - ! Get dimensions (required) - status = nf90_inq_dimid(ncid, 'time', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) - else - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain [time] dimension' - errflg = 1 - return - endif - ! - status = nf90_inq_dimid(ncid, 'lev', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) - else - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain [lev] dimension' - errflg = 1 - return - endif -#ifdef MPI - endif ! On master processor - - ! Other processors waiting... - call mpi_barrier(mpicomm, mpierr) - - ! Broadcast dimensions... - ! (ALL processors) - call mpi_bcast(ntime_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call mpi_bcast(nlev_data, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call mpi_barrier(mpicomm, mpierr) - - if (mpirank .eq. mpiroot) then -#endif - - ! - ! What data fields do we have? - status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) have_dTdt_LWRAD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) have_dTdt_SWRAD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) have_dTdt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) have_dqdt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) have_dudt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) have_dvdt_PBL_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) have_dTdt_GWD_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) have_dudt_GWD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) have_dvdt_GWD_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) have_dTdt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) have_dudt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) have_dvdt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) have_dqdt_SCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) have_dTdt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) have_dudt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) have_dvdt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) have_dqdt_DCNV_data = .true. - ! - status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) have_dTdt_cldMP_data = .true. - ! - status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) have_dqdt_cldMP_data = .true. - -#ifdef MPI - endif ! Master process -#endif - - ! Allocate space for data - allocate(time_data(ntime_data)) - if (have_dTdt_LWRAD_data) allocate(dTdt_LWRAD_data(nlev_data, ntime_data)) - if (have_dTdt_SWRAD_data) allocate(dTdt_SWRAD_data(nlev_data, ntime_data)) - if (have_dTdt_PBL_data) allocate(dTdt_PBL_data( nlev_data, ntime_data)) - if (have_dqdt_PBL_data) allocate(dqdt_PBL_data( nlev_data, ntime_data)) - if (have_dudt_PBL_data) allocate(dudt_PBL_data( nlev_data, ntime_data)) - if (have_dvdt_PBL_data) allocate(dvdt_PBL_data( nlev_data, ntime_data)) - if (have_dTdt_GWD_data) allocate(dTdt_GWD_data( nlev_data, ntime_data)) - if (have_dudt_GWD_data) allocate(dudt_GWD_data( nlev_data, ntime_data)) - if (have_dvdt_GWD_data) allocate(dvdt_GWD_data( nlev_data, ntime_data)) - if (have_dTdt_SCNV_data) allocate(dTdt_SCNV_data( nlev_data, ntime_data)) - if (have_dudt_SCNV_data) allocate(dudt_SCNV_data( nlev_data, ntime_data)) - if (have_dvdt_SCNV_data) allocate(dvdt_SCNV_data( nlev_data, ntime_data)) - if (have_dqdt_SCNV_data) allocate(dqdt_SCNV_data( nlev_data, ntime_data)) - if (have_dTdt_DCNV_data) allocate(dTdt_DCNV_data( nlev_data, ntime_data)) - if (have_dudt_DCNV_data) allocate(dudt_DCNV_data( nlev_data, ntime_data)) - if (have_dvdt_DCNV_data) allocate(dvdt_DCNV_data( nlev_data, ntime_data)) - if (have_dqdt_DCNV_data) allocate(dqdt_DCNV_data( nlev_data, ntime_data)) - if (have_dTdt_cldMP_data) allocate(dTdt_cldMP_data(nlev_data, ntime_data)) - if (have_dqdt_cldMP_data) allocate(dqdt_cldMP_data(nlev_data, ntime_data)) - - ! Read in data ... - ! (ONLY master processor(0), if MPI enabled) -#ifdef MPI - if (mpirank .eq. mpiroot) then -#endif - - ! Temporal info (required) - status = nf90_inq_varid(ncid, 'times', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, time_data) - else - errmsg = 'SCM data tendency file: '//trim(fileIN)//' does not contain times variable' - errflg = 1 - return - endif - - ! Read in physics data tendencies (optional) - status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_LWRAD_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SWRAD_data) - print*,'dTdt_SWRAD_data: ',dTdt_SWRAD_data - ! - status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_PBL_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_GWD_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_GWD_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_GWD_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_SCNV_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dudt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dvdt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_DCNV_data) - ! - status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dTdt_cldMP_data) - ! - status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, dqdt_cldMP_data) - ! - status = nf90_close(ncid) - -#ifdef MPI - endif ! Master process - - ! Other processors waiting... - call mpi_barrier(mpicomm, mpierr) - - ! Broadcast data... - ! (ALL processors) - if (have_dTdt_LWRAD_data) then - call mpi_bcast(dTdt_LWRAD_data, size(dTdt_LWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_SWRAD_data) then - call mpi_bcast(dTdt_SWRAD_data, size(dTdt_SWRAD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_PBL_data) then - call mpi_bcast(dTdt_PBL_data, size(dTdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_PBL_data) then - call mpi_bcast(dqdt_PBL_data, size(dqdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_PBL_data) then - call mpi_bcast(dudt_PBL_data, size(dudt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_PBL_data) then - call mpi_bcast(dvdt_PBL_data, size(dvdt_PBL_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_GWD_data) then - call mpi_bcast(dTdt_GWD_data, size(dTdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_GWD_data) then - call mpi_bcast(dudt_GWD_data, size(dudt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_GWD_data) then - call mpi_bcast(dvdt_GWD_data, size(dvdt_GWD_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_SCNV_data) then - call mpi_bcast(dTdt_SCNV_data, size(dTdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_SCNV_data) then - call mpi_bcast(dudt_SCNV_data, size(dudt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_SCNV_data) then - call mpi_bcast(dvdt_SCNV_data, size(dvdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_SCNV_data) then - call mpi_bcast(dqdt_SCNV_data, size(dqdt_SCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_DCNV_data) then - call mpi_bcast(dTdt_DCNV_data, size(dTdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dudt_DCNV_data) then - call mpi_bcast(dudt_DCNV_data, size(dudt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dvdt_DCNV_data) then - call mpi_bcast(dvdt_DCNV_data, size(dvdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_DCNV_data) then - call mpi_bcast(dqdt_DCNV_data, size(dqdt_DCNV_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dTdt_cldMP_data) then - call mpi_bcast(dTdt_cldMP_data, size(dTdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (have_dqdt_cldMP_data) then - call mpi_bcast(dqdt_cldMP_data, size(dqdt_cldMP_data), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - ! - call mpi_barrier(mpicomm, mpierr) -#endif - - ! ####################################################################################### - ! - ! Part B) Populate physics_process type. - ! - ! ####################################################################################### - - ! Allocate - allocate(physics_process(nPhysProcess)) - - ! Metadata - do iprc = 1,nPhysProcess - allocate(physics_process(iprc)%tend1d%T(nlev_data)) - allocate(physics_process(iprc)%tend1d%u(nlev_data)) - allocate(physics_process(iprc)%tend1d%v(nlev_data)) - allocate(physics_process(iprc)%tend1d%q(nlev_data)) - if (iprc == proc_SWRAD_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "SWRAD" - if (proc_SWRAD_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_SWRAD_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_LWRAD_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "LWRAD" - if (proc_LWRAD_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_LWRAD_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_GWD_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "GWD" - if (proc_GWD_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_GWD_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_PBL_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "PBL" - if (proc_PBL_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_PBL_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_SCNV_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "SCNV" - if (proc_SCNV_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_SCNV_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_DCNV_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "DCNV" - if (proc_DCNV_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_DCNV_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - if (iprc == proc_cldMP_config(3)) then - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "cldMP" - if (proc_cldMP_config(1) == 1) then - physics_process(iprc)%use_sim = .true. - endif - if (proc_cldMP_config(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - endif - enddo - - ! Load data - physics_process(proc_LWRAD_config(3))%tend2d%time => time_data - physics_process(proc_SWRAD_config(3))%tend2d%time => time_data - physics_process(proc_PBL_config(3))%tend2d%time => time_data - physics_process(proc_GWD_config(3))%tend2d%time => time_data - physics_process(proc_DCNV_config(3))%tend2d%time => time_data - physics_process(proc_SCNV_config(3))%tend2d%time => time_data - physics_process(proc_cldMP_config(3))%tend2d%time => time_data - if (have_dTdt_LWRAD_data) physics_process(proc_SWRAD_config(3))%tend2d%T => dTdt_LWRAD_data - if (have_dTdt_SWRAD_data) physics_process(proc_LWRAD_config(3))%tend2d%T => dTdt_SWRAD_data - if (have_dTdt_PBL_data) physics_process(proc_PBL_config(3))%tend2d%T => dTdt_PBL_data - if (have_dudt_PBL_data) physics_process(proc_PBL_config(3))%tend2d%u => dudt_PBL_data - if (have_dvdt_PBL_data) physics_process(proc_PBL_config(3))%tend2d%v => dvdt_PBL_data - if (have_dqdt_PBL_data) physics_process(proc_PBL_config(3))%tend2d%q => dqdt_PBL_data - if (have_dTdt_GWD_data) physics_process(proc_GWD_config(3))%tend2d%T => dTdt_GWD_data - if (have_dudt_GWD_data) physics_process(proc_GWD_config(3))%tend2d%u => dudt_GWD_data - if (have_dvdt_GWD_data) physics_process(proc_GWD_config(3))%tend2d%v => dvdt_GWD_data - if (have_dTdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend2d%T => dTdt_SCNV_data - if (have_dudt_SCNV_data) physics_process(proc_SCNV_config(3))%tend2d%u => dudt_SCNV_data - if (have_dvdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend2d%v => dvdt_SCNV_data - if (have_dqdt_SCNV_data) physics_process(proc_SCNV_config(3))%tend2d%q => dqdt_SCNV_data - if (have_dTdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend2d%T => dTdt_DCNV_data - if (have_dudt_DCNV_data) physics_process(proc_DCNV_config(3))%tend2d%u => dudt_DCNV_data - if (have_dvdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend2d%v => dvdt_DCNV_data - if (have_dqdt_DCNV_data) physics_process(proc_DCNV_config(3))%tend2d%q => dqdt_DCNV_data - if (have_dTdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend2d%T => dTdt_cldMP_data - if (have_dqdt_cldMP_data) physics_process(proc_cldMP_config(3))%tend2d%q => dqdt_cldMP_data - - ! How many active schemes are there? - nactive_proc = 0 - iactive = 0 - do iprc = 1,nPhysProcess - if (.not. physics_process(iprc)%use_sim) nactive_proc = nactive_proc + 1 - enddo - allocate(iactive_scheme(nactive_proc),active_name(nactive_proc),active_time_split_process(nactive_proc)) - - ! Which process-scheme(s) is(are) "Active"? Are they time-split process? - active_time_split_process(:) = .false. - do iprc = 1,nPhysProcess - if (.not. physics_process(iprc)%use_sim) then - iactive = iactive + 1 - iactive_scheme(iactive) = iprc - active_name(iactive) = physics_process(iprc)%name - if (physics_process(iprc)%time_split) then - active_time_split_process(iactive) = .true. - endif - endif - enddo - - ! - if (mpirank .eq. mpiroot) then - print*, "-----------------------------------" - print*, "--- Using CCPP scheme simulator ---" - print*, "-----------------------------------" - iactive = 1 - do iprc = 1,nPhysProcess - if (physics_process(iprc)%use_sim) then - print*," simulate_scheme: ", trim(physics_process(iprc)%name) - print*," order: ", physics_process(iprc)%order - print*," time_split: ", physics_process(iprc)%time_split - else - print*, " active_scheme: ", trim(active_name(iactive)) - print*, " order: ", physics_process(iactive_scheme(iactive))%order - print*, " time_split : ", active_time_split_process(iactive) - iactive = iactive + 1 - endif - enddo - print*, "-----------------------------------" - print*, "-----------------------------------" - endif - - end subroutine load_ccpp_scheme_sim_init - -end module load_ccpp_scheme_sim diff --git a/physics/load_ccpp_scheme_sim.meta b/physics/load_ccpp_scheme_sim.meta deleted file mode 100644 index 6e0aea925..000000000 --- a/physics/load_ccpp_scheme_sim.meta +++ /dev/null @@ -1,60 +0,0 @@ -[ccpp-table-properties] - name = load_ccpp_scheme_sim - type = scheme - dependencies = machine.F,ccpp_scheme_simulator.F90 - -######################################################################## -[ccpp-arg-table] - name = load_ccpp_scheme_sim_init - type = scheme -[mpirank] - standard_name = mpi_rank - long_name = MPI rank of current process - units = index - dimensions = () - type = integer - intent = in -[mpiroot] - standard_name = mpi_root - long_name = MPI rank of master process - units = index - dimensions = () - type = integer - intent = in -[mpicomm] - standard_name = mpi_communicator - long_name = MPI communicator - units = index - dimensions = () - type = integer - intent = in -[nlunit] - standard_name = iounit_of_namelist - long_name = fortran unit number for opening nameliust file - units = none - dimensions = () - type = integer - intent = in -[nml_file] - standard_name = filename_of_namelist - long_name = namelist filename - units = none - dimensions = () - type = character - kind = len=* - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out diff --git a/physics/module_ccpp_scheme_simulator.F90 b/physics/module_ccpp_scheme_simulator.F90 index a0756ab61..695a2bb03 100644 --- a/physics/module_ccpp_scheme_simulator.F90 +++ b/physics/module_ccpp_scheme_simulator.F90 @@ -15,41 +15,45 @@ module module_ccpp_scheme_simulator ! Type containing 1D (time) physics tendencies. type phys_tend_1d - real(kind_phys), dimension(:), pointer :: T - real(kind_phys), dimension(:), pointer :: u - real(kind_phys), dimension(:), pointer :: v - real(kind_phys), dimension(:), pointer :: q + real(kind_phys), dimension(:), allocatable :: T + real(kind_phys), dimension(:), allocatable :: u + real(kind_phys), dimension(:), allocatable :: v + real(kind_phys), dimension(:), allocatable :: q + real(kind_phys), dimension(:), allocatable :: p + real(kind_phys), dimension(:), allocatable :: z end type phys_tend_1d ! Type containing 2D (lev,time) physics tendencies. type phys_tend_2d - real(kind_phys), dimension(:), pointer :: time - real(kind_phys), dimension(:,:), pointer :: T - real(kind_phys), dimension(:,:), pointer :: u - real(kind_phys), dimension(:,:), pointer :: v - real(kind_phys), dimension(:,:), pointer :: q + real(kind_phys), dimension(:), allocatable :: time + real(kind_phys), dimension(:,:), allocatable :: T + real(kind_phys), dimension(:,:), allocatable :: u + real(kind_phys), dimension(:,:), allocatable :: v + real(kind_phys), dimension(:,:), allocatable :: q + real(kind_phys), dimension(:,:), allocatable :: p + real(kind_phys), dimension(:,:), allocatable :: z end type phys_tend_2d ! Type containing 3D (loc,lev,time) physics tendencies. type phys_tend_3d - real(kind_phys), dimension(:), pointer :: time - real(kind_phys), dimension(:), pointer :: lon - real(kind_phys), dimension(:), pointer :: lat - real(kind_phys), dimension(:,:,:), pointer :: T - real(kind_phys), dimension(:,:,:), pointer :: u - real(kind_phys), dimension(:,:,:), pointer :: v - real(kind_phys), dimension(:,:,:), pointer :: q + real(kind_phys), dimension(:), allocatable :: time + real(kind_phys), dimension(:), allocatable :: lon + real(kind_phys), dimension(:), allocatable :: lat + real(kind_phys), dimension(:,:,:), allocatable :: T + real(kind_phys), dimension(:,:,:), allocatable :: u + real(kind_phys), dimension(:,:,:), allocatable :: v + real(kind_phys), dimension(:,:,:), allocatable :: q end type phys_tend_3d - ! Type containing 4D (lon, lat,lev,time) physics tendencies. + ! Type containing 4D (lon,lat,lev,time) physics tendencies. type phys_tend_4d - real(kind_phys), dimension(:), pointer :: time - real(kind_phys), dimension(:,:), pointer :: lon - real(kind_phys), dimension(:,:), pointer :: lat - real(kind_phys), dimension(:,:,:,:), pointer :: T - real(kind_phys), dimension(:,:,:,:), pointer :: u - real(kind_phys), dimension(:,:,:,:), pointer :: v - real(kind_phys), dimension(:,:,:,:), pointer :: q + real(kind_phys), dimension(:), allocatable :: time + real(kind_phys), dimension(:,:), allocatable :: lon + real(kind_phys), dimension(:,:), allocatable :: lat + real(kind_phys), dimension(:,:,:,:), allocatable :: T + real(kind_phys), dimension(:,:,:,:), allocatable :: u + real(kind_phys), dimension(:,:,:,:), allocatable :: v + real(kind_phys), dimension(:,:,:,:), allocatable :: q end type phys_tend_4d ! This type contains the meta information and data for each physics process. @@ -58,14 +62,17 @@ module module_ccpp_scheme_simulator !! \htmlinclude base_physics_process.html !! type base_physics_process - character(len=16) :: name - logical :: time_split = .false. - logical :: use_sim = .false. - integer :: order - type(phys_tend_1d) :: tend1d - type(phys_tend_2d) :: tend2d - type(phys_tend_3d) :: tend3d - type(phys_tend_4d) :: tend4d + character(len=16) :: name ! Physics process name + logical :: time_split = .false. ! Is process time-split? + logical :: use_sim = .false. ! Is process "active"? + integer :: order ! Order of process in process-loop + type(phys_tend_1d) :: tend1d ! Instantaneous data + type(phys_tend_2d) :: tend2d ! 2-dimensional data + type(phys_tend_3d) :: tend3d ! Not used. Placeholder for 3-dimensional spatial data. + type(phys_tend_4d) :: tend4d ! Not used. Placeholder for 4-dimensional spatio-tempo data. + character(len=16) :: active_name ! "Active" scheme: Physics process name + integer :: iactive_scheme ! "Active" scheme: Order of process in process-loop + logical :: active_tsp ! "Active" scheme: Is process time-split? contains generic, public :: linterp => linterp_1D, linterp_2D procedure, private :: linterp_1D @@ -109,7 +116,7 @@ end function linterp_1D ! Type-bound procedure to compute tendency profile for time-of-day. ! ! For use with 2D data (location, level, time) tendencies with diurnal (24-hr) forcing. - ! This assumes that the location dimension has a [longitude, latitude] associated with + ! This assumes that the location dimension has a [longitude, latitude] allocated with ! each location. ! #################################################################################### function linterp_2D(this, var_name, lon, lat, year, month, day, hour, min, sec) result(err_message) @@ -180,7 +187,7 @@ subroutine sim_LWRAD( year, month, day, hour, min, sec, process) integer, intent(in) :: year, month, day, hour, min, sec character(len=128) :: errmsg - if (associated(process%tend2d%T)) then + if (allocated(process%tend2d%T)) then errmsg = process%linterp("T", year,month,day,hour,min,sec) endif @@ -193,7 +200,7 @@ subroutine sim_SWRAD( year, month, day, hour, min, sec, process) integer, intent(in) :: year, month, day, hour, min, sec character(len=128) :: errmsg - if (associated(process%tend2d%T)) then + if (allocated(process%tend2d%T)) then errmsg = process%linterp("T", year,month,day,hour,min,sec) endif @@ -206,13 +213,13 @@ subroutine sim_GWD( year, month, day, hour, min, sec, process) integer, intent(in) :: year, month, day, hour, min, sec character(len=128) :: errmsg - if (associated(process%tend2d%T)) then + if (allocated(process%tend2d%T)) then errmsg = process%linterp("T", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%u)) then + if (allocated(process%tend2d%u)) then errmsg = process%linterp("u", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%v)) then + if (allocated(process%tend2d%v)) then errmsg = process%linterp("v", year,month,day,hour,min,sec) endif @@ -225,16 +232,16 @@ subroutine sim_PBL( year, month, day, hour, min, sec, process) integer, intent(in) :: year, month, day, hour, min, sec character(len=128) :: errmsg - if (associated(process%tend2d%T)) then + if (allocated(process%tend2d%T)) then errmsg = process%linterp("T", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%u)) then + if (allocated(process%tend2d%u)) then errmsg = process%linterp("u", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%v)) then + if (allocated(process%tend2d%v)) then errmsg = process%linterp("v", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%q)) then + if (allocated(process%tend2d%q)) then errmsg = process%linterp("q", year,month,day,hour,min,sec) endif @@ -247,16 +254,16 @@ subroutine sim_DCNV( year, month, day, hour, min, sec, process) integer, intent(in) :: year, month, day, hour, min, sec character(len=128) :: errmsg - if (associated(process%tend2d%T)) then + if (allocated(process%tend2d%T)) then errmsg = process%linterp("T", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%u)) then + if (allocated(process%tend2d%u)) then errmsg = process%linterp("u", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%v)) then + if (allocated(process%tend2d%v)) then errmsg = process%linterp("v", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%q)) then + if (allocated(process%tend2d%q)) then errmsg = process%linterp("q", year,month,day,hour,min,sec) endif @@ -269,16 +276,16 @@ subroutine sim_SCNV( year, month, day, hour, min, sec, process) integer, intent(in) :: year, month, day, hour, min, sec character(len=128) :: errmsg - if (associated(process%tend2d%T)) then + if (allocated(process%tend2d%T)) then errmsg = process%linterp("T", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%u)) then + if (allocated(process%tend2d%u)) then errmsg = process%linterp("u", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%v)) then + if (allocated(process%tend2d%v)) then errmsg = process%linterp("v", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%q)) then + if (allocated(process%tend2d%q)) then errmsg = process%linterp("q", year,month,day,hour,min,sec) endif @@ -291,10 +298,10 @@ subroutine sim_cldMP( year, month, day, hour, min, sec, process) integer, intent(in) :: year, month, day, hour, min, sec character(len=128) :: errmsg - if (associated(process%tend2d%T)) then + if (allocated(process%tend2d%T)) then errmsg = process%linterp("T", year,month,day,hour,min,sec) endif - if (associated(process%tend2d%q)) then + if (allocated(process%tend2d%q)) then errmsg = process%linterp("q", year,month,day,hour,min,sec) endif end subroutine sim_cldMP From 12d4fc22128d7267fb6a8563a94bb579d27d2127 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Fri, 7 Jul 2023 12:16:54 -0600 Subject: [PATCH 16/22] Working as expected! --- physics/GFS_ccpp_scheme_sim_pre.F90 | 77 ++++++++++++++++++------ physics/GFS_ccpp_scheme_sim_pre.meta | 28 +++++++++ physics/ccpp_scheme_simulator.F90 | 47 ++++++++++----- physics/ccpp_scheme_simulator.meta | 28 +++++++++ physics/module_ccpp_scheme_simulator.F90 | 1 + 5 files changed, 150 insertions(+), 31 deletions(-) diff --git a/physics/GFS_ccpp_scheme_sim_pre.F90 b/physics/GFS_ccpp_scheme_sim_pre.F90 index 31bafff01..a5f6f0cfa 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.F90 +++ b/physics/GFS_ccpp_scheme_sim_pre.F90 @@ -24,8 +24,8 @@ module GFS_ccpp_scheme_sim_pre subroutine GFS_ccpp_scheme_sim_pre_run(dtend, ntqv, dtidx, dtp, index_of_process_dcnv, & index_of_process_longwave, index_of_process_shortwave, index_of_process_scnv, & index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & - index_of_temperature, index_of_x_wind, index_of_y_wind, & - physics_process, active_phys_tend, errmsg, errflg) + index_of_temperature, index_of_x_wind, index_of_y_wind, physics_process, & + iactive_T, iactive_u, iactive_v, iactive_q, active_phys_tend, errmsg, errflg) ! Inputs integer, intent(in) :: ntqv, index_of_process_dcnv, index_of_process_longwave, & @@ -36,6 +36,7 @@ subroutine GFS_ccpp_scheme_sim_pre_run(dtend, ntqv, dtidx, dtp, index_of_process real(kind_phys), intent(in) :: dtp real(kind_phys), intent(in), dimension(:,:,:) :: dtend type(base_physics_process),intent(in) :: physics_process(:) + integer, intent(in) :: iactive_T, iactive_u, iactive_v, iactive_q ! Outputs real(kind_phys), intent(out) :: active_phys_tend(:,:,:) @@ -76,23 +77,33 @@ subroutine GFS_ccpp_scheme_sim_pre_run(dtend, ntqv, dtidx, dtp, index_of_process ! Heat idtend = dtidx(index_of_temperature,iactive) - if (idtend >= 1) active_phys_tend(:,:,1) = dtend(:,:,idtend)/dtp + if (idtend >= 1) then + active_phys_tend(:,:,iactive_T) = dtend(:,:,idtend)/dtp + endif + ! u-wind idtend = dtidx(index_of_x_wind,iactive) - if (idtend >= 1) active_phys_tend(:,:,2) = dtend(:,:,idtend)/dtp + if (idtend >= 1) then + active_phys_tend(:,:,iactive_u) = dtend(:,:,idtend)/dtp + endif + ! v-wind idtend = dtidx(index_of_y_wind,iactive) - if (idtend >= 1) active_phys_tend(:,:,3) = dtend(:,:,idtend)/dtp + if (idtend >= 1) then + active_phys_tend(:,:,iactive_v) = dtend(:,:,idtend)/dtp + endif + ! Moisture idtend = dtidx(100+ntqv,iactive) - if (idtend >= 1) active_phys_tend(:,:,4) = dtend(:,:,idtend)/dtp - + if (idtend >= 1) then + active_phys_tend(:,:,iactive_q) = dtend(:,:,idtend)/dtp + endif end subroutine GFS_ccpp_scheme_sim_pre_run ! ###################################################################################### - subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, & - errmsg, errflg) + subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, & + iactive_T, iactive_u, iactive_v, iactive_q, errmsg, errflg) ! Inputs integer, intent (in) :: nlunit @@ -100,7 +111,7 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, ! Outputs type(base_physics_process),intent(inout),allocatable :: physics_process(:) - integer, intent(out) :: nprg_active + integer, intent(inout) :: iactive_T, iactive_u, iactive_v, iactive_q integer, intent(out) :: errflg character(len=256), intent(out) :: errmsg @@ -221,14 +232,17 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, physics_process(iprc)%name = "SWRAD" if (prc_SWRAD_cfg(1) == 1) then physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 1 + iactive_T = 1 endif if (prc_SWRAD_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - nprg_active = 1 endif if (iprc == prc_LWRAD_cfg(3)) then @@ -237,14 +251,17 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, physics_process(iprc)%name = "LWRAD" if (prc_LWRAD_cfg(1) == 1) then physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 1 + iactive_T = 1 endif if (prc_LWRAD_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - nprg_active =1 endif if (iprc == prc_GWD_cfg(3)) then @@ -253,10 +270,16 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, physics_process(iprc)%name = "GWD" if (prc_GWD_cfg(1) == 1) then physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 3 + iactive_T = 1 + iactive_u = 2 + iactive_v = 3 endif if (prc_GWD_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) @@ -264,7 +287,6 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) - nprg_active = 3 endif if (iprc == prc_PBL_cfg(3)) then @@ -273,10 +295,17 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, physics_process(iprc)%name = "PBL" if (prc_PBL_cfg(1) == 1) then physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 4 + iactive_T = 1 + iactive_u = 2 + iactive_v = 3 + iactive_q = 4 endif if (prc_PBL_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) @@ -286,7 +315,6 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) - nprg_active = 4 endif if (iprc == prc_SCNV_cfg(3)) then @@ -295,10 +323,17 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, physics_process(iprc)%name = "SCNV" if (prc_SCNV_cfg(1) == 1) then physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 4 + iactive_T = 1 + iactive_u = 2 + iactive_v = 3 + iactive_q = 4 endif if (prc_SCNV_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) @@ -308,7 +343,6 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) - nprg_active = 4 endif if (iprc == prc_DCNV_cfg(3)) then @@ -317,6 +351,12 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, physics_process(iprc)%name = "DCNV" if (prc_DCNV_cfg(1) == 1) then physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 4 + iactive_T = 1 + iactive_u = 2 + iactive_v = 3 + iactive_q = 4 endif if (prc_DCNV_cfg(2) == 1) then physics_process(iprc)%time_split = .true. @@ -330,7 +370,6 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) - nprg_active = 4 endif if (iprc == prc_cldMP_cfg(3)) then @@ -339,16 +378,20 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, nprg_active, physics_process(iprc)%name = "cldMP" if (prc_cldMP_cfg(1) == 1) then physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 2 + iactive_T = 1 + iactive_q = 2 endif if (prc_cldMP_cfg(2) == 1) then physics_process(iprc)%time_split = .true. endif + ! Data status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) - nprg_active = 2 endif ! Which process-scheme is "active"? Is process time-split? diff --git a/physics/GFS_ccpp_scheme_sim_pre.meta b/physics/GFS_ccpp_scheme_sim_pre.meta index e101e4650..682b4baf8 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.meta +++ b/physics/GFS_ccpp_scheme_sim_pre.meta @@ -122,6 +122,34 @@ type = real kind = kind_phys intent = out +[iactive_T] + standard_name = index_for_active_T_in_CCPP_scheme_simulator + long_name = index into active process tracer array for temperature in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_u] + standard_name = index_for_active_u_in_CCPP_scheme_simulator + long_name = index into active process tracer array for zonal wind in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_v] + standard_name = index_for_active_v_in_CCPP_scheme_simulator + long_name = index into active process tracer array for meridional wind in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_q] + standard_name = index_for_active_q_in_CCPP_scheme_simulator + long_name = index into active process tracer array for moisture in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index e4348599f..b825b8403 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -7,7 +7,7 @@ ! ######################################################################################## module ccpp_scheme_simulator use machine, only: kind_phys - use module_ccpp_scheme_simulator, only: base_physics_process, sim_LWRAD, sim_SWRAD, & + use module_ccpp_scheme_simulator, only: base_physics_process, sim_LWRAD, sim_SWRAD, & sim_PBL, sim_GWD, sim_DCNV, sim_SCNV, sim_cldMP implicit none public ccpp_scheme_simulator_run @@ -22,15 +22,16 @@ module ccpp_scheme_simulator !! \htmlinclude ccpp_scheme_simulator_run.html !! subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, jdat, & - proc_start, proc_end, physics_process, in_pre_active, in_post_active, tgrs, ugrs, & - vgrs, qgrs, active_phys_tend, gt0, gu0, gv0, gq0, errmsg, errflg) + iactive_T, iactive_u, iactive_v, iactive_q, proc_start, proc_end, physics_process,& + in_pre_active, in_post_active, tgrs, ugrs, vgrs, qgrs, active_phys_tend, gt0, gu0,& + gv0, gq0, errmsg, errflg) ! Inputs logical, intent(in) :: do_ccpp_scheme_sim - integer, intent(in) :: kdt, nCol, nLay, jdat(8) + integer, intent(in) :: kdt, nCol, nLay, jdat(8), iactive_T, iactive_u, & + iactive_v, iactive_q real(kind_phys), intent(in) :: dtp, tgrs(:,:), ugrs(:,:), vgrs(:,:), qgrs(:,:,:), & active_phys_tend(:,:,:) - ! Outputs type(base_physics_process),intent(inout) :: physics_process(:) real(kind_phys), intent(inout) :: gt0(:,:), gu0(:,:), gv0(:,:), gq0(:,:) @@ -125,18 +126,18 @@ subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, j ! Using data tendency from "active" scheme(s). else - physics_process(iprc)%tend1d%T = active_phys_tend(iCol,:,1) - physics_process(iprc)%tend1d%u = active_phys_tend(iCol,:,2) - physics_process(iprc)%tend1d%v = active_phys_tend(iCol,:,3) - physics_process(iprc)%tend1d%q = active_phys_tend(iCol,:,4) + if (iactive_T > 0) physics_process(iprc)%tend1d%T = active_phys_tend(iCol,:,iactive_T) + if (iactive_u > 0) physics_process(iprc)%tend1d%u = active_phys_tend(iCol,:,iactive_u) + if (iactive_v > 0) physics_process(iprc)%tend1d%v = active_phys_tend(iCol,:,iactive_v) + if (iactive_q > 0) physics_process(iprc)%tend1d%q = active_phys_tend(iCol,:,iactive_q) endif ! Update state now? (time-split scheme) if (physics_process(iprc)%time_split) then - gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%tend1d%T)*dtp - gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp - gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp - gq1(iCol,:) = gq1(iCol,:) + (dqdt(iCol,:) + physics_process(iprc)%tend1d%q)*dtp + gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%tend1d%T)*dtp + gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp + gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp + gq1(iCol,:) = gq1(iCol,:) + (dqdt(iCol,:) + physics_process(iprc)%tend1d%q)*dtp dTdt(iCol,:) = 0. dudt(iCol,:) = 0. dvdt(iCol,:) = 0. @@ -149,11 +150,29 @@ subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, j dqdt(iCol,:) = dqdt(iCol,:) + physics_process(iprc)%tend1d%q endif enddo ! END: Loop over columns + + ! Print diagnostics + if (physics_process(iprc)%use_sim) then + if (physics_process(iprc)%time_split) then + write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'time split scheme (simulated)' + else + write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'process split scheme (simulated)' + endif + else + if (physics_process(iprc)%time_split) then + write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,' time split scheme (active)' + else + write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,' process split scheme (active)' + endif + write(*,'(a25,i2)') ' # prog. vars.: ',physics_process(1)%nprg_active + endif enddo ! END: Loop over physics processes ! ! Update state with accumulated tendencies (process-split only) + ! (Suites where active scheme is last physical process) ! + iprc = minval([iprc,proc_end]) if (.not. physics_process(iprc)%time_split) then do iCol = 1,nCol gt0(iCol,:) = gt1(iCol,:) + dTdt(iCol,:)*dtp @@ -171,7 +190,7 @@ subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, j in_post_active = .true. endif - if (size(physics_process)+1 == iprc) then + if (size(physics_process) == proc_end) then in_pre_active = .true. in_post_active = .false. endif diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_scheme_simulator.meta index 8b2618317..c60cd9a38 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_scheme_simulator.meta @@ -117,6 +117,34 @@ type = real kind = kind_phys intent = in +[iactive_T] + standard_name = index_for_active_T_in_CCPP_scheme_simulator + long_name = index into active process tracer array for temperature in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_u] + standard_name = index_for_active_u_in_CCPP_scheme_simulator + long_name = index into active process tracer array for zonal wind in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_v] + standard_name = index_for_active_v_in_CCPP_scheme_simulator + long_name = index into active process tracer array for meridional wind in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_q] + standard_name = index_for_active_q_in_CCPP_scheme_simulator + long_name = index into active process tracer array for moisture in CCPP scheme simulator + units = count + dimensions = () + type = integer + intent = in [gt0] standard_name = air_temperature_of_new_state long_name = temperature updated by physics diff --git a/physics/module_ccpp_scheme_simulator.F90 b/physics/module_ccpp_scheme_simulator.F90 index 695a2bb03..a122563d9 100644 --- a/physics/module_ccpp_scheme_simulator.F90 +++ b/physics/module_ccpp_scheme_simulator.F90 @@ -73,6 +73,7 @@ module module_ccpp_scheme_simulator character(len=16) :: active_name ! "Active" scheme: Physics process name integer :: iactive_scheme ! "Active" scheme: Order of process in process-loop logical :: active_tsp ! "Active" scheme: Is process time-split? + integer :: nprg_active ! "Active" scheme: Number of prognostic variables contains generic, public :: linterp => linterp_1D, linterp_2D procedure, private :: linterp_1D From 9465b6f1a63606cf3ae4c0d48feab0507f338be4 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Tue, 11 Jul 2023 14:48:26 -0600 Subject: [PATCH 17/22] Housekeeping --- physics/GFS_ccpp_scheme_sim_pre.F90 | 21 +++++++++++++-------- physics/ccpp_scheme_simulator.F90 | 22 +++++++++++++++++----- 2 files changed, 30 insertions(+), 13 deletions(-) diff --git a/physics/GFS_ccpp_scheme_sim_pre.F90 b/physics/GFS_ccpp_scheme_sim_pre.F90 index a5f6f0cfa..61ab573a3 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.F90 +++ b/physics/GFS_ccpp_scheme_sim_pre.F90 @@ -1,8 +1,12 @@ ! ######################################################################################## ! -! Interstitial CCPP scheme to couple UFS physics to ccpp_scheme_simulator. -! ) load: read and load data into type used by ccpp_scheme_simulator -! ) _run: prepare GFS diagnostic physics tendencies for ccpp_scheme_simulator +! Description: Interstitial CCPP scheme to couple UFS physics to ccpp_scheme_simulator. +! +! Contains: +! - load_ccpp_scheme_sim(): read and load data into type used by ccpp_scheme_simulator. +! called once during model initialization +! - GFS_ccpp_scheme_sim_pre_run(): prepare GFS diagnostic physics tendencies for +! ccpp_scheme_simulator. ! ! ######################################################################################## module GFS_ccpp_scheme_sim_pre @@ -102,8 +106,8 @@ subroutine GFS_ccpp_scheme_sim_pre_run(dtend, ntqv, dtidx, dtp, index_of_process end subroutine GFS_ccpp_scheme_sim_pre_run ! ###################################################################################### - subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, & - iactive_T, iactive_u, iactive_v, iactive_q, errmsg, errflg) + subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, & + iactive_u, iactive_v, iactive_q, errmsg, errflg) ! Inputs integer, intent (in) :: nlunit @@ -121,7 +125,8 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, & logical :: exists, do_ccpp_scheme_sim integer :: nprc_sim - ! For each process there is a corresponding namelist entry, which is constructed as follows: + ! For each process there is a corresponding namelist entry, which is constructed as + ! follows: ! {use_scheme_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} integer, dimension(3) :: & prc_LWRAD_cfg = (/0,0,0/), & @@ -133,8 +138,8 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, & prc_cldMP_cfg = (/0,0,0/) ! Namelist - namelist / ccpp_scheme_sim_nml / do_ccpp_scheme_sim, scheme_sim_file, nprc_sim, & - prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg, prc_GWD_cfg, prc_SCNV_cfg, & + namelist / ccpp_scheme_sim_nml / do_ccpp_scheme_sim, scheme_sim_file, nprc_sim, & + prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg, prc_GWD_cfg, prc_SCNV_cfg, & prc_DCNV_cfg, prc_cldMP_cfg errmsg = '' diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_scheme_simulator.F90 index b825b8403..f3a6372ac 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_scheme_simulator.F90 @@ -1,8 +1,20 @@ ! ######################################################################################## -! -! CCPP scheme to replace physics schemes with simulated data tendencies. ! -! Description: +! Description: This scheme simulates the evolution of the internal physics state +! represented by a CCPP Suite Definition File (SDF). +! +! To activate this scheme it must be a) embedded within the SDF and b) activated through +! the physics namelist. +! The derived-data type "base_physics_process" contains the metadata needed to reconstruct +! the temporal evolution of the state. An array of base_physics_process, physics_process, +! is populated by the host during initialization and passed to the physics. Additionally, +! this type holds any data, or type-bound procedures, required by the scheme simulator(s). +! +! For this initial demonstration we are using 2-dimensional (height, time) forcing data, +! which is on the same native vertical grid as the SCM. The dataset has a temporal +! resolution of 1-hour, created by averaging all local times from a Tropical Warm Pool +! International Cloud Experiment (TWPICE) case. This was to create a dataset with a +! (constant) diurnal cycle. ! ! ######################################################################################## module ccpp_scheme_simulator @@ -160,9 +172,9 @@ subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, j endif else if (physics_process(iprc)%time_split) then - write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,' time split scheme (active)' + write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'time split scheme (active)' else - write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,' process split scheme (active)' + write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'process split scheme (active)' endif write(*,'(a25,i2)') ' # prog. vars.: ',physics_process(1)%nprg_active endif From c61a2a61e7493c4b3dccae26761bdbd4f1939c5b Mon Sep 17 00:00:00 2001 From: dustinswales Date: Thu, 13 Jul 2023 11:01:50 -0600 Subject: [PATCH 18/22] GNU bug found in SCM CI --- physics/GFS_ccpp_scheme_sim_pre.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/GFS_ccpp_scheme_sim_pre.F90 b/physics/GFS_ccpp_scheme_sim_pre.F90 index 61ab573a3..db80e0c84 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.F90 +++ b/physics/GFS_ccpp_scheme_sim_pre.F90 @@ -159,9 +159,9 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, close (nlunit) ! Only proceed if scheme simulator requested. - if (prc_SWRAD_cfg(1) .or. prc_LWRAD_cfg(1) .or. prc_PBL_cfg(1) .or. & - prc_GWD_cfg(1) .or. prc_SCNV_cfg(1) .or. prc_DCNV_cfg(1) .or. & - prc_cldMP_cfg(1)) then + if (prc_SWRAD_cfg(1) == 1 .or. prc_LWRAD_cfg(1) == 1 .or. prc_PBL_cfg(1) == 1 .or. & + prc_GWD_cfg(1) == 1 .or. prc_SCNV_cfg(1) == 1 .or. prc_DCNV_cfg(1) == 1 .or. & + prc_cldMP_cfg(1) == 1 ) then else return endif From 8e5646e91dc31ac88baf4905eeb3056578b8aa9e Mon Sep 17 00:00:00 2001 From: dustinswales Date: Mon, 17 Jul 2023 18:08:45 -0600 Subject: [PATCH 19/22] Some cleanup. --- physics/GFS_ccpp_scheme_sim_pre.F90 | 14 +++++++++----- physics/GFS_ccpp_scheme_sim_pre.meta | 7 +++++++ 2 files changed, 16 insertions(+), 5 deletions(-) diff --git a/physics/GFS_ccpp_scheme_sim_pre.F90 b/physics/GFS_ccpp_scheme_sim_pre.F90 index db80e0c84..47865353d 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.F90 +++ b/physics/GFS_ccpp_scheme_sim_pre.F90 @@ -25,13 +25,15 @@ module GFS_ccpp_scheme_sim_pre !! \section arg_table_GFS_ccpp_scheme_sim_pre_run !! \htmlinclude GFS_ccpp_scheme_sim_pre_run.html !! - subroutine GFS_ccpp_scheme_sim_pre_run(dtend, ntqv, dtidx, dtp, index_of_process_dcnv, & - index_of_process_longwave, index_of_process_shortwave, index_of_process_scnv, & - index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & - index_of_temperature, index_of_x_wind, index_of_y_wind, physics_process, & - iactive_T, iactive_u, iactive_v, iactive_q, active_phys_tend, errmsg, errflg) + subroutine GFS_ccpp_scheme_sim_pre_run(do_ccpp_scheme_sim, dtend, ntqv, dtidx, dtp, & + index_of_process_dcnv, index_of_process_longwave, index_of_process_shortwave, & + index_of_process_scnv, index_of_process_orographic_gwd, index_of_process_pbl, & + index_of_process_mp, index_of_temperature, index_of_x_wind, index_of_y_wind, & + physics_process, iactive_T, iactive_u, iactive_v, iactive_q, active_phys_tend, & + errmsg, errflg) ! Inputs + logical, intent(in) :: do_ccpp_scheme_sim integer, intent(in) :: ntqv, index_of_process_dcnv, index_of_process_longwave, & index_of_process_shortwave, index_of_process_scnv, & index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & @@ -54,6 +56,8 @@ subroutine GFS_ccpp_scheme_sim_pre_run(dtend, ntqv, dtidx, dtp, index_of_process errmsg = '' errflg = 0 + if (.not. do_ccpp_scheme_sim) return + ! Get tendency for "active" process. ! ###################################################################################### diff --git a/physics/GFS_ccpp_scheme_sim_pre.meta b/physics/GFS_ccpp_scheme_sim_pre.meta index 682b4baf8..ca6d4f7cc 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.meta +++ b/physics/GFS_ccpp_scheme_sim_pre.meta @@ -7,6 +7,13 @@ [ccpp-arg-table] name = GFS_ccpp_scheme_sim_pre_run type = scheme +[do_ccpp_scheme_sim] + standard_name = flag_for_ccpp_scheme_simulator + long_name = flag for ccpp scheme simulator + units = flag + dimensions = () + type = logical + intent = in [physics_process] standard_name = physics_process_type_for_CCPP_scheme_simulator long_name = physics process type for CCPP scheme simulator From e3c00d35207299024be4b016a2db8c3ad40f3ea7 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Wed, 19 Jul 2023 11:53:00 -0600 Subject: [PATCH 20/22] Renamed scheme simulator suite simulator --- ...sim_pre.F90 => GFS_ccpp_suite_sim_pre.F90} | 74 +++++++++---------- ...m_pre.meta => GFS_ccpp_suite_sim_pre.meta} | 40 +++++----- ...simulator.F90 => ccpp_suite_simulator.F90} | 28 +++---- ...mulator.meta => ccpp_suite_simulator.meta} | 56 +++++++------- ...or.F90 => module_ccpp_suite_simulator.F90} | 10 +-- ....meta => module_ccpp_suite_simulator.meta} | 4 +- 6 files changed, 106 insertions(+), 106 deletions(-) rename physics/{GFS_ccpp_scheme_sim_pre.F90 => GFS_ccpp_suite_sim_pre.F90} (86%) rename physics/{GFS_ccpp_scheme_sim_pre.meta => GFS_ccpp_suite_sim_pre.meta} (83%) rename physics/{ccpp_scheme_simulator.F90 => ccpp_suite_simulator.F90} (91%) rename physics/{ccpp_scheme_simulator.meta => ccpp_suite_simulator.meta} (76%) rename physics/{module_ccpp_scheme_simulator.F90 => module_ccpp_suite_simulator.F90} (98%) rename physics/{module_ccpp_scheme_simulator.meta => module_ccpp_suite_simulator.meta} (86%) diff --git a/physics/GFS_ccpp_scheme_sim_pre.F90 b/physics/GFS_ccpp_suite_sim_pre.F90 similarity index 86% rename from physics/GFS_ccpp_scheme_sim_pre.F90 rename to physics/GFS_ccpp_suite_sim_pre.F90 index 47865353d..fbaf5a1d9 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.F90 +++ b/physics/GFS_ccpp_suite_sim_pre.F90 @@ -1,31 +1,31 @@ ! ######################################################################################## ! -! Description: Interstitial CCPP scheme to couple UFS physics to ccpp_scheme_simulator. +! Description: Interstitial CCPP suite to couple UFS physics to ccpp_suite_simulator. ! ! Contains: -! - load_ccpp_scheme_sim(): read and load data into type used by ccpp_scheme_simulator. +! - load_ccpp_suite_sim(): read and load data into type used by ccpp_suite_simulator. ! called once during model initialization -! - GFS_ccpp_scheme_sim_pre_run(): prepare GFS diagnostic physics tendencies for -! ccpp_scheme_simulator. +! - GFS_ccpp_suite_sim_pre_run(): prepare GFS diagnostic physics tendencies for +! ccpp_suite_simulator. ! ! ######################################################################################## -module GFS_ccpp_scheme_sim_pre +module GFS_ccpp_suite_sim_pre use machine, only: kind_phys - use module_ccpp_scheme_simulator, only: base_physics_process + use module_ccpp_suite_simulator, only: base_physics_process use netcdf implicit none - public GFS_ccpp_scheme_sim_pre_run, load_ccpp_scheme_sim + public GFS_ccpp_suite_sim_pre_run, load_ccpp_suite_sim contains ! ###################################################################################### ! - ! SUBROUTINE GFS_ccpp_scheme_sim_pre_run + ! SUBROUTINE GFS_ccpp_suite_sim_pre_run ! ! ###################################################################################### -!! \section arg_table_GFS_ccpp_scheme_sim_pre_run -!! \htmlinclude GFS_ccpp_scheme_sim_pre_run.html +!! \section arg_table_GFS_ccpp_suite_sim_pre_run +!! \htmlinclude GFS_ccpp_suite_sim_pre_run.html !! - subroutine GFS_ccpp_scheme_sim_pre_run(do_ccpp_scheme_sim, dtend, ntqv, dtidx, dtp, & + subroutine GFS_ccpp_suite_sim_pre_run(do_ccpp_suite_sim, dtend, ntqv, dtidx, dtp, & index_of_process_dcnv, index_of_process_longwave, index_of_process_shortwave, & index_of_process_scnv, index_of_process_orographic_gwd, index_of_process_pbl, & index_of_process_mp, index_of_temperature, index_of_x_wind, index_of_y_wind, & @@ -33,7 +33,7 @@ subroutine GFS_ccpp_scheme_sim_pre_run(do_ccpp_scheme_sim, dtend, ntqv, dtidx, d errmsg, errflg) ! Inputs - logical, intent(in) :: do_ccpp_scheme_sim + logical, intent(in) :: do_ccpp_suite_sim integer, intent(in) :: ntqv, index_of_process_dcnv, index_of_process_longwave, & index_of_process_shortwave, index_of_process_scnv, & index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & @@ -56,7 +56,7 @@ subroutine GFS_ccpp_scheme_sim_pre_run(do_ccpp_scheme_sim, dtend, ntqv, dtidx, d errmsg = '' errflg = 0 - if (.not. do_ccpp_scheme_sim) return + if (.not. do_ccpp_suite_sim) return ! Get tendency for "active" process. @@ -64,7 +64,7 @@ subroutine GFS_ccpp_scheme_sim_pre_run(do_ccpp_scheme_sim, dtend, ntqv, dtidx, d ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional ! array, CCPP standard_name = cumulative_change_of_state_variables. ! These are not the instantaneous physics tendencies that are applied to the state by - ! the physics schemes. Not all schemes output physics tendencies... + ! the physics suites. Not all suites output physics tendencies... ! Rather these are intended for diagnostic puposes and are accumulated over some ! interval. ! In the UFS/SCM this is controlled by the diagnostic bucket interval, namelist option @@ -107,10 +107,10 @@ subroutine GFS_ccpp_scheme_sim_pre_run(do_ccpp_scheme_sim, dtend, ntqv, dtidx, d active_phys_tend(:,:,iactive_q) = dtend(:,:,idtend)/dtp endif - end subroutine GFS_ccpp_scheme_sim_pre_run + end subroutine GFS_ccpp_suite_sim_pre_run ! ###################################################################################### - subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, & + subroutine load_ccpp_suite_sim(nlunit, nml_file, physics_process, iactive_T, & iactive_u, iactive_v, iactive_q, errmsg, errflg) ! Inputs @@ -125,13 +125,13 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, ! Local variables integer :: ncid, dimID, varID, status, ios, iprc, nlev_data, ntime_data - character(len=256) :: scheme_sim_file - logical :: exists, do_ccpp_scheme_sim + character(len=256) :: suite_sim_file + logical :: exists, do_ccpp_suite_sim integer :: nprc_sim ! For each process there is a corresponding namelist entry, which is constructed as ! follows: - ! {use_scheme_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} + ! {use_suite_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} integer, dimension(3) :: & prc_LWRAD_cfg = (/0,0,0/), & prc_SWRAD_cfg = (/0,0,0/), & @@ -142,7 +142,7 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, prc_cldMP_cfg = (/0,0,0/) ! Namelist - namelist / ccpp_scheme_sim_nml / do_ccpp_scheme_sim, scheme_sim_file, nprc_sim, & + namelist / ccpp_suite_sim_nml / do_ccpp_suite_sim, suite_sim_file, nprc_sim, & prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg, prc_GWD_cfg, prc_SCNV_cfg, & prc_DCNV_cfg, prc_cldMP_cfg @@ -152,17 +152,17 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, ! Read in namelist inquire (file = trim (nml_file), exist = exists) if (.not. exists) then - errmsg = 'CCPP scheme simulator namelist file: '//trim(nml_file)//' does not exist.' + errmsg = 'CCPP suite simulator namelist file: '//trim(nml_file)//' does not exist.' errflg = 1 return else open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) endif rewind (nlunit) - read (nlunit, nml = ccpp_scheme_sim_nml, iostat=status) + read (nlunit, nml = ccpp_suite_sim_nml, iostat=status) close (nlunit) - ! Only proceed if scheme simulator requested. + ! Only proceed if suite simulator requested. if (prc_SWRAD_cfg(1) == 1 .or. prc_LWRAD_cfg(1) == 1 .or. prc_PBL_cfg(1) == 1 .or. & prc_GWD_cfg(1) == 1 .or. prc_SCNV_cfg(1) == 1 .or. prc_DCNV_cfg(1) == 1 .or. & prc_cldMP_cfg(1) == 1 ) then @@ -171,9 +171,9 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, endif ! Check that input data file exists. - inquire (file = trim (scheme_sim_file), exist = exists) + inquire (file = trim (suite_sim_file), exist = exists) if (.not. exists) then - errmsg = 'CCPP scheme simulator file: '//trim(scheme_sim_file)//' does not exist' + errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not exist' errflg = 1 return endif @@ -183,9 +183,9 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, ! ! Open file - status = nf90_open(trim(scheme_sim_file), NF90_NOWRITE, ncid) + status = nf90_open(trim(suite_sim_file), NF90_NOWRITE, ncid) if (status /= nf90_noerr) then - errmsg = 'Error reading in CCPP scheme simulator file: '//trim(scheme_sim_file) + errmsg = 'Error reading in CCPP suite simulator file: '//trim(suite_sim_file) errflg = 1 return endif @@ -195,7 +195,7 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, if (status == nf90_noerr) then status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) else - errmsg = 'CCPP scheme simulator file: '//trim(scheme_sim_file)//' does not contain [time] dimension' + errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not contain [time] dimension' errflg = 1 return endif @@ -204,7 +204,7 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, if (status == nf90_noerr) then status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) else - errmsg = 'CCPP scheme simulator file: '//trim(scheme_sim_file)//' does not contain [lev] dimension' + errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not contain [lev] dimension' errflg = 1 return endif @@ -230,7 +230,7 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, if (status == nf90_noerr) then status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%time) else - errmsg = 'SCM data tendency file: '//trim(scheme_sim_file)//' does not contain times variable' + errmsg = 'SCM data tendency file: '//trim(suite_sim_file)//' does not contain times variable' errflg = 1 return endif @@ -403,7 +403,7 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) endif - ! Which process-scheme is "active"? Is process time-split? + ! Which process-suite is "active"? Is process time-split? if (.not. physics_process(iprc)%use_sim) then physics_process(1)%iactive_scheme = iprc physics_process(1)%active_name = physics_process(iprc)%name @@ -416,20 +416,20 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, if (physics_process(1)%iactive_scheme == 0) then errflg = 1 - errmsg = "ERROR: No active scheme set for CCPP scheme simulator" + errmsg = "ERROR: No active suite set for CCPP suite simulator" return endif print*, "-----------------------------------" - print*, "--- Using CCPP scheme simulator ---" + print*, "--- Using CCPP suite simulator ---" print*, "-----------------------------------" do iprc = 1,nprc_sim if (physics_process(iprc)%use_sim) then - print*," simulate_scheme: ", trim(physics_process(iprc)%name) + print*," simulate_suite: ", trim(physics_process(iprc)%name) print*," order: ", physics_process(iprc)%order print*," time_split: ", physics_process(iprc)%time_split else - print*, " active_scheme: ", trim(physics_process(1)%active_name) + print*, " active_suite: ", trim(physics_process(1)%active_name) print*, " order: ", physics_process(physics_process(1)%iactive_scheme)%order print*, " time_split : ", physics_process(1)%active_tsp endif @@ -437,6 +437,6 @@ subroutine load_ccpp_scheme_sim(nlunit, nml_file, physics_process, iactive_T, print*, "-----------------------------------" print*, "-----------------------------------" - end subroutine load_ccpp_scheme_sim + end subroutine load_ccpp_suite_sim -end module GFS_ccpp_scheme_sim_pre +end module GFS_ccpp_suite_sim_pre diff --git a/physics/GFS_ccpp_scheme_sim_pre.meta b/physics/GFS_ccpp_suite_sim_pre.meta similarity index 83% rename from physics/GFS_ccpp_scheme_sim_pre.meta rename to physics/GFS_ccpp_suite_sim_pre.meta index ca6d4f7cc..cc73813fa 100644 --- a/physics/GFS_ccpp_scheme_sim_pre.meta +++ b/physics/GFS_ccpp_suite_sim_pre.meta @@ -1,24 +1,24 @@ [ccpp-table-properties] - name = GFS_ccpp_scheme_sim_pre + name = GFS_ccpp_suite_sim_pre type = scheme - dependencies = machine.F,module_ccpp_scheme_simulator.F90 + dependencies = machine.F,module_ccpp_suite_simulator.F90 ######################################################################## [ccpp-arg-table] - name = GFS_ccpp_scheme_sim_pre_run + name = GFS_ccpp_suite_sim_pre_run type = scheme -[do_ccpp_scheme_sim] - standard_name = flag_for_ccpp_scheme_simulator - long_name = flag for ccpp scheme simulator +[do_ccpp_suite_sim] + standard_name = flag_for_ccpp_suite_simulator + long_name = flag for ccpp suite simulator units = flag dimensions = () type = logical intent = in [physics_process] - standard_name = physics_process_type_for_CCPP_scheme_simulator - long_name = physics process type for CCPP scheme simulator + standard_name = physics_process_type_for_CCPP_suite_simulator + long_name = physics process type for CCPP suite simulator units = mixed - dimensions = (number_of_physics_process_in_CCPP_scheme_simulator) + dimensions = (number_of_physics_process_in_CCPP_suite_simulator) type = base_physics_process intent = in [dtend] @@ -122,37 +122,37 @@ type = integer intent = in [active_phys_tend] - standard_name = tendencies_for_active_process_in_ccpp_scheme_simulator - long_name = tendencies for active physics process in ccpp scheme simulator + standard_name = tendencies_for_active_process_in_ccpp_suite_simulator + long_name = tendencies for active physics process in ccpp suite simulator units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_scheme_simulator) + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_suite_simulator) type = real kind = kind_phys intent = out [iactive_T] - standard_name = index_for_active_T_in_CCPP_scheme_simulator - long_name = index into active process tracer array for temperature in CCPP scheme simulator + standard_name = index_for_active_T_in_CCPP_suite_simulator + long_name = index into active process tracer array for temperature in CCPP suite simulator units = count dimensions = () type = integer intent = in [iactive_u] - standard_name = index_for_active_u_in_CCPP_scheme_simulator - long_name = index into active process tracer array for zonal wind in CCPP scheme simulator + standard_name = index_for_active_u_in_CCPP_suite_simulator + long_name = index into active process tracer array for zonal wind in CCPP suite simulator units = count dimensions = () type = integer intent = in [iactive_v] - standard_name = index_for_active_v_in_CCPP_scheme_simulator - long_name = index into active process tracer array for meridional wind in CCPP scheme simulator + standard_name = index_for_active_v_in_CCPP_suite_simulator + long_name = index into active process tracer array for meridional wind in CCPP suite simulator units = count dimensions = () type = integer intent = in [iactive_q] - standard_name = index_for_active_q_in_CCPP_scheme_simulator - long_name = index into active process tracer array for moisture in CCPP scheme simulator + standard_name = index_for_active_q_in_CCPP_suite_simulator + long_name = index into active process tracer array for moisture in CCPP suite simulator units = count dimensions = () type = integer diff --git a/physics/ccpp_scheme_simulator.F90 b/physics/ccpp_suite_simulator.F90 similarity index 91% rename from physics/ccpp_scheme_simulator.F90 rename to physics/ccpp_suite_simulator.F90 index f3a6372ac..c1592263d 100644 --- a/physics/ccpp_scheme_simulator.F90 +++ b/physics/ccpp_suite_simulator.F90 @@ -1,14 +1,14 @@ ! ######################################################################################## ! -! Description: This scheme simulates the evolution of the internal physics state +! Description: This suite simulates the evolution of the internal physics state ! represented by a CCPP Suite Definition File (SDF). ! -! To activate this scheme it must be a) embedded within the SDF and b) activated through +! To activate this suite it must be a) embedded within the SDF and b) activated through ! the physics namelist. ! The derived-data type "base_physics_process" contains the metadata needed to reconstruct ! the temporal evolution of the state. An array of base_physics_process, physics_process, ! is populated by the host during initialization and passed to the physics. Additionally, -! this type holds any data, or type-bound procedures, required by the scheme simulator(s). +! this type holds any data, or type-bound procedures, required by the suite simulator(s). ! ! For this initial demonstration we are using 2-dimensional (height, time) forcing data, ! which is on the same native vertical grid as the SCM. The dataset has a temporal @@ -17,29 +17,29 @@ ! (constant) diurnal cycle. ! ! ######################################################################################## -module ccpp_scheme_simulator +module ccpp_suite_simulator use machine, only: kind_phys - use module_ccpp_scheme_simulator, only: base_physics_process, sim_LWRAD, sim_SWRAD, & + use module_ccpp_suite_simulator, only: base_physics_process, sim_LWRAD, sim_SWRAD, & sim_PBL, sim_GWD, sim_DCNV, sim_SCNV, sim_cldMP implicit none - public ccpp_scheme_simulator_run + public ccpp_suite_simulator_run contains ! ###################################################################################### ! - ! SUBROUTINE ccpp_scheme_simulator_run + ! SUBROUTINE ccpp_suite_simulator_run ! ! ###################################################################################### -!! \section arg_table_ccpp_scheme_simulator_run -!! \htmlinclude ccpp_scheme_simulator_run.html +!! \section arg_table_ccpp_suite_simulator_run +!! \htmlinclude ccpp_suite_simulator_run.html !! - subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, jdat, & + subroutine ccpp_suite_simulator_run(do_ccpp_suite_sim, kdt, nCol, nLay, dtp, jdat, & iactive_T, iactive_u, iactive_v, iactive_q, proc_start, proc_end, physics_process,& in_pre_active, in_post_active, tgrs, ugrs, vgrs, qgrs, active_phys_tend, gt0, gu0,& gv0, gq0, errmsg, errflg) ! Inputs - logical, intent(in) :: do_ccpp_scheme_sim + logical, intent(in) :: do_ccpp_suite_sim integer, intent(in) :: kdt, nCol, nLay, jdat(8), iactive_T, iactive_u, & iactive_v, iactive_q real(kind_phys), intent(in) :: dtp, tgrs(:,:), ugrs(:,:), vgrs(:,:), qgrs(:,:,:), & @@ -60,7 +60,7 @@ subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, j errmsg = '' errflg = 0 - if (.not. do_ccpp_scheme_sim) return + if (.not. do_ccpp_suite_sim) return ! Current forecast time (Data-format specific) year = jdat(1) @@ -207,6 +207,6 @@ subroutine ccpp_scheme_simulator_run(do_ccpp_scheme_sim, kdt, nCol, nLay, dtp, j in_post_active = .false. endif - end subroutine ccpp_scheme_simulator_run + end subroutine ccpp_suite_simulator_run -end module ccpp_scheme_simulator +end module ccpp_suite_simulator diff --git a/physics/ccpp_scheme_simulator.meta b/physics/ccpp_suite_simulator.meta similarity index 76% rename from physics/ccpp_scheme_simulator.meta rename to physics/ccpp_suite_simulator.meta index c60cd9a38..f2737a263 100644 --- a/physics/ccpp_scheme_simulator.meta +++ b/physics/ccpp_suite_simulator.meta @@ -1,14 +1,14 @@ [ccpp-table-properties] - name = ccpp_scheme_simulator + name = ccpp_suite_simulator type = scheme - dependencies = machine.F,module_ccpp_scheme_simulator.F90 + dependencies = machine.F,module_ccpp_suite_simulator.F90 [ccpp-arg-table] - name = ccpp_scheme_simulator_run + name = ccpp_suite_simulator_run type = scheme -[do_ccpp_scheme_sim] - standard_name = flag_for_ccpp_scheme_simulator - long_name = flag for ccpp scheme simulator +[do_ccpp_suite_sim] + standard_name = flag_for_ccpp_suite_simulator + long_name = flag for ccpp suite simulator units = flag dimensions = () type = logical @@ -50,29 +50,29 @@ type = integer intent = in [proc_start] - standard_name = index_for_first_physics_process_in_CCPP_scheme_simulator - long_name = index for first physics process in CCPP scheme simulator + standard_name = index_for_first_physics_process_in_CCPP_suite_simulator + long_name = index for first physics process in CCPP suite simulator units = count dimensions = () type = integer intent = inout [proc_end] - standard_name = index_for_last_physics_process_in_CCPP_scheme_simulator - long_name = index for last physics process in CCPP scheme simulator + standard_name = index_for_last_physics_process_in_CCPP_suite_simulator + long_name = index for last physics process in CCPP suite simulator units = count dimensions = () type = integer intent = inout [in_pre_active] - standard_name = flag_to_indicate_location_in_physics_process_loop_before_active_scheme - long_name = flag to indicate location in physics process loop before active scheme + standard_name = flag_to_indicate_location_in_physics_process_loop_before_active_suite + long_name = flag to indicate location in physics process loop before active suite units = flag dimensions = () type = logical intent = inout [in_post_active] - standard_name = flag_to_indicate_location_in_physics_process_loop_after_active_scheme - long_name = flag to indicate location in physics process loop after active scheme + standard_name = flag_to_indicate_location_in_physics_process_loop_after_active_suite + long_name = flag to indicate location in physics process loop after active suite units = flag dimensions = () type = logical @@ -110,37 +110,37 @@ kind = kind_phys intent = in [active_phys_tend] - standard_name = tendencies_for_active_process_in_ccpp_scheme_simulator - long_name = tendencies for active physics process in ccpp scheme simulator + standard_name = tendencies_for_active_process_in_ccpp_suite_simulator + long_name = tendencies for active physics process in ccpp suite simulator units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_scheme_simulator) + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_suite_simulator) type = real kind = kind_phys intent = in [iactive_T] - standard_name = index_for_active_T_in_CCPP_scheme_simulator - long_name = index into active process tracer array for temperature in CCPP scheme simulator + standard_name = index_for_active_T_in_CCPP_suite_simulator + long_name = index into active process tracer array for temperature in CCPP suite simulator units = count dimensions = () type = integer intent = in [iactive_u] - standard_name = index_for_active_u_in_CCPP_scheme_simulator - long_name = index into active process tracer array for zonal wind in CCPP scheme simulator + standard_name = index_for_active_u_in_CCPP_suite_simulator + long_name = index into active process tracer array for zonal wind in CCPP suite simulator units = count dimensions = () type = integer intent = in [iactive_v] - standard_name = index_for_active_v_in_CCPP_scheme_simulator - long_name = index into active process tracer array for meridional wind in CCPP scheme simulator + standard_name = index_for_active_v_in_CCPP_suite_simulator + long_name = index into active process tracer array for meridional wind in CCPP suite simulator units = count dimensions = () type = integer intent = in [iactive_q] - standard_name = index_for_active_q_in_CCPP_scheme_simulator - long_name = index into active process tracer array for moisture in CCPP scheme simulator + standard_name = index_for_active_q_in_CCPP_suite_simulator + long_name = index into active process tracer array for moisture in CCPP suite simulator units = count dimensions = () type = integer @@ -178,10 +178,10 @@ kind = kind_phys intent = inout [physics_process] - standard_name = physics_process_type_for_CCPP_scheme_simulator - long_name = physics process type for CCPP scheme simulator + standard_name = physics_process_type_for_CCPP_suite_simulator + long_name = physics process type for CCPP suite simulator units = mixed - dimensions = (number_of_physics_process_in_CCPP_scheme_simulator) + dimensions = (number_of_physics_process_in_CCPP_suite_simulator) type = base_physics_process intent = inout [errmsg] diff --git a/physics/module_ccpp_scheme_simulator.F90 b/physics/module_ccpp_suite_simulator.F90 similarity index 98% rename from physics/module_ccpp_scheme_simulator.F90 rename to physics/module_ccpp_suite_simulator.F90 index a122563d9..c759c583a 100644 --- a/physics/module_ccpp_scheme_simulator.F90 +++ b/physics/module_ccpp_suite_simulator.F90 @@ -1,12 +1,12 @@ ! ######################################################################################## ! ! This module contains the type, base_physics_process, and supporting subroutines needed -! by the ccpp scheme simulator. +! by the ccpp suite simulator. ! ! ######################################################################################## -module module_ccpp_scheme_simulator -!> \section arg_table_module_ccpp_scheme_simulator Argument table -!! \htmlinclude module_ccpp_scheme_simulator.html +module module_ccpp_suite_simulator +!> \section arg_table_module_ccpp_suite_simulator Argument table +!! \htmlinclude module_ccpp_suite_simulator.html !! use machine, only : kind_phys implicit none @@ -307,4 +307,4 @@ subroutine sim_cldMP( year, month, day, hour, min, sec, process) endif end subroutine sim_cldMP -end module module_ccpp_scheme_simulator +end module module_ccpp_suite_simulator diff --git a/physics/module_ccpp_scheme_simulator.meta b/physics/module_ccpp_suite_simulator.meta similarity index 86% rename from physics/module_ccpp_scheme_simulator.meta rename to physics/module_ccpp_suite_simulator.meta index 8eefb228c..cd8e3db1b 100644 --- a/physics/module_ccpp_scheme_simulator.meta +++ b/physics/module_ccpp_suite_simulator.meta @@ -9,12 +9,12 @@ ######################################################################## [ccpp-table-properties] - name = module_ccpp_scheme_simulator + name = module_ccpp_suite_simulator type = module dependencies = machine.F [ccpp-arg-table] - name = module_ccpp_scheme_simulator + name = module_ccpp_suite_simulator type = module [base_physics_process] standard_name = base_physics_process From 2d6d44c8d56aa707d4e11901f1965df322c2322a Mon Sep 17 00:00:00 2001 From: dustinswales Date: Wed, 19 Jul 2023 16:12:43 -0600 Subject: [PATCH 21/22] Omission from previous commit --- physics/ccpp_suite_simulator.meta | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/ccpp_suite_simulator.meta b/physics/ccpp_suite_simulator.meta index f2737a263..bfa664922 100644 --- a/physics/ccpp_suite_simulator.meta +++ b/physics/ccpp_suite_simulator.meta @@ -64,15 +64,15 @@ type = integer intent = inout [in_pre_active] - standard_name = flag_to_indicate_location_in_physics_process_loop_before_active_suite - long_name = flag to indicate location in physics process loop before active suite + standard_name = flag_to_indicate_location_in_physics_process_loop_before_active_scheme + long_name = flag to indicate location in physics process loop before active scheme units = flag dimensions = () type = logical intent = inout [in_post_active] - standard_name = flag_to_indicate_location_in_physics_process_loop_after_active_suite - long_name = flag to indicate location in physics process loop after active suite + standard_name = flag_to_indicate_location_in_physics_process_loop_after_active_scheme + long_name = flag to indicate location in physics process loop after active scheme units = flag dimensions = () type = logical From 5ab1a5bb7385214ec8febaa0d2bef2f6a1377481 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Wed, 19 Jul 2023 16:48:11 -0600 Subject: [PATCH 22/22] Add ability to use constant forcing data when one-dimensional data is provided. --- physics/module_ccpp_suite_simulator.F90 | 28 ++++++++++++++++++++----- 1 file changed, 23 insertions(+), 5 deletions(-) diff --git a/physics/module_ccpp_suite_simulator.F90 b/physics/module_ccpp_suite_simulator.F90 index c759c583a..c4f9fc4e4 100644 --- a/physics/module_ccpp_suite_simulator.F90 +++ b/physics/module_ccpp_suite_simulator.F90 @@ -94,21 +94,39 @@ function linterp_1D(this, var_name, year, month, day, hour, min, sec) result(err character(len=*), intent(in) :: var_name integer, intent(in) :: year, month, day, hour, min, sec character(len=128) :: err_message - integer :: ti(1), tf(1) + integer :: ti(1), tf(1), ntime real(kind_phys) :: w1, w2 ! Interpolation weights call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) + ntime = size(this%tend2d%T(1,:)) + select case(var_name) case("T") - this%tend1d%T = w1*this%tend2d%T(:,ti(1)) + w2*this%tend2d%T(:,tf(1)) + if (tf(1) .le. ntime) then + this%tend1d%T = w1*this%tend2d%T(:,ti(1)) + w2*this%tend2d%T(:,tf(1)) + else + this%tend1d%T = this%tend2d%T(:,1) + endif case("u") - this%tend1d%u = w1*this%tend2d%u(:,ti(1)) + w2*this%tend2d%u(:,tf(1)) + if (tf(1) .le. ntime) then + this%tend1d%u = w1*this%tend2d%u(:,ti(1)) + w2*this%tend2d%u(:,tf(1)) + else + this%tend1d%u = this%tend2d%u(:,1) + endif case("v") - this%tend1d%v = w1*this%tend2d%v(:,ti(1)) + w2*this%tend2d%v(:,tf(1)) + if (tf(1) .le. ntime) then + this%tend1d%v = w1*this%tend2d%v(:,ti(1)) + w2*this%tend2d%v(:,tf(1)) + else + this%tend1d%v = this%tend2d%v(:,1) + endif case("q") - this%tend1d%q = w1*this%tend2d%q(:,ti(1)) + w2*this%tend2d%q(:,tf(1)) + if (tf(1) .le. ntime) then + this%tend1d%q = w1*this%tend2d%q(:,ti(1)) + w2*this%tend2d%q(:,tf(1)) + else + this%tend1d%q = this%tend2d%q(:,1) + endif end select end function linterp_1D