! $Id: ESMF_ArrayIO.cppF90,v 1.45 2011/07/08 18:42:00 theurich Exp $ ! ! Earth System Modeling Framework ! Copyright 2002-2011, University Corporation for Atmospheric Research, ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics ! Laboratory, University of Michigan, National Centers for Environmental ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, ! NASA Goddard Space Flight Center. ! Licensed under the University of Illinois-NCSA License. ! !============================================================================== ^define ESMF_FILENAME "ESMF_ArrayIO.F90" !============================================================================== #if 0 !============================================================================== ! TKR overloading macros, limited to those interfaces implemented by PIO #endif ^define PIO_TKR #include "ESMF_TypeKindRankMacros.hcppF90" !============================================================================== ! ESMF ArrayIO module module ESMF_ArrayIOMod ! !============================================================================== ! ! This file contains the ArrayWrite() and ArrayRead() methods. ! !------------------------------------------------------------------------------ ! INCLUDES ^include "ESMF.h" !------------------------------------------------------------------------------ !BOPI ! !MODULE: ESMF_ArrayIOMod - Provide TKR overloading for ESMF_ArrayWrite() ! and ESMF_ArrayRead() ! ! !DESCRIPTION: ! ! The code in this file is part of the {\tt ESMF\_Array} class Fortran API. ! ! !------------------------------------------------------------------------------ ! !USES: use ESMF_UtilTypesMod ! ESMF utility types use ESMF_InitMacrosMod ! ESMF initializer macros use ESMF_BaseMod ! ESMF base class use ESMF_LogErrMod ! ESMF error handling use ESMF_LocalArrayMod use ESMF_ArraySpecMod use ESMF_VMMod use ESMF_DELayoutMod use ESMF_DistGridMod use ESMF_RHandleMod use ESMF_F90InterfaceMod ! ESMF Fortran-C++ interface helper ! class sub modules use ESMF_ArrayCreateMod ! contains the ESMF_Array derived type definition use ESMF_ArrayGetMod ^ifdef ESMF_PIO use ESMFPIOMod use ESMFPIO_pio_types ^endif implicit none ^ifdef ESMF_PIO !------------------------------------------------------------------------------ ! !PRIVATE TYPES: private !------------------------------------------------------------------------------ ! ! !PUBLIC MEMBER FUNCTIONS: TypeKindRankPublicMacro(ArrayReadIntl) TypeKindRankPublicMacro(ArrayWriteIntl) !EOPI !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ ! The following line turns the CVS identifier string into a printable variable. character(*), parameter, private :: version = & '$Id: ESMF_ArrayIO.cppF90,v 1.45 2011/07/08 18:42:00 theurich Exp $' !============================================================================== ! -------------------------- ESMF-public method ------------------------------- !BOPI ! !DESCRIPTION: ! This interface provides a single entry point for the various ! types of ! {\tt ESMF\_ArrayWrite} and {\tt ESMF\_ArrayRead} functions. !EOPI !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ ! Internally used subroutines that only exist if ESMF_PIO is defined. ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_checkpioerr" subroutine ESMF_checkpioerr(ierr, localPet, file, line, str1, str2, rc) implicit none integer,intent(in) :: ierr integer,intent(in) :: localPet character(len=*),intent(in) :: file integer,intent(in) :: line character(len=*),optional,intent(in) :: str1 character(len=*),optional,intent(in) :: str2 integer,intent(out) :: rc character(len=256) lstr1 character(len=256) lstr2 character(len=*),parameter :: myname_="ESMF_checkpioerr" integer :: local_rc local_rc = ESMF_SUCCESS rc = ESMF_SUCCESS lstr1 = "" if (present(str1)) then lstr1 = trim(str1) endif lstr2 = trim(lstr1) if (present(str2)) then lstr2 = trim(str2) endif if(ierr /= PIO_noerr) then write(*,*) trim(myname_),":: ERROR on my_task=",localPet," ierr=",ierr," ",trim(lstr1) local_rc = ESMF_FAILURE if (ESMF_LogFoundError(local_rc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return !! call piodie(file,line,trim(lstr2)) endif end subroutine ESMF_checkpioerr subroutine WriteHeader(FileObj,vname,puttag,nxyz,dimid_xyz,spacedim) implicit none type (File_desc_t), intent(inout) :: FileObj integer, intent(in) :: spacedim integer, intent(in) :: nxyz(spacedim) integer, intent(out) :: dimid_xyz(spacedim) character(*) :: vname integer, intent(in) :: puttag !(0 put att; 1 no att) character(len=80) :: text character(len=3) :: cdim integer :: itmp,iostat,i if (puttag.eq.0) then iostat = PIO_put_att(FileObj,pio_global,"title","ESMF_Array") if(iostat /= pio_noerr) then write(*,*) "testPIO: Error writing TITLE to netCDF file" endif iostat = PIO_put_att(FileObj,pio_global,"ivalue", 4) if(iostat /= pio_noerr) then write(*,*) "testPIO: Error writing iVALUE to netCDF file" endif endif ! puttag itmp = len_trim(vname) text = vname text(itmp+1:itmp+4) = "_dim" do i = 1,spacedim write(cdim,"(i3.3)") i text(itmp+5:itmp+8) = cdim iostat = PIO_def_dim(FileObj,trim(text),nxyz(i),dimid_xyz(i)) if(iostat /= pio_noerr) then write(*,*) "testPIO: Error inquiring dimension",i," for netCDF file" endif enddo end subroutine WriteHeader #define ArrayWriteIntlDoc() \ ! -------------------------- ESMF-public method ----------------------------- @\ !BOPI @\ ! @\ ! !IROUTINE: ESMF_ArrayWriteIntl - Write an ESMF_Array via PIO @\ ! @\ ! !INTERFACE: @\ ! subroutine ESMF_ArrayWriteIntl(array, file, varname, appd_internal, piofmt, rc) @\ ! @\ ! !ARGUMENTS: @\ ! type(ESMF_Array), intent(in) :: array @\ ! character(*), intent(in) :: file @\ ! character(*), intent(in) :: varname @\ ! logical, intent(in) :: appd_internal @\ ! character(*), intent(in) :: piofmt @\ ! integer, intent(out), optional :: rc @\ ! @\ ! @\ ! !DESCRIPTION: @\ ! Write the array data in the {ESMF\_Array} object to file through PIO. @\ ! @\ ! Limitation: @\ ! Assume 1 DE per Pet @\ ! @\ ! The arguments are: @\ ! \begin{description} @\ ! \item[array] @\ ! The {\tt ESMF\_Array} object that contains the data to be written. @\ ! \item[file] @\ ! The name of the output file in which Fortran array is written to. @\ ! \item[variableName] @\ ! Variable name written in output file @\ ! \item[{[appd_internal]}] @\ ! A logical tag indicates file already existed when it is .true. @\ ! The new data (with attributes) will be written to the existed file. ! \item[piofmt] @\ ! The IO format supported are "bin", "pnc", and "snc". @\ ! \item[{[rc]}] @\ ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. @\ ! \end{description} @\ ! @\ !EOPI @\ !---------------------------------------------------------------------------- @\ #define ArrayWriteIntlMacro(mtype, mtypekind, mrank, mdim, mlen, mrng, mloc) \ ! -------------------------- ESMF-public method ----------------------------- @\ ^undef ESMF_METHOD @\ ^define ESMF_METHOD "ESMF_ArrayWriteIntl" @\ subroutine ESMF_ArrayWriteIntl##mrank##D##mtypekind(array, file, varname, appd_internal, time, piofmt, rc) @\ @\ type(ESMF_Array), intent(in) :: array @\ character(*), intent(in) :: file @\ character(*), intent(in) :: varname @\ logical, intent(in) :: appd_internal @\ integer, intent(in) :: time @\ character(*), intent(in) :: piofmt @\ integer, intent(out), optional :: rc @\ @\ ! ESMF VARIABLES @\ type(ESMF_VM) :: vm_opt @\ integer :: pioDofCount @\ integer, allocatable :: pioDofList(:) @\ integer :: petCount,localPet,mpic @\ mtype (ESMF_KIND_##mtypekind),pointer,dimension(mdim) :: farraywr @\ integer, allocatable :: timestart(:), timecount(:) @\ integer :: dimC, time_len, dimid_time @\ integer, allocatable :: gDimsIndex(:), dimid_xyz(:) @\ integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) @\ logical :: isfilepresent @\ @\ ! PIO VARIABLES: @\ type (iosystem_desc_t) :: PIOSYS @\ type (File_desc_t) :: FileObj @\ type(var_desc_t) :: vard @\ type (IO_desc_t) :: IOdesc @\ integer :: num_aggregator @\ integer :: stride, base, num_iotasks, rearr_type @\ integer(kind=PIO_OFFSET) :: one @\ integer :: basepiotype, fmtiotype @\ integer :: pioerr @\ @\ ! OTHER VARIABLES: @\ integer :: localrc ! local return code @\ integer :: i @\ real (ESMF_KIND_r8) :: st,et,dt_write ! start/end times for timing @\ @\ ! Initialize return code @\ localrc = ESMF_RC_NOT_IMPL @\ if (present(rc)) rc = ESMF_RC_NOT_IMPL @\ @\ ! Check init status of arguments @\ ESMF_INIT_CHECK_DEEP(ESMF_ArrayGetInit, array, rc) @\ @\ ! Obtain VM info @\ call ESMF_VMGetCurrent(vm_opt, rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ call ESMF_VMGet(vm_opt, mpiCommunicator=mpic, localPet=localPet, & @\ petCount=petCount, rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ @\ !-------------------------------- @\ ! Obatin the pioDofList @\ !-------------------------------- @\ call ESMF_ArrayConstructPioDof(array, localDe=0, & @\ pioDofCount=pioDofCount, rc=rc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ allocate(pioDofList(pioDofCount)) @\ call ESMF_ArrayConstructPioDof(array, localDe=0, & @\ pioDofList=pioDofList, rc=rc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ @\ !------------------------------------------- @\ ! Get array dimension counts from ESMF Array @\ !------------------------------------------- @\ call ESMF_ArrayGet(array, dimCount=dimC, rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ allocate (dimid_xyz(dimC)) @\ allocate (gDimsIndex(dimC)) @\ allocate ( minIndexPTile(dimC,1) ) @\ allocate ( maxIndexPTile(dimC,1) ) @\ allocate ( timecount(dimC+1) ) @\ allocate ( timestart(dimC+1) ) @\ call ESMF_ArrayGet(array, localDe=0, farrayPtr=farraywr, rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ call ESMF_ArrayGet(array, maxIndexPTile=maxIndexPTile, & @\ minIndexPTile=minIndexPTile, rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ @\ do i=1,dimC @\ gDimsIndex(i) = maxIndexPTile(i,1)-minIndexPTile(i,1)+1 @\ timecount(i) = gDimsIndex(i) @\ enddo @\ timestart=1 @\ timecount(dimC+1) = 1 @\ time_len = 0 @\ @\ @\ !-------------------------------------- @\ ! parallel IO subsystem input @\ !-------------------------------------- @\ num_iotasks = petCount ! Same as Compute nodes. @\ num_aggregator = 1 ! For MPI-IO @\ stride = 1 ! IO stride @\ base = 0 ! the CPU (myID) associated with striding @\ ! non-zero, will off load the master @\ rearr_type = 2 ! no rearrangement=0 (use box[2] they said) @\ @\ !-------------------------------------- @\ ! Initalizes the parallel IO subsystem @\ !-------------------------------------- @\ call PIO_init(localPet, mpic, num_iotasks, num_aggregator, stride, & @\ rearr_type, PIOSYS, base) @\ !TODO: need error checking here! @\ @\ !------------------------------------------------------- @\ ! Explain the distributed array decomposition to PIOlib @\ !------------------------------------------------------- @\ select case (ESMF_TYPEKIND_##mtypekind%dkind) @\ case(ESMF_TYPEKIND_I4%dkind) @\ basepiotype=PIO_int @\ case(ESMF_TYPEKIND_R4%dkind) @\ basepiotype=PIO_real @\ case(ESMF_TYPEKIND_R8%dkind) @\ basepiotype=PIO_double @\ case default @\ call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg="Unsupported typekind", & @\ ESMF_CONTEXT, rcToReturn=rc) @\ return @\ end select @\ @\ !------------------------------------------------------- @\ ! Define the IO file type @\ !------------------------------------------------------- @\ select case (trim(piofmt)) @\ case('bin') @\ fmtiotype = iotype_pbinary @\ case('pnc') @\ fmtiotype = iotype_pnetcdf @\ case('snc') @\ fmtiotype = iotype_netcdf @\ case('nc4p') @\ fmtiotype = PIO_iotype_netcdf4p @\ case('nc4c') @\ fmtiotype = PIO_iotype_netcdf4c @\ case default @\ call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg="Unsupported IO format", & @\ ESMF_CONTEXT, rcToReturn=rc) @\ return @\ end select @\ @\ call PIO_initDecomp(PIOSYS,basepiotype, gDimsIndex, pioDofList, IOdesc) @\ !TODO: need error checking here! @\ @\ !------------ @\ ! Open file{s} @\ !------------ @\ ! @\ ! Check if a file exists @\ Inquire (file=trim(file), exist=isfilepresent) @\ call ESMF_VMBarrier(vm_opt, rc=localrc) @\ ! @\ if (appd_internal .and. piofmt.ne.'bin') then @\ ! For bundle append @\ pioerr = PIO_OpenFile(PIOSYS,FileObj,fmtiotype,trim(file),mode=PIO_write) @\ pioerr = PIO_redef(FileObj) @\ call WriteHeader(FileObj,varname,1,gDimsIndex,dimid_xyz,dimC) @\ else @\ if(isfilepresent .and. time.ge.0) then ! This is for "timeslice" @\ pioerr = PIO_OpenFile(PIOSYS,FileObj,fmtiotype,trim(file), & @\ mode=PIO_write) @\ pioerr = PIO_inq_dimid(FileObj,'time', dimid_time) @\ pioerr = PIO_inq_dimlen(FileObj, dimid_time, time_len) @\ pioerr = PIO_inq_varid(FileObj, trim(varname), vard) @\ else @\ ! For beginning and creating a file @\ pioerr = PIO_CreateFile(PIOSYS,FileObj,fmtiotype,trim(file),PIO_CLOBBER) @\ if(piofmt .ne. 'bin') then @\ call WriteHeader(FileObj,varname,0,gDimsIndex,dimid_xyz,dimC) @\ endif @\ ! To do below because of the macro limitation. @\ ^ifdef ESMF_NETCDF @\ if (time.gt.0) pioerr = PIO_def_dim(FileObj,'time',PIO_unlimited,dimid_time) @\ ^elif ESMF_PNETCDF @\ if (time.gt.0) pioerr = PIO_def_dim(FileObj,'time',PIO_unlimited,dimid_time) @\ ^endif @\ endif @\ endif @\ !TODO: need error checking here! @\ @\ !----------------------------------- @\ ! for the single record file @\ !----------------------------------- @\ ! Output are dimid_x,dimid_y,dimid_z @\ @\ if(piofmt .ne. 'bin') then @\ localrc = 1 @\ ! Comes in when append mode or file does not exist @\ ! However, do not come in when 2nd time of time slice @\ if(time.gt.0 .and. isfilepresent) then @\ ! skip @\ else @\ if(time.gt.0) then @\ pioerr = PIO_def_var(FileObj,varname,basepiotype, (/dimid_xyz,dimid_time/),vard) @\ else @\ pioerr = PIO_def_var(FileObj,varname,basepiotype, dimid_xyz ,vard) @\ endif @\ call ESMF_checkpioerr(pioerr, localPet, & @\ __FILE__, & @\ __LINE__, " defvar", rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ pioerr = PIO_enddef(FileObj) @\ !TODO: need error checking here! @\ endif @\ endif @\ @\ if(time.gt.0) then @\ ! Set Frame to '1' in the PIO descriptor file @\ timestart(dimC+1) = time_len + 1 @\ one = timestart(dimC+1) @\ call PIO_SetFrame(vard,one) @\ endif @\ @\ !------------------------- @\ ! Time the parallel write @\ !------------------------- @\ dt_write = 0. @\ ! call MPI_Barrier(mpic,rc) @\ ! st = MPI_Wtime() @\ call PIO_write_darray(FileObj,vard, IOdesc, farraywr, pioerr) @\ call ESMF_checkpioerr(pioerr, localPet, & @\ __FILE__, & @\ __LINE__, " write_darray",rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ ! et = MPI_Wtime() @\ @\ call PIO_CloseFile(FileObj) @\ !TODO: need error checking here! @\ ! call MPI_Barrier(mpic,localrc) @\ ! dt_write = dt_write + (et - st) @\ !@\ !!!!!!!!!!!!!!!!!!!!!!!!!!! @\ @\ ! Maximum read/write times @\ ! if(localPet.eq.0) write(*,*) "Time for write:", dt_write @\ @\ call pio_freedecomp(PIOSYS, IOdesc) @\ !TODO: need error checking here! @\ call pio_finalize (PIOSYS, rc) @\ !TODO: need error checking here! @\ deallocate (pioDofList) @\ deallocate (dimid_xyz) @\ deallocate (gDimsIndex) @\ deallocate (minIndexPTile) @\ deallocate (maxIndexPTile) @\ @\ ! Return successfully @\ if (present(rc)) rc = ESMF_SUCCESS @\ @\ end subroutine ESMF_ArrayWriteIntl##mrank##D##mtypekind @\ !---------------------------------------------------------------------------- @\ TypeKindRankDeclarationMacro(ArrayWriteIntl) #define ArrayReadIntlDoc() \ ! -------------------------- ESMF-public method ----------------------------- @\ !BOPI @\ ! @\ ! !IROUTINE: ESMF_ArrayReadIntl - Read an ESMF_Array via PIO @\ ! @\ ! !INTERFACE: @\ ! subroutine ESMF_ArrayReadIntl(array, file, varname, time, piofmt, rc) @\ ! @\ ! !ARGUMENTS: @\ ! type(ESMF_Array), intent(inout) :: array @\ ! character(*), intent(in) :: file @\ ! character(*), intent(in) :: varname @\ ! integer, intent(in) :: time @\ ! character(*), intent(in) :: piofmt @\ ! integer, intent(out), optional :: rc @\ ! @\ ! @\ ! !DESCRIPTION: @\ ! Read array data from file via PIO and put it into the {ESMF\_Array} object. @\ ! @\ ! Limitation: @\ ! Assume 1 DE per Pet @\ ! @\ ! The arguments are: @\ ! \begin{description} @\ ! \item[array] @\ ! The {\tt ESMF\_Array} object through which the read data is returned. @\ ! \item[file] @\ ! The name of the output file in which array data is read from. @\ ! \item[varname] @\ ! Variable name in netcdf file @\ ! \item[time] @\ ! The slice (time) of the variable to be read from file @\ ! \item[piofmt] @\ ! The IO format supported are "bin", "pnc", and "snc". @\ ! \item[{[rc]}] @\ ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. @\ ! \end{description} @\ ! @\ !EOPI @\ !---------------------------------------------------------------------------- @\ #define ArrayReadIntlMacro(mtype, mtypekind, mrank, mdim, mlen, mrng, mloc) \ ! -------------------------- ESMF-public method ----------------------------- @\ ^undef ESMF_METHOD @\ ^define ESMF_METHOD "ESMF_ArrayReadIntl" @\ subroutine ESMF_ArrayReadIntl##mrank##D##mtypekind(array, file, varname, time, piofmt, rc) @\ @\ type(ESMF_Array), intent(inout) :: array @\ character(*), intent(in) :: file @\ character(*), intent(in) :: varname @\ integer, intent(in) :: time @\ character(*), intent(in) :: piofmt @\ integer, intent(out), optional :: rc @\ @\ ! ESMF VARIABLES @\ type(ESMF_VM) :: vm_opt @\ type(ESMF_TypeKind_Flag) :: typekind @\ integer :: pioDofCount @\ integer, allocatable :: pioDofList(:) @\ integer :: petCount,localPet,mpic @\ mtype (ESMF_KIND_##mtypekind),pointer,dimension(mdim) :: farrayrd @\ integer :: dimC, time_len, dimid_time @\ integer, allocatable :: gDimsIndex(:) @\ integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) @\ @\ ! PIO VARIABLES: @\ type (iosystem_desc_t) :: PIOSYS @\ type (File_desc_t) :: FileObj @\ type(var_desc_t) :: vard @\ type (IO_desc_t) :: IOdesc @\ integer :: num_aggregator @\ integer :: stride, base, num_iotasks, rearr_type @\ integer(kind=PIO_OFFSET) :: frame @\ integer :: basepiotype, fmtiotype @\ integer :: pioerr @\ @\ ! OTHER VARIABLES: @\ integer :: localrc ! local return code @\ integer :: i @\ real (ESMF_KIND_r8) :: st,et,dt_read ! start/end times for timing @\ @\ ! Initialize return code @\ localrc = ESMF_RC_NOT_IMPL @\ if (present(rc)) rc = ESMF_RC_NOT_IMPL @\ @\ ! Check init status of arguments @\ ESMF_INIT_CHECK_DEEP(ESMF_ArrayGetInit, array, rc) @\ @\ ! Obtain localPet @\ call ESMF_VMGetCurrent(vm_opt, rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ call ESMF_VMGet(vm_opt, mpiCommunicator=mpic, localPet=localPet, & @\ petCount=petCount, rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ @\ !-------------------------------- @\ ! Obatin the DOF from (pioDofList) @\ !-------------------------------- @\ call ESMF_ArrayConstructPioDof(array, localDe=0, & @\ pioDofCount=pioDofCount, rc=rc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ allocate(pioDofList(pioDofCount)) @\ call ESMF_ArrayConstructPioDof(array, localDe=0, & @\ pioDofList=pioDofList, rc=rc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ @\ @\ !-------------------------------- @\ ! Get array typekind from ESMF array @\ !-------------------------------- @\ call ESMF_ArrayGet(array, dimCount=dimC, rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ allocate (gDimsIndex(dimC)) @\ allocate ( minIndexPTile(dimC,1) ) @\ allocate ( maxIndexPTile(dimC,1) ) @\ @\ call ESMF_ArrayGet(array, localDe=0, farrayPtr=farrayrd, rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ call ESMF_ArrayGet(array, maxIndexPTile=maxIndexPTile, & @\ minIndexPTile=minIndexPTile, rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ @\ do i=1,dimC @\ gDimsIndex(i) = maxIndexPTile(i,1)-minIndexPTile(i,1)+1 @\ enddo @\ @\ !-------------------------------------- @\ ! parallel IO subsystem input @\ !-------------------------------------- @\ num_iotasks = petCount ! Same as Compute nodes. @\ num_aggregator = 1 ! For MPI-IO @\ stride = 1 ! IO stride @\ base = 0 ! the CPU (myID) associated with striding @\ ! non-zero, will off load the master @\ rearr_type = 2 ! no rearrangement=0 (use box[2] they said) @\ @\ !-------------------------------------- @\ ! Initalizes the parallel IO subsystem @\ !-------------------------------------- @\ call PIO_init(localPet, mpic, num_iotasks, num_aggregator, stride, & @\ rearr_type, PIOSYS, base) @\ !TODO: need error checking here! @\ @\ !------------------------------------------------------- @\ ! Explain the distributed array decomposition to PIOlib @\ !------------------------------------------------------- @\ select case (ESMF_TYPEKIND_##mtypekind%dkind) @\ case(ESMF_TYPEKIND_I4%dkind) @\ basepiotype=PIO_int @\ case(ESMF_TYPEKIND_R4%dkind) @\ basepiotype=PIO_real @\ case(ESMF_TYPEKIND_R8%dkind) @\ basepiotype=PIO_double @\ case default @\ call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg="Unsupported typekind", & @\ ESMF_CONTEXT, rcToReturn=rc) @\ return @\ end select @\ @\ !------------------------------------------------------- @\ ! Define the IO file type @\ !------------------------------------------------------- @\ select case (trim(piofmt)) @\ case('bin') @\ fmtiotype = iotype_pbinary @\ case('pnc') @\ fmtiotype = iotype_pnetcdf @\ case('snc') @\ fmtiotype = iotype_netcdf @\ case('nc4p') @\ fmtiotype = PIO_iotype_netcdf4p @\ case('nc4c') @\ fmtiotype = PIO_iotype_netcdf4c @\ case default @\ call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg="Unsupported IO format", & @\ ESMF_CONTEXT, rcToReturn=rc) @\ return @\ end select @\ @\ call PIO_initDecomp(PIOSYS,basepiotype, gDimsIndex,pioDofList,IOdesc) @\ !TODO: need error checking here! @\ @\ !-------------------------------- @\ ! Open a file and check data @\ !-------------------------------- @\ pioerr = PIO_OpenFile(PIOSYS,FileObj,fmtiotype,file) @\ call ESMF_checkpioerr(pioerr,localPet, & @\ __FILE__, & @\ __LINE__," openfile",rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ @\ if( piofmt .ne. 'bin') then @\ ! Set Frame to '1' in the PIO descriptor file @\ frame = 1 @\ if (time.gt.0) then @\ pioerr = PIO_inq_dimid(FileObj,'time', dimid_time) @\ pioerr = PIO_inq_dimlen(FileObj, dimid_time, time_len) @\ if(time .gt. time_len) then @\ call ESMF_LogSetError(ESMF_RC_NOT_VALID, & @\ msg="Timeframe is greater than that in file", & @\ ESMF_CONTEXT, rcToReturn=rc) @\ return @\ endif @\ frame = time @\ endif @\ pioerr = PIO_inq_varid(FileObj, trim(varname), vard) @\ call ESMF_checkpioerr(pioerr,localPet, & @\ __FILE__, & @\ __LINE__," defvar", rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ ! Will read the time-slice number "frame" from the file @\ call PIO_SetFrame(vard,frame) @\ !TODO: need error checking here! @\ endif @\ @\ !------------------------- @\ ! Time the parallel read @\ !------------------------- @\ dt_read = 0. @\ ! call MPI_Barrier(mpic,rc) @\ ! st = MPI_Wtime() @\ call PIO_read_darray(FileObj,vard, IOdesc, farrayrd, pioerr) @\ call ESMF_checkpioerr(pioerr,localPet, & @\ __FILE__, & @\ __LINE__," read_darray",rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ ! et = MPI_Wtime() @\ @\ call PIO_CloseFile(FileObj) @\ !TODO: need error checking here! @\ ! call MPI_Barrier(mpic,localrc) @\ ! dt_read = dt_read + (et - st) @\ !@\ !!!!!!!!!!!!!!!!!!!!!!!!!!! @\ @\ ! Maximum read/write times @\ ! if(localPet.eq.0) write(*,*) "Time for read:", dt_read @\ @\ call pio_freedecomp(PIOSYS, IOdesc) @\ !TODO: need error checking here! @\ call pio_finalize (PIOSYS, rc) @\ !TODO: need error checking here! @\ deallocate (pioDofList) @\ deallocate (gDimsIndex) @\ deallocate (minIndexPTile) @\ deallocate (maxIndexPTile) @\ @\ ! Return successfully @\ if (present(rc)) rc = ESMF_SUCCESS @\ @\ end subroutine ESMF_ArrayReadIntl##mrank##D##mtypekind @\ !---------------------------------------------------------------------------- @\ TypeKindRankDeclarationMacro(ArrayReadIntl) ^endif !------------------------------------------------------------------------------ end module ESMF_ArrayIOMod