-
Notifications
You must be signed in to change notification settings - Fork 0
/
CELLMAP.for
297 lines (293 loc) · 8.23 KB
/
CELLMAP.for
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
SUBROUTINE CELLMAP
C
C ** SUBROUTINE CELLMAP GENERATES CELL MAPPINGS
C CHANGE RECORD
C
USE GLOBAL
C
C ** SET 1D CELL INDEX SEQUENCE AND MAPPINGS
C
C OPEN(1,FILE='CELL9.OUT',STATUS='UNKNOWN')
C WRITE (1,1616)IC,JC
L=2
DO J=1,JC
DO I=1,IC
IF(IJCT(I,J).GT.0.AND.IJCT(I,J).LT.9)THEN
IL(L)=I
JL(L)=J
LCT(L)=IJCT(I,J)
LIJ(I,J)=L
L=L+1
ENDIF
C IF(IJCT(I,J).EQ.9) WRITE(1,1616)I,J
ENDDO
ENDDO
LA=L-1
LCTT=L
IF(LCTT.NE.LC)THEN
WRITE(6,1617)LCTT,LC
WRITE(7,1617)LCTT,LC
WRITE(8,1617)LCTT,LC
STOP
ENDIF
IL(1)=0
IL(LC)=0
JL(1)=0
JL(LC)=0
c WRITE(1,601)LA
WRITE(7,601)LA
WRITE(8,601)LA
c CLOSE(1)
601 FORMAT(' LA=',I10,//)
1616 FORMAT(2I10)
1617 FORMAT(' LC =',I5,' DETERMINED IN CELLMAP',
& ' INCONSISTENT WITH INPUT VALUE =',I5//)
IF(ISWASP.LE.5)THEN
L=2
DO J=1,JC
DO I=1,IC
IF(IJCTLT(I,J).GT.0.AND.IJCTLT(I,J).LT.9)THEN
ILLT(L)=I
JLLT(L)=J
LCTLT(L)=IJCTLT(I,J)
LIJLT(I,J)=L
L=L+1
ENDIF
ENDDO
ENDDO
LALT=L-1
LCLT=L
ENDIF
IF(ISWASP.GE.6)THEN
L=2
DO J=1,JC
DO I=1,IC
IF(IJCTLT(I,J).GT.0.AND.IJCTLT(I,J).LT.7)THEN
ILLT(L)=I
JLLT(L)=J
LCTLT(L)=IJCTLT(I,J)
LIJLT(I,J)=L
L=L+1
ENDIF
ENDDO
ENDDO
LALT=L-1
LCLT=L
ENDIF
WRITE(7,1616)LALT,LCLT
WRITE(8,1616)LALT,LCLT
C
C ** ASSIGN RED AND BLACK CELL SEQUENCES (PMC - NOT FUNCTIONAL)
C
!IF(IRVEC.NE.9)THEN
!ENDIF
C
C ** SET NORTH AND SOUTH CELL IDENTIFIER ARRAYS
C
LNC(1)=LC
LSC(1)=LC
LNEC(1)=LC
LNWC(1)=LC
LSEC(1)=LC
LSWC(1)=LC
LNC(LC)=1
LSC(LC)=1
LNEC(LC)=1
LNWC(LC)=1
LSEC(LC)=1
LSWC(LC)=1
DO L=2,LA
I=IL(L)
J=JL(L)
IF(IJCT(I,J+1).EQ.9)THEN
LNC(L)=LC
ELSE
LNC(L)=LIJ(I,J+1)
ENDIF
IF(IJCT(I,J-1).EQ.9)THEN
LSC(L)=LC
ELSE
LSC(L)=LIJ(I,J-1)
ENDIF
IF(IJCT(I+1,J+1).EQ.9)THEN
LNEC(L)=LC
ELSE
LNEC(L)=LIJ(I+1,J+1)
ENDIF
IF(IJCT(I-1,J+1).EQ.9)THEN
LNWC(L)=LC
ELSE
LNWC(L)=LIJ(I-1,J+1)
ENDIF
IF(IJCT(I+1,J-1).EQ.9)THEN
LSEC(L)=LC
ELSE
LSEC(L)=LIJ(I+1,J-1)
ENDIF
IF(IJCT(I-1,J-1).EQ.9)THEN
LSWC(L)=LC
ELSE
LSWC(L)=LIJ(I-1,J-1)
ENDIF
ENDDO
C
C ** MODIFY NORTH-SOUTH CELL MAPPING FOR PERIOD GRID IN N-S DIRECTION
C
IF(ISPGNS.GE.1)THEN
DO NPN=1,NPNSBP
LS=LIJ(ISPNS(NPN),JSPNS(NPN))
LSC(LS)=LIJ(INPNS(NPN),JNPNS(NPN))
IF( IJCT(INPNS(NPN)+1,JNPNS(NPN)).EQ.9)THEN
LSEC(LS)=LC
ELSE
LSEC(LS)=LIJ(INPNS(NPN)+1,JNPNS(NPN))
ENDIF
IF( IJCT(INPNS(NPN)-1,JNPNS(NPN)).EQ.9)THEN
LSWC(LS)=LC
ELSE
LSWC(LS)=LIJ(INPNS(NPN)-1,JNPNS(NPN))
ENDIF
LN=LIJ(INPNS(NPN),JNPNS(NPN))
LNC(LN)=LIJ(ISPNS(NPN),JSPNS(NPN))
IF( IJCT(ISPNS(NPN)+1,JSPNS(NPN)).EQ.9)THEN
LNEC(LN)=LC
ELSE
LNEC(LN)=LIJ(ISPNS(NPN)+1,JSPNS(NPN))
ENDIF
IF( IJCT(ISPNS(NPN)-1,JSPNS(NPN)).EQ.9)THEN
LNWC(LN)=LC
ELSE
LNWC(LN)=LIJ(ISPNS(NPN)-1,JSPNS(NPN))
ENDIF
ENDDO
ENDIF
C
C ** SET LT NORTH AND SOUTH CELL IDENTIFIER ARRAYS
C
LNCLT(1)=LCLT
LSCLT(1)=LCLT
LNCLT(LC)=1
LSCLT(LC)=1
DO L=2,LALT
I=ILLT(L)
J=JLLT(L)
IF(IJCTLT(I,J+1).EQ.9)THEN
LNCLT(L)=LCLT
ELSE
LNCLT(L)=LIJLT(I,J+1)
ENDIF
IF(IJCTLT(I,J-1).EQ.9)THEN
LSCLT(L)=LCLT
ELSE
LSCLT(L)=LIJLT(I,J-1)
ENDIF
ENDDO
C
C hnr start modification may 2002---------------------------------C
C
C ** MODIFY lt NORTH-SOUTH CELL MAPPING FOR PERIOD GRID IN N-S DIRECTION
C
IF (ISPGNS.GE.1) THEN
DO NPN=1,NPNSBP
C
C SET NORTH CELL SOUTH OF SOUTH CELL
C
LS=LIJLT(ISPNS(NPN),JSPNS(NPN))
LSCLT(LS)=LIJLT(INPNS(NPN),JNPNS(NPN))
C
C SET SOUTH CELL NORTH OF NORTH CELL
C
LN=LIJLT(INPNS(NPN),JNPNS(NPN))
LNCLT(LN)=LIJLT(ISPNS(NPN),JSPNS(NPN))
END DO
END IF
C
C hnr end modification may 2002 -----------------------------------C
C
C ** SET NORTH, SOUTH, EAST AND WEST RED CELL IDENTIFIER ARRAYS (NOT FUNCTIONAL)
C
!IF(IRVEC.NE.9)THEN
!ENDIF
C
C ** SET NORTH, SOUTH, EAST AND WEST BLACK CELL IDENTIFIER ARRAYS (NOT FUNCTIONAL)
C
!IF(IRVEC.NE.9)THEN
!ENDIF
C
C ** DIAGNOSE OF RED-BLACK CELL MAPPING
C
!IF(IRVEC.EQ.2.OR.IRVEC.EQ.9) GOTO 220
C ! PMC - NOT USED
C ** RED CELL LOOP (PMC - RED/BLACK ITERATIVE SOLVER NOT FUNCIONAL)
C
!DO LR=1,NRC
!ENDDO
C
C ** BLACK CELL LOOP
C
!DO LB=1,NBC
!ENDDO
! 220 CONTINUE
101 FORMAT(' LR,LTMP = ',2I6/)
102 FORMAT(' LR,LTMP = ',2I6/)
103 FORMAT(' LN= 1, LR,LTMP,ITMP,JTMP = ',4I6/)
104 FORMAT(' LN=LC, LR,LTMP,ITMP,JTMP = ',4I6/)
105 FORMAT(' NERR, LR,LTMP,ITMP,JTMP,INTMP,JNTMP = ',6I6/)
106 FORMAT(' NERR, LR,LTMP,ITMP,JTMP,INTMP,JNTMP = ',6I6/)
107 FORMAT(' LS= 1, LR,LTMP,ITMP,JTMP = ',4I6/)
108 FORMAT(' LS=LC, LR,LTMP,ITMP,JTMP = ',4I6/)
109 FORMAT(' SERR, LR,LTMP,ITMP,JTMP,ISTMP,JSTMP = ',6I6/)
110 FORMAT(' SERR, LR,LTMP,ITMP,JTMP,ISTMP,JSTMP = ',6I6/)
111 FORMAT(' LE= 1, LR,LTMP,ITMP,JTMP = ',4I6/)
112 FORMAT(' LE=LC, LR,LTMP,ITMP,JTMP = ',4I6/)
113 FORMAT(' EERR, LR,LTMP,ITMP,JTMP,IETMP,JETMP = ',6I6/)
114 FORMAT(' EERR, LR,LTMP,ITMP,JTMP,IETMP,JETMP = ',6I6/)
115 FORMAT(' LW= 1, LR,LTMP,ITMP,JTMP = ',4I6/)
116 FORMAT(' LW=LC, LR,LTMP,ITMP,JTMP = ',4I6/)
117 FORMAT(' WERR, LR,LTMP,ITMP,JTMP,IWTMP,JWTMP = ',6I6/)
118 FORMAT(' WERR, LR,LTMP,ITMP,JTMP,IWTMP,JWTMP = ',6I6/)
201 FORMAT(' LB,LTMP = ',2I6/)
202 FORMAT(' LB,LTMP = ',2I6/)
203 FORMAT(' LN= 1, LB,LTMP,ITMP,JTMP = ',4I6/)
204 FORMAT(' LN=LC, LB,LTMP,ITMP,JTMP = ',4I6/)
205 FORMAT(' NERR, LB,LTMP,ITMP,JTMP,INTMP,JNTMP = ',6I6/)
206 FORMAT(' NERR, LB,LTMP,ITMP,JTMP,INTMP,JNTMP = ',6I6/)
207 FORMAT(' LS= 1, LB,LTMP,ITMP,JTMP = ',4I6/)
208 FORMAT(' LS=LC, LB,LTMP,ITMP,JTMP = ',4I6/)
209 FORMAT(' SERR, LB,LTMP,ITMP,JTMP,ISTMP,JSTMP = ',6I6/)
210 FORMAT(' SERR, LB,LTMP,ITMP,JTMP,ISTMP,JSTMP = ',6I6/)
211 FORMAT(' LE= 1, LB,LTMP,ITMP,JTMP = ',4I6/)
212 FORMAT(' LE=LC, LB,LTMP,ITMP,JTMP = ',4I6/)
213 FORMAT(' EERR, LB,LTMP,ITMP,JTMP,IETMP,JETMP = ',6I6/)
214 FORMAT(' EERR, LB,LTMP,ITMP,JTMP,IETMP,JETMP = ',6I6/)
215 FORMAT(' LW= 1, LB,LTMP,ITMP,JTMP = ',4I6/)
216 FORMAT(' LW=LC, LB,LTMP,ITMP,JTMP = ',4I6/)
217 FORMAT(' WERR, LB,LTMP,ITMP,JTMP,IWTMP,JWTMP = ',6I6/)
218 FORMAT(' WERR, LB,LTMP,ITMP,JTMP,IWTMP,JWTMP = ',6I6/)
119 FORMAT(' SUB(LETMP) = ',F10.2/)
120 FORMAT(' SUB(LTMP) = ',F10.2/)
C
C ** DEFINE MAPPING TO 3D GRAPHICS GRID
C
IF(ISCLO.EQ.0.OR.NWGG.EQ.0)THEN
IG=IC
JG=JC
ELSE
OPEN(1,FILE='GCELLMP.INP',STATUS='UNKNOWN')
READ(1,1111)
READ(1,1111)
READ(1,1111)
READ(1,1111)
READ(1,*)IG,JG
DO NW=1,NWGG
READ(1,*)IGTMP,JGTMP,ICOMP,JCOMP
LTMP=LIJ(ICOMP,JCOMP)
IWGG(NW)=IGTMP
JWGG(NW)=JGTMP
LWGG(NW)=LTMP
ENDDO
CLOSE(1)
ENDIF
1111 FORMAT(80X)
RETURN
END