Try using string length provided in file for broadcsting strings.

SamuelTrahanNOAA · Dec 9, 2019 · 0a726fd · 0a726fd
1 parent a25d714
commit 0a726fd
Show file tree

Hide file tree

Showing 2 changed files with 17 additions and 10 deletions.
diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90
@@ -93,6 +93,7 @@ subroutine rrtmgp_lw_gas_optics_init(Model, mpicomm, mpirank, mpiroot, lw_gas_pr
 
     ! Dimensions (to be broadcast across all processors)
     integer :: &
+         str_len,                         & !
          ntemps,                          & !   
          npress,                          & !   
          ngpts_lw,                        & !
@@ -297,6 +298,9 @@ subroutine rrtmgp_lw_gas_optics_init(Model, mpicomm, mpirank, mpiroot, lw_gas_pr
           !
           status = nf90_inq_varid(ncid_lw,'plank_fraction',varID)
           status = nf90_get_var(ncid_lw,varID,planck_frac)
+          !
+          status = nf90_inq_varid(ncid_lw,'str_len',varID)
+          status = nf90_get_var(ncid_lw,varID,str_len)
 
           ! Logical fields are read in as integers and then converted to logicals.
           status = nf90_inq_varid(ncid_lw,'minor_scales_with_density_lower',varID)
@@ -370,11 +374,11 @@ subroutine rrtmgp_lw_gas_optics_init(Model, mpicomm, mpirank, mpiroot, lw_gas_pr
     call MPI_BCAST(planck_frac,            size(planck_frac),            MPI_REAL,   mpiroot, mpicomm, ierr)
 #endif
     ! Character arrays
-    call MPI_BCAST(gas_names,         size(gas_names),                   MPI_CHAR,   mpiroot, mpicomm, ierr)
-    call MPI_BCAST(gas_minor,         size(gas_minor),                   MPI_CHAR,   mpiroot, mpicomm, ierr)
-    call MPI_BCAST(identifier_minor,  size(identifier_minor),            MPI_CHAR,   mpiroot, mpicomm, ierr)
-    call MPI_BCAST(minor_gases_lower, size(minor_gases_lower),           MPI_CHAR,   mpiroot, mpicomm, ierr)
-    call MPI_BCAST(minor_gases_upper, size(minor_gases_upper),           MPI_CHAR,   mpiroot, mpicomm, ierr)
+    call MPI_BCAST(gas_names,         size(gas_names)*str_len,           MPI_CHAR,   mpiroot, mpicomm, ierr)
+    call MPI_BCAST(gas_minor,         size(gas_minor)*str_len,           MPI_CHAR,   mpiroot, mpicomm, ierr)
+    call MPI_BCAST(identifier_minor,  size(identifier_minor)*str_len,    MPI_CHAR,   mpiroot, mpicomm, ierr)
+    call MPI_BCAST(minor_gases_lower, size(minor_gases_lower)*str_len,   MPI_CHAR,   mpiroot, mpicomm, ierr)
+    call MPI_BCAST(minor_gases_upper, size(minor_gases_upper)*str_len,   MPI_CHAR,   mpiroot, mpicomm, ierr)
     ! Logical arrays
     call MPI_BCAST(minor_scales_with_density_lower, nminor_absorber_intervals_lower, MPI_LOGICAL,  mpiroot, mpicomm, ierr)
     call MPI_BCAST(scale_by_complement_lower,       nminor_absorber_intervals_lower, MPI_LOGICAL,  mpiroot, mpicomm, ierr)

diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90
@@ -89,6 +89,7 @@ subroutine rrtmgp_sw_gas_optics_init(Model,  mpicomm, mpirank, mpiroot, sw_gas_p
          scale_by_complement_upper_sw          !  
     ! Dimensions (to be broadcast across all processors)
     integer :: &
+         str_len,                         & !
          ntemps_sw,                          & !  
          npress_sw,                          & !  
          ngpts_sw,                           & ! 
@@ -150,6 +151,8 @@ subroutine rrtmgp_sw_gas_optics_init(Model,  mpicomm, mpirank, mpiroot, sw_gas_p
           status = nf90_inquire_dimension(ncid_sw, dimid, len=nminor_absorber_intervals_lower_sw)
           status = nf90_inq_dimid(ncid_sw, 'minor_absorber_intervals_upper', dimid)
           status = nf90_inquire_dimension(ncid_sw, dimid, len=nminor_absorber_intervals_upper_sw)
+          status = nf90_inq_varid(ncid_lw,'str_len',varID)
+          status = nf90_get_var(ncid_lw,varID,str_len)
           status = nf90_close(ncid_sw)
        endif
     endif
@@ -371,11 +374,11 @@ subroutine rrtmgp_sw_gas_optics_init(Model,  mpicomm, mpirank, mpiroot, sw_gas_p
     call MPI_BCAST(rayl_upper_sw,             size(rayl_upper_sw),             MPI_REAL,   mpiroot, mpicomm, ierr)
 #endif
     ! Character arrays 
-    call MPI_BCAST(gas_names_sw,              size(gas_names_sw),              MPI_CHAR,   mpiroot, mpicomm, ierr)
-    call MPI_BCAST(gas_minor_sw,              size(gas_minor_sw),              MPI_CHAR,   mpiroot, mpicomm, ierr)
-    call MPI_BCAST(identifier_minor_sw,       size(identifier_minor_sw),       MPI_CHAR,   mpiroot, mpicomm, ierr)
-    call MPI_BCAST(minor_gases_lower_sw,      size(minor_gases_lower_sw),      MPI_CHAR,   mpiroot, mpicomm, ierr)
-    call MPI_BCAST(minor_gases_upper_sw,      size(minor_gases_upper_sw),      MPI_CHAR,   mpiroot, mpicomm, ierr)
+    call MPI_BCAST(gas_names_sw,              size(gas_names_sw)*str_len,                  MPI_CHAR,   mpiroot, mpicomm, ierr)
+    call MPI_BCAST(gas_minor_sw,              size(gas_minor_sw)*str_len,                  MPI_CHAR,   mpiroot, mpicomm, ierr)
+    call MPI_BCAST(identifier_minor_sw,       size(identifier_minor_sw)*str_len,           MPI_CHAR,   mpiroot, mpicomm, ierr)
+    call MPI_BCAST(minor_gases_lower_sw,      size(minor_gases_lower_sw)*str_len,          MPI_CHAR,   mpiroot, mpicomm, ierr)
+    call MPI_BCAST(minor_gases_upper_sw,      size(minor_gases_upper_sw)*str_len,          MPI_CHAR,   mpiroot, mpicomm, ierr)
     ! Logical arrays
     call MPI_BCAST(minor_scales_with_density_lower_sw, nminor_absorber_intervals_lower_sw, MPI_LOGICAL,  mpiroot, mpicomm, ierr)
     call MPI_BCAST(scale_by_complement_lower_sw,       nminor_absorber_intervals_lower_sw, MPI_LOGICAL,  mpiroot, mpicomm, ierr)