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