From d04714a24cd1cf7ee5a3506e718a3c618c9ff063 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Wed, 19 Dec 2018 16:29:49 -0700 Subject: [PATCH 1/3] update GFS_phys_time_var.scm.F90 to match changes to GFS_phys_time_vary.fv3.F90 (comment out sections that aren't ready to be run yet) --- physics/GFS_phys_time_vary.scm.F90 | 82 ++++++++++++++++++++++++++++-- 1 file changed, 77 insertions(+), 5 deletions(-) diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 303054911..54c780ada 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -7,6 +7,10 @@ module GFS_phys_time_vary use h2ointerp, only : setindxh2o, h2ointerpol + use aerclm_def, only : aerin, aer_pres, ntrcaer, ntrcaerm + + use iccn_def, only : ciplin, ccnin, ci_pres + implicit none private @@ -47,17 +51,62 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Tbd, errmsg, errflg) nb = Tbd%blkno - !--- initialize ozone and water + if (Model%aero_in) then + ! ! Consistency check that the value for ntrcaerm set in GFS_typedefs.F90 + ! ! and used to allocate Tbd%aer_nm matches the value defined in aerclm_def + ! if (size(Tbd%aer_nm, dim=3).ne.ntrcaerm) then + ! write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & + ! "ntrcaerm from aerclm_def does not match value in GFS_typedefs.F90: ", & + ! ntrcaerm, " /= ", size(Tbd%aer_nm, dim=3) + ! errflg = 1 + ! return + ! end if + ! ! Update the value of ntrcaer in aerclm_def with the value defined + ! ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. + ! ! If Model%aero_in is .true., then ntrcaer == ntrcaerm + ! ntrcaer = size(Tbd%aer_nm, dim=3) + ! ! Read aerosol climatology + ! call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate) + else + ! Update the value of ntrcaer in aerclm_def with the value defined + ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. + ! If Model%aero_in is .false., then ntrcaer == 1 + ntrcaer = size(Tbd%aer_nm, dim=3) + endif + if (Model%iccn) then + ! call read_cidata ( Model%me, Model%master) + ! ! No consistency check needed for in/ccn data, all values are + ! ! hardcoded in module iccn_def.F and GFS_typedefs.F90 + endif + + !--- read in and initialize ozone if (Model%ntoz > 0) then call setindxoz (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_o3, & Grid%jindx2_o3, Grid%ddy_o3) endif + !--- read in and initialize stratospheric water if (Model%h2o_phys) then call setindxh2o (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_h, & Grid%jindx2_h, Grid%ddy_h) endif + !--- read in and initialize aerosols + ! if (Model%aero_in) then + ! call setindxaer (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_aer, & + ! Grid%jindx2_aer, Grid%ddy_aer, Grid%xlon_d, & + ! Grid%iindx1_aer, Grid%iindx2_aer, Grid%ddx_aer, & + ! Model%me, Model%master) + ! endif + ! !--- read in and initialize IN and CCN + ! if (Model%iccn) then + ! call setindxci (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_ci, & + ! Grid%jindx2_ci, Grid%ddy_ci, Grid%xlon_d, & + ! Grid%iindx1_ci, Grid%iindx2_ci, Grid%ddx_ci) + ! endif + + + end subroutine GFS_phys_time_vary_init subroutine GFS_phys_time_vary_finalize() @@ -67,6 +116,7 @@ end subroutine GFS_phys_time_vary_finalize !! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | !! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| !! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | +!! | Statein | FV3-GFS_Statein_type | derived type GFS_statein_type in FV3 | DDT | 0 | GFS_statein_type | | in | F | !! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | inout | F | !! | Tbd | FV3-GFS_Tbd_type | Fortran DDT containing FV3-GFS miscellaneous data | DDT | 0 | GFS_tbd_type | | inout | F | !! | Sfcprop | FV3-GFS_Sfcprop_type | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | inout | F | @@ -75,17 +125,19 @@ end subroutine GFS_phys_time_vary_finalize !! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | !! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! - subroutine GFS_phys_time_vary_run (Grid, Model, Tbd, Sfcprop, Cldprop, Diag, errmsg, errflg) + subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, Diag, errmsg, errflg) use mersenne_twister, only: random_setseed, random_number use machine, only: kind_phys use GFS_typedefs, only: GFS_control_type, GFS_grid_type, & GFS_Tbd_type, GFS_sfcprop_type, & - GFS_cldprop_type, GFS_diag_type + GFS_cldprop_type, GFS_diag_type, & + GFS_statein_type implicit none type(GFS_grid_type), intent(in) :: Grid + type(GFS_statein_type), intent(in) :: Statein type(GFS_control_type), intent(inout) :: Model type(GFS_tbd_type), intent(inout) :: Tbd type(GFS_sfcprop_type), intent(inout) :: Sfcprop @@ -126,12 +178,12 @@ subroutine GFS_phys_time_vary_run (Grid, Model, Tbd, Sfcprop, Cldprop, Diag, err endif !--- random number needed for RAS and old SAS and when cal_pre=.true. - if ( ((Model%imfdeepcnv <= 0) .or. (Model%cal_pre)) .and. (Model%random_clds) ) then + if ( (Model%imfdeepcnv <= 0 .or. Model%cal_pre) .and. Model%random_clds ) then iseed = mod(con_100*sqrt(Model%fhour*con_hr),1.0d9) + Model%seed0 call random_setseed(iseed) call random_number(wrk) do i = 1,Model%cnx*Model%nrcm - iseed = iseed + nint(wrk(1)) * i + iseed = iseed + nint(wrk(1)*1000.0) * i call random_setseed(iseed) call random_number(rannie) rndval(1+(i-1)*Model%cny:i*Model%cny) = rannie(1:Model%cny) @@ -171,6 +223,26 @@ subroutine GFS_phys_time_vary_run (Grid, Model, Tbd, Sfcprop, Cldprop, Diag, err Grid%jindx1_h, Grid%jindx2_h, Tbd%h2opl, Grid%ddy_h) endif + !--- aerosol interpolation + ! if (Model%aero_in) then + ! call aerinterpol (Model%me, Model%master, Model%blksz(nb), & + ! Model%idate, Model%fhour, & + ! Grid%jindx1_aer, Grid%jindx2_aer, & + ! Grid%ddy_aer,Grid%iindx1_aer, & + ! Grid%iindx2_aer,Grid%ddx_aer, & + ! Model%levs,Statein%prsl, & + ! Tbd%aer_nm) + ! endif + ! !--- ICCN interpolation + ! if (Model%iccn) then + ! call ciinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & + ! Grid%jindx1_ci, Grid%jindx2_ci, & + ! Grid%ddy_ci,Grid%iindx1_ci, & + ! Grid%iindx2_ci,Grid%ddx_ci, & + ! Model%levs,Statein%prsl, & + ! Tbd%in_nm, Tbd%ccn_nm) + ! endif + !--- original FV3 code, not needed for SCM; also not compatible with the way ! the time vary steps are run (over each block) --> cannot use !--- repopulate specific time-varying sfc properties for AMIP/forecast runs From 11b29de82d93560b7091f5fc45c7b3eff80a1ad8 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Mon, 31 Dec 2018 13:59:54 -0700 Subject: [PATCH 2/3] replaced 'readonly' keyword in file open statement with action='read' in order to be compiled by gfortran --- physics/module_gfdl_cloud_microphys.F90 | 40 ++++++++++++------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/physics/module_gfdl_cloud_microphys.F90 b/physics/module_gfdl_cloud_microphys.F90 index 26b93feef..01f5c8fb9 100644 --- a/physics/module_gfdl_cloud_microphys.F90 +++ b/physics/module_gfdl_cloud_microphys.F90 @@ -1,5 +1,5 @@ !> \file gfdl_cloud_microphys.F90 -!! This file contains the column GFDL cloud microphysics ( Chen and Lin (2013) +!! This file contains the column GFDL cloud microphysics ( Chen and Lin (2013) !! \cite chen_and_lin_2013 ). !*********************************************************************** !* GNU Lesser General Public License @@ -772,9 +772,9 @@ subroutine mpdrv (hydrostatic, uin, vin, w, delp, pt, qv, ql, qr, qi, qs, & endif ! ----------------------------------------------------------------------- - !> - Calculate horizontal subgrid variability, which is used in cloud - !! fraction, relative humidity calculation, evaporation and condensation - !! processes. Horizontal sub-grid variability is a function of cell area + !> - Calculate horizontal subgrid variability, which is used in cloud + !! fraction, relative humidity calculation, evaporation and condensation + !! processes. Horizontal sub-grid variability is a function of cell area !! and land/sea mask: !!\n Over land: !!\f[ @@ -784,12 +784,12 @@ subroutine mpdrv (hydrostatic, uin, vin, w, delp, pt, qv, ql, qr, qi, qs, & !!\f[ !! t_{ocean}=dw_{ocean}(\frac{A_{r}}{10^{10}})^{0.25} !!\f] - !! where \f$A_{r}\f$ is cell area. \f$dw_{land}=0.16\f$ and \f$dw_{ocean}=0.10\f$ + !! where \f$A_{r}\f$ is cell area. \f$dw_{land}=0.16\f$ and \f$dw_{ocean}=0.10\f$ !! are base value for sub-grid variability over land and ocean. !! The total horizontal sub-grid variability is: !!\f[ !! h_{var}=t_{land}\times fr_{land}+t_{ocean}\times (1-fr_{land}) - !!\f] + !!\f] !!\f[ !! h_{var}=min[0.2,max(0.01,h_{var})] !!\f] @@ -820,7 +820,7 @@ subroutine mpdrv (hydrostatic, uin, vin, w, delp, pt, qv, ql, qr, qi, qs, & m2_rain (:, :) = 0. m2_sol (:, :) = 0. - + !> - Do loop on cloud microphysics sub time step. do n = 1, ntimes @@ -863,7 +863,7 @@ subroutine mpdrv (hydrostatic, uin, vin, w, delp, pt, qv, ql, qr, qi, qs, & !> - Call fall_speed() to calculate the fall velocity of cloud ice, snow !! and graupel. call fall_speed (ktop, kbot, den, qsz, qiz, qgz, qlz, tz, vtsz, vtiz, vtgz) - + !> - Call terminal_fall() to calculate the terminal fall speed. call terminal_fall (dts, ktop, kbot, tz, qvz, qlz, qrz, qgz, qsz, qiz, & dz1, dp1, den, vtgz, vtsz, vtiz, r1, g1, s1, i1, m1_sol, w1) @@ -1139,7 +1139,7 @@ subroutine warm_rain (dt, ktop, kbot, dp, dz, tz, qv, ql, qr, qi, qs, qg, & enddo ! ----------------------------------------------------------------------- - !> - Call revap_racc(), to calculate evaporation and accretion + !> - Call revap_racc(), to calculate evaporation and accretion !! of rain for the first 1/2 time step. ! ----------------------------------------------------------------------- @@ -1153,7 +1153,7 @@ subroutine warm_rain (dt, ktop, kbot, dp, dz, tz, qv, ql, qr, qi, qs, qg, & endif ! ----------------------------------------------------------------------- - !> - Calculate mass flux induced by falling rain + !> - Calculate mass flux induced by falling rain !! ( use_ppm =.false, call implicit_fall(): time-implicit monotonic fall scheme.) ! ----------------------------------------------------------------------- @@ -1194,7 +1194,7 @@ subroutine warm_rain (dt, ktop, kbot, dp, dz, tz, qv, ql, qr, qi, qs, qg, & call sedi_heat (ktop, kbot, dp, m1_rain, dz, tz, qv, ql, qr, qi, qs, qg, c_liq) ! ----------------------------------------------------------------------- - !> - Call revap_racc() to calculate evaporation and accretion + !> - Call revap_racc() to calculate evaporation and accretion !! of rain for the remaing 1/2 time step. ! ----------------------------------------------------------------------- @@ -1433,7 +1433,7 @@ subroutine linear_prof (km, q, dm, z_var, h_var) dm (km) = 0. ! ----------------------------------------------------------------------- - !> - Impose the background horizontal variability (\f$h_{var}\f$) that + !> - Impose the background horizontal variability (\f$h_{var}\f$) that !! is proportional to the value itself. ! ----------------------------------------------------------------------- @@ -1455,7 +1455,7 @@ end subroutine linear_prof !>\author Shian-Jiann Lin, GFDL !! !! This scheme is featured with: -!! - bulk cloud microphysics +!! - bulk cloud microphysics !! - processes splitting with some un-split sub-grouping !! - time implicit (when possible) accretion and autoconversion !>\section det_icloud GFDL icloud Detailed Algorithm @@ -1731,7 +1731,7 @@ subroutine icloud (ktop, kbot, tzk, p1, qvk, qlk, qrk, qik, qsk, qgk, dp1, & ! ----------------------------------------------------------------------- !> - \f$P_{saut}\f$: autoconversion: cloud ice \f$\rightarrow\f$ snow. !!\n similar to Lin et al.(1983) \cite lin_et_al_1983 eq. 21 solved implicitly; - !! threshold from wsm6 scheme, Hong et al. (2004) \cite hong_et_al_2004, + !! threshold from wsm6 scheme, Hong et al. (2004) \cite hong_et_al_2004, !! eq (13) : qi0_crt ~0.8e-4. ! ----------------------------------------------------------------------- @@ -2349,7 +2349,7 @@ subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & endif ! ----------------------------------------------------------------------- - !> - Compute cloud fraction, assuming subgrid linear distribution in horizontal; + !> - Compute cloud fraction, assuming subgrid linear distribution in horizontal; !! this is effectively a smoother for the binary cloud scheme. ! ----------------------------------------------------------------------- @@ -2810,7 +2810,7 @@ end subroutine check_column ! ======================================================================= !>\ingroup gfdlmp -!>@brief The subroutine computes the time-implicit monotonic +!>@brief The subroutine computes the time-implicit monotonic !! fall scheme. !>@author Shian-Jiann Lin, 2016 ! ======================================================================= @@ -3504,7 +3504,7 @@ subroutine gfdl_cloud_microphys_mod_init (me, master, nlunit, input_nml_file, lo write (6, *) 'gfdl - mp :: namelist file: ', trim (fn_nml), ' does not exist' stop else - open (unit = nlunit, file = fn_nml, readonly, status = 'old', iostat = ios) + open (unit = nlunit, file = fn_nml, action = 'read' , status = 'old', iostat = ios) endif rewind (nlunit) read (nlunit, nml = gfdl_cloud_microphysics_nml) @@ -3752,7 +3752,7 @@ subroutine qsmith_init des2 (length) = des2 (length - 1) des3 (length) = des3 (length - 1) desw (length) = desw (length - 1) - + tables_are_initialized = .true. endif @@ -3791,7 +3791,7 @@ end function wqs1 ! ======================================================================= ! compute the gradient of saturated specific humidity for table ii !>@brief The function 'wqs2' returns the saturation vapor pressure over pure -!! liquid water for a given temperature and air density, as well as the +!! liquid water for a given temperature and air density, as well as the !! analytic dqs/dT: rate of change of saturation vapor pressure WRT temperature. ! ======================================================================= @@ -4668,7 +4668,7 @@ end subroutine interpolate_z ! ======================================================================= !> \ingroup gfdlmp -!>@brief The subroutine 'cloud_diagnosis' diagnoses the radius of cloud +!>@brief The subroutine 'cloud_diagnosis' diagnoses the radius of cloud !! species. ! ======================================================================= From 207e4c952d9907f6cf754589f554b2bbea61ca39 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Mon, 25 Feb 2019 14:51:31 -0700 Subject: [PATCH 3/3] updates to SCM-specific 'time_vary' routines --- physics/GFS_phys_time_vary.scm.F90 | 85 +++++++++++++++----------- physics/GFS_rad_time_vary.scm.F90 | 34 ++++------- physics/GFS_time_vary_pre.scm.F90 | 95 +++++++++++++++++------------- 3 files changed, 115 insertions(+), 99 deletions(-) diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 59526e530..c7693b352 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -17,6 +17,8 @@ module GFS_phys_time_vary public GFS_phys_time_vary_init, GFS_phys_time_vary_run, GFS_phys_time_vary_finalize + logical :: is_initialized = .false. + contains !> \section arg_table_GFS_phys_time_vary_init Argument Table @@ -43,13 +45,13 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Tbd, errmsg, errflg) integer, intent(out) :: errflg ! Local variables - integer :: nb + integer :: i, j, ix, nb ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - nb = Tbd%blkno + nb = 1 if (Model%aero_in) then ! ! Consistency check that the value for ntrcaerm set in GFS_typedefs.F90 @@ -105,6 +107,22 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Tbd, errmsg, errflg) ! Grid%iindx1_ci, Grid%iindx2_ci, Grid%ddx_ci) ! endif + !--- initial calculation of maps local ix -> global i and j, store in Tbd + ix = 0 + nb = 1 + do j = 1,Model%ny + do i = 1,Model%nx + ix = ix + 1 + if (ix .gt. Model%blksz(nb)) then + ix = 1 + nb = nb + 1 + endif + Tbd%jmap(ix) = j + Tbd%imap(ix) = i + enddo + enddo + + is_initialized = .true. end subroutine GFS_phys_time_vary_init @@ -156,22 +174,29 @@ subroutine GFS_phys_time_vary_run (Grid, Model, Tbd, Sfcprop, Cldprop, Diag, err errmsg = '' errflg = 0 - if (Tbd%blkno==1) then - !--- switch for saving convective clouds - cnvc90.f - !--- aka Ken Campana/Yu-Tai Hou legacy - if ((mod(Model%kdt,Model%nsswr) == 0) .and. (Model%lsswr)) then - !--- initialize,accumulate,convert - Model%clstp = 1100 + min(Model%fhswr/con_hr,Model%fhour,con_99) - elseif (mod(Model%kdt,Model%nsswr) == 0) then - !--- accumulate,convert - Model%clstp = 0100 + min(Model%fhswr/con_hr,Model%fhour,con_99) - elseif (Model%lsswr) then - !--- initialize,accumulate - Model%clstp = 1100 - else - !--- accumulate - Model%clstp = 0100 - endif + ! Check initialization status + if (.not.is_initialized) then + write(errmsg,'(*(a))') "Logic error: GFS_phys_time_vary_run called before GFS_phys_time_vary_init" + errflg = 1 + return + end if + + nb = 1 + + !--- switch for saving convective clouds - cnvc90.f + !--- aka Ken Campana/Yu-Tai Hou legacy + if ((mod(Model%kdt,Model%nsswr) == 0) .and. (Model%lsswr)) then + !--- initialize,accumulate,convert + Model%clstp = 1100 + min(Model%fhswr/con_hr,Model%fhour,con_99) + elseif (mod(Model%kdt,Model%nsswr) == 0) then + !--- accumulate,convert + Model%clstp = 0100 + min(Model%fhswr/con_hr,Model%fhour,con_99) + elseif (Model%lsswr) then + !--- initialize,accumulate + Model%clstp = 1100 + else + !--- accumulate + Model%clstp = 0100 endif !--- random number needed for RAS and old SAS and when cal_pre=.true. @@ -186,37 +211,25 @@ subroutine GFS_phys_time_vary_run (Grid, Model, Tbd, Sfcprop, Cldprop, Diag, err rndval(1+(i-1)*Model%cny:i*Model%cny) = rannie(1:Model%cny) enddo - ! DH* TODO - this could be sped up by saving jsc, jec, isc, iec in Tbd (for example) - ! and looping just over them; ix would then run from 1 to blksz(nb); one could also - ! use OpenMP to speed up this loop or the inside loops *DH do k = 1,Model%nrcm iskip = (k-1)*Model%cnx*Model%cny - ix = 0 - nb = 1 - do j = 1,Model%ny - do i = 1,Model%nx - ix = ix + 1 - if (ix .gt. Model%blksz(nb)) then - ix = 1 - nb = nb + 1 - endif - if (nb == Tbd%blkno) then - Tbd%rann(ix,k) = rndval(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + iskip) - endif + do ix=1,Model%blksz(nb) + j = Tbd%jmap(ix) + i = Tbd%imap(ix) + Tbd%rann(ix,k) = rndval(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + iskip) enddo - enddo enddo endif ! imfdeepcnv, cal_re, random_clds !--- o3 interpolation if (Model%ntoz > 0) then - call ozinterpol (Model%me, Model%blksz(Tbd%blkno), Model%idate, Model%fhour, & + call ozinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & Grid%jindx1_o3, Grid%jindx2_o3, Tbd%ozpl, Grid%ddy_o3) endif !--- h2o interpolation if (Model%h2o_phys) then - call h2ointerpol (Model%me, Model%blksz(Tbd%blkno), Model%idate, Model%fhour, & + call h2ointerpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & Grid%jindx1_h, Grid%jindx2_h, Tbd%h2opl, Grid%ddy_h) endif diff --git a/physics/GFS_rad_time_vary.scm.F90 b/physics/GFS_rad_time_vary.scm.F90 index 6df24ac87..4ea13a416 100644 --- a/physics/GFS_rad_time_vary.scm.F90 +++ b/physics/GFS_rad_time_vary.scm.F90 @@ -10,7 +10,7 @@ module GFS_rad_time_vary contains -!>\defgroup GFS_rad_time_vary GFS RRTMG Update +!>\defgroup GFS_rad_time_vary GFS RRTMG Update !!\ingroup RRTMG !! @{ !! \section arg_table_GFS_rad_time_vary_init Argument Table @@ -55,6 +55,8 @@ subroutine GFS_rad_time_vary_run (Model, Statein, Tbd, errmsg, errflg) errmsg = '' errflg = 0 + nb = 1 + if (Model%lsswr .or. Model%lslwr) then !--- call to GFS_radupdate_run is now in GFS_rrtmg_setup_run @@ -64,30 +66,18 @@ subroutine GFS_rad_time_vary_run (Model, Statein, Tbd, errmsg, errflg) ipseed = mod(nint(con_100*sqrt(Model%sec)), ipsdlim) + 1 + ipsd0 call random_setseed (ipseed, stat) call random_index (ipsdlim, numrdm, stat) - + !--- set the random seeds for each column in a reproducible way - ix = 0 - nb = 1 - ! DH* TODO - this could be sped up by saving jsc, jec, isc, iec in Tbd (for example) - ! and looping just over them; ix would then run from 1 to blksz(nb); one could also - ! use OpenMP to speed up this loop *DH - do j = 1,Model%ny - do i = 1,Model%nx - ix = ix + 1 - if (ix .gt. Model%blksz(nb)) then - ix = 1 - nb = nb + 1 - endif - if (nb == Tbd%blkno) then - !--- for testing purposes, replace numrdm with '100' - Tbd%icsdsw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx) - Tbd%icsdlw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + Model%cnx*Model%cny) - endif - enddo + do ix=1,Model%blksz(nb) + j = Tbd%jmap(ix) + i = Tbd%imap(ix) + !--- for testing purposes, replace numrdm with '100' + Tbd%icsdsw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx) + Tbd%icsdlw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + Model%cnx*Model%cny) enddo endif ! isubc_lw and isubc_sw - if (Model%num_p3d == 4) then + if (Model%imp_physics == 99) then if (Model%kdt == 1) then Tbd%phy_f3d(:,:,1) = Statein%tgrs Tbd%phy_f3d(:,:,2) = max(qmin,Statein%qgrs(:,:,1)) @@ -101,7 +91,7 @@ subroutine GFS_rad_time_vary_run (Model, Statein, Tbd, errmsg, errflg) endif end subroutine GFS_rad_time_vary_run - + !> \section arg_table_GFS_rad_time_vary_finalize Argument Table !! subroutine GFS_rad_time_vary_finalize() diff --git a/physics/GFS_time_vary_pre.scm.F90 b/physics/GFS_time_vary_pre.scm.F90 index 6b3fdd944..bb246cd32 100644 --- a/physics/GFS_time_vary_pre.scm.F90 +++ b/physics/GFS_time_vary_pre.scm.F90 @@ -11,6 +11,8 @@ module GFS_time_vary_pre public GFS_time_vary_pre_init, GFS_time_vary_pre_run, GFS_time_vary_pre_finalize + logical :: is_initialized = .false. + contains !> \section arg_table_GFS_time_vary_pre_init Argument Table @@ -30,9 +32,13 @@ subroutine GFS_time_vary_pre_init (errmsg, errflg) errmsg = '' errflg = 0 + if (is_initialized) return + !--- Call gfuncphys (funcphys.f) to compute all physics function tables. call gfuncphys () + is_initialized = .true. + end subroutine GFS_time_vary_pre_init @@ -49,12 +55,16 @@ subroutine GFS_time_vary_pre_finalize(errmsg, errflg) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - ! DH* this is the place to deallocate whatever is allocated by gfuncphys() in GFS_time_vary_pre_init - ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + if (.not. is_initialized) return + + ! DH* this is the place to deallocate whatever is allocated by gfuncphys() in GFS_time_vary_pre_init + + is_initialized = .false. + end subroutine GFS_time_vary_pre_finalize @@ -62,19 +72,17 @@ end subroutine GFS_time_vary_pre_finalize !! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | !! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------| !! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | inout | F | -!! | Tbd | GFS_tbd_type_instance | Fortran DDT containing FV3-GFS miscellaneous data | DDT | 0 | GFS_tbd_type | | in | F | !! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | !! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! - subroutine GFS_time_vary_pre_run (Model, Tbd, errmsg, errflg) + subroutine GFS_time_vary_pre_run (Model, errmsg, errflg) use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, GFS_tbd_type + use GFS_typedefs, only: GFS_control_type implicit none type(GFS_control_type), intent(inout) :: Model - type(GFS_tbd_type), intent(in) :: Tbd character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -86,41 +94,46 @@ subroutine GFS_time_vary_pre_run (Model, Tbd, errmsg, errflg) errmsg = '' errflg = 0 - if (Tbd%blkno==1) then - !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 - !--- update calendars and triggers - rinc(1:5) = 0 - call w3difdat(Model%jdat,Model%idat,4,rinc) - Model%sec = rinc(4) - Model%phour = Model%sec/con_hr - !--- set current bucket hour - Model%zhour = Model%phour - Model%fhour = (Model%sec + Model%dtp)/con_hr - Model%kdt = nint((Model%sec + Model%dtp)/Model%dtp) - - Model%ipt = 1 - Model%lprnt = .false. - Model%lssav = .true. - - !--- radiation triggers - Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) - Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) - - !--- set the solar hour based on a combination of phour and time initial hour - Model%solhr = mod(Model%phour+Model%idate(1),con_24) - - if ((Model%debug) .and. (Model%me == Model%master)) then - print *,' sec ', Model%sec - print *,' kdt ', Model%kdt - print *,' nsswr ', Model%nsswr - print *,' nslwr ', Model%nslwr - print *,' nscyc ', Model%nscyc - print *,' lsswr ', Model%lsswr - print *,' lslwr ', Model%lslwr - print *,' fhour ', Model%fhour - print *,' phour ', Model%phour - print *,' solhr ', Model%solhr - endif + ! Check initialization status + if (.not.is_initialized) then + write(errmsg,'(*(a))') "Logic error: GFS_time_vary_pre_run called before GFS_time_vary_pre_init" + errflg = 1 + return + end if + + !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 + !--- update calendars and triggers + rinc(1:5) = 0 + call w3difdat(Model%jdat,Model%idat,4,rinc) + Model%sec = rinc(4) + Model%phour = Model%sec/con_hr + !--- set current bucket hour + Model%zhour = Model%phour + Model%fhour = (Model%sec + Model%dtp)/con_hr + Model%kdt = nint((Model%sec + Model%dtp)/Model%dtp) + + Model%ipt = 1 + Model%lprnt = .false. + Model%lssav = .true. + + !--- radiation triggers + Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) + Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) + + !--- set the solar hour based on a combination of phour and time initial hour + Model%solhr = mod(Model%phour+Model%idate(1),con_24) + + if ((Model%debug) .and. (Model%me == Model%master)) then + print *,' sec ', Model%sec + print *,' kdt ', Model%kdt + print *,' nsswr ', Model%nsswr + print *,' nslwr ', Model%nslwr + print *,' nscyc ', Model%nscyc + print *,' lsswr ', Model%lsswr + print *,' lslwr ', Model%lslwr + print *,' fhour ', Model%fhour + print *,' phour ', Model%phour + print *,' solhr ', Model%solhr endif end subroutine GFS_time_vary_pre_run