/[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.3 - (show annotations) (download)
Wed Aug 31 21:48:10 2005 UTC (16 years, 1 month ago) by jmc
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +1 -1 lines
FILE REMOVED
use the standard version of ini_curvilinear_grid.F with EXCH2.

1 C $Header: /u/gcmpack/MITgcm/verification/solid-body.cs-32x32x1/code/ini_curvilinear_grid.F,v 1.2 2001/07/31 19:40:30 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 c write(10) XC
193 c write(10) YC
194 c write(10) DXF
195 c write(10) DYF
196 c write(10) RA
197 c write(10) XG
198 c write(10) YG
199 c write(10) DXV
200 c write(10) DYU
201 c write(10) RAZ
202 c write(10) DXC
203 c write(10) DYC
204 c write(10) RAW
205 c write(10) RAS
206 c write(10) DXG
207 c 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