1 |
C $Header: /u/gcmpack/MITgcm/pkg/exch2/w2_readparms.F,v 1.5 2012/09/04 00:44:30 jmc Exp $ |
2 |
C $Name: BASE $ |
3 |
|
4 |
#include "CPP_EEOPTIONS.h" |
5 |
#include "W2_OPTIONS.h" |
6 |
|
7 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
8 |
CBOP 0 |
9 |
C !ROUTINE: W2_READPARMS |
10 |
|
11 |
C !INTERFACE: |
12 |
SUBROUTINE W2_READPARMS( myThid ) |
13 |
|
14 |
C !DESCRIPTION: |
15 |
C Initialize W2_EXCH2 variables and constants. |
16 |
|
17 |
C !USES: |
18 |
IMPLICIT NONE |
19 |
#include "SIZE.h" |
20 |
#include "EEPARAMS.h" |
21 |
#include "W2_EXCH2_SIZE.h" |
22 |
#include "W2_EXCH2_TOPOLOGY.h" |
23 |
#include "W2_EXCH2_PARAMS.h" |
24 |
|
25 |
C !INPUT PARAMETERS: |
26 |
C myThid :: my Thread Id number |
27 |
C (Note: not relevant since threading has not yet started) |
28 |
INTEGER myThid |
29 |
CEOP |
30 |
|
31 |
C !LOCAL VARIABLES: |
32 |
C === Local variables === |
33 |
C msgBuf :: Informational/error message buffer |
34 |
C iUnit :: Work variable for IO unit number |
35 |
CHARACTER*(MAX_LEN_MBUF) msgBuf |
36 |
LOGICAL fileExist, errFlag |
37 |
INTEGER i, j, iUnit, stdUnit, errCnt |
38 |
C-- Note: To avoid error in reading the namelist, |
39 |
C use larger local array to read-in lists dimsFacets & facetEdgeLink, |
40 |
C store only W2_maxNbFacets values, and stop if more values are found. |
41 |
INTEGER namList_NbFacets |
42 |
PARAMETER ( namList_NbFacets = W2_maxNbFacets*2 ) |
43 |
INTEGER dimsFacets( 2*namList_NbFacets ) |
44 |
Real*4 facetEdgeLink( 4, namList_NbFacets ) |
45 |
|
46 |
C-- topology defined from processing "data.exch2" (selectTopol=0): |
47 |
C dimsFacets :: facet pair of dimensions (n1x,n1y,n2x,n2y ...) |
48 |
C facetEdgeLink :: Face-Edge connectivity map: |
49 |
C facetEdgeLink(i,j)=XX.1 : face(j)-edge(i) (i=1,2,3,4 <==> N,S,E,W) |
50 |
C is connected to Northern edge of face "XX" ; similarly, |
51 |
C = XX.2 : to Southern.E, XX.3 = Eastern.E, XX.4 = Western.E of face "XX". |
52 |
C-- |
53 |
C edges order: N,S,E,W <==> 1,2,3,4 |
54 |
|
55 |
NAMELIST /W2_EXCH2_PARM01/ |
56 |
& preDefTopol, |
57 |
& dimsFacets, facetEdgeLink, |
58 |
& blankList, |
59 |
& W2_mapIO, |
60 |
& W2_printMsg, |
61 |
& W2_useE2ioLayOut |
62 |
|
63 |
stdUnit = standardMessageUnit |
64 |
|
65 |
C-- Default values for W2_EXCH2 |
66 |
W2_printMsg = -1 |
67 |
W2_mapIO = -1 |
68 |
W2_useE2ioLayOut = .TRUE. |
69 |
IF ( useCubedSphereExchange ) THEN |
70 |
preDefTopol = 3 |
71 |
ELSE |
72 |
preDefTopol = 1 |
73 |
ENDIF |
74 |
DO i=1,W2_maxNbTiles |
75 |
blankList(i) = 0 |
76 |
ENDDO |
77 |
|
78 |
C-- Initialise other params in namelist |
79 |
DO j=1,W2_maxNbFacets*2 |
80 |
dimsFacets(2*j-1) = 0 |
81 |
dimsFacets( 2*j ) = 0 |
82 |
DO i=1,4 |
83 |
facetEdgeLink(i,j) = 0. |
84 |
ENDDO |
85 |
ENDDO |
86 |
|
87 |
C- Initialise other parameters: |
88 |
nFacets = 0 |
89 |
nBlankTiles = 0 |
90 |
DO j=1,W2_maxNbFacets |
91 |
facet_dims(2*j-1) = 0 |
92 |
facet_dims( 2*j ) = 0 |
93 |
DO i=1,4 |
94 |
facet_link(i,j) = 0. |
95 |
ENDDO |
96 |
ENDDO |
97 |
|
98 |
C Set filling value for face-corner halo regions |
99 |
e2FillValue_RL = 0. _d 0 |
100 |
e2FillValue_RS = 0. _d 0 |
101 |
e2FillValue_R4 = 0.e0 |
102 |
e2FillValue_R8 = 0.d0 |
103 |
C- for testing only: put a large value (should not affects the results) |
104 |
c e2FillValue_RL = 1. _d+20 |
105 |
c e2FillValue_RS = 1. _d+20 |
106 |
c e2FillValue_R4 = 1.e+20 |
107 |
c e2FillValue_R8 = 1.d+20 |
108 |
|
109 |
C- Check for file "data.ech2": |
110 |
fileExist = .FALSE. |
111 |
INQUIRE( FILE='data.exch2', EXIST=fileExist ) |
112 |
|
113 |
IF ( fileExist ) THEN |
114 |
WRITE(msgBuf,'(A)') 'W2_READPARMS: opening data.exch2' |
115 |
CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid ) |
116 |
CALL OPEN_COPY_DATA_FILE( |
117 |
I 'data.exch2', 'W2_READPARMS', |
118 |
O iUnit, |
119 |
I myThid ) |
120 |
|
121 |
C Read parameters from open data file |
122 |
READ(UNIT=iUnit,NML=W2_EXCH2_PARM01) |
123 |
WRITE(msgBuf,'(A)') |
124 |
& 'W2_READPARMS: finished reading data.exch2' |
125 |
CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid ) |
126 |
C Close the open data file |
127 |
#ifdef SINGLE_DISK_IO |
128 |
CLOSE(iUnit) |
129 |
#else |
130 |
CLOSE(iUnit,STATUS='DELETE') |
131 |
#endif /* SINGLE_DISK_IO */ |
132 |
ELSE |
133 |
WRITE(msgBuf,'(A)') 'W2_READPARMS: file data.exch2 not found' |
134 |
CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid ) |
135 |
IF ( preDefTopol.EQ.1 ) THEN |
136 |
WRITE(msgBuf,'(2A,I3)') '=> use W2_EXCH2 default:', |
137 |
& ' Single sub-domain (nFacets=1)' |
138 |
ELSEIF ( preDefTopol .EQ. 3 ) THEN |
139 |
WRITE(msgBuf,'(2A,I3)') '=> use W2_EXCH2 default:', |
140 |
& ' regular 6-facets Cube' |
141 |
ELSE |
142 |
WRITE(msgBuf,'(2A,I3)') '=> use W2_EXCH2 default:', |
143 |
& ' preDefTopol=', preDefTopol |
144 |
ENDIF |
145 |
CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid ) |
146 |
ENDIF |
147 |
|
148 |
C-- copy local arrays dimsFacets & facetEdgeLink to var in common block |
149 |
DO j=1,2*W2_maxNbFacets |
150 |
c write(0,*) j, dimsFacets(j) |
151 |
facet_dims(j) = dimsFacets(j) |
152 |
ENDDO |
153 |
DO j=1,W2_maxNbFacets |
154 |
DO i=1,4 |
155 |
facet_link(i,j) = facetEdgeLink(i,j) |
156 |
ENDDO |
157 |
ENDDO |
158 |
|
159 |
C-- Check if too many values are specified in data.exch2: |
160 |
errCnt = 0 |
161 |
DO j=W2_maxNbFacets+1,namList_NbFacets |
162 |
errFlag = .FALSE. |
163 |
DO i=1,4 |
164 |
IF ( facetEdgeLink(i,j).NE.0. ) errFlag = .TRUE. |
165 |
ENDDO |
166 |
IF ( errFlag ) errCnt = errCnt + 1 |
167 |
ENDDO |
168 |
IF ( errCnt.GT.0 ) THEN |
169 |
WRITE(msgBuf,'(2A)') ' W2_READPARMS:', |
170 |
& ' Number of "facetEdgeLink" list in "data.exch2"' |
171 |
CALL PRINT_ERROR( msgBuf, myThid ) |
172 |
WRITE(msgBuf,'(A,2(A,I3))') ' W2_READPARMS:', |
173 |
& ' exceeds maxNbFacets(=',W2_maxNbFacets,') by', errCnt |
174 |
CALL PRINT_ERROR( msgBuf, myThid ) |
175 |
errFlag = .TRUE. |
176 |
ELSE |
177 |
errFlag = .FALSE. |
178 |
ENDIF |
179 |
|
180 |
errCnt = 0 |
181 |
DO j=2*W2_maxNbFacets+1,2*namList_NbFacets |
182 |
IF ( dimsFacets(j).NE.0 ) errCnt = errCnt + 1 |
183 |
ENDDO |
184 |
IF ( errCnt.GT.0 ) THEN |
185 |
WRITE(msgBuf,'(2A)') ' W2_READPARMS:', |
186 |
& ' Number of "dimsFacets" in "data.exch2"' |
187 |
CALL PRINT_ERROR( msgBuf, myThid ) |
188 |
WRITE(msgBuf,'(A,2(A,I3))') ' W2_READPARMS:', |
189 |
& ' exceeds 2*maxNbFacets(=',W2_maxNbFacets*2,') by', errCnt |
190 |
CALL PRINT_ERROR( msgBuf, myThid ) |
191 |
ENDIF |
192 |
IF ( errFlag .OR. errCnt.GT.0 ) THEN |
193 |
STOP 'ABNORMAL END: S/R W2_READPARMS' |
194 |
ENDIF |
195 |
|
196 |
C-- Print some Exch2 parameters: |
197 |
WRITE(msgBuf,'(A,L5,A)') 'W2_useE2ioLayOut=', W2_useE2ioLayOut, |
198 |
& ' ;/* T: use Exch2 glob IO map; F: use model default */' |
199 |
CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid ) |
200 |
WRITE(msgBuf,'(A,I4,A)') 'W2_mapIO =', W2_mapIO, |
201 |
& ' ; /* select option for Exch2 global-IO map */' |
202 |
CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid ) |
203 |
WRITE(msgBuf,'(A,I4,A)') 'W2_printMsg =', W2_printMsg, |
204 |
& ' ; /* select option for printing information */' |
205 |
CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid ) |
206 |
|
207 |
RETURN |
208 |
END |