restfilemod.f90

CCSM Research Tools: Community Atmosphere Model (CAM)

    call wrtout (nio, buf1d)  

    buf1d(begpatch:endpatch) = clm(begpatch:endpatch)%tlai            
    call wrtout (nio, buf1d)  

    buf1d(begpatch:endpatch) = clm(begpatch:endpatch)%tsai            
    call wrtout (nio, buf1d)  

    buf1d(begpatch:endpatch) = clm(begpatch:endpatch)%elai            
    call wrtout (nio, buf1d)  

    buf1d(begpatch:endpatch) = clm(begpatch:endpatch)%esai            
    call wrtout (nio, buf1d)  

    buf1d(begpatch:endpatch) = clm(begpatch:endpatch)%fsun            
    call wrtout (nio, buf1d)  

    buf1d(begpatch:endpatch) = clm(begpatch:endpatch)%htop
    call wrtout (nio, buf1d)

    buf1d(begpatch:endpatch) = clm(begpatch:endpatch)%hbot
    call wrtout (nio, buf1d)

    deallocate (ibuf1d)
    deallocate ( buf1d)

! write out multi level snow only fields

    allocate (buf2d(-nlevsno+1:0,begpatch:endpatch))
    do j = -nlevsno+1,0
       buf2d(j,begpatch:endpatch) = clm(begpatch:endpatch)%dz(j)  
    end do
    call wrtout (nio, buf2d, nlevsno)

    do j = -nlevsno+1,0
       buf2d(j,begpatch:endpatch) = clm(begpatch:endpatch)%z(j)  
    end do
    call wrtout (nio, buf2d, nlevsno)
    deallocate(buf2d)

    allocate (buf2d(-nlevsno:0,begpatch:endpatch))
    do j = -nlevsno,0
       buf2d(j,begpatch:endpatch) = clm(begpatch:endpatch)%zi(j)  
    end do
    call wrtout (nio, buf2d, nlevsno+1)
    deallocate(buf2d)

! write out multi level snow-soil fields

    allocate (buf2d(-nlevsno+1:nlevsoi,begpatch:endpatch))
    do j = -nlevsno+1,nlevsoi
       buf2d(j,begpatch:endpatch) = clm(begpatch:endpatch)%t_soisno(j)  
    end do
    call wrtout (nio, buf2d, nlevsoi+nlevsno)
    do j = -nlevsno+1,nlevsoi
       buf2d(j,begpatch:endpatch) = clm(begpatch:endpatch)%h2osoi_liq(j)  
    end do
    call wrtout (nio, buf2d, nlevsoi+nlevsno)
    do j = -nlevsno+1,nlevsoi
       buf2d(j,begpatch:endpatch) = clm(begpatch:endpatch)%h2osoi_ice(j)  
    end do
    call wrtout (nio, buf2d, nlevsoi+nlevsno)
    deallocate(buf2d)

    allocate (buf2d(1:nlevlak,begpatch:endpatch))
    do j = 1,nlevlak
       buf2d(j,begpatch:endpatch) = clm(begpatch:endpatch)%t_lake(j)  
    end do
    call wrtout (nio, buf2d, nlevlak)
    deallocate(buf2d)

! write out multi level albedo and surface radiation related fields

    allocate (buf2d(numrad,begpatch:endpatch))
    do j = 1,numrad
       buf2d(j,begpatch:endpatch) = clm(begpatch:endpatch)%albd(j)  
    end do
    call wrtout (nio, buf2d  , numrad)

    do j = 1,numrad
       buf2d(j,begpatch:endpatch) = clm(begpatch:endpatch)%albi(j)  
    end do
    call wrtout (nio, buf2d  , numrad)

    do j = 1,numrad
       buf2d(j,begpatch:endpatch) = clm(begpatch:endpatch)%albgrd(j)  
    end do
    call wrtout (nio, buf2d, numrad)

    do j = 1,numrad
       buf2d(j,begpatch:endpatch) = clm(begpatch:endpatch)%albgri(j)  
    end do
    call wrtout (nio, buf2d, numrad)

    do j = 1,numrad
       buf2d(j,begpatch:endpatch) = clm(begpatch:endpatch)%fabd(j)  
    end do
    call wrtout (nio, buf2d  , numrad)

    do j = 1,numrad
       buf2d(j,begpatch:endpatch) = clm(begpatch:endpatch)%fabi(j)  
    end do
    call wrtout (nio, buf2d  , numrad)

    do j = 1,numrad
       buf2d(j,begpatch:endpatch) = clm(begpatch:endpatch)%ftdd(j)  
    end do
    call wrtout (nio, buf2d  , numrad)

    do j = 1,numrad
       buf2d(j,begpatch:endpatch) = clm(begpatch:endpatch)%ftid(j)  
    end do
    call wrtout (nio, buf2d  , numrad)

    do j = 1,numrad
       buf2d(j,begpatch:endpatch) = clm(begpatch:endpatch)%ftii(j)  
    end do
    call wrtout (nio, buf2d  , numrad)
    deallocate(buf2d)

#if (defined RTM)

! write river routing data (if applicable)

#if (defined SPMD)
    call compute_mpigs_patch(1, numsend, numrecvv, displsv)

    allocate(gather1d(numpatch))
    call mpi_gatherv (totrunin_ave(begpatch), numsend , mpir8, &
         gather1d, numrecvv, displsv, mpir8, 0, mpicom, ier)
    if (masterproc) totrunin_ave(:) = gather1d(:)
    call mpi_gatherv (prec_ave(begpatch)    , numsend , mpir8, &
         gather1d, numrecvv, displsv, mpir8, 0, mpicom, ier)
    if (masterproc) prec_ave(:) = gather1d(:)
    call mpi_gatherv (evap_ave(begpatch)    , numsend , mpir8, &
         gather1d, numrecvv, displsv, mpir8, 0, mpicom, ier)
    if (masterproc) evap_ave(:) = gather1d(:)
    call mpi_gatherv (qchocn2(begpatch)     , numsend , mpir8, &
         gather1d, numrecvv, displsv, mpir8, 0, mpicom, ier)
    if (masterproc) qchocn2(:) = gather1d(:)
    call mpi_gatherv (qchan2(begpatch)      , numsend , mpir8, &
         gather1d, numrecvv, displsv, mpir8, 0, mpicom, ier)
    if (masterproc) qchan2(:) = gather1d(:)
    deallocate(gather1d)
#endif
    if (masterproc) then
       write(nio) volr
       write(nio) ncount_rtm
       write(nio) ncount_global, yrold
       write(nio) prec_global,evap_global,runlnd_global,runrtm_global,volrtm_global,ocnrtm_global
       write(nio) (totrunin_ave(j),j=1,numpatch)
       write(nio) (prec_ave(j)    ,j=1,numpatch)
       write(nio) (evap_ave(j)    ,j=1,numpatch)
       write(nio) (qchan2(j)      ,j=1,numpatch)
       write(nio) (qchocn2(j)     ,j=1,numpatch)
#if (defined COUP_CSM)
       write(nio) ocnrof_vec 
#endif
    endif

#endif

! write coupled model related data (if applicable)

#if (defined COUP_CSM)
    call wrtout (nio, csm_doflxave)
    call wrtout (nio, dosend)
#endif

! write case name

    if (masterproc) then
       write(nio) caseid
    endif

! -----------------------------------------------------------------
! Write history file related data
! -----------------------------------------------------------------
!
! Only needed for history files to restart on any time step. 
! NOTE - to reduce file size, only write history accumulators and
! history counters if not end of history interval.
! The following is NOT read in for branch runs

    do m = 1, nhist
       call wrtout (nio, ntim(m))
       call wrtout (nio, mcdate_i(m))
       call wrtout (nio, mcsec_i(m))
       call wrtout (nio, mdcur_i(m))
       call wrtout (nio, mscur_i(m))
       call wrtout (nio, nbeghis(m))
       call wrtout (nio, slfld%num(m))
       call wrtout (nio, mlsoifld%num(m))
       if (nbeghis(m) /= 1) then
          num = slfld%num(m)
          if (num > 0) then
             allocate(ibuf2d(num,begpatch:endpatch))
             do j = 1, num
             do i = begpatch, endpatch
                ibuf2d(j,i) = slfld%count(i,j,m)
             end do
             end do
             call wrtout (nio, ibuf2d, num)
             deallocate(ibuf2d)

             allocate(buf2d(num,begpatch:endpatch))
             do j = 1, num
             do i = begpatch, endpatch
                buf2d(j,i) = slfld%value(i,j,m)
             end do
             end do
             call wrtout (nio, buf2d, num)
             deallocate(buf2d)
          endif
          num = mlsoifld%num(m)
          if (num > 0) then
             allocate(ibuf3d(nlevsoi,num,begpatch:endpatch))
             do j = 1, num
             do n = 1, nlevsoi
             do i = begpatch, endpatch
                ibuf3d(n,j,i) = mlsoifld%count(i,n,j,m)
             end do
             end do
             end do
             call wrtout (nio, ibuf3d, nlevsoi, num)
             deallocate(ibuf3d)

             allocate(buf3d(nlevsoi,num,begpatch:endpatch))
             do j = 1, num
             do n = 1, nlevsoi
             do i = begpatch, endpatch
                buf3d(n,j,i) = mlsoifld%value(i,n,j,m) 
             end do
             end do
             end do
             call wrtout (nio, buf3d, nlevsoi, num)
             deallocate(buf3d)
          endif
       end if
    end do

! write name of current history file 

    if (masterproc) then
       do m = 1, nhist
          if (mss_irt == 0) then
             filename = locfnh(m)
          else
             rem_dir = trim(archive_dir) // '/hist/'
             filename = set_filename(rem_dir, locfnh(m))
          endif
          write(nio) filename
       end do
    endif

! -----------------------------------------------------------------
! Close and dispose restart file to mass store
! -----------------------------------------------------------------

    if (masterproc) then
       lremove = .true.
#if (defined OFFLINE) || (defined COUP_CAM)
       if (is_last_step()) lremove = .false.
#elif (defined COUP_CSM)
       if (csmstop_next) lremove = .false.
#endif
       call relavu (nio)
       write(6,*) 'Successfully wrote local restart file ',trim(loc_fn)
       if (mss_irt > 0) then
          rem_dir = trim(archive_dir) // '/rest/'
          rem_fn = set_filename(rem_dir, loc_fn)
          call putfil (loc_fn, rem_fn, mss_wpass, mss_irt, lremove)
       endif
    endif

! -----------------------------------------------------------------
! Write restart pointer file
! -----------------------------------------------------------------

    if (masterproc) then
       call write_rest_pfile(loc_fn)
       write(6,'(72a1)') ("-",i=1,60)
       write(6,*)
    endif

    return
  end subroutine restwrt

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

  subroutine write_rest_pfile (loc_fn)

!----------------------------------------------------------------------- 
! 
! Purpose: 
! Open restart pointer file. Write names of current restart and 
! history files. If using mass store, these are the mass store
! names except if mss_irt=0 (no mass store files written). Close. 
! 
! Method: 
!
! Author: Mariana Vertenstein
! 
!-----------------------------------------------------------------------

! ------------------------ arguments -----------------------------------
    character(len=*), intent(in) :: loc_fn !local restart filename
!-----------------------------------------------------------------------

! ------------------------ local variables -----------------------------
    integer :: m                           !index
    integer :: nio                         !Fortran unit number
    character(len=256) :: filename         !local file name
    character(len=256) :: rem_dir          !remote directory
!-----------------------------------------------------------------------

    nio = getavu()
    filename= trim(rpntdir) //'/'// trim(rpntfil)
    call opnfil (filename, nio, 'f')

    ! write name of restart file to pointer file 
    if (mss_irt == 0) then
       write(nio,'(a)') loc_fn
    else
       rem_dir = trim(archive_dir) // '/rest/'
       write(nio,'(a)') set_filename(rem_dir, loc_fn)
    endif

    ! add comments to pointer file of all files that are needed for restart
    write(nio,*)'The following lines list files needed for restart - do not edit'

    ! only write names of open history files
    do m = 1, nhist
       if (locfnh(m) /= ' ') then
          if (mss_irt == 0) then
             filename = locfnh(m)
          else
             rem_dir = trim(archive_dir) // '/hist/'
             filename = set_filename(rem_dir, locfnh(m))
          endif
          write(nio, '(a)') filename
       end if
    end do

    call relavu (nio)
    write(6,*)'Successfully wrote local restart pointer file'