PRM/prmtop_mod.dir/prmtop.F90

      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
1	cnh	1.1	MODULE PRMTop
2
3			USE EEsmfMod
4
5			! Internal state type for a PRMTop component
6			! nSets :: Total number of component sets in this PRM.
7			! cTypeArr :: Array of nSets values that specify the
8			! :: component type of the components in
9			! :: a component set.
10			! ncTypeArr :: Number of entries in cTypeArr (should
11			! :: be the same as nSets).
12			! fPrefArr :: Array of prefix strings used to name
13			! :: the components.
14			! nFPrefArr :: Number of entries in fPrefArr (should
15			! :: be the same as nSets).
16			! nComps :: Number of components in each component
17			! :: set.
18			! nNComps :: Number of entries in the nComps list.
19			! :: (should be the same as nSets).
20			! topTimeStep :: Time step for PRMTop.
21			! topStartStep :: Time to start run.
22			! topEndTime :: Time to end run.
23			! topStartStep :: Starting step number.
24			! rootDirectory :: Root directory for all relative pathnames used
25			! :: in PRMTop
26			TYPE PRMTopInternalState
27			INTEGER :: nSets
28			CHARACTER(LEN=1024), POINTER :: cTypeArr(:)
29			INTEGER :: nCTypeArr
30			CHARACTER(LEN=1024), POINTER :: fPrefArr(:)
31			INTEGER :: nFPrefArr
32			INTEGER, POINTER :: nComps(:)
33			INTEGER :: nNComps
34			INTEGER :: topTimeStep
35			INTEGER :: topStartTime
36			INTEGER :: topEndTime
37			INTEGER :: topStartStep
38			CHARACTER(LEN=MAX_DIR_NAME), POINTER :: rootDirectory
39			END TYPE
40
41			CONTAINS
42
43			SUBROUTINE ComponentsInit( theComponents )
44			!
45			! Set up the components for this experiment.
46			! This is done by allocating a series of combined component and state
47			! derived type objects. The returned list of components is then assigned
48			! to point to this set of objects.
49
50			! Routine arguments
51			TYPE( EEsmfComponentList ), POINTER :: theComponents
52
53			! Local variables
54			TYPE( PRMTopInternalState ), POINTER :: internalState
55			TYPE( EEsmfGridComp ), ALLOCATABLE :: coarseGridOcean(:)
56			TYPE( EEsmfGridComp ), ALLOCATABLE :: fineGridOceans(:)
57			TYPE( EEsmfCplComp ), ALLOCATABLE :: coarse2fine(:)
58			TYPE( EEsmfCplComp ), ALLOCATABLE :: fine2coarse(:)
59			TYPE( EEsmfGridComp ), POINTER :: gcArr(:)
60			TYPE( EEsmfCplComp ), POINTER :: ccArr(:)
61
62			!
63			! Boot up ESMF
64			CALL PRMBoot( 'prmtop.rc', internalState )
65			IF ( internalState%nFPrefArr .NE. internalState%nSets ) THEN
66			STOP 'ABNORMAL END: PRMTop found too few file prefix entries'
67			ENDIF
68			IF ( internalState%nCTypeArr .NE. internalState%nSets ) THEN
69			STOP 'ABNORMAL END: PRMTop found too few component type entries'
70			ENDIF
71			IF ( internalState%nNComps .NE. internalState%nSets ) THEN
72			STOP 'ABNORMAL END: PRMTop found too few component count entries'
73			ENDIF
74			!
75			! Allocate requested gridded and coupler components.
76			DO I=1,internalState%nSets
77			IF ( TRIM(internalState%cTypeArr(I)) .EQ. 'gridded' ) THEN
78			CALL EEsmfAllocGridC( gcArr, internalState%nComps(I) )
79			ENDIF
80			IF ( TRIM(internalState%cTypeArr(I)) .EQ. 'coupler' ) THEN
81			CALL EEsmfAllocCplC( ccArr, internalState%nComps(I) )
82			ENDIF
83			ENDDO
84			CALL PRMShut( internalState )
85			! CALL EEsmfAllocGridC( coarseGridOcean, 1 )
86			! CALL EEsmfAllocGridC( fineGridOceans, nFine )
87			! CALL EEsmfAllocCplC( coarse2Fine, nFine )
88			! CALL EEsmfAllocCplC( fine2Coarse, 1 )
89			!
90			! Setup the components we need
91			CALL EEsmfMakeGridComp(coarseGridOcean,
92			I 'cg.rc')
93			CALL EEsmfMakeGridComp( fineGridOceans,
94			& 'fg.rc')
95			CALL EEsmfMakeCplComp( fine2coarse, fineGridOceans,
96			& coarseGridOcean,
97			I 'f2c.rc')
98			CALL EEsmfMakeCplComp( coarse2fine, coarseGridOcean,
99			& fineGridOceans,
100			I 'c2f.rc')
101
102
103			END SUBROUTINE ComponentsInit
104
105			SUBROUTINE ComponentsRun( theComponents )
106			TYPE( EEsmfComponentList ), POINTER :: theComponents
107			END SUBROUTINE ComponentsRun
108
109			SUBROUTINE ComponentsFinalize( theComponents )
110			TYPE( EEsmfComponentList ), POINTER :: theComponents
111			END SUBROUTINE ComponentsFinalize
112
113			SUBROUTINE PRMBoot( theResourceFile, theState )
114
115			! Routine arguments
116			CHARACTER() :: theResourceFile
117			TYPE( PRMTopInternalState ), POINTER :: theState
118
119			! Local variables
120			INTEGER rc
121			TYPE (ESMF_Config) :: cf
122			INTEGER :: nSets, nComps, I
123			CHARACTER(len=1024) :: fPref
124			CHARACTER(len=1024) :: cType
125
126			! Boot PRMTop
127
128			! Allocate a PRMTop internal state object
129			ALLOCATE( theState )
130
131			! Read PRM config
132			cf = ESMF_ConfigCreate(rc)
133			CALL ESMF_ConfigLoadFile( cf, theResourceFile, rc = rc)
134
135			! Find how many sets of components have been requested.
136			! If the number requested is less than 1 it is an error.
137			CALL EEsmf_ReadConfig( cf, label='nsets:', default=1,
138			& rVal=theState%nSets, rc=rc )
139			IF ( theState%nSets <= 0 ) THEN
140			STOP 'ABNORMAL END:: PRMTop - nSets <= 0'
141			ENDIF
142
143			! Get basic details for each components set
144			ALLOCATE( theState%cTypeArr(theState%nSets) )
145			ALLOCATE( theState%fPrefArr(theState%nSets) )
146			ALLOCATE( theState%nComps(theState%nSets) )
147			theState%nCTypeArr = 0
148			theState%nFPrefArr = 0
149			theState%nNComps = 0
150
151			DO I=1,theState%nSets
152			! Get the component type for each component set.
153			CALL EEsmf_ReadConfig( cf, label='ctype:', default='gridded', index=I,
154			& rVal=theState%cTypeArr(I), rc=rc )
155			IF ( rc .EQ. ESMF_SUCCESS ) theState%nCTypeArr = theState%nCTypeArr+1
156			! Get the number of components to create for each component set.
157			CALL EEsmf_ReadConfig( cf, label='counts:', default=1, index=I,
158			& rVal=theState%nComps(I), rc=rc )
159			IF ( rc .EQ. ESMF_SUCCESS ) theState%nNComps = theState%nNComps+1
160			! Get the prefix label used to distinguish each component set.
161			CALL EEsmf_ReadConfig( cf, label='preflist:', default='cg', index=I,
162			& rVal=theState%fPrefArr(I), rc=rc )
163			IF ( rc .EQ. ESMF_SUCCESS ) theState%nFPrefArr = theState%nFPrefArr+1
164			ENDDO
165
166			CALL EEsmf_ReadConfig( cf, label='topStartTime:', default=0,
167			& rVal=theState%topStartTime, rc=rc )
168
169			END SUBROUTINE PRMBoot
170
171			SUBROUTINE PRMShut( theState )
172
173			! Routine arguments
174			TYPE( PRMTopInternalState ), POINTER :: theState
175
176			! Free PRM internal data
177			DEALLOCATE( theState%fPrefArr )
178			DEALLOCATE( theState%cTypeArr )
179			DEALLOCATE( theState%nComps )
180
181			! Free PRMTop internal state object
182			DEALLOCATE( theState )
183
184			END SUBROUTINE PRMShut
185
186			END MODULE PRMTop