MAPL_CFIOCreateFromFile Subroutine

public subroutine MAPL_CFIOCreateFromFile(MCFIO, BundleIn, RegridMethod, hw, only_vars, RC)

Arguments

Type IntentOptional Attributes Name
type(MAPL_CFIO), intent(inout) :: MCFIO
type(ESMF_FieldBundle), intent(inout), optional :: BundleIn
integer, intent(in), optional :: RegridMethod
integer, intent(in), optional :: hw
character(len=*), intent(in), optional :: only_vars
integer, intent(out), optional :: RC

Calls

proc~~mapl_cfiocreatefromfile~~CallsGraph proc~mapl_cfiocreatefromfile MAPL_CFIOCreateFromFile ESMF_AttributeGet ESMF_AttributeGet proc~mapl_cfiocreatefromfile->ESMF_AttributeGet ESMF_AttributeSet ESMF_AttributeSet proc~mapl_cfiocreatefromfile->ESMF_AttributeSet ESMF_DELayoutCreate ESMF_DELayoutCreate proc~mapl_cfiocreatefromfile->ESMF_DELayoutCreate ESMF_DistGridCreate ESMF_DistGridCreate proc~mapl_cfiocreatefromfile->ESMF_DistGridCreate ESMF_DistGridDestroy ESMF_DistGridDestroy proc~mapl_cfiocreatefromfile->ESMF_DistGridDestroy ESMF_GridGet ESMF_GridGet proc~mapl_cfiocreatefromfile->ESMF_GridGet ESMF_UtilStringLowerCase ESMF_UtilStringLowerCase proc~mapl_cfiocreatefromfile->ESMF_UtilStringLowerCase ESMF_VMGet ESMF_VMGet proc~mapl_cfiocreatefromfile->ESMF_VMGet ESMF_VMGetCurrent ESMF_VMGetCurrent proc~mapl_cfiocreatefromfile->ESMF_VMGetCurrent esmf_fieldbundleget esmf_fieldbundleget proc~mapl_cfiocreatefromfile->esmf_fieldbundleget esmf_fieldcreate esmf_fieldcreate proc~mapl_cfiocreatefromfile->esmf_fieldcreate esmf_fieldget esmf_fieldget proc~mapl_cfiocreatefromfile->esmf_fieldget esmf_localarraycreate esmf_localarraycreate proc~mapl_cfiocreatefromfile->esmf_localarraycreate esmf_localarraydestroy esmf_localarraydestroy proc~mapl_cfiocreatefromfile->esmf_localarraydestroy interface~mapl_assert MAPL_Assert proc~mapl_cfiocreatefromfile->interface~mapl_assert interface~mapl_fieldbundleadd MAPL_FieldBundleAdd proc~mapl_cfiocreatefromfile->interface~mapl_fieldbundleadd nf90_inq_varid nf90_inq_varid proc~mapl_cfiocreatefromfile->nf90_inq_varid none~at~128 CFIOCollectionVector%at proc~mapl_cfiocreatefromfile->none~at~128 none~find~33 CFIOCollection%find proc~mapl_cfiocreatefromfile->none~find~33 none~make_grid~4 GridManager%make_grid proc~mapl_cfiocreatefromfile->none~make_grid~4 none~make_regridder~2 RegridderManager%make_regridder proc~mapl_cfiocreatefromfile->none~make_regridder~2 proc~esmf_cfioget ESMF_CFIOGet proc~mapl_cfiocreatefromfile->proc~esmf_cfioget proc~esmf_cfiogridget ESMF_CFIOGridGet proc~mapl_cfiocreatefromfile->proc~esmf_cfiogridget proc~esmf_cfiovarinfoget ESMF_CFIOVarInfoGet proc~mapl_cfiocreatefromfile->proc~esmf_cfiovarinfoget proc~mapl_gridget MAPL_GridGet proc~mapl_cfiocreatefromfile->proc~mapl_gridget proc~mapl_return MAPL_Return proc~mapl_cfiocreatefromfile->proc~mapl_return proc~mapl_roundrobinpelist MAPL_RoundRobinPEList proc~mapl_cfiocreatefromfile->proc~mapl_roundrobinpelist proc~mapl_verify MAPL_Verify proc~mapl_cfiocreatefromfile->proc~mapl_verify vectorlist vectorlist proc~mapl_cfiocreatefromfile->vectorlist

Source Code

  subroutine MAPL_CFIOCreateFromFile(MCFIO,bundlein,RegridMethod,hw,only_vars,rc)

    type(MAPL_CFIO  ),               intent(INOUT) :: MCFIO
    type(ESMF_FieldBundle), optional, intent(INOUT) :: BundleIn
    integer,               optional, intent(IN   ) :: RegridMethod
    integer,               optional, intent(IN   ) :: hw
    character(len=*),      optional, intent(IN   ) :: only_vars
    integer,               optional, intent(  OUT) :: RC

    type(ESMF_CFIOGrid), pointer :: CFIOGRID => null()
    type(ESMF_GRID)              :: ESMFGRID
    type(ESMF_CFIOGrid)          :: varsGrid
    type(ESMF_CFIOVarInfo), pointer :: VARS(:) => null()
    type(ESMF_VM)    :: vm
    integer          :: i,k,kv
    integer          :: im,jm,lm,nvars,fvars,bvars,img,jmg,lt,num2dvars,num3dvars
    logical          :: twoD,fillbundle
    character(len=ESMF_MAXSTR) :: units,cfiovarname,long_name,bundlevarname,ctemp1,ctemp2
    integer          :: regridMethod_
    integer, allocatable    :: gridToFieldMap(:)
    integer          :: hw_, gridrank, dims(3), counts(3), halowidth(3)
    real, pointer    :: ptr2(:,:)
    real, pointer    :: ptr3(:,:,:)
    type(ESMF_Field) :: field
    integer          :: status
    logical          :: found
    logical          :: isPresent
    real, pointer    :: lonsfile(:) => null()
    real, pointer    :: latsfile(:) => null()
    real, pointer    :: levsfile(:) => null()
    type(ESMF_CFIO), pointer :: cfiop
    type(CFIOCollection), pointer :: collection

    call ESMF_VMGetCurrent(vm,rc=status)
    _VERIFY(STATUS)
    call ESMF_VMGet(vm,localPet=mcfio%myPE,rc=status)
    _VERIFY(STATUS)

    collection => collections%at(mcfio%collection_ID)
    cfiop => collection%find(mcfio%fname, _RC)

    call ESMF_CFIOGet       (cfiop,     grid=CFIOGRID,                     RC=STATUS)
    _VERIFY(STATUS)
    call ESMF_CFIOGridGet   (CFIOGRID, IM=IM, JM=JM, KM=LM,               RC=STATUS)
    _VERIFY(STATUS)
    call ESMF_CFIOGridGet    (CFIOGRID, LON=LONSFILE, LAT=LATSFILE, RC=STATUS)
    _VERIFY(STATUS)
    deallocate(CFIOGRID)

    call ESMF_CFIOGet (cfiop,varObjs=VARS, nVars=fVars, RC=STATUS)
    _VERIFY(STATUS)

    if (present(hw)) then
       hw_=hw
    else
       hw_=0
    end if
    haloWidth = (/hw_,hw_,0/)
    mcfio%kreverse = .false.
    mcfio%xshift   = .false.
    if (JM /= 6*IM) then
       mcfio%xshift = abs(LONSfile(1)+180._REAL64) .GT. abs(LONSfile(2)-LONSfile(1))
    end if

    call ESMF_FieldbundleGet(bundlein,grid=esmfgrid,rc=status)
    _VERIFY(status)
    call MAPL_GridGet(esmfgrid, globalCellCountPerDim=COUNTS, &
         localCellCountPerDim=DIMS, RC=STATUS)
    img=counts(1)
    jmg=counts(2)

    ! Get the number of variables we will be reading
    call ESMF_FieldBundleGet(bundlein,fieldCount=bvars,rc=status)
    _VERIFY(status)
    if (bvars>0) then
       fillbundle=.false.
       nvars=bvars
    else
       fillbundle=.true.
       nvars=0
       do i=1,fVars
          if ( present(ONLY_VARS) ) then
             if ( index(','//trim(ONLY_VARS)  //',', &
                        ','//trim(CFIOVARNAME)//',') < 1 ) cycle
          endif
          nvars=nvars+1
       end do
    end if

    allocate(MCFIO%VarDims(NVars), stat=STATUS)
    _VERIFY(STATUS)
    allocate(MCFIO%VarName(NVars), stat=STATUS)
    _VERIFY(STATUS)
    allocate(MCFIO%VarID(NVars), stat=STATUS)
    _VERIFY(STATUS)
    if (.not.fillbundle) then
       do i=1,nvars
          call ESMF_FieldBundleGet(bundlein,i,field,rc=status)
          _VERIFY(status)
          call ESMF_FieldGet(field,name=bundlevarname,rc=status)
          _VERIFY(status)
          found=.false.
          do k=1,fvars
             call ESMF_CFIOVarInfoGet(VARS(K),vname=CFIOVARNAME,twoDimVar=twoD,RC=STATUS)
             _VERIFY(STATUS)
             ctemp1 = ESMF_UtilStringLowerCase(cfiovarname,rc=status)
             _VERIFY(STATUS)
             ctemp2 = ESMF_UtilStringLowerCase(bundlevarname,rc=status)
             _VERIFY(STATUS)
             if (trim(ctemp1)==trim(ctemp2)) then
                found=.true.
                kv=k
                exit
             endif
          enddo
          _ASSERT(found, 'search failed')
          mcfio%varname(i)=bundleVarName
          if (twoD) then
             mcfio%vardims(i)=2
          else
             mcfio%vardims(i)=3
             call ESMF_CFIOVarinfoGet(Vars(kv),grid=varsgrid,rc=status)
             _VERIFY(STATUS)
             call ESMF_CFIOGridGet (varsGrid, lev=levsfile, rc=status)
             _VERIFY(STATUS)
             if (levsfile(1) > levsfile(lm)) mcfio%kreverse = .true.
          end if
          status = nf90_inq_varid(cfiop%fid,cfiovarname,mcfio%varid(i))
          _VERIFY(STATUS)
          call ESMF_FieldGet(FIELD,   Grid=ESMFGRID, RC=STATUS)
          _VERIFY(STATUS)
          call MAPL_GridGet(ESMFGRID, globalCellCountPerDim=COUNTS, RC=STATUS)
          _VERIFY(STATUS)
          _ASSERT( LM==0 .or. counts(3) == 0 .or. LM==counts(3) .or. lm == (counts(3)+1), 'incompatible file and bundle' )
       enddo

    else
       nVars=0
       do i=1,fvars

          call ESMF_CFIOVarInfoGet(VARS(i),vname=CFIOVARNAME, vtitle=LONG_NAME, vunits=UNITS, twoDimVar=twoD, RC=STATUS)
          _VERIFY(STATUS)
          if ( present(ONLY_VARS) ) then
             if ( index(','//trim(ONLY_VARS)  //',', &
                        ','//trim(CFIOVARNAME)//',') < 1 ) cycle
          endif
          nvars=nvars+1
          MCFIO%VarName(nvars) = cfiovarname

          if (twoD) then
             MCFIO%VarDims(nvars) = 2

             allocate(PTR2(1-hw_:DIMS(1)+hw_,1-hw_:DIMS(2)+hw_),stat=STATUS)
             _VERIFY(STATUS)
             PTR2  = 0.0

             call ESMF_GridGet(esmfgrid, dimCount=gridRank, rc=status)
             _VERIFY(STATUS)
             allocate(gridToFieldMap(gridRank), stat=status)
             _VERIFY(STATUS)
             if(gridRank == 2) then
                gridToFieldMap(1) = 1
                gridToFieldMap(2) = 2
             else if (gridRank == 3) then
                gridToFieldMap(1) = 1
                gridToFieldMap(2) = 2
                gridToFieldMap(3) = 0
             else
                _RETURN(ESMF_FAILURE)
             end if
             FIELD = ESMF_FieldCreate(grid=esmfgrid, &
                             datacopyFlag = ESMF_DATACOPY_REFERENCE,   &
                             farrayPtr=PTR2, gridToFieldMap=gridToFieldMap, &
                             name=CFIOVARNAME, &
                             totalLWidth=haloWidth(1:2),     &
                             totalUWidth=haloWidth(1:2),     &
                             rc = status)
             _VERIFY(STATUS)

             deallocate(gridToFieldMap)

             call ESMF_AttributeSet(FIELD, NAME='LONG_NAME', VALUE=LONG_NAME, RC=STATUS)
             _VERIFY(STATUS)
             call ESMF_AttributeSet(FIELD, NAME='UNITS', VALUE=UNITS, RC=STATUS)
             _VERIFY(STATUS)
             call ESMF_AttributeSet(FIELD, NAME='DIMS', VALUE=MAPL_DimsHorzOnly, RC=STATUS)
             _VERIFY(STATUS)
             call ESMF_AttributeSet(FIELD, NAME='VLOCATION', &
                                        VALUE=MAPL_VLocationNone, RC=STATUS)
             _VERIFY(STATUS)

          else
             call ESMF_CFIOVarinfoGet(Vars(i),grid=varsgrid,rc=status)
             _VERIFY(STATUS)
             call ESMF_CFIOGridGet (varsGrid, lev=levsfile, rc=status)
             _VERIFY(STATUS)
             if (levsfile(1) > levsfile(lm)) mcfio%kreverse = .true.
               MCFIO%VarDims(nvars) = 3
               if (lm == counts(3)) then
                  allocate(PTR3(1-hw_:DIMS(1)+hw_,1-hw_:DIMS(2)+hw_,LM),stat=STATUS)
                  _VERIFY(STATUS)
               else if (lm == (counts(3)+1)) then
                  allocate(PTR3(1-hw_:DIMS(1)+hw_,1-hw_:DIMS(2)+hw_,0:LM-1),stat=STATUS)
                  _VERIFY(STATUS)
               endif
               PTR3  = 0.0
               FIELD = ESMF_FieldCreate(grid=esmfgrid, &
                               datacopyFlag = ESMF_DATACOPY_REFERENCE,   &
                               farrayPtr=PTR3, name=CFIOVARNAME,       &
                               totalLWidth=haloWidth(1:2),     &
                               totalUWidth=haloWidth(1:2),     &
                               rc = status)
               _VERIFY(STATUS)
   !ALT: for now we add only HorzVert (no tiles)
               call ESMF_AttributeSet(FIELD, NAME='LONG_NAME', VALUE=LONG_NAME, RC=STATUS)
               _VERIFY(STATUS)
               call ESMF_AttributeSet(FIELD, NAME='UNITS', VALUE=UNITS, RC=STATUS)
               _VERIFY(STATUS)
               call ESMF_AttributeSet(FIELD, NAME='DIMS', VALUE=MAPL_DimsHorzVert, RC=STATUS)
               _VERIFY(STATUS)
               if (lm == counts(3)) then
                  call ESMF_AttributeSet(FIELD, NAME='VLOCATION', &
                                              VALUE=MAPL_VLocationCenter, RC=STATUS)
               else if (lm == (counts(3)+1)) then
                  call ESMF_AttributeSet(FIELD, NAME='VLOCATION', &
                                              VALUE=MAPL_VLocationEdge, RC=STATUS)
               end if

               _VERIFY(STATUS)

          end if

          call MAPL_FieldBundleAdd(bundlein,field,rc=status)
          _VERIFY(STATUS)
          status = nf90_inq_varid(cfiop%fid,cfiovarname,mcfio%varid(i))
          _VERIFY(STATUS)

       enddo
    end if

    ! Fill in MCFIO object
    mcfio%grid = esmfgrid
    mcfio%bundle = bundlein
    mcfio%im = im
    mcfio%jm = jm
    mcfio%lm = lm
    Num2DVars = count(MCFIO%VarDims==2)
    Num3DVars = count(MCFIO%VarDims==3)
    LT  = Num2DVars + Num3DVars*LM
    allocate( MCFIO%reqs (LT),stat=STATUS)
    _VERIFY(STATUS)
    allocate( MCFIO%Krank(LT),stat=STATUS)
    _VERIFY(STATUS)
    mcfio%krank = -1
    allocate( MCFIO%pairList(LT),stat=STATUS)
    _VERIFY(STATUS)


    if (present(regridmethod)) then
       regridmethod_=regridmethod
    else
       regridmethod_=REGRID_METHOD_BILINEAR
    endif

    mcfio%regrid_type=-1
    if ( (img /= im .or. jmg /= jm) .and. (regridMethod_ /= -1) ) then
       if (regridmethod_==REGRID_METHOD_VOTE .or. regridmethod_==REGRID_METHOD_CONSERVE .or. regridmethod_==REGRID_METHOD_FRACTION) then
          mcfio%regridConservative = .true.
          mcfio%regridder => make_regridder(esmfgrid,regridMethod_,lonsfile,latsfile,im,jm,counts(3),.false.,localTiles=.false.,rc=status)
          _VERIFY(status)
       else if (regridmethod_==REGRID_METHOD_BILINEAR) then
          mcfio%regridder => make_regridder(ESMFGRID, regridMethod_, LONSfile, LATSfile, IM, JM, counts(3), .false., rc=status)
          _VERIFY(status)
       end if
       mcfio%regrid_type=regridmethod_
    end if

    !check for vector pairs, right now limit to 1
    block
       character(len=ESMF_MAXSTR) :: vectorlist(2)
       logical :: found
       integer :: j
       integer :: rotation,gridstagger,rotation1,rotation2,gridStagger1,gridStagger2
       type(ESMF_Field) :: field1,field2
       allocate(mCFIO%needVar(size(mCFIO%varname)),stat=status)
       _VERIFY(status)
       mCFIO%needVar=0
       call ESMF_AttributeGet(bundlein,name="VectorList:",isPresent=isPresent,rc=status)
       _VERIFY(STATUS)
       if (isPresent) then
          call ESMF_AttributeGet(bundlein,name="VectorList:",valuelist=vectorlist,rc=status)
          _VERIFY(STATUS)

          do i=1,size(mCFIO%varname)
             if (mCFIO%varname(i) == vectorList(1)) then
                found=.false.
                do j=1,size(mCFIO%varname)
                   if (trim(mCFIO%varName(J)) == vectorlist(2)) then
                      found = .true.
                      exit
                   end if
                end do
                _ASSERT(found, 'search failed')
                mCFIO%needvar(i)=j
             else if (mCFIO%varname(i) == vectorList(2)) then
                found=.false.
                do j=1,size(mCFIO%varname)
                   if (trim(mCFIO%varName(J)) == vectorlist(1)) then
                      found = .true.
                      exit
                   end if
                end do
                _ASSERT(found, 'search failed')
                mCFIO%needvar(i)=-j
             end if
          end do

          call ESMF_FieldBundleGet(MCFIO%BUNDLE, trim(vectorList(1)), field=FIELD1,RC=STATUS)
          _VERIFY(STATUS)
          call ESMF_FieldBundleGet(MCFIO%BUNDLE, trim(vectorList(2)), field=FIELD2,RC=STATUS)
          _VERIFY(STATUS)
          mCFIO%doRotate=.false.
          call ESMF_AttributeGet(field1,name='ROTATION',value=rotation1,rc=status)
          call ESMF_AttributeGet(field1,name='STAGGERING',value=gridStagger1,rc=status)
          call ESMF_AttributeGet(field2,name='ROTATION',value=rotation2,rc=status)
          call ESMF_AttributeGet(field2,name='STAGGERING',value=gridStagger2,rc=status)
          _ASSERT(rotation1==rotation2,'rotation does not match')
          _ASSERT(gridStagger1==gridStagger2,'stagger does not match')
          rotation=rotation1
          gridStagger=gridStagger1
          if (gridStagger == MAPL_AGrid) then
             if (rotation == MAPL_RotateLL) then
                mCFIO%doRotate = .false.
             else if (rotation == MAPL_RotateCube) then
                mCFIO%doRotate = .true.
             end if
          else if (gridStagger == MAPL_DGrid) then
             if (rotation /= MAPL_RotateCube) then
                _FAIL('must rotate LL')
             else
                mCFIO%doRotate = .false.
             end if
          else if (gridStagger == MAPL_CGrid) then
             if (rotation /= MAPL_RotateCube) then
               _FAIL('must rotate LL')
             else
                mCFIO%doRotate = .false.
             end if
          end if
       end if
    end block
!@    call ESMF_CFIOVarInfoDestroy(vars, _RC)
    deallocate(vars)
    deallocate(LONSfile,LATSfile)
    if (associated(levsfile)) then
       deallocate(levsfile)
       nullify(levsfile)
    end if

    mCFIO%PartSize=-1
    mCFIO%root=-1

    _RETURN(ESMF_SUCCESS)

  end subroutine MAPL_CFIOCreateFromFile