MODULE PRMTop USE EEsmfMod ! Internal state type for a PRMTop component ! nSets :: Total number of component sets in this PRM. ! cTypeArr :: Array of nSets values that specify the ! :: component type of the components in ! :: a component set. ! ncTypeArr :: Number of entries in cTypeArr (should ! :: be the same as nSets). ! fPrefArr :: Array of prefix strings used to name ! :: the components. ! nFPrefArr :: Number of entries in fPrefArr (should ! :: be the same as nSets). ! nComps :: Number of components in each component ! :: set. ! nNComps :: Number of entries in the nComps list. ! :: (should be the same as nSets). ! topTimeStep :: Time step for PRMTop. ! topStartStep :: Time to start run. ! topEndTime :: Time to end run. ! topStartStep :: Starting step number. ! rootDirectory :: Root directory for all relative pathnames used ! :: in PRMTop TYPE PRMTopInternalState INTEGER :: nSets CHARACTER(LEN=1024), POINTER :: cTypeArr(:) INTEGER :: nCTypeArr CHARACTER(LEN=1024), POINTER :: fPrefArr(:) INTEGER :: nFPrefArr INTEGER, POINTER :: nComps(:) INTEGER :: nNComps INTEGER :: topTimeStep INTEGER :: topStartTime INTEGER :: topEndTime INTEGER :: topStartStep CHARACTER(LEN=MAX_DIR_NAME), POINTER :: rootDirectory END TYPE CONTAINS SUBROUTINE ComponentsInit( theComponents ) ! ! Set up the components for this experiment. ! This is done by allocating a series of combined component and state ! derived type objects. The returned list of components is then assigned ! to point to this set of objects. ! Routine arguments TYPE( EEsmfComponentList ), POINTER :: theComponents ! Local variables TYPE( PRMTopInternalState ), POINTER :: internalState TYPE( EEsmfGridComp ), ALLOCATABLE :: coarseGridOcean(:) TYPE( EEsmfGridComp ), ALLOCATABLE :: fineGridOceans(:) TYPE( EEsmfCplComp ), ALLOCATABLE :: coarse2fine(:) TYPE( EEsmfCplComp ), ALLOCATABLE :: fine2coarse(:) TYPE( EEsmfGridComp ), POINTER :: gcArr(:) TYPE( EEsmfCplComp ), POINTER :: ccArr(:) ! ! Boot up ESMF CALL PRMBoot( 'prmtop.rc', internalState ) IF ( internalState%nFPrefArr .NE. internalState%nSets ) THEN STOP 'ABNORMAL END: PRMTop found too few file prefix entries' ENDIF IF ( internalState%nCTypeArr .NE. internalState%nSets ) THEN STOP 'ABNORMAL END: PRMTop found too few component type entries' ENDIF IF ( internalState%nNComps .NE. internalState%nSets ) THEN STOP 'ABNORMAL END: PRMTop found too few component count entries' ENDIF ! ! Allocate requested gridded and coupler components. DO I=1,internalState%nSets IF ( TRIM(internalState%cTypeArr(I)) .EQ. 'gridded' ) THEN CALL EEsmfAllocGridC( gcArr, internalState%nComps(I) ) ENDIF IF ( TRIM(internalState%cTypeArr(I)) .EQ. 'coupler' ) THEN CALL EEsmfAllocCplC( ccArr, internalState%nComps(I) ) ENDIF ENDDO CALL PRMShut( internalState ) ! CALL EEsmfAllocGridC( coarseGridOcean, 1 ) ! CALL EEsmfAllocGridC( fineGridOceans, nFine ) ! CALL EEsmfAllocCplC( coarse2Fine, nFine ) ! CALL EEsmfAllocCplC( fine2Coarse, 1 ) ! ! Setup the components we need CALL EEsmfMakeGridComp(coarseGridOcean, I 'cg.rc') CALL EEsmfMakeGridComp( fineGridOceans, & 'fg.rc') CALL EEsmfMakeCplComp( fine2coarse, fineGridOceans, & coarseGridOcean, I 'f2c.rc') CALL EEsmfMakeCplComp( coarse2fine, coarseGridOcean, & fineGridOceans, I 'c2f.rc') END SUBROUTINE ComponentsInit SUBROUTINE ComponentsRun( theComponents ) TYPE( EEsmfComponentList ), POINTER :: theComponents END SUBROUTINE ComponentsRun SUBROUTINE ComponentsFinalize( theComponents ) TYPE( EEsmfComponentList ), POINTER :: theComponents END SUBROUTINE ComponentsFinalize SUBROUTINE PRMBoot( theResourceFile, theState ) ! Routine arguments CHARACTER*(*) :: theResourceFile TYPE( PRMTopInternalState ), POINTER :: theState ! Local variables INTEGER rc TYPE (ESMF_Config) :: cf INTEGER :: nSets, nComps, I CHARACTER(len=1024) :: fPref CHARACTER(len=1024) :: cType ! Boot PRMTop ! Allocate a PRMTop internal state object ALLOCATE( theState ) ! Read PRM config cf = ESMF_ConfigCreate(rc) CALL ESMF_ConfigLoadFile( cf, theResourceFile, rc = rc) ! Find how many sets of components have been requested. ! If the number requested is less than 1 it is an error. CALL EEsmf_ReadConfig( cf, label='nsets:', default=1, & rVal=theState%nSets, rc=rc ) IF ( theState%nSets <= 0 ) THEN STOP 'ABNORMAL END:: PRMTop - nSets <= 0' ENDIF ! Get basic details for each components set ALLOCATE( theState%cTypeArr(theState%nSets) ) ALLOCATE( theState%fPrefArr(theState%nSets) ) ALLOCATE( theState%nComps(theState%nSets) ) theState%nCTypeArr = 0 theState%nFPrefArr = 0 theState%nNComps = 0 DO I=1,theState%nSets ! Get the component type for each component set. CALL EEsmf_ReadConfig( cf, label='ctype:', default='gridded', index=I, & rVal=theState%cTypeArr(I), rc=rc ) IF ( rc .EQ. ESMF_SUCCESS ) theState%nCTypeArr = theState%nCTypeArr+1 ! Get the number of components to create for each component set. CALL EEsmf_ReadConfig( cf, label='counts:', default=1, index=I, & rVal=theState%nComps(I), rc=rc ) IF ( rc .EQ. ESMF_SUCCESS ) theState%nNComps = theState%nNComps+1 ! Get the prefix label used to distinguish each component set. CALL EEsmf_ReadConfig( cf, label='preflist:', default='cg', index=I, & rVal=theState%fPrefArr(I), rc=rc ) IF ( rc .EQ. ESMF_SUCCESS ) theState%nFPrefArr = theState%nFPrefArr+1 ENDDO CALL EEsmf_ReadConfig( cf, label='topStartTime:', default=0, & rVal=theState%topStartTime, rc=rc ) END SUBROUTINE PRMBoot SUBROUTINE PRMShut( theState ) ! Routine arguments TYPE( PRMTopInternalState ), POINTER :: theState ! Free PRM internal data DEALLOCATE( theState%fPrefArr ) DEALLOCATE( theState%cTypeArr ) DEALLOCATE( theState%nComps ) ! Free PRMTop internal state object DEALLOCATE( theState ) END SUBROUTINE PRMShut END MODULE PRMTop