MAPL_ClimUpdate Subroutine

public subroutine MAPL_ClimUpdate(STATE, BEFORE, AFTER, CURRENT_TIME, NAMES, FILE, RC)

Arguments

Type IntentOptional Attributes Name
type(ESMF_State), intent(inout) :: STATE
type(ESMF_Time), intent(out) :: BEFORE
type(ESMF_Time), intent(out) :: AFTER
type(ESMF_Time), intent(inout) :: CURRENT_TIME
character(len=*), intent(in) :: NAMES(:)
character(len=*), intent(in) :: FILE
integer, intent(out), optional :: RC

Calls

proc~~mapl_climupdate~~CallsGraph proc~mapl_climupdate MAPL_ClimUpdate ESMF_DistGridGet ESMF_DistGridGet proc~mapl_climupdate->ESMF_DistGridGet ESMF_GridGet ESMF_GridGet proc~mapl_climupdate->ESMF_GridGet ESMF_TimeGet ESMF_TimeGet proc~mapl_climupdate->ESMF_TimeGet ESMF_TimeIntervalSet ESMF_TimeIntervalSet proc~mapl_climupdate->ESMF_TimeIntervalSet esmf_fieldget esmf_fieldget proc~mapl_climupdate->esmf_fieldget esmf_stateget esmf_stateget proc~mapl_climupdate->esmf_stateget interface~mapl_assert MAPL_Assert proc~mapl_climupdate->interface~mapl_assert interface~mapl_fieldgettime MAPL_FieldGetTime proc~mapl_climupdate->interface~mapl_fieldgettime interface~mapl_fieldsettime MAPL_FieldSetTime proc~mapl_climupdate->interface~mapl_fieldsettime interface~mapl_varread MAPL_VarRead proc~mapl_climupdate->interface~mapl_varread proc~free_file FREE_FILE proc~mapl_climupdate->proc~free_file proc~getfile GETFILE proc~mapl_climupdate->proc~getfile proc~mapl_return MAPL_Return proc~mapl_climupdate->proc~mapl_return proc~mapl_skip MAPL_Skip proc~mapl_climupdate->proc~mapl_skip proc~mapl_verify MAPL_Verify proc~mapl_climupdate->proc~mapl_verify proc~free_file->interface~mapl_assert proc~free_file->proc~mapl_return proc~getfile->proc~mapl_return proc~getfile->proc~mapl_verify interface~mapl_am_i_root MAPL_Am_I_Root proc~getfile->interface~mapl_am_i_root 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_skip->proc~mapl_return proc~mapl_skip->proc~mapl_verify proc~mapl_skip->interface~mapl_am_i_root proc~mapl_verify->proc~mapl_throw_exception

Source Code

    subroutine MAPL_ClimUpdate ( STATE, BEFORE, AFTER, &
                                 CURRENT_TIME, NAMES, FILE, RC )
        type(ESMF_State),       intent(INOUT) :: STATE
        type(ESMF_Time),        intent(  out) :: BEFORE, AFTER
        type(ESMF_Time),        intent(inout) :: CURRENT_TIME !ALT:intent(in)
        character(len=*),       intent(in   ) :: NAMES(:)
        character(len=*),       intent(in   ) :: FILE
        integer,  optional,     intent(  out) :: RC

        integer :: STATUS


        integer          :: I, M, M1, M2
        integer          :: NFLD
        integer          :: UNIT
        integer          :: DONE

        type (ESMF_Field   ), pointer :: PREV(:)
        type (ESMF_Field   ), pointer :: NEXT(:)
        type (ESMF_DELayout)          :: LAYOUT
        type (ESMF_Grid    )          :: GRID
        type (ESMF_DistGrid)          :: distGRID


    ! --------------------------------------------------------------------------
    ! Allocate the number of fileds in the file
    ! --------------------------------------------------------------------------

        NFLD = size(NAMES)
        _ASSERT(NFLD>0, 'NFLD must be > 0')

        allocate(PREV(NFLD),stat=STATUS)
        _VERIFY(STATUS)
        allocate(NEXT(NFLD),stat=STATUS)
        _VERIFY(STATUS)

    ! --------------------------------------------------------------------------
    ! get the fields from the state
    ! --------------------------------------------------------------------------

        do I=1,NFLD
           call ESMF_StateGet ( STATE, trim(NAMES(I))//'_PREV', PREV(I), RC=STATUS )
           _VERIFY(STATUS)
           call ESMF_StateGet ( STATE, trim(NAMES(I))//'_NEXT', NEXT(I), RC=STATUS )
           _VERIFY(STATUS)
        end do

        call ESMF_FieldGet(PREV(1), GRID=GRID,    RC=STATUS)
        _VERIFY(STATUS)
        call ESMF_GridGet    (GRID,   distGrid=distGrid, rc=STATUS)
        _VERIFY(STATUS)
        call ESMF_DistGridGet(distGRID, delayout=layout, rc=STATUS)
        _VERIFY(STATUS)

    ! --------------------------------------------------------------------------
    ! Find out the times of next, prev from the field attributes
    ! --------------------------------------------------------------------------

        call MAPL_FieldGetTime ( PREV(1), BEFORE, RC=STATUS )
        _VERIFY(STATUS)
        call MAPL_FieldGetTime ( NEXT(1), AFTER , RC=STATUS )
        _VERIFY(STATUS)

    ! --------------------------------------------------------------------------
    ! check to see if albedos need to be refreshed in the
    ! ESMF Internal State (prev, next need to surround
    ! the current time)
    ! --------------------------------------------------------------------------

        call ESMF_TimeGet ( BEFORE, yy=I, rc=STATUS )
        _VERIFY(STATUS)

        DONE = 0
        if( I > 0) then
           if( (BEFORE <= CURRENT_TIME) .and. (AFTER >= CURRENT_TIME)) then
              DONE = 1
           end if
        end if

        if(DONE /= 1) then

    ! --------------------------------------------------------------------------
    !  Get the midmonth times for the months before and after the current time
    ! --------------------------------------------------------------------------

           call MAPL_GetClimMonths ( CURRENT_TIME, BEFORE, AFTER,  RC=STATUS )
           _VERIFY(STATUS)

           call ESMF_TimeGet ( BEFORE, MM=M1, rc=STATUS )
           _VERIFY(STATUS)
           call ESMF_TimeGet ( AFTER , MM=M2, rc=STATUS )
           _VERIFY(STATUS)

    ! --------------------------------------------------------------------------
    !  Read the albedo climatologies from file
    ! --------------------------------------------------------------------------

           UNIT = GETFILE(FILE, form="unformatted",  RC=STATUS)
           _VERIFY(STATUS)

           DONE = 0
           do M=1,12
              if    (M==M1) then
                 do I=1,NFLD
                    call MAPL_VarRead(UNIT, PREV(I), RC=STATUS)
                    _VERIFY(STATUS)
                 end do
                 if(DONE==1) exit
                 DONE = DONE + 1
              elseif(M==M2) then
                 do I=1,NFLD
                    call MAPL_VarRead(UNIT, NEXT(I), RC=STATUS)
                    _VERIFY(STATUS)
                 end do
                 if(DONE==1) exit
                 DONE = DONE + 1
              else
                 call MAPL_Skip(UNIT,LAYOUT,COUNT=NFLD,rc=status)
                 _VERIFY(STATUS)
              end if
           end do

           call FREE_FILE ( Unit )

    ! --------------------------------------------------------------------------
    !  Reset the time on all fields
    ! --------------------------------------------------------------------------

           do I=1,NFLD
              call MAPL_FieldSetTime (  PREV(I), BEFORE, rc=STATUS )
              _VERIFY(STATUS)
              call MAPL_FieldSetTime (  NEXT(I), AFTER , rc=STATUS )
              _VERIFY(STATUS)
           end do

        endif

        deallocate(NEXT)
        deallocate(PREV)

        _RETURN(ESMF_SUCCESS)
      end subroutine MAPL_ClimUpdate