restart_physics.f90

来自「CCSM Research Tools: Community Atmospher」· F90 代码 · 共 356 行

#include <misc.h>
#include <params.h>

module restart_physics

   use precision
   use ppgrid
   use phys_grid,   only: read_chunk_from_field, write_field_from_chunk
   use pmgrid,      only: masterproc
   use prognostics, only: ptimelevels, n3
   use buffer
   use radae,       only: abstot_3d, absnxt_3d, emstot_3d, initialize_radbuffer
   use comsrf
   use ioFileMod
#if ( defined COUP_CSM )
   use ccsm_msg, only: initialize_ccsm_msg, write_restart_ccsm, read_restart_ccsm
#endif

   implicit none

   private
!
! Public interfaces
!
   public write_restart_physics  ! Write the physics restart info out
   public read_restart_physics   ! Read the physics restart info in
   public get_abs_restart_filepath ! Get the name of the restart filepath

!
! Private data
!
   character(len=256) :: pname  ! Full abs-ems restart filepath
!
! Filename specifier for restart abs-ems file
! (%c = caseid, $y = year, $m = month, $d = day, $s = seconds in day, %t = tape number)
!
   character(len=256) :: rafilename_spec = '%c.cam2.ra.%y-%m-%d-%s'   ! abs-ems restart


CONTAINS

   subroutine write_restart_physics (nrg, nrg2)
   use filenames, only: mss_irt, mss_wpass, get_archivedir, interpret_filename_spec
! for nlend and aeres
#include <comctl.h>
!
! Input arguments
!
      integer :: nrg
      integer :: nrg2
!
! Local workspace
!
      real(r8) tmpfield(pcols,begchunk:endchunk)
      real(r8) tmpfield3d(pcols,plevmx,begchunk:endchunk)
      integer i                 ! loop index
      integer n3tmp             ! timestep index
      character(len=256) fname  ! abs-ems restart filename
      integer ioerr             ! I/O status
!
! Buffer module variables
!
      call write_field_from_chunk(nrg,1,1,1,pblht)
      call write_field_from_chunk(nrg,1,1,1,tpert)
      call write_field_from_chunk(nrg,1,pver,1,qrs)
      call write_field_from_chunk(nrg,1,pver,1,qrl)
      call write_field_from_chunk(nrg,1,pcnst+pnats,1,qpert)
!
! cld, qcwat, and tcwat are physics things, but have dynamics time levels
!
      n3tmp = n3
      do i=1,ptimelevels
         call write_field_from_chunk(nrg,1,pver,1,cld(1,1,begchunk,n3tmp))
         n3tmp = mod(n3tmp,ptimelevels) + 1
      enddo

      n3tmp = n3
      do i=1,ptimelevels
         call write_field_from_chunk(nrg,1,pver,1,qcwat(1,1,begchunk,n3tmp))
         n3tmp = mod(n3tmp,ptimelevels) + 1
      enddo
 
      n3tmp = n3
      do i=1,ptimelevels
         call write_field_from_chunk (nrg,1,pver,1,tcwat(1,1,begchunk,n3tmp))
         call write_field_from_chunk (nrg,1,pver,1,lcwat(1,1,begchunk,n3tmp))
         n3tmp = mod(n3tmp,ptimelevels) + 1
      enddo
!
! Comsrf module variables
!
      call write_field_from_chunk(nrg,1,1,1,fsnt)
      call write_field_from_chunk(nrg,1,1,1,fsns)
      call write_field_from_chunk(nrg,1,1,1,flnt)
      call write_field_from_chunk(nrg,1,1,1,flns)
      do i=begchunk,endchunk
	tmpfield(:,i) = srfflx_state2d(i)%asdir(:)
      end do
      call write_field_from_chunk(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	tmpfield(:,i) = srfflx_state2d(i)%asdif(:)
      end do
      call write_field_from_chunk(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	tmpfield(:,i) = srfflx_state2d(i)%aldir(:)
      end do
      call write_field_from_chunk(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	tmpfield(:,i) = srfflx_state2d(i)%aldif(:)
      end do
      call write_field_from_chunk(nrg,1,1,1,tmpfield)

      call write_field_from_chunk(nrg,1,1,1,asdirice)
      call write_field_from_chunk(nrg,1,1,1,asdifice)
      call write_field_from_chunk(nrg,1,1,1,aldirice)
      call write_field_from_chunk(nrg,1,1,1,aldifice)
      call write_field_from_chunk(nrg,1,1,1,tsice)

      do i=begchunk,endchunk
	tmpfield(:,i) = srfflx_state2d(i)%lwup(:)
      end do
      call write_field_from_chunk(nrg,1,1,1,tmpfield)
      call write_field_from_chunk(nrg,1,1,1,landfrac)
      call write_field_from_chunk(nrg,1,1,1,landm)
      call write_field_from_chunk(nrg,1,1,1,sgh)
      do i=begchunk,endchunk
	tmpfield(:,i) = srfflx_state2d(i)%ts(:)
      end do
      call write_field_from_chunk(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	tmpfield3d(:,:,i) = surface_state2d(i)%tssub(:,:)
      end do
      call write_field_from_chunk(nrg,1,plevmx,1,tmpfield3d)
      call write_field_from_chunk(nrg,1,1,1,sicthk)
      call write_field_from_chunk(nrg,1,1,1,snowhland)
      call write_field_from_chunk(nrg,1,1,1,snowhice)
      do i=begchunk,endchunk
	tmpfield(:,i) = surface_state2d(i)%flwds(:)
      end do
      call write_field_from_chunk(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	tmpfield(:,i) = surface_state2d(i)%sols(:)
      end do
      call write_field_from_chunk(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	tmpfield(:,i) = surface_state2d(i)%soll(:)
      end do
      call write_field_from_chunk(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	tmpfield(:,i) = surface_state2d(i)%solsd(:)
      end do
      call write_field_from_chunk(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	tmpfield(:,i) = surface_state2d(i)%solld(:)
      end do
      call write_field_from_chunk(nrg,1,1,1,tmpfield)
      call write_field_from_chunk(nrg,1,1,1,trefmxav)
      call write_field_from_chunk(nrg,1,1,1,trefmnav)
      call write_field_from_chunk(nrg,1,1,1,icefrac)

#if ( defined COUP_CSM )
      call write_restart_ccsm ()
#endif
!
!-----------------------------------------------------------------------
! Write the abs/ems restart dataset if necessary    
!-----------------------------------------------------------------------
!
      if (aeres) then
         if (masterproc) then
            fname = interpret_filename_spec( rafilename_spec )
            pname = trim(get_archivedir('rest'))//fname
            call opnfil(fname, nrg2, 'u')
            write(nrg,iostat=ioerr) pname
            if (ioerr /= 0 ) then
               write (6,*) 'WRITE ioerror ',ioerr,' on i/o unit = ',nrg
               call endrun
            end if
         endif

         call write_field_from_chunk(nrg2, 1, pverp*pverp,1, abstot_3d(1,1,1,begchunk))
         call write_field_from_chunk(nrg2, 1, pver*4,     1, absnxt_3d(1,1,1,begchunk))
         call write_field_from_chunk(nrg2, 1, pverp,      1, emstot_3d(1,1,begchunk))

         if (masterproc) then
            close(nrg2)
            call putfil (fname, pname, mss_wpass, mss_irt, (.not. nlend) )
         end if
      end if
      
      return
   end subroutine write_restart_physics

!#######################################################################

   subroutine read_restart_physics (nrg, nrg2, aeres )
!
! Arguments
!
      integer, intent(in) :: nrg
      integer, intent(in) :: nrg2

      logical, intent(in) :: aeres
!
! Local workspace
!
      real(r8) tmpfield(pcols,begchunk:endchunk)
      real(r8) tmpfield3d(pcols,plevmx,begchunk:endchunk)
      integer i                 ! loop index
      integer n3tmp             ! timestep index
      character*80  locfn       ! Local filename
      integer ioerr             ! I/O status
!
! Buffer module variables
!
      call initialize_buffer ()

      call read_chunk_from_field(nrg,1,1,1,pblht)
      call read_chunk_from_field(nrg,1,1,1,tpert)
      call read_chunk_from_field(nrg,1,pver,1,qrs)
      call read_chunk_from_field(nrg,1,pver,1,qrl)
      call read_chunk_from_field(nrg,1,pcnst+pnats,1,qpert)
!
! cld, qcwat, and tcwat are physics things, but have dynamics time levels
!
      n3tmp = n3
      do i=1,ptimelevels
         call read_chunk_from_field(nrg,1,pver,1,cld(1,1,begchunk,n3tmp))
         n3tmp = mod(n3tmp,ptimelevels) + 1
      enddo

      n3tmp = n3
      do i=1,ptimelevels
         call read_chunk_from_field(nrg,1,pver,1,qcwat(1,1,begchunk,n3tmp))
         n3tmp = mod(n3tmp,ptimelevels) + 1
      enddo

      n3tmp = n3
      do i=1,ptimelevels
         call read_chunk_from_field(nrg,1,pver,1,tcwat(1,1,begchunk,n3tmp))
         call read_chunk_from_field(nrg,1,pver,1,lcwat(1,1,begchunk,n3tmp))
         n3tmp = mod(n3tmp,ptimelevels) + 1
      enddo
!
! Comsrf module variables
!
      call initialize_comsrf
      call read_chunk_from_field(nrg,1,1,1,fsnt)
      call read_chunk_from_field(nrg,1,1,1,fsns)
      call read_chunk_from_field(nrg,1,1,1,flnt)
      call read_chunk_from_field(nrg,1,1,1,flns)
      call read_chunk_from_field(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	srfflx_state2d(i)%asdir(:) = tmpfield(:,i)
      end do
      call read_chunk_from_field(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	srfflx_state2d(i)%asdif(:) = tmpfield(:,i)
      end do
      call read_chunk_from_field(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	srfflx_state2d(i)%aldir(:) = tmpfield(:,i)
      end do
      call read_chunk_from_field(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	srfflx_state2d(i)%aldif(:) = tmpfield(:,i)
      end do

      call read_chunk_from_field(nrg,1,1,1,asdirice)
      call read_chunk_from_field(nrg,1,1,1,asdifice)
      call read_chunk_from_field(nrg,1,1,1,aldirice)
      call read_chunk_from_field(nrg,1,1,1,aldifice)
      call read_chunk_from_field(nrg,1,1,1,tsice)

      call read_chunk_from_field(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	srfflx_state2d(i)%lwup(:) = tmpfield(:,i)
      end do
      call read_chunk_from_field(nrg,1,1,1,landfrac)
      call read_chunk_from_field(nrg,1,1,1,landm)
      call read_chunk_from_field(nrg,1,1,1,sgh)
      call read_chunk_from_field(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	srfflx_state2d(i)%ts(:) = tmpfield(:,i)
      end do
      call read_chunk_from_field(nrg,1,plevmx,1,tmpfield3d)
      do i=begchunk,endchunk
	surface_state2d(i)%tssub(:,:) = tmpfield3d(:,:,i)
      end do
      call read_chunk_from_field(nrg,1,1,1,sicthk)
      call read_chunk_from_field(nrg,1,1,1,snowhland)
      call read_chunk_from_field(nrg,1,1,1,snowhice)
      call read_chunk_from_field(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	surface_state2d(i)%flwds(:) = tmpfield(:,i)
      end do
      call read_chunk_from_field(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	surface_state2d(i)%sols(:) = tmpfield(:,i)
      end do
      call read_chunk_from_field(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	surface_state2d(i)%soll(:) = tmpfield(:,i)
      end do
      call read_chunk_from_field(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	surface_state2d(i)%solsd(:) = tmpfield(:,i)
      end do
      call read_chunk_from_field(nrg,1,1,1,tmpfield)
      do i=begchunk,endchunk
	surface_state2d(i)%solld(:) = tmpfield(:,i)
      end do
      call read_chunk_from_field(nrg,1,1,1,trefmxav)
      call read_chunk_from_field(nrg,1,1,1,trefmnav)
      call read_chunk_from_field(nrg,1,1,1,icefrac)

#if ( defined COUP_CSM )
      call initialize_ccsm_msg ()
      call read_restart_ccsm ()
#endif
!
!-----------------------------------------------------------------------
! Read the abs/ems restart dataset if necessary    
!-----------------------------------------------------------------------
!
      call initialize_radbuffer ()
      if (aeres) then
         if (masterproc) then
            read(nrg,iostat=ioerr) pname
            if (ioerr /= 0 ) then
               write (6,*) 'READ ioerror ',ioerr,' on i/o unit = ',nrg
               call endrun
            end if
            call getfil (pname, locfn)
            call opnfil (locfn, nrg2, 'u')
         endif

         call read_chunk_from_field(nrg2, 1, pverp*pverp,1,abstot_3d(1,1,1,begchunk))
         call read_chunk_from_field(nrg2, 1, pver*4,     1,absnxt_3d(1,1,1,begchunk))
         call read_chunk_from_field(nrg2, 1, pverp,      1,emstot_3d(1,1,begchunk))

         if (masterproc) close(nrg2)
      end if
      
      return
   end subroutine read_restart_physics

   character(len=256) function get_abs_restart_filepath ( )
!
! Return the full filepath to the abs-ems restart file
!
     get_abs_restart_filepath = pname
   end function get_abs_restart_filepath

end module restart_physics