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
integer :: COUNTS(2)
integer :: io_nodes, io_rank
integer :: attr
character(len=MPI_MAX_INFO_VAL ) :: romio_cb_read
logical :: bootstrapable
logical :: restartRequired
logical :: nwrgt1
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
_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
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_AttributeGet(STATE, NAME="MAPL_RestartRequired", isPresent=isPresent, RC=status)
_VERIFY(status)
if (isPresent) then
call ESMF_AttributeGet(STATE, NAME="MAPL_RestartRequired", VALUE=rstReq, RC=status)
_VERIFY(status)
else
rstReq = 0
end if
restartRequired = (rstReq /= 0)
call ESMF_VmGetCurrent(vm, rc=status)
_VERIFY(status)
amIRoot = MAPL_AM_I_Root(vm)
nwrgt1 = (mpl%grid%num_readers > 1)
if(INDEX(FNAME,'*') == 0) then
if (AmIRoot) then
block
character(len=:), allocatable :: fname_by_face
logical :: fexist
integer :: i
FileExists = .false.
if (mpl%grid%read_restart_by_face) then
FileExists = .true.
do i = 1,6 ! 6 faces
fname_by_face = get_fname_by_face(trim(fname), i)
inquire(FILE = trim(fname_by_face), 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_face),isNC4,rc=status)
_VERIFY(status)
endif
deallocate(fname_by_face)
endif
end block
if( .not. FileExists) then
inquire(FILE = FNAME, EXIST=FileExists)
if (FileExists) then
call MAPL_NCIOGetFileType(FNAME,isNC4,rc=status)
_VERIFY(status)
endif
endif
end if
call MAPL_CommsBcast(vm, fileExists, n=1, ROOT=MAPL_Root, rc=status)
_VERIFY(status)
if (FileExists) then
!if (AmIRoot) then
! call MAPL_NCIOGetFileType(FNAME,isNC4,rc=status)
! _VERIFY(status)
!end if
call MAPL_CommsBcast(vm,isNC4,n=1,ROOT=MAPL_Root,rc=status)
_VERIFY(status)
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
! if (ignoreEOF) then
! if (filetype == 'pbinary' .or. filetype == 'PBINARY') then
! filetype = 'binary'
! 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)
AmReader = mpl%grid%readers_comm/=MPI_COMM_NULL
call ESMF_AttributeGet(STATE, NAME = "MAPL_GridTypeBits", VALUE=ATTR, RC=status)
_VERIFY(status)
TILE: if(IAND(ATTR, MAPL_AttrTile) /= 0) 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, &
readers_comm = mpl%grid%readers_comm, &
ioscattercomm = mpl%grid%comm )
if(AmReader) then
call MPI_COMM_SIZE(mpl%grid%readers_comm, io_nodes, status)
_VERIFY(status)
call MPI_COMM_RANK(mpl%grid%readers_comm, io_rank, status)
_VERIFY(status)
endif
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) )
else
if (AmReader) then
call MPI_COMM_SIZE(mpl%grid%readers_comm, io_nodes, status)
_VERIFY(status)
call MPI_COMM_RANK(mpl%grid%readers_comm, io_rank, status)
_VERIFY(status)
endif
call ArrDescrSet(arrdes, offset, &
readers_comm = mpl%grid%readers_comm, &
ioscattercomm = mpl%grid%ioscattercomm, &
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)
end if TILE
UNIT=-999
offset = 0
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)
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
AmReader = mpl%grid%readers_comm/=MPI_COMM_NULL
call ESMF_AttributeGet(STATE, NAME = "MAPL_GridTypeBits", VALUE=ATTR, RC=status)
_VERIFY(status)
PNC4_TILE: if(IAND(ATTR, MAPL_AttrTile) /= 0) 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_AttributeGet(MPL%GRID%ESMFGRID,'GridType',isPresent=isPresent,rc=status)
_VERIFY(status)
if (isPresent) then
call ESMF_AttributeGet(MPL%GRID%ESMFGRID,'GridType',value=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 (mpl%grid%readers_comm/=MPI_COMM_NULL) then
call MPI_COMM_RANK(mpl%grid%readers_comm, io_rank, status)
_VERIFY(status)
if (io_rank == 0) then
print *,'Using parallel NetCDF to read file: ',trim(FNAME)
end if
endif
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_AttributeSet(STATE,'MAPL_Initialized', .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_face(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