restfilemod.f90

CCSM Research Tools: Community Atmosphere Model (CAM)

     do k = begpatch,endpatch
        do j = 1,nlevsoi
           clm(k)%h2osoi_vol(j) = clm(k)%h2osoi_liq(j)/(clm(k)%dz(j)*denh2o) &
                                + clm(k)%h2osoi_ice(j)/(clm(k)%dz(j)*denice)
        end do
     end do

! read in multi level surface albedo and radiation data

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

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

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

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

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

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

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

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

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

! read data for river routing model, if appropriate

#if (defined RTM)

    if (masterproc) then
       read (nio) volr
       read (nio) ncount_rtm
       read (nio) ncount_global, yrold
       read (nio) prec_global,evap_global,runlnd_global,runrtm_global,volrtm_global,ocnrtm_global
       read (nio) (totrunin_ave(j),j=1,numpatch)
       read (nio) (prec_ave(j)    ,j=1,numpatch)
       read (nio) (evap_ave(j)    ,j=1,numpatch)
       read (nio) (qchan2(j)      ,j=1,numpatch)
       read (nio) (qchocn2(j)     ,j=1,numpatch)
#if (defined COUP_CSM)
       read (nio) ocnrof_vec 
#endif
    endif
#if (defined SPMD)
    call compute_mpigs_patch(1, numrecv, numsendv, displsv)

    allocate(scatter1d(numpatch))
    if (masterproc) scatter1d(:) = totrunin_ave(:)
    call mpi_scatterv (scatter1d, numsendv, displsv, mpir8, &
         totrunin_ave(begpatch), numrecv , mpir8, 0, mpicom, ier)
    if (masterproc) scatter1d(:) = prec_ave(:)
    call mpi_scatterv (scatter1d, numsendv, displsv, mpir8, &
         prec_ave(begpatch), numrecv , mpir8, 0, mpicom, ier)
    if (masterproc) scatter1d(:) = evap_ave(:)
    call mpi_scatterv (scatter1d, numsendv, displsv, mpir8, &
         evap_ave(begpatch), numrecv , mpir8, 0, mpicom, ier)
    if (masterproc) scatter1d(:) = qchocn2(:)
    call mpi_scatterv (scatter1d, numsendv, displsv, mpir8, &
         qchocn2(begpatch), numrecv , mpir8, 0, mpicom, ier)
    if (masterproc) scatter1d(:) = qchan2(:)
    call mpi_scatterv (scatter1d, numsendv, displsv, mpir8, &
         qchan2(begpatch), numrecv , mpir8, 0, mpicom, ier)
    deallocate(scatter1d)
#endif

#endif

! read data for flux coupled case, if appropriate

#if (defined COUP_CSM)
    call readin (nio, flxave_res)
    call readin (nio, dosend)
    if (masterproc) then
       if ((flxave_res .and. .not.csm_doflxave).or.(.not.flxave_res .and. csm_doflxave)) then
          write(6,*)'(RESTRD): flxave value from namelist ',csm_doflxave, &
               ' must be the same as flxave value from restart dataset ',flxave_res
          call endrun
       endif
       if (flxave_res .and. .not. dosend) then
          write(6,*)'(RESTRD): assume that current flux coupled model with flux ', &
               'averaging must stop on a time step where dosend (doalb) is true'
          call endrun
       end if
    endif
#endif

! read case name 

    if (masterproc) then
       read (nio) casename
    endif
    
! -----------------------------------------------------------------
! If branch run - check that case name is different and
! return now (no history file data reads for branch run)
! -----------------------------------------------------------------

    if (nsrest == 3) then
       if (masterproc) then
          if (casename==caseid) then
             write(6,*) 'RESTRD ERROR: Must change case name on branch run'
             write(6,*) 'Prev case name ',trim(casename)
             write(6,*)' Current case name ',trim(caseid)
             call endrun
          end if
          call relavu (nio)
          write(6,'(72a1)') ("-",i=1,60)
          write(6,*) 'Successfully read restart data for branch run'
          write(6,*)
       endif
       RETURN
    end if

! -----------------------------------------------------------------
! If restart run - read history file related data 
! -----------------------------------------------------------------

! to reduce file size, only read history accumulators and counters if not
! end of history interval

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

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

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

! Read names of history files. If history file is not full, 
! open netCDF history file and set flag to obtain time 
! dependent netCDF variable id's in history file module
! Note id's must be read in from routine histwrt since
! routine histini is called after the routine restrd

       if (masterproc) then
          do m = 1, nhist
             read (nio) fnameh(m)
          end do
          do m = 1, nhist
             if (ntim(m) /= 0) then
                ncgetid(m) = .true.
                call getfil (fnameh(m), locfnh(m), 0)
                call wrap_open (locfnh(m), nf_write, ncid(m))
             end if
          end do
       end if

! Close restart file

       if (masterproc) then
          call relavu (nio)
          write(6,'(72a1)') ("-",i=1,60)
          write(6,*) 'Successfully read restart data for restart run'
          write(6,*)
       endif
          
    end if !end of if restart 

    return
  end subroutine restrd

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

  subroutine restwrt ()

!----------------------------------------------------------------------- 
! 
! Purpose: 
! Write CLM restart files
! 
! Method: 
! 
! Author: Mariana Vertenstein
! 
!-----------------------------------------------------------------------
! $Id: restFileMod.F90,v 1.19.6.7.6.1 2002/05/13 19:25:07 erik Exp $
!-----------------------------------------------------------------------

    use time_manager, only : get_nstep, timemgr_write_restart, is_last_step
    include 'netcdf.inc'

! ------------------------ local variables ------------------------
    integer :: i,j,k,m,n           !indices
    integer :: nio                 !fortran unit number
    integer :: num                 !number of fields (temporary)
    logical :: lremove             !true => remove file after archive
    character(len=256) :: rem_fn   !remote (archive) filename
    character(len=256) :: rem_dir  !remote (archive) directory
    character(len=256) :: loc_fn   !local restart filename
    character(len=256) :: filename !generic filename
    integer :: ier                 !error code
#if (defined SPMD)                
    integer :: numrecvv(0:npes-1)  !vector of items to be received  
    integer :: displsv(0:npes-1)   !displacement vector
    integer :: numsend             !number of items to be sent
    real(r8), allocatable :: gather1d(:) !scatter temporary 
#endif                            
! -----------------------------------------------------------------


! -----------------------------------------------------------------
! Open main restart file. write data. close and dispose if 
! appropriate
! -----------------------------------------------------------------

    if (masterproc) then
       write(6,*)
       write(6,'(72a1)') ("-",i=1,60)
       write(6,*) 'nstep = ',get_nstep()

       loc_fn = set_restart_filename()
       nio = getavu()
       call opnfil (loc_fn, nio, 'u')
    endif

! -----------------------------------------------------------------
! Write data
! -----------------------------------------------------------------

! main restart data

    call wrtout (nio, rest_id) 

#if (defined COUP_CAM)

    call wrtout (nio, get_nstep())

#else

    if (masterproc) call timemgr_write_restart(nio)

#endif

! write out required 1d fields

    allocate ( buf1d(begpatch:endpatch))
    allocate (ibuf1d(begpatch:endpatch))

    ibuf1d(begpatch:endpatch)= clm(begpatch:endpatch)%snl             
    call wrtout (nio,ibuf1d)

    ibuf1d(begpatch:endpatch)= clm(begpatch:endpatch)%frac_veg_nosno_alb  
    call wrtout (nio,ibuf1d)

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

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

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

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

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

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

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

    buf1d(begpatch:endpatch) = clm(begpatch:endpatch)%fwet