MAPL_ESMFStateReadFromFile Subroutine

public subroutine MAPL_ESMFStateReadFromFile(STATE, CLOCK, FILENAME, MPL, HDR, RC)

Arguments

Type IntentOptional Attributes Name
type(ESMF_State), intent(inout) :: STATE
type(ESMF_Clock), intent(in) :: CLOCK
character(len=*), intent(in) :: FILENAME
type(MAPL_MetaComp), intent(inout) :: MPL
logical, intent(in) :: HDR
integer, intent(out), optional :: RC

Calls

MAPL_ESMFStateReadFromFilewArrDescrCreateReaderComm
w
wArrDescrCreateWriterComm
w
wArrDescrSet
w
wESMF_GridGet
w
wESMF_InfoGet
w
wESMF_InfoGetFromHost
w
wESMF_InfoIsPresent
w
wESMF_InfoSet
w
wesmf_stateget
w
wESMF_UtilStringUpperCase
w
wESMF_VMGetCurrent
w
wFREE_FILE
w
wget_factory
w
wget_fname_by_rank
w
wGETFILE
w
wGridManager%make_factory
w
wLogger%warning
w
wMAPL_Am_I_Root
w
wMAPL_Assert
w
wMAPL_AttributeSet
w
wMAPL_CommsBcast
w
wMAPL_GetLogger
w
wMAPL_GetResource
w
wMAPL_GridGet
w
wMAPL_LocStreamGet
w
wMAPL_LocStreamIsAssociated
w
wMAPL_MemFileInquire
w
wMAPL_NCIOGetFileType
w
wMAPL_Return
w
wMAPL_Skip
w
wMAPL_VarRead
w
wMAPL_VarReadNCPar
w
wMAPL_Verify
w
wmpi_barrier
w
wmpi_comm_rank
w
wmpi_file_close
w
wmpi_file_open
w
wmpi_info_create
w
wmpi_info_set
w
wphysical_params_are_equal
w
wWRITE_PARALLEL
w

Called by

proc~~mapl_esmfstatereadfromfile~~CalledByGraph proc~mapl_esmfstatereadfromfile MAPL_ESMFStateReadFromFile proc~mapl_genericinitialize MAPL_GenericInitialize proc~mapl_genericinitialize->proc~mapl_esmfstatereadfromfile proc~mapl_genericrefresh MAPL_GenericRefresh proc~mapl_genericrefresh->proc~mapl_esmfstatereadfromfile proc~mapl_genericrefresh->proc~mapl_genericrefresh proc~mapl_genericstaterestore MAPL_GenericStateRestore proc~mapl_genericstaterestore->proc~mapl_esmfstatereadfromfile proc~mapl_genericstaterestore->proc~mapl_genericstaterestore

Source Code

   subroutine MAPL_ESMFStateReadFromFile(STATE,CLOCK,FILENAME,MPL,HDR,RC)
      type(ESMF_State),                 intent(INOUT) :: STATE
      type(ESMF_Clock),                 intent(IN   ) :: CLOCK
      character(LEN=*),                 intent(IN   ) :: FILENAME
      type(MAPL_MetaComp),              intent(INOUT) :: MPL
      logical,                          intent(IN   ) :: HDR
      integer, optional,                intent(  OUT) :: RC

      character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_ESMFStateReadFromFile"
      integer                               :: status
      integer                               :: UNIT
      character(len=ESMF_MAXSTR)            :: FNAME
      type(ArrDescr)                        :: ArrDes
      integer(kind=MPI_OFFSET_KIND)         :: offset
      integer                               :: dimcount
      integer                               :: info
      logical                               :: AmReader
      logical                               :: FileExists

      type(ESMF_Grid) :: TILEGRID
      type(ESMF_Info) :: infoh
      integer :: COUNTS(2)
      integer :: io_rank
      integer :: attr
      character(len=MPI_MAX_INFO_VAL )      :: romio_cb_read
      logical                               :: bootstrapable
      logical                               :: restartRequired
      logical                               :: nwrgt1, on_tiles
      character(len=ESMF_MAXSTR)            :: rstBoot
      integer                               :: rstReq
      logical                               :: amIRoot
      type (ESMF_VM)                        :: vm
      character(len=1)                      :: firstChar
      character(len=ESMF_MAXSTR)            :: FileType
      integer                               :: isNC4
      logical                               :: isPresent
      character(len=ESMF_MAXSTR) :: grid_type
      logical :: empty, split_restart
      integer :: num_files
      type(ESMF_HConfig) :: hconfig

      _UNUSED_DUMMY(CLOCK)

      ! Check if state is empty. If "yes", simply return
      empty = MAPL_IsStateEmpty(state, _RC)
      if (empty) then
         call warn_empty('Restart '//trim(filename), MPL, _RC)
         _RETURN(ESMF_SUCCESS)
      end if


      call ESMF_InfoGetFromHost(STATE,infoh,RC=STATUS)
      call ESMF_InfoGet(infoh,'MAPL_GridTypeBits',ATTR,RC=STATUS)
      _VERIFY(STATUS)
      on_tiles = IAND(ATTR, MAPL_AttrTile) /= 0

      FNAME = adjustl(FILENAME)
      bootstrapable = .false.

      ! check resource for restart mode (strict would require restarts regardless of the specs)
      call MAPL_GetResource( MPL, rstBoot, Label='MAPL_ENABLE_BOOTSTRAP:', &
           Default='NO', RC=status)
      _VERIFY(status)

      rstBoot = ESMF_UtilStringUpperCase(rstBoot,rc=status)
      _VERIFY(status)

      bootstrapable = (rstBoot /= 'NO')

      firstChar = FNAME(1:1)

      ! get the "required restart" attribute from the state
      call ESMF_InfoGetFromHost(STATE,infoh,RC=STATUS)
      isPresent = ESMF_InfoIsPresent(infoh,'MAPL_RestartRequired',RC=STATUS)
      _VERIFY(STATUS)
      if (isPresent) then
         call ESMF_InfoGet(infoh,'MAPL_RestartRequired',rstReq,RC=STATUS)
         _VERIFY(STATUS)
      else
         rstReq = 0
      end if
      restartRequired = (rstReq /= 0)
         call ESMF_InfoGet(infoh,'MAPL_GridTypeBits',ATTR,RC=STATUS)
         _VERIFY(STATUS)

      call ESMF_VmGetCurrent(vm, rc=status)
      _VERIFY(status)

      amIRoot = MAPL_AM_I_Root(vm)

      nwrgt1 = (mpl%grid%num_readers > 1)

      isNC4 = -100
      if (on_tiles) mpl%grid%split_restart = .false.
      if(INDEX(FNAME,'*') == 0) then
         if (AmIRoot) then
             !if (mpl%grid%split_restart) then
                !hconfig = ESMF_HConfigCreate(filename = trim(filename), _RC)
                !_ASSERT(ESMF_HConfigIsDefined(hconfig,keyString="num_files"),"if input file is split must supply num_files")
                !num_files =  ESMF_HConfigAsI4(hconfig,keystring="num_files",_RC)
                !split_restart = .true.
             !end if
            block
              character(len=:), allocatable :: fname_by_reader
              logical :: fexist
              integer :: i

              FileExists = .false.
              if (mpl%grid%split_restart) then
                 FileExists = .true.
                 do i = 0,mpl%grid%num_readers-1
                    fname_by_reader = get_fname_by_rank(trim(fname), i)
                    inquire(FILE = trim(fname_by_reader), EXIST=fexist)
                    FileExists = FileExists .and. fexist
                 enddo
                 if (FileExists) then
                    ! just pick one face to deduce filetype, only in root
                    call MAPL_NCIOGetFileType(trim(fname_by_reader),isNC4,rc=status)
                    _VERIFY(status)
                 endif
                 deallocate(fname_by_reader)
              else
                 inquire(FILE = FNAME, EXIST=FileExists)
                 if (FileExists) then
                    call MAPL_NCIOGetFileType(FNAME,isNC4,rc=status)
                    _VERIFY(status)
                 endif
              endif
            end block
         end if
         call MAPL_CommsBcast(vm,split_restart,n=1,ROOT=MAPL_Root,_RC)

         call MAPL_CommsBcast(vm, fileExists, n=1, ROOT=MAPL_Root, _RC)
         call MAPL_CommsBcast(vm, isNC4, n=1, ROOT=MAPL_Root, _RC)
         !if (split_restart) then
            !call MAPL_CommsBcast(vm, num_files,  n=1, ROOT=MAPL_Root, _RC)
            !call MAPL_CommsBcast(vm, split_restart, n=1, ROOT=MAPL_Root, _RC)
            !mpl%grid%num_readers = num_files
            !mpl%grid%split_restart = split_restart
         !end if

         if (FileExists) then
            if (isNC4 == 0) then
               filetype = 'pnc4'
            else
               if (.not.nwrgt1) then
                  filetype='binary'
               else
                  filetype='pbinary'
               end if
            end if
         end if
      else
         FileExists = MAPL_MemFileInquire(NAME=FNAME)
      end if
      if (.not. FileExists) then
         if (.not. bootstrapable .or. restartRequired) then
            call WRITE_PARALLEL('ERROR: Required restart '//trim(FNAME)//' does not exist!')
            _RETURN(ESMF_FAILURE)
         else
            if (len_trim(FNAME) > 0) call WRITE_PARALLEL("Bootstrapping " // trim(FNAME))
            _RETURN(ESMF_SUCCESS)
         end if
      end if
      ! Open file
      !----------

      !   Test if is a memory unit, if not must be real file
      if (index(filename,'*') /= 0) then
         !ALT: this is a special, MAPL_Write2RAM type
         filetype = 'binary'
      end if

      if (filetype == 'binary' .or. filetype == 'BINARY') then
         UNIT = GETFILE(FNAME, form="unformatted", all_pes=.true., rc=status)
         _VERIFY(status)

      elseif(filetype=="formatted".or.filetype=="FORMATTED") then
         UNIT = GETFILE(FNAME, form="formatted", all_pes=.true., rc=status)
         _VERIFY(status)

      elseif(filetype=='pbinary') then
         call ESMF_GridGet(MPL%GRID%ESMFGRID, dimCount=dimCount, RC=status)
         _VERIFY(status)

         TILE: if (on_tiles) then
            _ASSERT(IAND(ATTR, MAPL_AttrGrid) == 0,'needs informative message') ! no hybrid allowed
            _ASSERT(MAPL_LocStreamIsAssociated(MPL%LOCSTREAM,RC=status),'needs informative message')

            call MAPL_LocStreamGet(mpl%LocStream, TILEGRID=TILEGRID, RC=status)
            _VERIFY(status)

            call MAPL_GridGet(TILEGRID, globalCellCountPerDim=COUNTS, RC=status)
            _VERIFY(status)

            call ArrDescrSet(arrdes,                   &
                 i1 = mpl%grid%i1, in = mpl%grid%in,   &
                 j1 = mpl%grid%j1, jn = mpl%grid%jn,   &
                 im_world = COUNTS(1),                 &
                 jm_world = COUNTS(2)                  )
            call ArrDescrCreateReaderComm(arrdes,mpl%grid%comm,mpl%grid%num_readers,_RC)
            call ArrDescrSet(arrdes, ioscattercomm = mpl%grid%comm )

         else

            call ArrDescrSet(arrdes, offset, &
                 i1 = mpl%grid%i1, in = mpl%grid%in,     &
                 j1 = mpl%grid%j1, jn = mpl%grid%jn,     &
                 im_world = mpl%grid%im_world,           &
                 jm_world = mpl%grid%jm_world)
            call ArrDescrCreateReaderComm(arrdes,mpl%grid%comm,mpl%grid%num_readers,_RC)

         end if TILE

         UNIT=-999

         offset = 0
         AmReader = arrdes%readers_comm/=MPI_COMM_NULL
         if (AmReader) then
            call MPI_Info_create(info, status)
            _VERIFY(status)
            ! This need to be tested on GPFS and Lustre to determine best performance
            call MAPL_GetResource(MPL, romio_cb_read, Label="ROMIO_CB_READ:", default="automatic", RC=status)
            _VERIFY(status)
            call MPI_Info_set(info, "romio_cb_read", trim(romio_cb_read), status)
            _VERIFY(status)
            call MPI_COMM_RANK(mpl%grid%readers_comm, io_rank, status)
            _VERIFY(status)
            if (io_rank == 0) then
               print *,'Using parallel IO for reading file: ',trim(FNAME)
            end if
            call MPI_Barrier(mpl%grid%readers_comm, status)
            _VERIFY(status)
            call MPI_FILE_OPEN(mpl%grid%readers_comm, FNAME, MPI_MODE_RDONLY, &
                 MPI_INFO_NULL, UNIT, status)
            _VERIFY(status)
            call MPI_Barrier(mpl%grid%readers_comm, status)
            _VERIFY(status)
         else
            UNIT=0
         endif ! AmReader

      else if (filetype=='pnc4') then
#ifndef H5_HAVE_PARALLEL
         if (nwrgt1) then
            print*,trim(Iam),': num_readers and number_writers must be 1 with pnc4 unless HDF5 was built with -enable-parallel'
            _FAIL('needs informative message')
         end if
#endif
         PNC4_TILE: if (on_tiles) then
            _ASSERT(IAND(ATTR, MAPL_AttrGrid) == 0,'needs informative message') ! no hybrid allowed
            call ArrDescrSetNCPar(arrdes,MPL,tile=.TRUE.,num_readers=mpl%grid%num_readers,RC=status)
            _VERIFY(status)
         else
            call ESMF_InfoGetFromHost(MPL%GRID%ESMFGRID,infoh,rc=status)
            isPresent = ESMF_InfoIsPresent(infoh,'GridType',rc=status)
            _VERIFY(status)
            if (isPresent) then
               call ESMF_InfoGet(infoh,'GridType',grid_type,rc=status)
               _VERIFY(status)
            end if
            _ASSERT(grid_is_consistent(grid_type, fname), "grid in the file is different from app's grid")
            call ArrDescrSetNCPar(arrdes,MPL,num_readers=mpl%grid%num_readers,RC=status)
            _VERIFY(status)
         end if PNC4_TILE
         if (mapl_am_i_root())print*,'Using parallel NetCDF to read file: ',trim(FNAME)
      else
         UNIT=0
      end if

      ! Skip Header
      !------------

      if (HDR .and. filetype/='pnc4') then
         if(filetype=='pbinary') then
            offset = 16*4 ! + aks and bks ????
         else
            call MAPL_Skip(UNIT, MPL%GRID%LAYOUT, COUNT=2, RC=status)
            _VERIFY(status)
         endif
      end if

      ! Read data
      ! ---------

      if(filetype=='pbinary') then
         call ArrDescrSet(arrdes, offset)
         arrdes%Ycomm = mpl%grid%Ycomm
         call MAPL_VarRead(UNIT=UNIT, STATE=STATE, arrdes=arrdes, RC=status)
         _VERIFY(status)
         if (AmReader) then
            call MPI_Barrier(mpl%grid%readers_comm, status)
            _VERIFY(status)
            call MPI_FILE_CLOSE(UNIT, status)
            _VERIFY(status)
            call MPI_Barrier(mpl%grid%readers_comm, status)
            _VERIFY(status)
         endif
      elseif(filetype=='pnc4') then

         call MAPL_VarReadNCPar(fname,STATE,ArrDes,bootstrapable,RC=status)
         _VERIFY(status)

      elseif(UNIT/=0) then
         call MAPL_VarRead(UNIT=UNIT, STATE=STATE, bootstrapable=bootstrapable, RC=status)
         _VERIFY(status)
         call FREE_FILE(UNIT)
      else
         status = -1 ! not yet
         _VERIFY(status)
      endif

      call ESMF_InfoGetFromHost(STATE,infoh,RC=STATUS)
      call ESMF_InfoSet(infoh,key='MAPL_Initialized',value=.TRUE.,RC=STATUS)
      _VERIFY(STATUS)

      call MAPL_AttributeSet(STATE, NAME="MAPL_InitStatus", VALUE=MAPL_InitialRestart, RC=status)
      _VERIFY(status)

      _RETURN(ESMF_SUCCESS)

     contains
       function grid_is_consistent(grid_type, fname) result( consistent)
         logical :: consistent
         character(*), intent(in) :: grid_type
         character(*), intent(in) :: fname
         !note this only works for geos cubed-sphere restarts currently because of
         !possible insufficent metadata in the other restarts to support the other grid factories
         class(AbstractGridFactory), pointer :: app_factory
         class (AbstractGridFactory), allocatable :: file_factory
         character(len=:), allocatable :: fname_by_face
         logical :: fexist

         consistent = .True.
         if (trim(grid_type) == 'Cubed-Sphere') then
            app_factory => get_factory(MPL%GRID%ESMFGRID)
            ! at this point, arrdes%read_restart_by_face is not initialized
            ! pick the first face
            fname_by_face = get_fname_by_rank(trim(fname), 1)
            inquire(FILE = trim(fname_by_face), EXIST=fexist)
            if(fexist) then
               allocate(file_factory,source=grid_manager%make_factory(fname_by_face))
            else
               allocate(file_factory,source=grid_manager%make_factory(trim(fname)))
            endif
            consistent = file_factory%physical_params_are_equal(app_factory)
         end if
       end function

   end subroutine MAPL_ESMFStateReadFromFile