Merge pull request #1073 from grantfirl/ufs-dev-PR184

UFS-dev PR#184

Author: grantfirl

CMakeLists.txt

@@ -1,4 +1,4 @@
-cmake_minimum_required(VERSION 3.3)
+cmake_minimum_required(VERSION 3.10)
 
 project(ccpp_physics
         VERSION 5.0.0
@@ -8,6 +8,13 @@ project(ccpp_physics
 set(PACKAGE "ccpp-physics")
 set(AUTHORS "Grant Firl" "Dustin Swales" "Man Zhang" "Mike Kavulich" )
 
+#------------------------------------------------------------------------------
+# Set MPI flags for Fortran with MPI F08 interface
+find_package(MPI REQUIRED Fortran)
+if(NOT MPI_Fortran_HAVE_F08_MODULE)
+  message(FATAL_ERROR "MPI implementation does not support the Fortran 2008 mpi_f08 interface")
+endif()
+
 #------------------------------------------------------------------------------
 # Set OpenMP flags for C/C++/Fortran
 if (OPENMP)

physics/GWD/cires_tauamf_data.F90

@@ -180,7 +180,6 @@ subroutine gfs_idate_calendar(idate, fhour, ddd, fddd)
       integer              :: jdow, jdoy, jday
       real(8)              :: rinc(5)
       real(4)              :: rinc4(5)
-      integer              :: w3kindreal, w3kindint
 
       integer ::  iw3jdn
       integer :: jd1, jddd
@@ -196,13 +195,7 @@ subroutine gfs_idate_calendar(idate, fhour, ddd, fddd)
       rinc(1:5)    = 0.
       rinc(2) = fhour
 !    
-      call w3kind(w3kindreal,w3kindint)
-      if(w3kindreal==4) then
-        rinc4 = rinc
-        call w3movdat(rinc4, idat,jdat)
-      else
-        call w3movdat(rinc,  idat,jdat)
-      endif           
+      call w3movdat(rinc,  idat,jdat)
 !     jdate(8)- date and time (yr, mo, day, [tz], hr, min, sec)
       jdow = 0
       jdoy = 0

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90

@@ -385,7 +385,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling,
                                        nthreads, blkno, errmsg, errflg)
 
 #ifdef MPI
-         use mpi
+         use mpi_f08
 #endif
 #ifdef _OPENMP
          use omp_lib
@@ -1055,7 +1055,7 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup
                                            nthreads, blkno, errmsg, errflg)
 
 #ifdef MPI
-         use mpi
+         use mpi_f08
 #endif
 #ifdef _OPENMP
          use omp_lib

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90

@@ -793,7 +793,6 @@ subroutine GFS_phys_time_vary_timestep_init (
          real(kind_phys) :: rannie(cny)
          real(kind_phys) :: rndval(cnx*cny*nrcm)
          real(kind_dbl_prec)  :: rinc(5)
-         real(kind_sngl_prec) :: rinc4(5)
 
          ! Initialize CCPP error handling variables
          errmsg = ''
@@ -813,7 +812,7 @@ subroutine GFS_phys_time_vary_timestep_init (
 !$OMP          shared(ozpl,ddy_o3,h2o_phys,jindx1_h,jindx2_h,h2opl,ddy_h,iaerclm,master) &
 !$OMP          shared(levs,prsl,iccn,jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci)     &
 !$OMP          shared(ddx_ci,in_nm,ccn_nm,do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau)    &
-!$OMP          shared(ddy_j2tau,tau_amf,iflip,ozphys,rjday,n1,n2,idat,jdat,rinc,rinc4)   &
+!$OMP          shared(ddy_j2tau,tau_amf,iflip,ozphys,rjday,n1,n2,idat,jdat,rinc)         &
 !$OMP          shared(w3kindreal,w3kindint,jdow,jdoy,jday)                               &
 !$OMP          private(iseed,iskip,i,j,k)
 
@@ -873,13 +872,7 @@ subroutine GFS_phys_time_vary_timestep_init (
          idat(5)=idate(1)
          rinc=0.
          rinc(2)=fhour
-         call w3kind(w3kindreal,w3kindint)
-         if(w3kindreal==4) then
-            rinc4=rinc
-            CALL w3movdat(rinc4,idat,jdat)
-         else
-            CALL w3movdat(rinc,idat,jdat)
-         endif
+         CALL w3movdat(rinc,idat,jdat)
          jdow = 0
          jdoy = 0
          jday = 0

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90

@@ -19,7 +19,7 @@ module GFS_rrtmg_pre
 !>\section rrtmg_pre_gen General Algorithm
       subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
         ltp, imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_c3, me, ncnd, ntrac,        &
-        num_p3d, npdf3d,                                                       &
+        num_p3d, npdf3d, xr_cnvcld,                                            &
         ncnvcld3d,ntqv, ntcw,ntiw, ntlnc, ntinc, ntrnc, ntsnc, ntccn, top_at_1,&
         ntrw, ntsw, ntgl, nthl, ntwa, ntoz, ntsmoke, ntdust, ntcoarsepm,       &
         ntclamt, nleffr, nieffr, nseffr, lndp_type, kdt,                       &
@@ -129,7 +129,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
                                           uni_cld, effr_in, do_mynnedmf,       &
                                           lmfshal, lmfdeep2, pert_clds, lcrick,&
                                           lcnorm, top_at_1, lextop, mraerosol
-      logical,              intent(in) :: rrfs_sd, aero_dir_fdb
+      logical,              intent(in) :: rrfs_sd, aero_dir_fdb, xr_cnvcld
 
       logical,              intent(in) :: nssl_ccn_on, nssl_invertccn
       integer,              intent(in) :: spp_rad
@@ -981,7 +981,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
      &       iovr_dcorr, iovr_exp, iovr_exprand, idcor, idcor_con,      &
      &       idcor_hogan, idcor_oreopoulos, lcrick, lcnorm,             &
      &       imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_c3, do_mynnedmf,     &
-     &       lgfdlmprad,                                                &
+     &       lgfdlmprad, xr_cnvcld,                                     &
      &       uni_cld, lmfshal, lmfdeep2, cldcov, clouds1,               &
      &       effrl, effri, effrr, effrs, effr_in,                       &
      &       effrl_inout, effri_inout, effrs_inout,                     &

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta

@@ -56,6 +56,13 @@
   dimensions = ()
   type = logical
   intent = in
+[xr_cnvcld]
+  standard_name = flag_for_suspended_convective_clouds_in_Xu_Randall
+  long_name = flag for using suspended convective clouds in Xu Randall
+  units = flag
+  dimensions = ()
+  type = logical
+  intent = in
 [ltp]
   standard_name = extra_top_layer
   long_name = extra top layer for radiation

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90

@@ -94,10 +94,8 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr,
 
         real(kind=kind_phys), parameter :: con_24  =   24.0_kind_phys
         real(kind=kind_phys), parameter :: con_hr  = 3600.0_kind_phys
-        real(kind=kind_sngl_prec) :: rinc4(5)
         real(kind=kind_dbl_prec)  :: rinc8(5)
 
-        integer :: w3kindreal,w3kindint
         integer ::  iw3jdn
         integer :: jd0, jd1
         real    :: fjd
@@ -115,19 +113,9 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr,
 
         !--- jdat is being updated directly inside of FV3GFS_cap.F90
         !--- update calendars and triggers
-        call w3kind(w3kindreal,w3kindint)
-        if (w3kindreal == 8) then
-           rinc8(1:5) = 0
-           call w3difdat(jdat,idat,4,rinc8)
-           sec = rinc8(4)
-        else if (w3kindreal == 4) then
-           rinc4(1:5) = 0
-           call w3difdat(jdat,idat,4,rinc4)
-           sec = rinc4(4)
-        else
-           write(0,*)' FATAL ERROR: Invalid w3kindreal'
-           call abort
-        endif
+        rinc8(1:5) = 0
+        call w3difdat(jdat,idat,4,rinc8)
+        sec = rinc8(4)
         phour = sec/con_hr
         !--- set current bucket hour
         zhour = phour

physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90

@@ -91,10 +91,8 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, &
 
         real(kind=kind_phys), parameter :: con_24  =   24.0_kind_phys
         real(kind=kind_phys), parameter :: con_hr  = 3600.0_kind_phys
-        real(kind=kind_sngl_prec) :: rinc4(5)
         real(kind=kind_dbl_prec)  :: rinc8(5)
 
-        integer :: w3kindreal,w3kindint
         integer ::  iw3jdn      
         integer :: jd0, jd1
         real    :: fjd
@@ -114,19 +112,9 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, &
         !--- jdat is being updated directly inside of the time integration
         !--- loop of scm.F90
         !--- update calendars and triggers
-        call w3kind(w3kindreal,w3kindint)
-        if (w3kindreal == 8) then
-           rinc8(1:5) = 0
-           call w3difdat(jdat,idat,4,rinc8)
-           sec = rinc8(4)
-        else if (w3kindreal == 4) then
-           rinc4(1:5) = 0
-           call w3difdat(jdat,idat,4,rinc4)
-           sec = rinc4(4)
-        else
-           write(0,*)' FATAL ERROR: Invalid w3kindreal'
-           call abort
-        endif
+        rinc8(1:5) = 0
+        call w3difdat(jdat,idat,4,rinc8)
+        sec = rinc8(4)
         phour = sec/con_hr
         !--- set current bucket hour
         zhour = phour

physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90

@@ -23,6 +23,7 @@ SUBROUTINE read_cidata (me, master)
       integer, intent(in) :: me
       integer, intent(in) :: master
 !--- locals
+      integer :: ncerr
       integer :: i, n, k, ncid, varid,j,it
       real(kind=kind_phys), allocatable, dimension(:) :: hyam,hybm
       real(kind=4), allocatable, dimension(:,:,:) :: ci_ps
@@ -31,29 +32,29 @@ SUBROUTINE read_cidata (me, master)
       allocate (ciplin(lonscip,latscip,kcipl,timeci))
       allocate (ccnin(lonscip,latscip,kcipl,timeci))
       allocate (ci_pres(lonscip,latscip,kcipl,timeci))
-      call nf_open("cam5_4_143_NAAI_monclimo2.nc", NF90_NOWRITE, ncid)
-      call nf_inq_varid(ncid, "lat", varid)
-      call nf_get_var(ncid, varid, ci_lat)
-      call nf_inq_varid(ncid, "lon", varid)
-      call nf_get_var(ncid, varid, ci_lon)
-      call nf_inq_varid(ncid, "PS", varid)
-      call nf_get_var(ncid, varid, ci_ps)
-      call nf_inq_varid(ncid, "hyam", varid)
-      call nf_get_var(ncid, varid, hyam)
-      call nf_inq_varid(ncid, "hybm", varid)
-      call nf_get_var(ncid, varid, hybm)
-      call nf_inq_varid(ncid, "NAAI", varid)
-      call nf_get_var(ncid, varid, ciplin)
+      ncerr = nf90_open("cam5_4_143_NAAI_monclimo2.nc", NF90_NOWRITE, ncid)
+      ncerr = nf90_inq_varid(ncid, "lat", varid)
+      ncerr = nf90_get_var(ncid, varid, ci_lat)
+      ncerr = nf90_inq_varid(ncid, "lon", varid)
+      ncerr = nf90_get_var(ncid, varid, ci_lon)
+      ncerr = nf90_inq_varid(ncid, "PS", varid)
+      ncerr = nf90_get_var(ncid, varid, ci_ps)
+      ncerr = nf90_inq_varid(ncid, "hyam", varid)
+      ncerr = nf90_get_var(ncid, varid, hyam)
+      ncerr = nf90_inq_varid(ncid, "hybm", varid)
+      ncerr = nf90_get_var(ncid, varid, hybm)
+      ncerr = nf90_inq_varid(ncid, "NAAI", varid)
+      ncerr = nf90_get_var(ncid, varid, ciplin)
       do it = 1,timeci
         do k=1, kcipl
           ci_pres(:,:,k,it)=hyam(k)*1.e5+hybm(k)*ci_ps(:,:,it)
         end do
       end do
-      call nf_close(ncid)
-      call nf_open("cam5_4_143_NPCCN_monclimo2.nc", NF90_NOWRITE, ncid)
-      call nf_inq_varid(ncid, "NPCCN", varid)
-      call nf_get_var(ncid, varid, ccnin)
-      call nf_close(ncid)
+      ncerr = nf90_close(ncid)
+      ncerr = nf90_open("cam5_4_143_NPCCN_monclimo2.nc", NF90_NOWRITE, ncid)
+      ncerr = nf90_inq_varid(ncid, "NPCCN", varid)
+      ncerr = nf90_get_var(ncid, varid, ccnin)
+      ncerr = nf90_close(ncid)
 !---
       deallocate (hyam, hybm, ci_ps)
       if (me == master) then
@@ -128,7 +129,7 @@ END SUBROUTINE setindxci
       SUBROUTINE ciinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ddy, &
                  iindx1,iindx2,ddx,lev, prsl, ciplout,ccnout)
 !
-      USE MACHINE,  ONLY : kind_phys
+      USE MACHINE,  ONLY : kind_phys, kind_dbl_prec
       use iccn_def
       implicit none
       integer   i1,i2, iday,j,j1,j2,l,npts,nc,n1,n2,lev,k,i
@@ -144,10 +145,8 @@ SUBROUTINE ciinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ddy, &
       real(kind=kind_phys) ccnout(npts,lev),ccnpm(npts,kcipl)
       real(kind=kind_phys) cipres(npts,kcipl), prsl(npts,lev)
       real(kind=kind_phys) rjday
+      real(kind=kind_dbl_prec) rinc(5)
       integer jdow, jdoy, jday
-      real(8) RINC(5)
-      real(4) rinc4(5)
-      integer w3kindreal,w3kindint
 !
       IDAT=0
       IDAT(1)=IDATE(4)
@@ -156,13 +155,7 @@ SUBROUTINE ciinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ddy, &
       IDAT(5)=IDATE(1)
       RINC=0.
       RINC(2)=FHOUR
-      call w3kind(w3kindreal,w3kindint)
-      if(w3kindreal==4) then
-        rinc4=rinc
-        CALL W3MOVDAT(RINC4,IDAT,JDAT)
-      else
-        CALL W3MOVDAT(RINC,IDAT,JDAT)
-      endif
+      CALL W3MOVDAT(RINC,IDAT,JDAT)
 !
       jdow = 0
       jdoy = 0

physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90

@@ -15,6 +15,9 @@ module maximum_hourly_diagnostics
    real(kind=kind_phys), parameter ::PQ0=379.90516E0, A2A=17.2693882, A3=273.16, A4=35.86, RHmin=1.0E-6
    ! *DH
 
+   ! Conversion from flashes per five minutes to flashes per minute.
+   real(kind=kind_phys), parameter :: scaling_factor = 0.2
+
 contains
 
 #if 0
@@ -195,7 +198,10 @@ subroutine lightning_threat_indices
                       endif
 
                       IF ( ltg1 .LT. clim1 ) ltg1 = 0.
-                      
+
+                      ! Scale to flashes per minue
+                      ltg1 = ltg1 * scaling_factor
+
                       IF ( ltg1 .GT. ltg1_max(i) ) THEN
                          ltg1_max(i) = ltg1
                       ENDIF
@@ -208,14 +214,19 @@ subroutine lightning_threat_indices
              ltg2 = coef2 * totice_colint(i)
 
              IF ( ltg2 .LT. clim2 ) ltg2 = 0.
+
+             ! Scale to flashes per minute
+             ltg2 = ltg2 * scaling_factor
 
              IF ( ltg2 .GT. ltg2_max(i) ) THEN
                 ltg2_max(i) = ltg2
              ENDIF
 
+             ! This calculation is already in flashes per minute.
              ltg3_max(i) = 0.95 * ltg1_max(i) + 0.05 * ltg2_max(i)
 
-             IF ( ltg3_max(i) .LT. clim3 ) ltg3_max(i) = 0.
+             ! Thus, we must scale clim3. The compiler will optimize this away.
+             IF ( ltg3_max(i) .LT. clim3 * scaling_factor ) ltg3_max(i) = 0.
           enddo
 
        end subroutine lightning_threat_indices