/[MITgcm]/MITgcm_contrib/PRM/prmtop_mod.dir/prmtop.F90
ViewVC logotype

Contents of /MITgcm_contrib/PRM/prmtop_mod.dir/prmtop.F90

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.2 - (show annotations) (download)
Tue Apr 5 19:57:02 2005 UTC (19 years, 1 month ago) by cnh
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +0 -0 lines
FILE REMOVED
Making it compile!

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

  ViewVC Help
Powered by ViewVC 1.1.22