MAPL_CFIOWriteBundleWrite Subroutine

public subroutine MAPL_CFIOWriteBundleWrite(MCFIO, CLOCK, RC)

Arguments

Type IntentOptional Attributes Name
type(MAPL_CFIO), intent(inout) :: MCFIO
type(ESMF_Clock), intent(inout) :: CLOCK
integer, intent(out), optional :: RC

Calls

proc~~mapl_cfiowritebundlewrite~~CallsGraph proc~mapl_cfiowritebundlewrite MAPL_CFIOWriteBundleWrite ESMF_AlarmIsRinging ESMF_AlarmIsRinging proc~mapl_cfiowritebundlewrite->ESMF_AlarmIsRinging ESMF_ClockGet ESMF_ClockGet proc~mapl_cfiowritebundlewrite->ESMF_ClockGet ESMF_ClockGetAlarm ESMF_ClockGetAlarm proc~mapl_cfiowritebundlewrite->ESMF_ClockGetAlarm ESMF_TimeGet ESMF_TimeGet proc~mapl_cfiowritebundlewrite->ESMF_TimeGet ESMF_TimeIntervalGet ESMF_TimeIntervalGet proc~mapl_cfiowritebundlewrite->ESMF_TimeIntervalGet ESMF_TimeSet ESMF_TimeSet proc~mapl_cfiowritebundlewrite->ESMF_TimeSet interface~esmf_cfiovarwrite ESMF_CFIOVarWrite proc~mapl_cfiowritebundlewrite->interface~esmf_cfiovarwrite interface~mapl_assert MAPL_Assert proc~mapl_cfiowritebundlewrite->interface~mapl_assert mpi_recv mpi_recv proc~mapl_cfiowritebundlewrite->mpi_recv mpi_wait mpi_wait proc~mapl_cfiowritebundlewrite->mpi_wait proc~mapl_gridget MAPL_GridGet proc~mapl_cfiowritebundlewrite->proc~mapl_gridget proc~mapl_return MAPL_Return proc~mapl_cfiowritebundlewrite->proc~mapl_return proc~mapl_verify MAPL_Verify proc~mapl_cfiowritebundlewrite->proc~mapl_verify proc~strtoint strToInt proc~mapl_cfiowritebundlewrite->proc~strtoint proc~mapl_gridget->proc~mapl_return proc~mapl_gridget->proc~mapl_verify ESMF_AttributeGet ESMF_AttributeGet proc~mapl_gridget->ESMF_AttributeGet ESMF_DistGridGet ESMF_DistGridGet proc~mapl_gridget->ESMF_DistGridGet ESMF_GridGet ESMF_GridGet proc~mapl_gridget->ESMF_GridGet proc~mapl_distgridget MAPL_DistGridGet proc~mapl_gridget->proc~mapl_distgridget proc~mapl_getimsjms MAPL_GetImsJms proc~mapl_gridget->proc~mapl_getimsjms proc~mapl_gridhasde MAPL_GridHasDE proc~mapl_gridget->proc~mapl_gridhasde at at proc~mapl_return->at insert insert proc~mapl_return->insert proc~mapl_throw_exception MAPL_throw_exception proc~mapl_return->proc~mapl_throw_exception proc~mapl_verify->proc~mapl_throw_exception proc~mapl_distgridget->proc~mapl_verify proc~mapl_distgridget->ESMF_DistGridGet proc~mapl_getimsjms->interface~mapl_assert proc~mapl_getimsjms->proc~mapl_return proc~mapl_getimsjms->proc~mapl_verify interface~mapl_sort MAPL_Sort proc~mapl_getimsjms->interface~mapl_sort proc~mapl_gridhasde->proc~mapl_return proc~mapl_gridhasde->proc~mapl_verify proc~mapl_gridhasde->ESMF_DistGridGet proc~mapl_gridhasde->ESMF_GridGet ESMF_DELayoutGet ESMF_DELayoutGet proc~mapl_gridhasde->ESMF_DELayoutGet

Source Code

  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