#include <misc.h>#include <params.h>module restart!----------------------------------------------------------------------- ! ! module to handle reading and writing of the master restart files.!!----------------------------------------------------------------------- ! $Id: restart.F90,v 1.9.2.5 2002/05/02 04:18:11 erik Exp $!-----------------------------------------------------------------------    use precision,    only: r8   use pmgrid,       only: masterproc, plev, plevp, plond, plat   use rgrid,        only: nlon, wnummax   use ioFileMod,    only: putfil, getfil, opnfil   use filenames,    only: get_archivedir#ifndef COUP_CSM   use atm_lndMod,   only: is_lsm   use spmd_phys,    only: is_366_physics#endif#ifdef SPMD   use mpishorthand, only: mpicom, mpir8, mpiint, mpilog#endif   implicit none!! Public interfaces!   public write_restart          ! Write the master restart file out   public read_restart           ! Read the master restart file in   public set_restart_filepath   ! Set the full filepath to the master restart file!! Everything else is private!   private   integer, parameter :: nlen = 256 ! Length of character strings   character(len=nlen) :: pname     ! Full restart pathname!! Filename specifiers for master restart filename! (%c = caseid, $y = year, $m = month, $d = day, $s = seconds in day, %t = number)!   character(len=256) :: rfilename_spec = '%c.cam2.r.%y-%m-%d-%s'!! Common blocks!!-----------------------------------------------------------------------#include <comctl.h>!-----------------------------------------------------------------------#include <comlun.h>!-----------------------------------------------------------------------#include <comhyb.h>!-----------------------------------------------------------------------#include <comtfc.h>!-----------------------------------------------------------------------CONTAINS   subroutine write_restart!----------------------------------------------------------------------- ! ! Purpose: ! Write the primary, secondary, and history buffer regeneration files.! ! Method: ! The cpp SPMD definition provides for the funnelling of all program i/o! through the master processor. Processor 0 either reads restart/history! data from the disk and distributes it to all processors, or collects! data from all processors and writes it to disk.! ! Author: ! !-----------------------------------------------------------------------       use history,          only: write_restart_history      use restart_physics,  only: write_restart_physics      use restart_dynamics, only: write_restart_dynamics      use time_manager,     only: timemgr_write_restart      use filenames,        only: caseid, mss_wpass, mss_irt, get_archivedir, &                                  interpret_filename_spec!! Local workspace!      integer ioerr             ! write error status      character(len=256) fname  ! Restart filename!-----------------------------------------------------------------------! Write the primary restart datasets!-----------------------------------------------------------------------!#ifdef DEBUG      write(6,*)'Entered WRITE_RESTART: writing nstep+1=',nstep+1, ' data to restart file'#endif!! Everything inside the following "if" is from the obsolete RGNFLS!      if (masterproc) then!     ! Open master restart file.!         fname = interpret_filename_spec( rfilename_spec )         call opnfil (fname, nrg, 'u')!!-----------------------------------------------------------------------! Write the master restart dataset!-----------------------------------------------------------------------         call timemgr_write_restart(nrg)         write (nrg, iostat=ioerr) eps, caseid, hyai, hybi, hyam,  &                                   hybm, aeres         if (ioerr /= 0 ) then            write (6,*) 'WRITE ioerror ',ioerr,' on i/o unit = ',nrg            call endrun         end if!! Reduced grid stuff!         write (nrg, iostat=ioerr) nlon, wnummax         if (ioerr /= 0 ) then            write (6,*) 'WRITE ioerror ',ioerr,' on i/o unit = ',nrg            call endrun         end if      end if!!-----------------------------------------------------------------------! Dynamics, physics, History!-----------------------------------------------------------------------!      call write_restart_dynamics (nrg)      call write_restart_physics (nrg, nrg2)      call write_restart_history (nrg, luhrest)      if (masterproc) then         close(nrg)         pname = trim(get_archivedir( 'rest' )) // fname         call putfil (fname, pname, mss_wpass, mss_irt, (.not. nlend) )         call write_rest_pfile      end if      return   end subroutine write_restart!#######################################################################   subroutine read_restart!----------------------------------------------------------------------- ! ! Purpose: ! Acquire and position the restart, master, primary and secondary! datasets for a continuation run! ! Method: ! ! Author: ! !-----------------------------------------------------------------------      use phys_grid,        only: phys_grid_init      use history,          only: read_restart_history      use filenames,        only: caseid      use restart_physics,  only: read_restart_physics      use restart_dynamics, only: read_restart_dynamics      use time_manager,     only: timemgr_read_restart, timemgr_restart!-----------------------------------------------------------------------!! Local workspace!      integer i                     ! Indices      integer ioerr                 ! read error status      integer decomp                ! decomposition type      character*256 locfn           ! Local filename      character*33  tcase           ! Read in previous case name!!-----------------------------------------------------------------------! Determine full restart pathname!------------------------------------------------------------------------!! Test for existence of a restart pointer dataset (nsrest=1 only).! If restart pinter dataset exists, obtain it and read it.!      if (masterproc) then         if (.not.nlhst) then            call read_rest_pfile         endif!!------------------------------------------------------------------------! Obtain and read the master restart dataset !------------------------------------------------------------------------!#ifdef DEBUG         write(6,*)'READ_RESTART: Reading master resart dataset'#endif!! Obtain master restart dataset!         call getfil (pname, locfn)         call opnfil (locfn, nrg, 'u')!     ! Read comtim, comtfc, comhst, comhed and history buffer variables !              call timemgr_read_restart(nrg)         read (nrg, iostat=ioerr) eps, tcase, hyai, hybi, hyam,  &                                  hybm, aeres         if (ioerr /= 0 ) then            write (6,*) 'READ ioerror ',ioerr,' on i/o unit = ',nrg            call endrun         end if         if (lbrnch .and. tcase == caseid) then            write(6,*) 'READ_RESTART: Must change case name on branch run'            write(6,*) 'Prev case = ',tcase,' current case = ',caseid            call endrun         end if!! Reduced grid stuff!         read (nrg, iostat=ioerr) nlon, wnummax         if (ioerr /= 0 ) then            write (6,*) 'READ ioerror ',ioerr,' on i/o unit = ',nrg            call endrun         end if         write(6,*) 'MASTER RESTART DATASET READ. EPS= ',eps         write(6,*) 'Files for restart:'      endif  ! end of if-masterproc#if ( defined SPMD )       call mpibcast (eps    ,1        ,mpir8  ,0,mpicom)      call mpibcast (hyai   ,plev+1   ,mpir8  ,0,mpicom)       call mpibcast (hybi   ,plev+1   ,mpir8  ,0,mpicom)       call mpibcast (hyam   ,plev     ,mpir8  ,0,mpicom)         call mpibcast (hybm   ,plev     ,mpir8  ,0,mpicom)         call mpibcast (aeres  ,1        ,mpilog ,0,mpicom)      call mpibcast (nlon,   plat,     mpiint, 0,mpicom)      call mpibcast (wnummax,plat,     mpiint, 0,mpicom)#endif! Restart the time manager.      call timemgr_restart()!-----------------------------------------------------------------------! Dynamics, physics, history!-----------------------------------------------------------------------      call read_restart_dynamics (nrg)      call initcom ()#ifdef COUP_CSM      decomp = -1      ! Do latitude-band chunking for current coupled model#else      if ( is_lsm() .or. is_366_physics() )then         decomp = -1      ! Do latitude-band chunking for old physics or lsm      else         decomp = 0      end if#endif      call phys_grid_init (decomp, 1)      call read_restart_physics (nrg, nrg2, aeres )      if (nsrest == 1) then         call read_restart_history (nrg, luhrest)      end if      if (masterproc) close(nrg)      ! Done reading restart info      return   end subroutine read_restart   subroutine write_rest_pfile!----------------------------------------------------------------------- ! ! Purpose: !! Write out the restart pointer file!!-----------------------------------------------------------------------    use filenames,       only: rest_pfile   use restart_physics, only: get_abs_restart_filepath   use history,         only: get_mtapes, get_hist_restart_filepath, &                              hstwr, get_hfilepath, nfils, mfilt!-----------------------------------------------------------------------! for nsds#include <comlun.h>!-----------------------------------------------------------------------! for aeres#include <comctl.h>!-----------------------------------------------------------------------   integer t      ! Tape number   integer mtapes ! Number of tapes that are active   call opnfil(rest_pfile, nsds, 'f')   rewind nsds   write (nsds,'(a)') trim(pname)   write (nsds,'(//a,a)') '# The following lists the other files needed for restarts', &                        ' (cam only reads the first line of this file).'   write (nsds,'(a,a)') '# The files below refer to the files needed for the master restart file:', &                       trim(pname)   if ( aeres )then      write (nsds,'(a,a)') '# ', trim(get_abs_restart_filepath())   end if!! History files: Need restart history files when not a time-step to write history info! Need: history files if they are not full!   mtapes = get_mtapes( )   do t=1,mtapes      if ( .not. hstwr(t) ) then         write (nsds,'(a,a)') '# ', trim(get_hist_restart_filepath( t ))      end if      if ( nfils(t) > 0 .and. nfils(t) < mfilt(t) ) then         write (nsds,'(a,a)') '# ', trim(get_hfilepath( t ))      end if   end do   close (nsds)   write(6,*)'(WRITE_REST_PFILE): successfully wrote local restart pointer file ',trim(rest_pfile)   write(6,'("---------------------------------------")')   end subroutine write_rest_pfile   subroutine read_rest_pfile!----------------------------------------------------------------------- ! ! Purpose: !! Read the master restart file from the restart pointer file!!-----------------------------------------------------------------------    use filenames, only: rest_pfile!-----------------------------------------------------------------------! for nsds#include <comlun.h>   character(len=256) :: locfn    ! Local pathname for restart pointer file   call getfil (rest_pfile, locfn)   call opnfil (locfn, nsds, 'f')   read (nsds,'(a)') pname   close(nsds)   end subroutine read_rest_pfile!-----------------------------------------------------------------------! BOP!! !ROUTINE: set_restart_filepath!! !DESCRIPTION: Set the filepath of the specific type of restart file.!!-----------------------------------------------------------------------! !INTERFACE:subroutine set_restart_filepath( rgpath )!! !PARAMETERS:!  character(len=*), intent(in)  :: rgpath ! Full pathname to restart file!! EOP!  if ( trim(rgpath) == '' )then     write(6,*) 'SET_RESTART_FILEPATH: rgpath sent into subroutine is empty'     call endrun  end if  if ( rgpath(1:1) /= '/' )then     write(6,*) 'SET_RESTART_FILEPATH: rgpath sent into subroutine is not an absolute pathname'     call endrun  end if  if ( len_trim(rgpath) > nlen )then     write(6,*) 'SET_RESTART_FILEPATH: rgpath is too long :', rgpath     call endrun  end if  pname = trim(rgpath)end subroutine set_restart_filepathend module restart