/[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.2 - (show annotations) (download)
Tue Jul 31 19:40:30 2001 UTC (20 years, 4 months ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint48f_post, checkpoint46k_post, checkpoint51k_post, checkpoint53f_post, checkpoint47j_post, checkpoint54a_pre, checkpoint55c_post, checkpoint53b_pre, checkpoint48d_pre, checkpoint51l_post, checkpoint51j_post, branch-exfmods-tag, checkpoint47e_post, checkpoint57m_post, checkpoint44h_pre, checkpoint47i_post, checkpoint52l_pre, checkpoint48i_post, checkpoint52e_pre, release1_p12, release1_p13, release1_p10, release1_p11, release1_p16, checkpoint57g_pre, checkpoint52j_post, release1_p15, checkpoint47f_post, checkpoint48d_post, checkpoint51o_pre, checkpoint57f_post, checkpoint46j_post, checkpoint47c_post, checkpoint50e_post, checkpoint52e_post, checkpoint50c_post, checkpoint46i_post, checkpoint51n_pre, checkpoint47d_post, checkpoint44e_post, checkpoint57j_post, checkpoint44f_pre, checkpoint47a_post, checkpoint57b_post, checkpoint46f_post, checkpoint46l_pre, checkpoint53c_post, checkpoint53d_post, checkpoint57f_pre, checkpoint48a_post, checkpoint55d_pre, checkpoint51f_pre, release1_beta1, checkpoint46d_pre, checkpoint57g_post, checkpoint48e_post, checkpoint46e_post, checkpoint57c_pre, checkpoint48h_post, checkpoint55j_post, checkpoint56b_post, checkpoint50c_pre, release1-branch_tutorials, checkpoint57h_pre, checkpoint46c_post, release1_p14, checkpoint44g_post, branchpoint-genmake2, checkpoint46h_pre, checkpoint44h_post, checkpoint46l_post, checkpoint50b_pre, checkpoint52j_pre, checkpoint54a_post, checkpoint46e_pre, checkpoint43a-release1mods, branch-netcdf, checkpoint50d_pre, checkpoint55h_post, checkpoint45d_post, checkpoint51r_post, checkpoint52b_pre, checkpoint52n_post, checkpoint54b_post, checkpoint46j_pre, checkpoint45b_post, checkpoint46b_pre, checkpoint51i_post, checkpoint57e_post, checkpoint54d_post, checkpoint47h_post, checkpoint48c_post, chkpt44a_pre, release1-branch-end, checkpoint56c_post, checkpoint54e_post, release1_final_v1, checkpoint55b_post, checkpoint51e_post, checkpoint51b_post, checkpoint46, checkpoint57h_post, checkpoint51l_pre, checkpoint52m_post, checkpoint51c_post, checkpoint46c_pre, checkpoint55, checkpoint53a_post, checkpoint41, checkpoint55a_post, checkpoint57a_post, checkpoint44, checkpoint45, checkpoint48, checkpoint49, checkpoint44f_post, checkpoint47b_post, checkpoint56, checkpoint57o_post, checkpoint55g_post, checkpoint57h_done, checkpoint51o_post, checkpoint40pre8, checkpoint48g_post, release1_p17, checkpoint57k_post, checkpoint57d_post, release1_b1, checkpoint44b_post, checkpoint55f_post, checkpoint57i_post, checkpoint51q_post, checkpoint52l_post, checkpoint52k_post, chkpt44c_post, chkpt44d_post, checkpoint57a_pre, checkpoint54, checkpoint57, checkpoint53b_post, checkpoint51, checkpoint50, checkpoint53, checkpoint52, release1_p8, release1_p9, checkpoint50d_post, checkpoint52d_post, checkpoint46g_pre, release1_p2, release1_p3, release1_p4, checkpoint51b_pre, release1_p6, checkpoint52a_post, checkpoint46a_post, checkpoint47g_post, checkpoint52b_post, checkpoint53g_post, chkpt44a_post, checkpoint52f_post, checkpoint44b_pre, checkpoint52c_post, release1_p1, checkpoint46m_post, checkpoint57p_post, checkpoint51h_pre, checkpoint46a_pre, checkpoint50g_post, checkpoint45c_post, checkpoint57q_post, release1_p5, checkpoint44e_pre, checkpoint51g_post, ecco_c52_e35, chkpt44c_pre, checkpoint40pre9, release1_p7, checkpoint46b_post, checkpoint54f_post, checkpoint51f_post, checkpoint46d_post, checkpoint48b_post, checkpoint50b_post, eckpoint57e_pre, checkpoint46g_post, release1_p13_pre, release1_p12_pre, checkpoint45a_post, checkpoint57c_post, checkpoint50f_post, checkpoint50a_post, checkpoint42, checkpoint50f_pre, checkpoint52a_pre, checkpoint43, checkpoint47d_pre, checkpoint51d_post, checkpoint40, checkpoint48c_pre, release1-branch_branchpoint, checkpoint51m_post, checkpoint51t_post, checkpoint53d_pre, checkpoint47, checkpoint55e_post, checkpoint54c_post, checkpoint50h_post, checkpoint52i_post, checkpoint51a_post, checkpoint46h_post, checkpoint50e_pre, checkpoint50i_post, checkpoint51p_post, checkpoint51n_post, release1_chkpt44d_post, checkpoint55i_post, checkpoint51i_pre, checkpoint57l_post, checkpoint52i_pre, checkpoint51u_post, checkpoint52h_pre, checkpoint52f_pre, checkpoint56a_post, checkpoint51s_post, checkpoint55d_post
Branch point for: netcdf-sm0, branch-genmake2, release1_coupled, branch-nonh, tg2-branch, release1_final, checkpoint51n_branch, release1-branch, release1, release1_50yr, branch-exfmods-curt
Changes since 1.1: +17 -17 lines
Commented out some debugging.

1 C $Header: /u/gcmpack/models/MITgcmUV/verification/solid-body.cs-32x32x1/code/ini_curvilinear_grid.F,v 1.1 2001/07/31 18:30:55 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