/[MITgcm]/MITgcm/verification/solid-body.cs-32x32x1/code/ini_curvilinear_grid.F
ViewVC logotype

Contents of /MITgcm/verification/solid-body.cs-32x32x1/code/ini_curvilinear_grid.F

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


Revision 1.1 - (show annotations) (download)
Tue Jul 31 18:30:55 2001 UTC (20 years, 2 months ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint40pre5
Solid-body rotation test (Williamson JCP '92: tests 1 & 2)

1 C $Header: /u/gcmpack/models/MITgcmUV/model/src/ini_curvilinear_grid.F,v 1.2 2001/05/29 14:01:37 adcroft Exp $
2 C $Name: $
3
4 #include "CPP_OPTIONS.h"
5
6 SUBROUTINE INI_CURVILINEAR_GRID( myThid )
7 C /==========================================================\
8 C | SUBROUTINE INI_CURVILINEAR_GRID |
9 C | o Initialise curvilinear coordinate system |
10 C |==========================================================|
11 C \==========================================================/
12 IMPLICIT NONE
13
14 C === Global variables ===
15 #include "SIZE.h"
16 #include "EEPARAMS.h"
17 #include "PARAMS.h"
18 #include "GRID.h"
19
20 C == Routine arguments ==
21 C myThid - Number of this instance of INI_CARTESIAN_GRID
22 INTEGER myThid
23
24 C == Local variables ==
25 INTEGER bi,bj,I,J
26 CHARACTER*(12) ff
27
28 C-- Set everything to zero everywhere
29 DO bj = myByLo(myThid), myByHi(myThid)
30 DO bi = myBxLo(myThid), myBxHi(myThid)
31
32 DO J=1-Oly,sNy+Oly
33 DO I=1-Olx,sNx+Olx
34 XC(i,j,bi,bj)=0.
35 YC(i,j,bi,bj)=0.
36 XG(i,j,bi,bj)=0.
37 YG(i,j,bi,bj)=0.
38 DXC(i,j,bi,bj)=0.
39 DYC(i,j,bi,bj)=0.
40 DXG(i,j,bi,bj)=0.
41 DYG(i,j,bi,bj)=0.
42 DXF(i,j,bi,bj)=0.
43 DYF(i,j,bi,bj)=0.
44 DXV(i,j,bi,bj)=0.
45 DYU(i,j,bi,bj)=0.
46 RA(i,j,bi,bj)=0.
47 RAZ(i,j,bi,bj)=0.
48 RAW(i,j,bi,bj)=0.
49 RAS(i,j,bi,bj)=0.
50 tanPhiAtU(i,j,bi,bj)=0.
51 tanPhiAtV(i,j,bi,bj)=0.
52 cosFacU(J,bi,bj)=1.
53 cosFacV(J,bi,bj)=1.
54 sqcosFacU(J,bi,bj)=1.
55 sqcosFacV(J,bi,bj)=1.
56 ENDDO
57 ENDDO
58
59 CALL READSYMTILE_RS('DXF.bin',DXF,0,0,bi,bj,myThid)
60 CALL READSYMTILE_RS('DYF.bin',DYF,0,0,bi,bj,myThid)
61 CALL READSYMTILE_RS('RA.bin',RA,0,0,bi,bj,myThid)
62 CALL READSYMTILE_RS('DXV.bin',DXV,1,1,bi,bj,myThid)
63 CALL READSYMTILE_RS('DYU.bin',DYU,1,1,bi,bj,myThid)
64 CALL READSYMTILE_RS('RAZ.bin',RAZ,1,1,bi,bj,myThid)
65 CALL READSYMTILE_RS('DXC.bin',DXC,1,0,bi,bj,myThid)
66 CALL READSYMTILE_RS('DYC.bin',DYC,0,1,bi,bj,myThid)
67 CALL READSYMTILE_RS('RAW.bin',RAW,1,0,bi,bj,myThid)
68 CALL READSYMTILE_RS('RAS.bin',RAS,0,1,bi,bj,myThid)
69 CALL READSYMTILE_RS('DXG.bin',DXG,0,1,bi,bj,myThid)
70 CALL READSYMTILE_RS('DYG.bin',DYG,1,0,bi,bj,myThid)
71
72 write(ff(1:12),'(a,i3.3,a)') 'LONC.',bi+(bj-1)*nSx,'.bin'
73 CALL READSYMTILE_RS(ff,XC,0,0,bi,bj,myThid)
74 write(ff(1:12),'(a,i3.3,a)') 'LATC.',bi+(bj-1)*nSx,'.bin'
75 CALL READSYMTILE_RS(ff,YC,0,0,bi,bj,myThid)
76 write(ff(1:12),'(a,i3.3,a)') 'LONG.',bi+(bj-1)*nSx,'.bin'
77 CALL READSYMTILE_RS(ff,XG,1,1,bi,bj,myThid)
78 write(ff(1:12),'(a,i3.3,a)') 'LATG.',bi+(bj-1)*nSx,'.bin'
79 CALL READSYMTILE_RS(ff,YG,1,1,bi,bj,myThid)
80
81 ENDDO ! bi
82 ENDDO ! bj
83
84 C Here we make no assumptions about grid symmetry and simply
85 C read the raw grid data from files
86
87 C- Cell centered quantities
88 c CALL MDSREADFIELD('LONC.bin',readBinaryPrec,'RL',1,XC, 1,myThid)
89 c CALL MDSREADFIELD('LATC.bin',readBinaryPrec,'RL',1,YC, 1,myThid)
90 _EXCH_XY_R4(XC,myThid)
91 _EXCH_XY_R4(YC,myThid)
92
93 c CALL MDSREADFIELD('DXF.bin',readBinaryPrec,'RL',1,DXF, 1,myThid)
94 c CALL MDSREADFIELD('DYF.bin',readBinaryPrec,'RL',1,DYF, 1,myThid)
95 C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned, myThid )
96 cs! this is not correct! <= need paired exchange for DXF,DYF
97 _EXCH_XY_R4(DXF,myThid)
98 _EXCH_XY_R4(DYF,myThid)
99
100 c CALL MDSREADFIELD('RA.bin',readBinaryPrec,'RL',1,RA, 1,myThid)
101 _EXCH_XY_R4(RA,myThid )
102
103 C- Corner quantities
104 C *********** this are not degbugged ************
105 c CALL MDSREADFIELD('LONG.bin',readBinaryPrec,'RL',1,XG, 1,myThid)
106 c CALL MDSREADFIELD('LATG.bin',readBinaryPrec,'RL',1,YG, 1,myThid)
107 cs- this block needed by cubed sphere until we write more useful I/O routines
108 bi=3
109 bj=1
110 YG(1,sNy+1,bj,1)=YG(1,1,bi,1)
111 bj=bj+2
112 YG(1,sNy+1,bj,1)=YG(1,1,bi,1)
113 bj=bj+2
114 YG(1,sNy+1,bj,1)=YG(1,1,bi,1)
115 bi=6
116 bj=2
117 YG(sNx+1,1,bj,1)=YG(1,1,bi,1)
118 bj=bj+2
119 YG(sNx+1,1,bj,1)=YG(1,1,bi,1)
120 bj=bj+2
121 YG(sNx+1,1,bj,1)=YG(1,1,bi,1)
122 cs- end block
123 CALL EXCH_Z_XY_RS(XG,myThid)
124 CALL EXCH_Z_XY_RS(YG,myThid)
125
126 c CALL MDSREADFIELD('DXV.bin',readBinaryPrec,'RL',1,DXV, 1,myThid)
127 c CALL MDSREADFIELD('DYU.bin',readBinaryPrec,'RL',1,DYU, 1,myThid)
128 cs- this block needed by cubed sphere until we write more useful I/O routines
129 C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)
130 cs! this is not correct <= need paired exchange for dxv,dyu
131 CALL EXCH_Z_XY_RS(DXV,myThid)
132 CALL EXCH_Z_XY_RS(DYU,myThid)
133 DO bj = myByLo(myThid), myByHi(myThid)
134 DO bi = myBxLo(myThid), myBxHi(myThid)
135 DXV(sNx+1,1,bi,bj)=DXV(1,1,bi,bj)
136 DXV(1,sNy+1,bi,bj)=DXV(1,1,bi,bj)
137 DYU(sNx+1,1,bi,bj)=DYU(1,1,bi,bj)
138 DYU(1,sNy+1,bi,bj)=DYU(1,1,bi,bj)
139 ENDDO
140 ENDDO
141 cs- end block
142 C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)
143 cs! this is not correct <= need paired exchange for dxv,dyu
144 CALL EXCH_Z_XY_RS(DXV,myThid)
145 CALL EXCH_Z_XY_RS(DYU,myThid)
146
147 c CALL MDSREADFIELD('RAZ.bin',readBinaryPrec,'RL',1,RAZ, 1,myThid)
148 cs- this block needed by cubed sphere until we write more useful I/O routines
149 CALL EXCH_Z_XY_RS(RAZ , myThid )
150 DO bj = myByLo(myThid), myByHi(myThid)
151 DO bi = myBxLo(myThid), myBxHi(myThid)
152 RAZ(sNx+1,1,bi,bj)=RAZ(1,1,bi,bj)
153 RAZ(1,sNy+1,bi,bj)=RAZ(1,1,bi,bj)
154 ENDDO
155 ENDDO
156 cs- end block
157 CALL EXCH_Z_XY_RS(RAZ,myThid)
158
159 C- Staggered (u,v pairs) quantities
160 c CALL MDSREADFIELD('DXC.bin',readBinaryPrec,'RL',1,DXC, 1,myThid)
161 c CALL MDSREADFIELD('DYC.bin',readBinaryPrec,'RL',1,DYC, 1,myThid)
162 CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)
163
164 c CALL MDSREADFIELD('RAW.bin',readBinaryPrec,'RL',1,RAW, 1,myThid)
165 c CALL MDSREADFIELD('RAS.bin',readBinaryPrec,'RL',1,RAS, 1,myThid)
166 cs- this block needed by cubed sphere until we write more useful I/O routines
167 DO bj = myByLo(myThid), myByHi(myThid)
168 DO bi = myBxLo(myThid), myBxHi(myThid)
169 DO J = 1,sNy
170 c RAW(sNx+1,J,bi,bj)=RAW(1,J,bi,bj)
171 c RAS(J,sNy+1,bi,bj)=RAS(J,1,bi,bj)
172 ENDDO
173 ENDDO
174 ENDDO
175 cs- end block
176 CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)
177
178 c CALL MDSREADFIELD('DXG.bin',readBinaryPrec,'RL',1,DXG, 1,myThid)
179 c CALL MDSREADFIELD('DYG.bin',readBinaryPrec,'RL',1,DYG, 1,myThid)
180 cs- this block needed by cubed sphere until we write more useful I/O routines
181 DO bj = myByLo(myThid), myByHi(myThid)
182 DO bi = myBxLo(myThid), myBxHi(myThid)
183 DO J = 1,sNy
184 c DYG(sNx+1,J,bi,bj)=DYG(1,J,bi,bj)
185 c DXG(J,sNy+1,bi,bj)=DXG(J,1,bi,bj)
186 ENDDO
187 ENDDO
188 ENDDO
189 cs- end block
190 CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)
191
192 write(10) XC
193 write(10) YC
194 write(10) DXF
195 write(10) DYF
196 write(10) RA
197 write(10) XG
198 write(10) YG
199 write(10) DXV
200 write(10) DYU
201 write(10) RAZ
202 write(10) DXC
203 write(10) DYC
204 write(10) RAW
205 write(10) RAS
206 write(10) DXG
207 write(10) DYG
208
209 RETURN
210 END
211
212 SUBROUTINE READSYMTILE_RS(fileName,array,Xol,Yol,bi,bj,myThid)
213 C /==========================================================\
214 C | SUBROUTINE READSYMTILE_RS |
215 C |==========================================================|
216 C \==========================================================/
217 IMPLICIT NONE
218
219 C === Global variables ===
220 #include "SIZE.h"
221 #include "EEPARAMS.h"
222
223 C == Routine arguments ==
224 CHARACTER*(*) fileName
225 _RS array(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy)
226 INTEGER Xol,Yol,bi,bj,myThid
227
228 C == Local variables ==
229 INTEGER I,J
230
231 _BEGIN_MASTER(myThid)
232 OPEN(36,FILE=fileName,STATUS='OLD',ACCESS='DIRECT',
233 #ifdef REAL4_IS_SLOW
234 & RECL=((sNx+Xol)*(sNy+Yol))*WORDLENGTH*2 )
235 #else
236 & RECL=((sNx+Xol)*(sNy+Yol))*WORDLENGTH )
237 #endif
238 READ(36,REC=1) ((array(I,J,bi,bj),I=1,sNx+Xol),J=1,sNy+Yol)
239 CLOSE(36)
240 #ifdef _BYTESWAPIO
241 #ifdef REAL4_IS_SLOW
242 CALL MDS_BYTESWAPR8((sNx+2*Olx)*(sNy+2*Oly),
243 & array(1-Olx,1-Oly,bi,bj))
244 #else
245 CALL MDS_BYTESWAPR4((sNx+2*Olx)*(sNy+2*Oly),
246 & array(1-Olx,1-Oly,bi,bj))
247 #endif
248 #endif
249
250 C Avoid broken exchanges
251 DO J=1,Oly
252 DO I=1,sNx+Xol
253 array(I,1-J,bi,bj)=array(I,J+Yol,bi,bj)
254 ENDDO
255 ENDDO
256 DO J=1+Yol,Oly
257 DO I=1,sNx+Xol
258 array(I,sNy+J,bi,bj)=array(I,sNy+1-J+Yol,bi,bj)
259 ENDDO
260 ENDDO
261 DO J=1,sNy+Yol
262 c DO J=1-Oly,sNy+Oly
263 DO I=1,Olx
264 array(1-I,J,bi,bj)=array(I+Xol,J,bi,bj)
265 ENDDO
266 ENDDO
267 DO J=1,sNy+Yol
268 c DO J=1-Oly,sNy+Oly
269 DO I=1+Xol,Olx
270 array(sNx+I,J,bi,bj)=array(sNy+1-I+Xol,J,bi,bj)
271 ENDDO
272 ENDDO
273 _END_MASTER(myThid)
274
275 RETURN
276 END

  ViewVC Help
Powered by ViewVC 1.1.22