userm1_init Subroutine

private subroutine userm1_init(comp, importState, exportState, clock, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_GridComp) :: comp
type(ESMF_State) :: importState
type(ESMF_State) :: exportState
type(ESMF_Clock) :: clock
integer, intent(out) :: rc

Source Code

  subroutine userm1_init(comp, importState, exportState, clock, rc)
    type(ESMF_GridComp) :: comp
    type(ESMF_State) :: importState, exportState
    type(ESMF_Clock) :: clock
    integer, intent(out) :: rc

    type(ESMF_AttPack)        :: attpack
    type(ESMF_VM)               :: vm
    integer                     :: petCount, status, myPet
    character(ESMF_MAXSTR)      :: name1,name2,name3,name4,value1,value2, &
                                   value3,value4,convESMF,purpGen,convCC
    type(ESMF_ArraySpec)        :: arrayspec
    type(ESMF_Grid)             :: grid, grid2, grid3
    type(ESMF_Field)            :: field, field2, field3, field4, field5, &
                                   field6, field7, field8, field9, field10
    type(ESMF_FieldBundle)      :: fieldbundle, fieldbundle2
    character(ESMF_MAXSTR),dimension(2)   :: attrList

    rc = ESMF_SUCCESS

    call ESMF_GridCompGet(comp, vm=vm, rc=status)
    if (status .ne. ESMF_SUCCESS) return
    call ESMF_VMGet(vm, petCount=petCount, localPet=myPet, rc=status)
    if (status .ne. ESMF_SUCCESS) return

    call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc)
    if (rc/=ESMF_SUCCESS) return
    grid = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=(/100,150/), &
      regDecomp=(/1,petCount/), &
      gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,0/), &
      indexflag=ESMF_INDEX_GLOBAL, rc=rc)
    if (rc/=ESMF_SUCCESS) return

    convCC = 'CustomConvention'
    convESMF = 'ESMF'
    purpGen = 'General'
    name1 = 'ShortName'
    name2 = 'StandardName'
    name3 = 'LongName'
    name4 = 'Units'

    value1 = 'fieldAttribute'
    value2 = 'tendency_of_air_pressure'
    value3 = 'Edge pressure tendency'
    value4 = 'Pa s-1'

    field = ESMF_FieldCreate(grid, arrayspec=arrayspec, &
              staggerloc=ESMF_STAGGERLOC_CENTER, name="field", rc=status)
    call ESMF_AttributeAdd(field, convention=convESMF, purpose=purpGen, &
      rc=status)
    call ESMF_AttributeSet(field, name1, value1, &
      convention=convESMF, purpose=purpGen, rc=status)
    call ESMF_AttributeSet(field, name2, value2, &
      convention=convESMF, purpose=purpGen, rc=status)
    call ESMF_AttributeSet(field, name3, value3, &
      convention=convESMF, purpose=purpGen, rc=status)
    call ESMF_AttributeSet(field, name4, value4, &
      convention=convESMF, purpose=purpGen, rc=status)
    if (status .ne. ESMF_SUCCESS) return

    ! Create the Grid Attribute Package
    call ESMF_AttributeAdd(grid,convention=convESMF, purpose=purpGen, rc=status)
    call ESMF_AttributeSet(grid,'RegDecompX', 96, &
      convention=convESMF, purpose=purpGen, rc=status)
    call ESMF_AttributeSet(grid,'RegDecompY', 84, &
      convention=convESMF, purpose=purpGen, rc=status)
    if (status .ne. ESMF_SUCCESS) return

    fieldbundle = ESMF_FieldBundleCreate(name="fieldbundle", rc=status)
    if (status .ne. ESMF_SUCCESS) return

    call ESMF_FieldBundleSet(fieldbundle, grid=grid, rc=status)
    if (status .ne. ESMF_SUCCESS) return

    call ESMF_FieldBundleAdd(fieldbundle, (/ field /), rc=status)
    if (status .ne. ESMF_SUCCESS) return

    call ESMF_StateAdd(exportState, fieldbundleList=(/fieldbundle/), rc=status)
    if (status .ne. ESMF_SUCCESS) return


    ! do a bunch of crazy stuff
    grid2 = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=(/100,150/), &
      regDecomp=(/1,petCount/), &
      gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,0/), &
      indexflag=ESMF_INDEX_GLOBAL, rc=rc)
    if (rc/=ESMF_SUCCESS) return

    field2 = ESMF_FieldCreate(grid2, arrayspec=arrayspec, &
              staggerloc=ESMF_STAGGERLOC_CENTER, name="field2", rc=status)
    call ESMF_AttributeAdd(field2, convention=convESMF, purpose=purpGen, &
      rc=status)
    call ESMF_AttributeSet(field2, name1, value1, &
      convention=convESMF, purpose=purpGen, rc=status)
    field3 = ESMF_FieldCreate(grid2, arrayspec=arrayspec, &
              staggerloc=ESMF_STAGGERLOC_CENTER, name="field3", rc=status)
    call ESMF_AttributeAdd(field3, convention=convESMF, purpose=purpGen, &
      rc=status)
    call ESMF_AttributeSet(field3, name1, value1, &
      convention=convESMF, purpose=purpGen, rc=status)
    field4 = ESMF_FieldCreate(grid2, arrayspec=arrayspec, &
              staggerloc=ESMF_STAGGERLOC_CENTER, name="field4", rc=status)
    call ESMF_AttributeAdd(field4, convention=convESMF, purpose=purpGen, &
      rc=status)
    call ESMF_AttributeSet(field4, name1, value1, &
      convention=convESMF, purpose=purpGen, rc=status)
    field5 = ESMF_FieldCreate(grid2, arrayspec=arrayspec, &
              staggerloc=ESMF_STAGGERLOC_CENTER, name="field5", rc=status)
    call ESMF_AttributeAdd(field5, convention=convESMF, purpose=purpGen, &
      rc=status)
    call ESMF_AttributeSet(field5, name1, value1, &
      convention=convESMF, purpose=purpGen, rc=status)
    field6 = ESMF_FieldCreate(grid2, arrayspec=arrayspec, &
              staggerloc=ESMF_STAGGERLOC_CENTER, name="field6", rc=status)
    call ESMF_AttributeAdd(field6, convention=convESMF, purpose=purpGen, &
      rc=status)
    call ESMF_AttributeSet(field6, name1, value1, &
      convention=convESMF, purpose=purpGen, rc=status)
    field7 = ESMF_FieldCreate(grid2, arrayspec=arrayspec, &
              staggerloc=ESMF_STAGGERLOC_CENTER, name="field7", rc=status)
    call ESMF_AttributeAdd(field7, convention=convESMF, purpose=purpGen, &
      rc=status)
    call ESMF_AttributeSet(field7, name1, value1, &
      convention=convESMF, purpose=purpGen, rc=status)
    field8 = ESMF_FieldCreate(grid2, arrayspec=arrayspec, &
              staggerloc=ESMF_STAGGERLOC_CENTER, name="field8", rc=status)
    call ESMF_AttributeAdd(field8, convention=convESMF, purpose=purpGen, &
      rc=status)
    call ESMF_AttributeSet(field8, name1, value1, &
      convention=convESMF, purpose=purpGen, rc=status)
    field9 = ESMF_FieldCreate(grid2, arrayspec=arrayspec, &
              staggerloc=ESMF_STAGGERLOC_CENTER, name="field9", rc=status)
    call ESMF_AttributeAdd(field9, convention=convESMF, purpose=purpGen, &
      rc=status)
    call ESMF_AttributeSet(field9, name1, value1, &
      convention=convESMF, purpose=purpGen, rc=status)
    field10 = ESMF_FieldCreate(grid2, arrayspec=arrayspec, &
              staggerloc=ESMF_STAGGERLOC_CENTER, name="field10", rc=status)
    call ESMF_AttributeAdd(field10, convention=convESMF, purpose=purpGen, &
      rc=status)
    call ESMF_AttributeSet(field10, name1, value1, &
      convention=convESMF, purpose=purpGen, rc=status)
    if (rc/=ESMF_SUCCESS) return

    fieldbundle2 = ESMF_FieldBundleCreate(name="fieldbundle2", rc=status)
    if (status .ne. ESMF_SUCCESS) return

    call ESMF_FieldBundleSet(fieldbundle2, grid=grid2, rc=status)
    if (status .ne. ESMF_SUCCESS) return

    call ESMF_FieldBundleAdd(fieldbundle2, (/ field2, field3, field4, field5, &
                                             field6, field7, field8, field9 /), &
                             rc=status)
    if (status .ne. ESMF_SUCCESS) return

    call ESMF_StateAdd(exportState, fieldList=(/field10/), rc=status)
    if (status .ne. ESMF_SUCCESS) return


    call ESMF_FieldBundleRemove(fieldbundle2, &
                                fieldNameList=(/"field2", "field3"/), rc=status)
    if (status .ne. ESMF_SUCCESS) return


    call ESMF_StateRemove(exportState, itemNameList=(/"fieldbundle"/), rc=status)
    if (status .ne. ESMF_SUCCESS) return
    call ESMF_StateAdd(exportState, fieldbundleList=(/fieldbundle2/), rc=status)
    if (status .ne. ESMF_SUCCESS) return


    call ESMF_FieldBundleAddReplace(fieldbundle2, fieldList=(/field2, field3/), rc=status)
    if (status .ne. ESMF_SUCCESS) return

    call ESMF_FieldBundleRemove(fieldbundle2, &
                                fieldNameList=(/"field4", "field5"/), rc=status)
    if (status .ne. ESMF_SUCCESS) return

    call ESMF_FieldBundleDestroy(fieldbundle, rc=rc)
    call ESMF_FieldDestroy(field, rc=rc)
    call ESMF_GridDestroy(grid)
    call ESMF_FieldDestroy(field4, rc=rc)
    call ESMF_FieldDestroy(field5, rc=rc)

#if 0

AttributeUpdateContainerStress

The State and FieldBundle containers will be stressed with Add, Replace, and Remove
operations on the Attribute bearing objects before they are Reconciled.  After the
Reconcile call tests are done to verify that the structure of the Container is
correct.  Then the remaining Attribute bearing objects will be heavily manipulated
with Attribute packages Added and Removed, and the individual Attributes within them
Set and re-Set and Removed multiple times.  AttributeUpdate will be called and then
another round of tests is done to verify that the Attribute structure and values are
correct.

Pre-Reconcile

create 10 fields and 3 fieldbundles.  each field receives a standard attribute package
with one of the attributes set.  field1 is added to fieldbundle1 which is added to the
state.  fields 2-9 are added to fieldbundle2. field10 is added directly to the state.
field2 and field3 are removed from fieldbundle2, then fieldbundle1 is replaced by
fieldbundle2.  field2 and field3 are added back to fieldbundle2 with an addreplace call
and then field4 and field5 are removed.

after all of this we have fieldbundle2 and field10 on the state and fieldbundle2
should include field2, 3, 6, 7, 8, 9.

#endif


  end subroutine userm1_init