Move some code to modules

physics/GFS_MP_generic_post.F90

@@ -30,7 +30,7 @@ subroutine GFS_MP_generic_post_run(
         index_of_process_dfi_radar, ix_dfi_radar, dfi_radar_tten, radar_tten_limits, fhour, errmsg, errflg)
 !
       use machine, only: kind_phys
-
+      use calpreciptype_mod, only: calpreciptype
       implicit none
 
       integer, intent(in) :: im, levs, kdt, nrcm, nncl, ntcw, ntrac, num_dfi_radar, index_of_process_dfi_radar

physics/calpreciptype.f90

@@ -1,6 +1,8 @@
 !>\file calpreciptype.f90
 !! This file contains the subroutines that calculates dominant precipitation type.
 
+module calpreciptype_mod
+contains
 !>\ingroup gfs_calpreciptype
 !! Foure algorithms are called to calculate dominant precipitation type, and the 
 !!tallies are sumed in calwxt_dominant().
@@ -510,13 +512,6 @@ subroutine calwxt_ramer(lm,lp1,t,q,pmid,rh,td,pint,ptyp)
               rhavg,dtavg,dpk,ptw,pbot
 !     real(kind=kind_phys) b,qtmp,rate,qc
 !
-      interface
-         function xmytw(t,td,p)
-           use machine , only : kind_phys
-           implicit none
-           real(kind=kind_phys)   t, td, p, xmytw
-         end function xmytw
-      end interface
 !
 !  initialize.
       icefrac = -9999.
@@ -1391,3 +1386,4 @@ subroutine calwxt_dominant(nalg,rain,freezr,sleet,snow, &
       return
       end
 !! @}
+end module calpreciptype_mod

physics/cires_orowam2017.f

@@ -1,3 +1,5 @@
+      module cires_orowam2017
+      contains
       subroutine oro_wam_2017(im, levs,npt,ipt, kref,kdt,me,master,
      &   dtp,dxres, taub, u1, v1, t1, xn, yn, bn2, rho, prsi, prsL, 
      &   del, sigma, hprime, gamma, theta,
@@ -384,3 +386,4 @@ subroutine ugwpv0_tofd1d(levs, sigflt, elvmax, zsurf,
       enddo
 !                
       end subroutine ugwpv0_tofd1d
+      end module cires_orowam2017

physics/cires_ugwp.F90

@@ -16,9 +16,14 @@ module cires_ugwp
     use machine, only: kind_phys
 
     use cires_ugwpv0_module, only: knob_ugwp_version, cires_ugwpv0_mod_init, cires_ugwpv0_mod_finalize
+    use ugwp_driver_v0
 
     use gwdps, only: gwdps_run
 
+    use cires_ugwp_triggers
+
+    use ugwp_driver_v0
+
     implicit none
 
     private

physics/cires_ugwp_triggers.F90

@@ -1,3 +1,5 @@
+      module cires_ugwp_triggers
+      contains
 !
       subroutine slat_geos5_tamp_v0(im, tau_amp, xlatdeg, tau_gw)
 !=================
@@ -97,3 +99,4 @@ subroutine init_nazdir_v0(naz,  xaz,  yaz)
           yaz(4) =-1.0     !S
       endif      
       end  subroutine init_nazdir_v0
+      end module cires_ugwp_triggers

physics/cires_ugwpv1_oro.F90

@@ -1,5 +1,5 @@
 module cires_ugwpv1_oro
-
+   use cires_ugwpv1_sporo
 contains
 
    subroutine orogw_v1 (im, km,  imx,   me,  master, dtp, kdt, do_tofd,   &

physics/cires_ugwpv1_sporo.F90

@@ -1,4 +1,5 @@
-
+      module cires_ugwpv1_sporo
+      contains
       subroutine oro_spectral_solver(im, levs,npt,ipt, kref,kdt,me,master, &
         dtp,dxres, taub, u1, v1, t1, xn, yn, bn2, rho, prsi, prsL,         &
         del, sigma, hprime, gamma, theta,                                  &
@@ -349,3 +350,4 @@ subroutine oro_meanflow(nz, nzi, u1, v1, t1, pint, pmid,       &
 
       end subroutine oro_meanflow
 
+      end module cires_ugwpv1_sporo

physics/hedmf.f

@@ -5,7 +5,8 @@
 !> This module contains the CCPP-compliant hybrid eddy-diffusivity mass-flux
 !! scheme.
       module hedmf
-
+      use tridi_mod
+      use mfpbl_mod
       contains
 
 !> \section arg_table_hedmf_init Argument Table

physics/lsm_noah.f

@@ -7,6 +7,7 @@ module lsm_noah
       use machine,          only: kind_phys
       use set_soilveg_mod,  only: set_soilveg
       use namelist_soilveg
+      use sflx
 
       implicit none
 

physics/mfpbl.f

@@ -1,6 +1,7 @@
 !>  \file mfpbl.f
 !!  This file contains the subroutine that calculates the updraft properties and mass flux for use in the Hybrid EDMF PBL scheme.
-
+      module mfpbl_mod
+      contains
 !>  \ingroup HEDMF
 !!  \brief This subroutine is used for calculating the mass flux and updraft properties.
 !!
@@ -396,3 +397,4 @@ subroutine mfpbl(im,ix,km,ntrac,delt,cnvflg,                      &
       return
       end
 !> @}
+      end module mfpbl_mod

physics/mfpblt.f

@@ -2,7 +2,8 @@
 !! This file contains the subroutine that calculates mass flux and
 !! updraft parcel properties for thermals driven by surface heating 
 !! for use in the TKE-EDMF PBL scheme.
-
+      module mfpblt_mod
+      contains
 !>\ingroup satmedmf
 !! This subroutine computes mass flux and updraft parcel properties for
 !! thermals driven by surface heating. 
@@ -452,3 +453,4 @@ subroutine mfpblt(im,ix,km,kmpbl,ntcw,ntrac1,delt,                &
       return
       end
 !> @}
+      end module mfpblt_mod

physics/mfpbltq.f

@@ -2,7 +2,8 @@
 !! This file contains the subroutine that calculates mass flux and
 !! updraft parcel properties for thermals driven by surface heating 
 !! for use in the TKE-EDMF PBL scheme (updated version).
-
+      module mfpbltq_mod
+      contains
 !>\ingroup satmedmfvdifq
 !! This subroutine computes mass flux and updraft parcel properties for
 !! thermals driven by surface heating. 
@@ -477,3 +478,4 @@ subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt,
       return
       end
 !> @}
+      end module mfpbltq_mod

physics/mfscu.f

@@ -1,7 +1,8 @@
 !>\file mfscu.f
 !! This file contains the mass flux and downdraft parcel preperties
 !! parameterization for stratocumulus-top-driven turbulence.
-
+      module mfscu_mod
+      contains
 !>\ingroup satmedmf
 !! This subroutine computes mass flux and downdraft parcel properties
 !! for stratocumulus-top-driven turbulence.
@@ -554,3 +555,4 @@ subroutine mfscu(im,ix,km,kmscu,ntcw,ntrac1,delt,                 &
       return
       end
 !> @}
+      end module mfscu_mod

physics/mfscuq.f

@@ -1,7 +1,8 @@
 !>\file mfscuq.f
 !! This file contains the mass flux and downdraft parcel preperties
 !! parameterization for stratocumulus-top-driven turbulence (updated version).
-
+      module mfscuq_mod
+      contains
 !>\ingroup satmedmfvdifq
 !! This subroutine computes mass flux and downdraft parcel properties
 !! for stratocumulus-top-driven turbulence.
@@ -557,3 +558,4 @@ subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt,
       return
       end
 !> @}
+      end module mfscuq_mod

physics/module_bl_mynn.F90

@@ -1384,8 +1384,11 @@ SUBROUTINE boulac_length0(k,kts,kte,zw,dz,qtke,theta,lb1,lb2)
      dld = min(dld,zw(k+1))!not used in PBL anyway, only free atmos
      lb1 = min(dlu,dld)     !minimum
      !JOE-fight floating point errors
+#ifdef SINGLE_PREC
+     !JM: keep up the fight, JOE
      dlu=MAX(0.1,MIN(dlu,1000.))
      dld=MAX(0.1,MIN(dld,1000.))
+#endif
      lb2 = sqrt(dlu*dld)    !average - biased towards smallest
      !lb2 = 0.5*(dlu+dld)   !average
 

physics/moninshoc.f

@@ -4,6 +4,9 @@
 !> This module contains the CCPP-compliant SHOC scheme.
       module moninshoc
 
+      use mfpbl_mod
+      use tridi_mod
+
       contains
 
       subroutine moninshoc_init (do_shoc, errmsg, errflg)

physics/satmedmfvdif.F

@@ -5,6 +5,10 @@
 
       module satmedmfvdif
 
+      use tridi_mod
+      use mfscu_mod
+      use mfpblt_mod
+
       contains
 
 !> \section arg_table_satmedmfvdif_init Argument Table

physics/satmedmfvdifq.F

@@ -4,7 +4,9 @@
 !! eddy-diffusion mass-flux (TKE-EDMF) parameterization (by Jongil Han).
 
       module satmedmfvdifq
-
+      use mfpbltq_mod
+      use tridi_mod
+      use mfscuq_mod
       contains
 
 !> \defgroup satmedmfvdifq GFS Scale-aware TKE-based Moist Eddy-Diffusivity Mass-flux (TKE-EDMF, updated version) Scheme Module

physics/sflx.f

@@ -1,6 +1,7 @@
 !>\file sflx.f
 !! This file is the entity of GFS Noah LSM Model(Version 2.7).
-
+      module sflx
+      contains
 !>\ingroup Noah_LSM
 !!\brief This is the entity of GFS Noah LSM model of physics subroutines.
 !! It is a soil/veg/snowpack land-surface model to update soil moisture, soil
@@ -906,7 +907,15 @@ subroutine gfssflx                                                &!  ---  input
         eta = etp
       endif
 
+#ifdef SINGLE_PREC
+      IF (ETP == 0.0) THEN
+        BETA = 0.0
+      ELSE
+        BETA = ETA/ETP
+      ENDIF
+#else
       beta = eta / etp
+#endif
 
 !>  - Convert the sign of soil heat flux so that:
 !!   -  ssoil>0: warm the surface  (night time)
@@ -5801,3 +5810,4 @@ end subroutine wdfcnd
       end subroutine gfssflx
 !! @}
 !-----------------------------------
+      end module sflx

physics/tridi.f

@@ -1,6 +1,7 @@
 !>\file tridi.f
 !! These subroutines are originally internal subroutines in moninedmf.f
-
+      module tridi_mod
+      contains
 !>\ingroup HEDMF
 !!\brief Routine to solve the tridiagonal system to calculate
 !!temperature and moisture at \f$ t + \Delta t \f$; part of two-part
@@ -220,3 +221,4 @@ subroutine tridit(l,n,nt,cl,cm,cu,rt,au,at)
       return
       end subroutine tridit
 !> @}
+      end module tridi_mod

physics/ugwp_driver_v0.F

@@ -1,5 +1,7 @@
 !>\file ugwp_driver_v0.F
-
+      module ugwp_driver_v0
+      use cires_orowam2017
+      contains
 !
 !=====================================================================
 !
@@ -1485,3 +1487,4 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime,
        end subroutine fv3_ugwp_solv2_v0
 
       
+      end module ugwp_driver_v0

physics/unified_ugwp.F90

@@ -37,7 +37,8 @@ module unified_ugwp
 !    use cires_ugwp_module,   only: knob_ugwp_version, cires_ugwp_mod_init,   cires_ugwp_mod_finalize
     use cires_ugwpv0_module, only: knob_ugwp_version, cires_ugwpv0_mod_init, cires_ugwpv0_mod_finalize
     use gwdps, only: gwdps_run
-
+    use cires_ugwp_triggers
+    use ugwp_driver_v0
     use drag_suite, only: drag_suite_run
 
     implicit none