Merge pull request #491 from nmizukami/cesm-coupling_cleanup

Clean up

route/build/cpl/RtmFileUtils.F90

@@ -5,7 +5,7 @@ module RtmFileUtils
 !
 ! !USES:
   USE shr_sys_mod , ONLY : shr_sys_abort, shr_sys_flush
-  USE shr_file_mod, ONLY : shr_file_get, shr_file_getUnit, shr_file_freeUnit
+  USE shr_file_mod, ONLY : shr_file_get
   USE globalData  , ONLY : masterproc
   USE public_var  , ONLY : iulog
 !
@@ -17,8 +17,6 @@ module RtmFileUtils
   public :: get_filename  !Returns filename given full pathname
   public :: opnfil        !Open local unformatted or formatted file
   public :: getfil        !Obtain local copy of file
-  public :: relavu        !Close and release Fortran unit no longer in use
-  public :: getavu        !Get next available Fortran unit number
 !
 ! !REVISION HISTORY:
 ! Created by Mariana Vertenstein
@@ -169,7 +167,7 @@ subroutine opnfil (locfn, iun, form)
      else
         ft = 'formatted  '
      end if
-     open (unit=iun,file=locfn,status='unknown',form=ft,iostat=ioe)
+     open (newunit=iun,file=locfn,status='unknown',form=ft,iostat=ioe)
      if (ioe /= 0) then
         write(iulog,*)'(OPNFIL): failed to open file ',trim(locfn),        &
              &     ' on unit ',iun,' ierr=',ioe
@@ -182,33 +180,4 @@ subroutine opnfil (locfn, iun, form)
 
    end subroutine opnfil
 
-!------------------------------------------------------------------------
-
-  integer function getavu()
-
-    ! !DESCRIPTION:
-    ! Get next available Fortran unit number.
-    implicit none
-
-    getavu = shr_file_getunit()
-
-  end function getavu
-
-!------------------------------------------------------------------------
-
-  subroutine relavu (iunit)
-
-    ! !DESCRIPTION:
-    ! Close and release Fortran unit no longer in use!
-
-    ! !ARGUMENTS:
-    implicit none
-    integer, intent(in) :: iunit    !Fortran unit number
-    !----------------------------------------------------
-
-    close(iunit)
-    call shr_file_freeUnit(iunit)
-
-  end subroutine relavu
-
 end module RtmFileUtils

route/build/cpl/RtmMod.F90

@@ -808,7 +808,7 @@ SUBROUTINE restFile_read_pfile( pnamer )
     ! [fname_state_in] contains the restart file name and restart file must be stored in output_dir.
     ! New history files are always created for branch runs.
 
-    USE RtmFileUtils, ONLY: relavu, getavu, opnfil
+    USE RtmFileUtils, ONLY: opnfil
     USE RtmVar,       ONLY: inst_suffix
     USE public_var,   ONLY: rpntfil
     USE public_var,   ONLY: secprmin, secprhour
@@ -830,8 +830,6 @@ SUBROUTINE restFile_read_pfile( pnamer )
       write(iulog,*) 'Reading restart pointer file....'
     endif
 
-    nio = getavu() ! get available unit number
-
     ! construct rpointer file name with datetime - simDatetime has three datetime at previous(0), current(1) and next(2) time stamp
     sec_in_day = simDatetime(1)%hour()*nint(secprhour)+simDatetime(1)%minute()*nint(secprmin)+nint(simDatetime(1)%sec())
     write(timestamp,'(".",I4.4,"-",I2.2,"-",I2.2,"-",I5.5)') &
@@ -843,7 +841,7 @@ SUBROUTINE restFile_read_pfile( pnamer )
     end if
     call opnfil (locfn, nio, 'f')
     read (nio,'(a256)') pnamer
-    call relavu (nio)
+    close(nio)
 
     if (masterproc) then
       write(iulog,*) 'Reading restart data: ', trim(pnamer)

route/build/src/ascii_utils.f90

@@ -76,11 +76,8 @@ SUBROUTINE file_open(infile,unt,err,message)
    message=trim(message)//"FileIsAlreadyOpen[file='"//trim(infile)//"']"
    err=20; return
  endif
- ! get spare file unit
- call getSpareUnit(unt,err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
  ! open file
- open(unt,file=trim(infile),status="old",action="read",iostat=err)
+ open(newunit=unt,file=trim(infile),status="old",action="read",iostat=err)
  if(err/=0)then
    message=trim(message)//"OpenError['"//trim(infile)//"']"
    err=30; return

route/build/src/mpi_utils.f90

@@ -38,6 +38,7 @@ MODULE mpi_utils
     shr_mpi_bcastInt,         &
     shr_mpi_bcastLong,        &
     shr_mpi_bcastReal,        &
+    shr_mpi_bcastChar,        &
     shr_mpi_bcastLogical
   END INTERFACE
 
@@ -334,6 +335,43 @@ SUBROUTINE shr_mpi_bcastLogical(allocArray,    & ! inout: array to be broadcaste
 
   END SUBROUTINE shr_mpi_bcastLogical
 
+  ! ----------------------------------
+  ! BROADCAST - character allocatable array (fixed character length)
+  ! ----------------------------------
+  SUBROUTINE shr_mpi_bcastChar(allocArray,    & ! inout: array to be broadcasted to each proc
+                               ierr, message)   ! output: error handling
+    implicit none
+    ! Argument variables:
+    character(strLen), allocatable, intent(inout) :: allocArray(:) ! inout: array to be sent to proc
+    integer(i4b),                   intent(out)   :: ierr
+    character(strLen),              intent(out)   :: message       ! error message
+    ! local variable
+    integer(i4b)                                  :: flat_size
+    integer(i4b)                                  :: num_elements
+
+    ierr=0; message='shr_mpi_bcastChar/'
+
+    if (masterproc) then
+      num_elements = size(allocArray)
+    end if
+    call MPI_BCAST(num_elements, 1, MPI_INTEGER, root, mpicom_route, ierr)
+    flat_size = num_elements*strLen
+
+    ! Allocate allocArray in other ranks after receiving num_elements
+    if (.not. masterproc) then
+      if (allocated(allocArray)) then
+        deallocate(allocArray, stat=ierr)
+        if(ierr/=0)then; message=trim(message)//'probleml de-allocating array for [allocArray]'; return; endif
+      endif
+      allocate(allocArray(num_elements), stat=ierr)
+      if(ierr/=0)then; message=trim(message)//'problem allocating array for [allocArray]'; return; endif
+    end if
+
+    ! Broadcast the flattened character array
+    call MPI_BCAST(allocArray, flat_size, MPI_CHARACTER, root, mpicom_route, ierr)
+
+  END SUBROUTINE shr_mpi_bcastChar
+
   ! ----------------------------------
   ! SCATTERV - 1D integer array
   ! ----------------------------------

route/build/src/standalone/model_setup.f90

@@ -181,8 +181,7 @@ SUBROUTINE inFile_pop(dir_name,         & ! input: name of the directory of the
                        inputFileInfo,    & ! output: input file information
                        ierr, message)      ! output: error control
 
-  USE globalData,          ONLY: masterproc, &
-                                 mpicom_route
+  USE globalData,          ONLY: masterproc
   USE dataTypes,           ONLY: inFileInfo     ! the data type for storing the infromation of the nc files and its attributes
   USE datetime_data,       ONLY: datetime       ! datetime data
   USE ascii_utils,         ONLY: file_open      ! open file (performs a few checks as well)
@@ -194,7 +193,7 @@ SUBROUTINE inFile_pop(dir_name,         & ! input: name of the directory of the
   USE public_var,          ONLY: secprmin,  &   ! time conversion factor (min->sec)
                                  secprhour, &   ! time conversion factor (hour->sec)
                                  secprday       ! time conversion factor (day->sec)
-  USE mpi_utils,           ONLY: shr_mpi_barrier
+  USE mpi_utils,           ONLY: shr_mpi_bcast
 
   ! Argument variables
   character(len=strLen), intent(in)                 :: dir_name         ! the name of the directory that the txt file located
@@ -222,18 +221,25 @@ SUBROUTINE inFile_pop(dir_name,         & ! input: name of the directory of the
   ierr=0; message='inFile_pop/'
 
   ! build filename and its path containing list of NetCDF files
-  infilename = trim(dir_name)//trim(file_name)
-  tmp_file_list = trim(dir_name)//'tmp'
-  call execute_command_line("ls "//infilename//" > "//trim(tmp_file_list))
+  ! then construct a character array including the file paths
+  if (masterproc) then
+    infilename = trim(dir_name)//trim(file_name)
+    tmp_file_list = trim(dir_name)//'tmp'
+    call execute_command_line("ls "//infilename//" > "//trim(tmp_file_list))
 
-  call shr_mpi_barrier(mpicom_route, message)
+    call file_open(tmp_file_list,funit,ierr,cmessage) ! open the text file
+    if(ierr/=0)then; message=trim(message)//trim(cmessage); return; end if
 
-  call file_open(tmp_file_list,funit,ierr,cmessage) ! open the text file
-  if(ierr/=0)then; message=trim(message)//trim(cmessage); return; end if
+    ! get a list of character strings from non-commented lines
+    call get_vlines(funit,dataLines,ierr,cmessage)
+    if(ierr/=0)then; ierr=20; message=trim(message)//trim(cmessage); return; end if
+
+    call execute_command_line("rm -f "//trim(tmp_file_list))
+  end if
 
-  ! get a list of character strings from non-commented lines
-  call get_vlines(funit,dataLines,ierr,cmessage)
+  call shr_mpi_bcast(dataLines, ierr, cmessage)
   if(ierr/=0)then; ierr=20; message=trim(message)//trim(cmessage); return; end if
+
   nFile = size(dataLines) ! get the name of the lines in the file
 
   ! allocate space for forcing information
@@ -320,8 +326,6 @@ SUBROUTINE inFile_pop(dir_name,         & ! input: name of the directory of the
   close(unit=funit,iostat=ierr) ! close ascii file
   if(ierr/=0)then;message=trim(message)//'problem closing forcing file list'; return; end if
 
-  call execute_command_line("rm -f "//trim(tmp_file_list))
-
  END SUBROUTINE inFile_pop
 
  ! *********************************************************************