Needed to add MPI commands to open diagnostic output file.

grantfirl · Jan 7, 2020 · 203cd4a · 203cd4a
1 parent b679203
commit 203cd4a
Show file tree

Hide file tree

Showing 6 changed files with 154 additions and 19 deletions.
diff --git a/physics/radlw_main.f b/physics/radlw_main.f
@@ -255,6 +255,9 @@ module rrtmg_lw
       use module_radlw_avplank, only : totplnk
       use module_radlw_ref,     only : preflog, tref, chi_mls
 !
+#ifdef MPI
+      use mpi
+#endif
       implicit none
 !
       private
@@ -352,10 +355,19 @@ module rrtmg_lw
 ! ================
       contains
 ! ================
+!! \section arg_table_rrtmg_lw_init
+!! \htmlinclude rrtmg_lw.html
+!!
+        subroutine rrtmg_lw_init (mpicomm, mpirank, mpiroot)
+          ! Inputs
+          integer, intent(in) :: mpicomm,mpirank,mpiroot
+
+          if (mpirank .eq. mpiroot) then
+             print*,'DJS+ Opening file containing RRTMG LW cloud fields'
+             open(47,file='rrtmg_clds.txt',status='unknown')
+          endif
 
-      subroutine rrtmg_lw_init ()
-      open(47,file='rrtmg_clds.txt',status='unknown')
-      end subroutine rrtmg_lw_init
+        end subroutine rrtmg_lw_init
 
 !> \defgroup module_radlw_main GFS RRTMG Longwave Module 
 !! \brief This module includes NCEP's modifications of the RRTMG-LW radiation
@@ -381,7 +393,7 @@ end subroutine rrtmg_lw_init
 !!  This model is provided as is without any express or implied warranties.
 !!  (http://www.rtweb.aer.com/)
 !! \section arg_table_rrtmg_lw_run Argument Table
-!! \htmlinclude rrtmg_lw_run.html
+!! \htmlinclude rrtmg_lw.html
 !!
 !> \section gen_lwrad RRTMG Longwave Radiation Scheme General Algorithm
 !> @{
@@ -1257,9 +1269,20 @@ subroutine rrtmg_lw_run                                           &
       end subroutine rrtmg_lw_run
 !-----------------------------------
 !> @}
-      subroutine rrtmg_lw_finalize ()
-      close(47)
-      end subroutine rrtmg_lw_finalize 
+!! \section arg_table_rrtmg_lw_finalize Argument Table
+!! \htmlinclude rrtmg_lw.html
+!!
+      subroutine rrtmg_lw_finalize (mpicomm, mpirank, mpiroot)
+        ! Inputs
+        integer, intent(in) :: mpicomm,mpirank,mpiroot
+        ! Local variables
+        integer :: ierr
+        
+#ifdef MPI
+        call MPI_BARRIER(mpicomm, ierr)
+#endif
+        close(47)
+      end subroutine rrtmg_lw_finalize
 
 
 

diff --git a/physics/radlw_main.meta b/physics/radlw_main.meta
@@ -1,3 +1,32 @@
+[ccpp-arg-table]
+  name = rrtmg_lw_init
+  type = scheme
+[mpirank]
+  standard_name = mpi_rank
+  long_name = current MPI rank
+  units = index
+  dimensions = ()
+  type = integer
+  intent = in
+  optional = F
+[mpiroot]
+  standard_name = mpi_root
+  long_name = master MPI rank
+  units = index
+  dimensions = ()
+  type = integer
+  intent = in
+  optional = F
+[mpicomm]
+  standard_name = mpi_comm
+  long_name = MPI communicator
+  units = index
+  dimensions = ()
+  type = integer
+  intent = in
+  optional = F
+
+########################################################################
 [ccpp-arg-table]
   name = rrtmg_lw_run
   type = scheme
@@ -406,3 +435,32 @@
   type = integer
   intent = out
   optional = F
+
+########################################################################
+[ccpp-arg-table]
+  name = rrtmg_lw_finalize
+  type = scheme
+[mpirank]
+  standard_name = mpi_rank
+  long_name = current MPI rank
+  units = index
+  dimensions = ()
+  type = integer
+  intent = in
+  optional = F
+[mpiroot]
+  standard_name = mpi_root
+  long_name = master MPI rank
+  units = index
+  dimensions = ()
+  type = integer
+  intent = in
+  optional = F
+[mpicomm]
+  standard_name = mpi_comm
+  long_name = MPI communicator
+  units = index
+  dimensions = ()
+  type = integer
+  intent = in
+  optional = F
diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90
@@ -7,6 +7,9 @@ module rrtmgp_lw_cloud_optics
   use mo_rrtmg_lw_cloud_optics, only: rrtmg_lw_cloud_optics   
   use rrtmgp_aux,               only: check_error_msg
   use netcdf
+#ifdef MPI
+    use mpi
+#endif
 
   public rrtmgp_lw_cloud_optics_init, rrtmgp_lw_cloud_optics_run, rrtmgp_lw_cloud_optics_finalize
 contains
@@ -19,9 +22,6 @@ module rrtmgp_lw_cloud_optics
 !!
   subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_dir,       &
        rrtmgp_lw_file_clouds, mpicomm, mpirank, mpiroot, lw_cloud_props, errmsg, errflg)
-#ifdef MPI
-    use mpi
-#endif
 
     ! Inputs
     integer, intent(in) :: &
@@ -99,7 +99,10 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d
     errmsg = ''
     errflg = 0
 
-    open(47,file='rrtmgp_clds.txt',status='unknown')
+    if (mpirank .eq. mpiroot) then
+       print*,'DJS+ Opening file containing RRTMGP LW cloud fields'
+       open(47,file='rrtmgp_clds.txt',status='unknown')
+    endif
 
     if (cld_optics_scheme .eq. 0) return
 
@@ -443,8 +446,8 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nr
           call rrtmg_lw_cloud_optics(ncol, nLev, lw_gas_props%get_nband(), cld_lwp,     &
                cld_reliq, cld_iwp, cld_reice, cld_rwp, cld_rerain, cld_swp, cld_resnow, &
                cld_frac, tau_cld)
-          lw_optical_props_cloudsByBand%tau = tau_cld
        endif
+       lw_optical_props_cloudsByBand%tau = tau_cld
     endif
 
     write(47,*) "In rrtmgp_lw_cloud_optics: "
@@ -465,7 +468,22 @@ end subroutine rrtmgp_lw_cloud_optics_run
   ! #########################################################################################
   ! SUBROUTINE rrtmgp_lw_cloud_optics_finalize()
   ! #########################################################################################
-  subroutine rrtmgp_lw_cloud_optics_finalize()
+!! \section arg_table_rrtmgp_lw_cloud_optics_finalize
+!! \htmlinclude rrtmgp_lw_cloud_optics.html
+!!
+  subroutine rrtmgp_lw_cloud_optics_finalize(mpicomm, mpirank, mpiroot)
+    ! Inputs
+    integer, intent(in) :: &
+         mpicomm,            & ! MPI communicator
+         mpirank,            & ! Current MPI rank
+         mpiroot               ! Master MPI rank
+    ! Local variables
+    integer :: ierr
+
+#ifdef MPI
+    call MPI_BARRIER(mpicomm, ierr)
+#endif
     close(47)
+
   end subroutine rrtmgp_lw_cloud_optics_finalize
 end module rrtmgp_lw_cloud_optics
diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta
@@ -278,3 +278,32 @@
   type = integer
   intent = out
   optional = F
+
+########################################################################
+[ccpp-arg-table]
+  name = rrtmgp_lw_cloud_optics_finalize
+  type = scheme
+[mpirank]
+  standard_name = mpi_rank
+  long_name = current MPI rank
+  units = index
+  dimensions = ()
+  type = integer
+  intent = in
+  optional = F
+[mpiroot]
+  standard_name = mpi_root
+  long_name = master MPI rank
+  units = index
+  dimensions = ()
+  type = integer
+  intent = in
+  optional = F
+[mpicomm]
+  standard_name = mpi_comm
+  long_name = MPI communicator
+  units = index
+  dimensions = ()
+  type = integer
+  intent = in
+  optional = F
diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90
@@ -115,6 +115,8 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp
     errmsg = ''
     errflg = 0
 
+    write(*,"(a12,3i10)") 'MPI ranks: ',mpirank,mpiroot,mpicomm
+
     ! Filenames are set in the physics_nml
     lw_gas_props_file  = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_gas)
 

diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90
@@ -118,6 +118,12 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t
     errmsg = ''
     errflg  = 0
 
+    ! Initialize output fluxes
+    fluxswUP_allsky(:,:)   = 0._kind_phys
+    fluxswDOWN_allsky(:,:) = 0._kind_phys
+    fluxswUP_clrsky(:,:)   = 0._kind_phys
+    fluxswDOWN_clrsky(:,:) = 0._kind_phys
+
     if (.not. doSWrad) return
     if (nDay .gt. 0) then
 
@@ -138,12 +144,6 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t
        if ( l_scmpsw ) then
           scmpsw = cmpfsw_type (0., 0., 0., 0., 0., 0.)
        endif
-
-       ! Initialize fluxes
-       fluxswUP_allsky(:,:)   = 0._kind_phys
-       fluxswDOWN_allsky(:,:) = 0._kind_phys
-       fluxswUP_clrsky(:,:)   = 0._kind_phys
-       fluxswDOWN_clrsky(:,:) = 0._kind_phys
 
        ! Subset the gas concentrations, only need daylit points.
        do iGas=1,rrtmgp_nGases
@@ -154,6 +154,11 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t
        enddo
 
        ! Initialize RRTMGP DDT containing 2D(3D) fluxes
+       fluxSW_up_allsky(:,:,:)     = 0._kind_phys
+       fluxSW_dn_allsky(:,:,:)     = 0._kind_phys
+       fluxSW_dn_dir_allsky(:,:,:) = 0._kind_phys
+       fluxSW_up_clrsky(:,:,:)     = 0._kind_phys
+       fluxSW_dn_clrsky(:,:,:)     = 0._kind_phys
        flux_allsky%bnd_flux_up     => fluxSW_up_allsky
        flux_allsky%bnd_flux_dn     => fluxSW_dn_allsky
        flux_allsky%bnd_flux_dn_dir => fluxSW_dn_dir_allsky