subroutine MAPL_CFIOWriteBundleWrite( MCFIO, CLOCK, RC )
type(MAPL_CFIO ), intent(INOUT) :: MCFIO
type(ESMF_CLOCK), intent(INOUT) :: CLOCK
integer, optional, intent( OUT) :: RC
! Locals
!-------
integer :: status
integer :: L, K, NN
integer :: YY,MM,DD,H,M,S
integer :: noffset
logical :: AmRoot, MyGlobal, LPERP
type(ESMF_TIME ) :: TIME
type(ESMF_Alarm) :: PERPETUAL
character(len=ESMF_MAXSTR) :: DATE
character(len=ESMF_MAXSTR) :: ClockName
real, pointer :: Gptr3Out(:,:,:)
real, pointer :: Gptr2Out(:,: )
integer :: counts(5)
integer :: IM0,JM0
integer :: nymd,nhms
! Space for global arrays is allocated everywhere, even if not used.
!------------------------------------------------------------------
_ASSERT(MCFIO%CREATED, 'MCFIO%CREATED is false')
! Set the time at which we will be writing from the clock
!--------------------------------------------------------
call ESMF_ClockGet (CLOCK, name=ClockName, CurrTime =TIME, RC=STATUS)
_VERIFY(STATUS)
call ESMF_TimeIntervalGet( MCFIO%OFFSET, S=noffset, rc=status )
_VERIFY(STATUS)
if( noffset /= 0 ) then
LPERP = ( index( trim(clockname),'_PERPETUAL' ).ne.0 )
if( LPERP ) then
call ESMF_ClockGetAlarm ( clock, alarmName='PERPETUAL', alarm=PERPETUAL, rc=status )
_VERIFY(STATUS)
if( ESMF_AlarmIsRinging(PERPETUAL) ) then
call ESMF_TimeGet ( Time, YY = YY, &
MM = MM, &
DD = DD, &
H = H , &
M = M , &
S = S, rc=status )
MM = MM + 1
call ESMF_TimeSet ( Time, YY = YY, &
MM = MM, &
DD = DD, &
H = H , &
M = M , &
S = S, rc=status )
endif
endif
endif
TIME = TIME - MCFIO%OFFSET
call ESMF_TimeGet (TIME, timeString=DATE, RC=STATUS)
_VERIFY(STATUS)
! Allocate global 2d and 3d arrays at the writing resolution
! Note that everybody allocated these.
!-----------------------------------------------------------
call MAPL_GridGet( MCFIO%GRID, globalCellCountPerDim=COUNTS, RC=STATUS)
_VERIFY(STATUS)
IM0 = COUNTS(1)
JM0 = COUNTS(2)
if(any(mCFIO%myPE==mCFIO%Krank)) then
allocate(Gptr3Out(Mcfio%IM, Mcfio%JM,1), stat=STATUS)
_VERIFY(STATUS)
Gptr2Out => Gptr3Out(:,:,1)
Gptr2Out(:,:) = 0.0
end if
AmRoot = mCFIO%myPE==mCFIO%rootRank
! Finally Do The Writes
!______________________
nn = 0
VARIABLESW: do L=1,size(MCFIO%VarDims)
RANKW: if (MCFIO%VarDims(L)==2) then
nn = nn + 1
MyGlobal = mCFIO%Krank(nn) == MCFIO%MYPE
! Horizontal Interpolation and Shaving on PEs with global data
! ------------------------------------------------------------
IAMVARROOT: if(AmRoot) then
Gptr2Out => Gptr3Out(:,:,1)
call MPI_Recv(Gptr2Out,size(Gptr2Out),MPI_REAL, mCFIO%Krank(nn), &
trans_tag, mCFIO%comm, MPI_STATUS_IGNORE, STATUS)
_VERIFY(STATUS)
call StrToInt(date,nymd,nhms)
call ESMF_CFIOVarWrite(MCFIO%CFIO, trim(MCFIO%VARNAME(L)), &
Gptr2Out, timeString=DATE, RC=STATUS)
_VERIFY(STATUS)
end if IAMVARROOT
elseif (MCFIO%VarDims(L)==3) then
! Everyone waits, processes their layer, and sends it to root.
! Root write it out.
!-------------------------------------------------------------
LEVELSW: do k=1,MCFIO%lm
nn = nn + 1
MyGlobal = MCFIO%Krank(nn) == MCFIO%MYPE
IAMLEVROOT: if(AmRoot) then
Gptr2Out => Gptr3Out(:,:,1)
call MPI_Recv(Gptr2Out, size(Gptr2Out), MPI_REAL, mCFIO%Krank(nn), &
trans_tag, mCFIO%comm, MPI_STATUS_IGNORE, STATUS)
_VERIFY(STATUS)
call StrToInt(date,nymd,nhms)
call ESMF_CFIOVarWrite(MCFIO%CFIO, trim(MCFIO%VARNAME(L)), &
Gptr3Out, kbeg=K, kount=1, &
timeString=DATE, RC=STATUS)
_VERIFY(STATUS)
end if IAMLEVROOT
end do LEVELSW
endif RANKW
end do VARIABLESW
!if(AmRoot) then
! write(6,'(1X,"Wrote: ",i6," Slices (",i3," Nodes, ",i2," CoresPerNode) to File: ",a)') &
! size(MCFIO%reqs),mCFIO%partsize/mCFIO%numcores,mCFIO%numcores,trim(mCFIO%fName)
!endif
! Clean-up
!---------
nn = 0
VARIABLESC: do L=1,size(MCFIO%VarDims)
RANKC: if (MCFIO%VarDims(L)==2) then
nn = nn + 1
MyGlobal = mCFIO%Krank(nn) == MCFIO%MYPE
if( MyGlobal ) then
call MPI_Wait(MCFIO%reqs(nn)%s_rqst, MPI_STATUS_IGNORE, STATUS)
_VERIFY(STATUS)
deallocate( MCFIO%reqs(nn)%Trans_Array, stat=STATUS)
_VERIFY(STATUS)
nullify( MCFIO%reqs(nn)%Trans_Array )
endif
elseif (MCFIO%VarDims(L)==3) then
LEVELSC: do k=1,MCFIO%lm
nn = nn + 1
MyGlobal = MCFIO%Krank(nn) == MCFIO%MYPE
if( MyGlobal ) then
call MPI_Wait(MCFIO%reqs(nn)%s_rqst, MPI_STATUS_IGNORE, STATUS)
_VERIFY(STATUS)
deallocate( MCFIO%reqs(nn)%Trans_Array, stat=STATUS)
_VERIFY(STATUS)
nullify( MCFIO%reqs(nn)%Trans_Array )
endif
end do LEVELSC
endif RANKC
end do VARIABLESC
! if(AmRoot) then
! write(6,'(1X,"Cleaned: ",i6," Slices (",i3," Nodes, ",i2," CoresPerNode) to File: ",a)') &
! size(MCFIO%reqs),mCFIO%partsize/mCFIO%numcores,mCFIO%numcores,trim(mCFIO%fName)
! endif
if (any(mCFIO%myPE==mCFIO%Krank)) then
deallocate(Gptr3Out, stat=STATUS)
_VERIFY(STATUS)
end if
_RETURN(ESMF_SUCCESS)
end subroutine MAPL_CFIOWriteBundleWrite