restfilemod.f90

CCSM Research Tools: Community Atmosphere Model (CAM)

  end subroutine write_rest_pfile

!=======================================================================

  character(len=256) function set_restart_filename ()

    use clm_varctl  , only : caseid
    use time_manager, only : get_curr_date

! ------------------------ local variables ------------------------
    character(len=256) :: cdate       !date char string
    integer :: day                    !day (1 -> 31)
    integer :: mon                    !month (1 -> 12)
    integer :: yr                     !year (0 -> ...)
    integer :: sec                    !seconds into current day
! -----------------------------------------------------------------

    call get_curr_date (yr, mon, day, sec) 
    write(cdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr,mon,day,sec
    set_restart_filename = "./"//trim(caseid)//".clm2.r."//trim(cdate)

  end function set_restart_filename

!=======================================================================
! BEGIN GENERIC PROCEDURE DEFINITIONS
!=======================================================================

  subroutine readinsc_int(iu, scalar)
!-----------------------------------------------------------------------
! Wrapper routine to read real scalar variable from restart binary file 
!------------------------------Arguments--------------------------------
    integer, intent(in)  :: iu                 !input unit
    integer, intent(out) :: scalar             !scalar to read in
!---------------------------Local variables-----------------------------
    integer ier               ! errorcode
!-----------------------------------------------------------------------
    if (masterproc) then
       read(iu, iostat=ier) scalar
       if (ier /= 0 ) then
          write(6,*) 'READIN ieror ',ier,' on i/o unit = ',iu
          call endrun
       end if
    endif
#if ( defined SPMD ) 
    call mpi_bcast(scalar,1,mpiint,0,mpicom,ier)
#endif
    return
  end subroutine readinsc_int

!=======================================================================

  subroutine readinsc_log(iu, scalar)
!-----------------------------------------------------------------------
! Wrapper routine to read real scalar variable from restart binary file 
!------------------------------Arguments--------------------------------
    integer, intent(in)  :: iu                 !input unit
    logical, intent(out) :: scalar             !scalar to read in
!---------------------------Local variables-----------------------------
    integer ier               ! errorcode
!-----------------------------------------------------------------------
    if (masterproc) then
       read (iu, iostat=ier) scalar
       if (ier /= 0 ) then
          write(6,*) 'READIN ieror ',ier,' on i/o unit = ',iu
          call endrun
       end if
    endif
#if ( defined SPMD ) 
    call mpi_bcast(scalar,1,mpilog,0,mpicom,ier)
#endif
    return
  end subroutine readinsc_log

!=======================================================================

  subroutine readinsc_real(iu, scalar)
!-----------------------------------------------------------------------
! Wrapper routine to read real scalar variable from restart binary file 
!------------------------------Arguments--------------------------------
    integer , intent(in)  :: iu            !input unit
    real(r8), intent(out) :: scalar        !scalar to read in
!---------------------------Local variables-----------------------------
    integer ier               ! errorcode
!-----------------------------------------------------------------------
    if (masterproc) then
       read (iu, iostat=ier) scalar
       if (ier /= 0 ) then
          write(6,*) 'READIN ieror ',ier,' on i/o unit = ',iu
          call endrun
       end if
    endif
#if ( defined SPMD ) 
    call mpi_bcast(scalar,1,mpir8,0,mpicom,ier)
#endif
    return
  end subroutine readinsc_real

!=======================================================================

  subroutine readin1d_int (iu, iarr)
!-----------------------------------------------------------------------
! Wrapper routine to read real variable from restart binary file 
!------------------------------Arguments--------------------------------
    integer , intent(in) :: iu                        !input unit
    integer , intent(out):: iarr(begpatch:endpatch)   !read data
!---------------------------Local variables-----------------------------
    integer :: ier                   !error status
#if (defined SPMD)
    integer, allocatable :: ibuf(:)
    integer :: numsendv(0:npes-1)    !vector of items to be sent
    integer :: displsv(0:npes-1)     !displacement vector
    integer :: numrecv               !number of items to be received
!-----------------------------------------------------------------------
    call compute_mpigs_patch(1, numrecv, numsendv, displsv)
    if (masterproc) then
       allocate(ibuf(numpatch))
       read (iu,iostat=ier) ibuf
       if (ier /= 0 ) then
          write(6,*) 'READIN ieror ',ier,' on i/o unit = ',iu
          call endrun
       end if
       call mpi_scatterv (ibuf, numsendv, displsv, mpiint, &
            iarr(begpatch), numrecv , mpiint , 0, mpicom, ier)
       deallocate(ibuf)
    else
       call mpi_scatterv (0._r8, numsendv, displsv, mpiint, &
            iarr(begpatch), numrecv , mpiint , 0, mpicom, ier)
    endif
#else 
    read (iu,iostat=ier) iarr
    if (ier /= 0 ) then
       write(6,*) 'READIN ieror ',ier,' on i/o unit = ',iu
       call endrun
    end if
#endif
    return
  end subroutine readin1d_int

!=======================================================================

  subroutine readin2d_int (iu, iarr, ndim1)
!-----------------------------------------------------------------------
! Wrapper routine to read integer array from restart binary file 
!------------------------------Arguments--------------------------------
    integer, intent(in)  :: iu                            !input unit
    integer, intent(in)  :: ndim1                         !dimension
    integer, intent(out) :: iarr(ndim1,begpatch:endpatch) !read data
!---------------------------Local variables-----------------------------
    integer :: ier                   !error status
#if (defined SPMD)
    integer, allocatable :: ibuf(:,:)
    integer :: numsendv(0:npes-1)    !vector of items to be sent
    integer :: displsv(0:npes-1)     !displacement vector
    integer :: numrecv               !number of items to be received
!-----------------------------------------------------------------------
! Read in data master processor, scatter from master processor
    call compute_mpigs_patch(ndim1, numrecv, numsendv, displsv)
    if (masterproc) then
       allocate(ibuf(ndim1,numpatch))
       read (iu,iostat=ier) ibuf
       if (ier /= 0 ) then
          write(6,*) 'READIN ieror ',ier,' on i/o unit = ',iu
          call endrun
       end if
       call mpi_scatterv (ibuf, numsendv, displsv, mpiint, &
            iarr(1,begpatch), numrecv ,  mpiint, 0, mpicom, ier)
       deallocate(ibuf)
    else
       call mpi_scatterv (0._r8, numsendv, displsv, mpiint, &
            iarr(1,begpatch), numrecv ,  mpiint, 0, mpicom, ier)
    endif
#else 
! Read in array directly
    read (iu,iostat=ier) iarr
    if (ier /= 0 ) then
       write(6,*) 'READIN ieror ',ier,' on i/o unit = ',iu
       call endrun
    end if
#endif
    return
  end subroutine readin2d_int

!=======================================================================

  subroutine readin3d_int (iu, iarr, ndim1, ndim2)
!-----------------------------------------------------------------------
! Wrapper routine to read integer arry from restart binary file 
!------------------------------Arguments--------------------------------
    integer, intent(in)  :: iu                                  !input unit
    integer, intent(in)  :: ndim1                               !dimension
    integer, intent(in)  :: ndim2                               !dimension
    integer, intent(out) :: iarr(ndim1,ndim2,begpatch:endpatch) !read data
!---------------------------Local variables-----------------------------
    integer :: ier               
#if (defined SPMD)
    integer, allocatable :: ibuf(:,:,:)
    integer :: numsendv(0:npes-1)    !vector of items to be sent
    integer :: displsv(0:npes-1)     !displacement vector
    integer :: numrecv               !number of items to be received
!-----------------------------------------------------------------------
! Read in data master processor, scatter from master processor
    call compute_mpigs_patch(ndim1*ndim2, numrecv, numsendv, displsv)
    if (masterproc) then
       allocate(ibuf(ndim1,ndim2,numpatch))
       read (iu, iostat=ier) ibuf
       if (ier /= 0 ) then
          write(6,*) 'READIN3D_INT error ',ier,' on i/o unit = ',iu
          call endrun
       end if
       call mpi_scatterv (ibuf, numsendv, displsv, mpiint, &
            iarr(1,1,begpatch), numrecv ,  mpiint, 0, mpicom, ier)
       deallocate(ibuf)
    else
       call mpi_scatterv (0._r8, numsendv, displsv, mpiint, &
            iarr(1,1,begpatch), numrecv ,  mpiint, 0, mpicom, ier)
    endif
#else 
! Read in data directly
    read (iu,iostat=ier) iarr
    if (ier /= 0 ) then
       write(6,*) 'READIN3D_INT error ',ier,' on i/o unit = ',iu
       call endrun
    end if
#endif
    return
  end subroutine readin3d_int

!=======================================================================

  subroutine readin1d_real (iu, arr)
!-----------------------------------------------------------------------
! Wrapper routine to read real array from restart binary file 
!------------------------------Arguments--------------------------------
    integer , intent(in) :: iu                        !input unit
    real(r8), intent(out):: arr(begpatch:endpatch)    !read data
!---------------------------Local variables-----------------------------
    integer :: ier                    !errorcode
#if (defined SPMD)
    real(r8), allocatable :: buf(:)
    integer  :: numsendv(0:npes-1)    !vector of items to be sent
    integer  :: displsv(0:npes-1)     !displacement vector
    integer  :: numrecv               !number of items to be received
!-----------------------------------------------------------------------
! Read in data master processor, scatter from master processor
    call compute_mpigs_patch(1, numrecv, numsendv, displsv)
    if (masterproc) then
       allocate(buf(numpatch))
       read (iu,iostat=ier) buf
       if (ier /= 0 ) then
          write(6,*) 'READIN1D_REAL error ',ier,' on i/o unit = ',iu
          call endrun
       end if
       call mpi_scatterv (buf, numsendv, displsv, mpir8, &
            arr(begpatch), numrecv , mpir8, 0, mpicom, ier)
       deallocate(buf)
    else
       call mpi_scatterv (0._r8, numsendv, displsv, mpir8, &
            arr(begpatch), numrecv , mpir8, 0, mpicom, ier)
    endif
#else 
! Read in data directly
    read (iu,iostat=ier) arr
    if (ier /= 0 ) then
       write(6,*) 'READIN1D_REAL error ',ier,' on i/o unit = ',iu
       call endrun
    end if
#endif
    return
  end subroutine readin1d_real

!=======================================================================

  subroutine readin2d_real (iu, arr, ndim1)
!-----------------------------------------------------------------------
! Wrapper routine to read real array from restart binary file 
!------------------------------Arguments--------------------------------
    integer , intent(in)  :: iu                           !input unit
    integer , intent(in)  :: ndim1                        !dimension
    real(r8), intent(out) :: arr(ndim1,begpatch:endpatch) !read data
!---------------------------Local variables-----------------------------
    integer  :: ier                   !error code 
#if (defined SPMD)
    real(r8), allocatable :: buf(:,:)
    integer  :: numsendv(0:npes-1)    !vector of items to be sent
    integer  :: displsv(0:npes-1)     !displacement vector
    integer  :: numrecv               !number of items to be received
!-----------------------------------------------------------------------
! Read in data master processor, scatter from master processor
    call compute_mpigs_patch(ndim1, numrecv, numsendv, displsv)
    if (masterproc) then
       allocate(buf(ndim1,numpatch))
       read (iu,iostat=ier) buf
       if (ier /= 0 ) then
          write(6,*) 'READIN2D_REAL error ',ier,' on i/o unit = ',iu
          call endrun
       end if
       call mpi_scatterv (buf, numsendv, displsv, mpir8, &
            arr(1,begpatch), numrecv , mpir8, 0, mpicom, ier)
       deallocate(buf)
    else
       call mpi_scatterv (0._r8, numsendv, displsv, mpir8, &
            arr(1,begpatch), numrecv , mpir8, 0, mpicom, ier)
    endif
#else 
! Read in array directly
    read (iu,iostat=ier) arr
    if (ier /= 0 ) then
       write(6,*) 'READIN2D_REAL error ',ier,' on i/o unit = ',iu
       call endrun
    end if
#endif
    return
  end subroutine readin2d_real

!=======================================================================

  subroutine readin3d_real (iu, arr, ndim1, ndim2)
!-----------------------------------------------------------------------
! Wrapper routine to read real array fom restart binary file 
!------------------------------Arguments--------------------------------
    integer , intent(in)  :: iu              !input unit
    integer , intent(in)  :: ndim1           !dimension
    integer , intent(in)  :: ndim2           !dimension
    real(r8), intent(out) :: arr(ndim1,ndim2,begpatch:endpatch) !read data
!---------------------------Local variables-----------------------------
    integer :: ier                    !error code 
#if (defined SPMD)
    real(r8), allocatable :: buf(:,:,:)
    integer  :: numsendv(0:npes-1)    !vector of items to be sent
    integer  :: displsv(0:npes-1)     !displacement vector
    integer  :: numrecv               !number of items to be received
!-----------------------------------------------------------------------
! Read in data master processor, scatter from master processor
    call compute_mpigs_patch(ndim1*ndim2, numrecv, numsendv, displsv)
    if (masterproc) then
       allocate(buf(ndim1,ndim2,numpatch))
       read (iu, iostat=ier) buf
       if (ier /= 0 ) then
          write(6,*) 'READIN3D_REAL error ',ier,' on i/o unit = ',iu
          call endrun
       end if
       call mpi_scatterv (buf, numsendv, displsv, mpir8, &
            arr(1,1,begpatch), numrecv , mpir8, 0, mpicom, ier)
       deallocate(buf)
    else
       call mpi_scatterv (0._r8, numsendv, displsv, mpir8, &
            arr(1,1,begpatch), numrecv , mpir8, 0, mpicom, ier)