Update consistency checks and effective radii calculation for Thompson MP

physics/GFS_rrtmg_pre.F90

@@ -195,9 +195,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp,        &
                           effrl, effri, effrr, effrs, rho, orho, plyrpa
 
       ! for Thompson MP
-      real(kind=kind_phys), dimension(im,lm+LTP) ::         &
-                                  re_cloud, re_ice, re_snow, qv_mp, qc_mp, &
-                                  qi_mp, qs_mp, nc_mp, ni_mp, nwfa
+      real(kind=kind_phys), dimension(im,lm+LTP) ::           &
+                                  qv_mp, qc_mp, qi_mp, qs_mp, &
+                                  nc_mp, ni_mp, nwfa
       real (kind=kind_phys), dimension(lm) :: cldfra1d, qv1d,           &
      &                                 qc1d, qi1d, qs1d, dz1d, p1d, t1d
 
@@ -816,30 +816,18 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp,        &
             !     it will raise the low limit from 5 to 10, but the high limit will remain 125.
             call calc_effectRad (tlyr(i,:), plyr(i,:)*100., qv_mp(i,:), qc_mp(i,:),   &
                                  nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), &
-                                 re_cloud(i,:), re_ice(i,:), re_snow(i,:), 1, lm )
+                                 effrl(i,:), effri(i,:), effrs(i,:), 1, lm )
+            ! Scale Thompson's effective radii from meter to micron
             do k=1,lm
-              re_cloud(i,k) = MAX(re_qc_min, MIN(re_cloud(i,k), re_qc_max))
-              re_ice(i,k)   = MAX(re_qi_min, MIN(re_ice(i,k),   re_qi_max))
-              re_snow(i,k)  = MAX(re_qs_min, MIN(re_snow(i,k),  re_qs_max))
-            end do
-          end do
-          ! Scale Thompson's effective radii from meter to micron
-          do k=1,lm
-            do i=1,im
-              re_cloud(i,k) = re_cloud(i,k)*1.e6
-              re_ice(i,k)   = re_ice(i,k)*1.e6
-              re_snow(i,k)  = re_snow(i,k)*1.e6
+              effrl(i,k) = MAX(re_qc_min, MIN(effrl(i,k), re_qc_max))*1.e6
+              effri(i,k) = MAX(re_qi_min, MIN(effri(i,k), re_qi_max))*1.e6
+              effrs(i,k) = MAX(re_qs_min, MIN(effrs(i,k), re_qs_max))*1.e6
             end do
+            effrl(i,lmk) = re_qc_min*1.e6
+            effri(i,lmk) = re_qi_min*1.e6
+            effrs(i,lmk) = re_qs_min*1.e6
           end do
-          do k=1,lm
-            k1 = k + kd
-            do i=1,im
-              effrl(i,k1) = re_cloud (i,k)
-              effri(i,k1) = re_ice (i,k)
-              effrr(i,k1) = 1000. ! rrain_def=1000.
-              effrs(i,k1) = re_snow(i,k)
-            enddo
-          enddo
+          effrr(:,:) = 1000. ! rrain_def=1000.
           ! Update global arrays
           do k=1,lm
             k1 = k + kd
@@ -971,8 +959,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp,        &
                          ntrac-1, ntcw-1,ntiw-1,ntrw-1,             &
                          ntsw-1,ntgl-1,                             &
                          im, lm, lmp, uni_cld, lmfshal, lmfdeep2,   &
-                         cldcov(:,1:LM), effrl_inout,               &
-                         effri_inout, effrs_inout,                  &
+                         cldcov(:,1:LM), effrl, effri, effrs,       &
                          lwp_ex, iwp_ex, lwp_fc, iwp_fc,            &
                          dzb, xlat_d, julian, yearlen, gridkm,      &
                          clouds, cldsa, mtopa ,mbota, de_lgth, alpha) !  --- outputs
@@ -1005,8 +992,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp,        &
                          ntrac-1, ntcw-1,ntiw-1,ntrw-1,             &
                          ntsw-1,ntgl-1,                             &
                          im, lm, lmp, uni_cld, lmfshal, lmfdeep2,   &
-                         cldcov(:,1:LM), effrl_inout,               &
-                         effri_inout, effrs_inout,                  &
+                         cldcov(:,1:LM), effrl, effri, effrs,       &
                          lwp_ex, iwp_ex, lwp_fc, iwp_fc,            &
                          dzb, xlat_d, julian, yearlen, gridkm,      &
                          clouds, cldsa, mtopa ,mbota, de_lgth, alpha) !  --- outputs
@@ -1017,8 +1003,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp,        &
                          ntrac-1, ntcw-1,ntiw-1,ntrw-1,             &
                          ntsw-1,ntgl-1,                             &
                          im, lmk, lmp, uni_cld, lmfshal, lmfdeep2,  &
-                         cldcov(:,1:LMK), cnvw, effrl_inout,        &
-                         effri_inout, effrs_inout,                  &
+                         cldcov(:,1:LMK), cnvw, effrl, effri, effrs,&
                          lwp_ex, iwp_ex, lwp_fc, iwp_fc,            &
                          dzb, xlat_d, julian, yearlen,              &
                          clouds, cldsa, mtopa ,mbota, de_lgth, alpha) !  --- outputs

physics/module_mp_thompson.F90

@@ -1252,16 +1252,6 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc,     &
       ndt = max(nint(dt_in/dt_inner),1)
       dt = dt_in/ndt
       if(dt_in .le. dt_inner) dt= dt_in
-      if(nsteps>1 .and. ndt>1) then
-         if (present(errmsg) .and. present(errflg)) then
-            write(errmsg, '(a)') 'Logic error in mp_gt_driver: inner loop cannot be used with subcycling'
-            errflg = 1
-            return
-         else
-            write(*,'(a)') 'Warning: inner loop cannot be used with subcycling, resetting ndt=1'
-            ndt = 1
-         endif
-      endif
 
       do it = 1, ndt
 

physics/mp_thompson.F90

@@ -377,6 +377,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd,        &
 
          ! Reduced time step if subcycling is used
          real(kind_phys) :: dtstep
+         integer         :: ndt
          ! Air density
          real(kind_phys) :: rho(1:ncol,1:nlev)              !< kg m-3
          ! Water vapor mixing ratio (instead of specific humidity)
@@ -456,11 +457,39 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd,        &
          errmsg = ''
          errflg = 0
 
-         ! Check initialization state
-         if (.not.is_initialized) then
-            write(errmsg, fmt='((a))') 'mp_thompson_run called before mp_thompson_init'
-            errflg = 1
-            return
+         if (first_time_step .and. istep==1 .and. blkno==1) then
+            ! Check initialization state
+            if (.not.is_initialized) then
+               write(errmsg, fmt='((a))') 'mp_thompson_run called before mp_thompson_init'
+               errflg = 1
+               return
+            end if
+            ! Check forr optional arguments of aerosol-aware microphysics
+            if (is_aerosol_aware .and. .not. (present(nc)     .and. &
+                                              present(nwfa)   .and. &
+                                              present(nifa)   .and. &
+                                              present(nwfa2d) .and. &
+                                              present(nifa2d)       )) then
+               write(errmsg,fmt='(*(a))') 'Logic error in mp_thompson_run:',  &
+                                          ' aerosol-aware microphysics require all of the', &
+                                          ' following optional arguments:', &
+                                          ' nc, nwfa, nifa, nwfa2d, nifa2d'
+               errflg = 1
+               return
+            end if
+            ! Consistency cheecks - subcycling and inner loop at the same time are not supported
+            if (nsteps>1 .and. dt_inner < dtp) then
+               write(errmsg,'(*(a))') "Logic error: Subcycling and inner loop cannot be used at the same time"
+               errflg = 1
+               return
+            else if (mpirank==mpiroot .and. nsteps>1) then
+               write(*,'(a,i0,a,a,f6.2,a)') 'Thompson MP is using ', nsteps, ' substep(s) per time step with an ', &
+                                            'effective time step of ', dtp/real(nsteps, kind=kind_phys), ' seconds'
+            else if (mpirank==mpiroot .and. dt_inner < dtp) then
+               ndt = max(nint(dtp/dt_inner),1)
+               write(*,'(a,i0,a,a,f6.2,a)') 'Thompson MP is using ', ndt, ' inner loops per time step with an ', &
+                                            'effective time step of ', dtp/real(ndt, kind=kind_phys), ' seconds'
+            end if
          end if
 
          ! Set reduced time step if subcycling is used
@@ -469,25 +498,6 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd,        &
          else
             dtstep = dtp
          end if
-         if (first_time_step .and. istep==1 .and. mpirank==mpiroot .and. blkno==1) then
-            write(*,'(a,i0,a,a,f8.2,a)') 'Thompson MP is using ', nsteps, ' substep(s) per time step', &
-                                         ' with an effective time step of ', dtstep, ' seconds'
-         end if
-
-         if (first_time_step .and. istep==1) then
-           if (is_aerosol_aware .and. .not. (present(nc)     .and. &
-                                             present(nwfa)   .and. &
-                                             present(nifa)   .and. &
-                                             present(nwfa2d) .and. &
-                                             present(nifa2d)       )) then
-              write(errmsg,fmt='(*(a))') 'Logic error in mp_thompson_run:',  &
-                                         ' aerosol-aware microphysics require all of the', &
-                                         ' following optional arguments:', &
-                                         ' nc, nwfa, nifa, nwfa2d, nifa2d'
-              errflg = 1
-              return
-           end if
-         end if
 
          !> - Convert specific humidity to water vapor mixing ratio.
          !> - Also, hydrometeor variables are mass or number mixing ratio