/[MITgcm]/MITgcm/model/src/ini_curvilinear_grid.F
ViewVC logotype

Contents of /MITgcm/model/src/ini_curvilinear_grid.F

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

Revision 1.5 - (show annotations) (download)
Thu Dec 6 16:36:13 2001 UTC (22 years, 4 months ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint47e_post, checkpoint44e_post, checkpoint46l_post, checkpoint46g_pre, checkpoint47c_post, checkpoint50c_post, checkpoint46f_post, checkpoint48e_post, checkpoint50c_pre, checkpoint44f_post, checkpoint46b_post, checkpoint43a-release1mods, checkpoint48i_post, checkpoint46l_pre, chkpt44d_post, checkpoint51, checkpoint50, checkpoint50d_post, checkpoint50b_pre, checkpoint44e_pre, checkpoint48b_post, checkpoint51d_post, checkpoint48c_pre, checkpoint47d_pre, checkpoint47a_post, checkpoint48d_pre, checkpoint47i_post, checkpoint47d_post, checkpoint46d_pre, checkpoint48d_post, release1-branch_tutorials, checkpoint48f_post, checkpoint45d_post, checkpoint46j_pre, chkpt44a_post, checkpoint44h_pre, checkpoint48h_post, checkpoint51b_pre, checkpoint46a_post, checkpoint47g_post, checkpoint46j_post, checkpoint46k_post, chkpt44c_pre, checkpoint48a_post, checkpoint45a_post, checkpoint50f_post, checkpoint50a_post, checkpoint50f_pre, checkpoint47j_post, branch-exfmods-tag, checkpoint44g_post, checkpoint46e_pre, checkpoint48c_post, checkpoint45b_post, checkpoint46b_pre, release1-branch-end, release1_final_v1, checkpoint51b_post, checkpoint51c_post, checkpoint46c_pre, checkpoint46, checkpoint47b_post, checkpoint44b_post, checkpoint46h_pre, checkpoint46m_post, checkpoint46a_pre, checkpoint50g_post, checkpoint45c_post, checkpoint44h_post, checkpoint46g_post, checkpoint50h_post, checkpoint50e_pre, checkpoint50i_post, checkpoint47f_post, checkpoint50e_post, chkpt44a_pre, checkpoint46i_post, checkpoint46c_post, checkpoint50d_pre, checkpoint46e_post, checkpoint44b_pre, checkpoint47, checkpoint44, checkpoint45, checkpoint48, checkpoint49, checkpoint46h_post, chkpt44c_post, checkpoint48g_post, checkpoint47h_post, checkpoint44f_pre, checkpoint46d_post, checkpoint50b_post, release1-branch_branchpoint, checkpoint51a_post
Branch point for: branch-exfmods-curt, release1_final, release1-branch
Changes since 1.4: +42 -3 lines 
Added fix for overlaps of DXV,DYU and DXF,DYF.
 o no expts are affected since these grid factors are not
   used in the vector-invariant case
 o they are used by the deformation based dissipation operator
1 C $Header: /u/gcmpack/models/MITgcmUV/model/src/ini_curvilinear_grid.F,v 1.4 2001/11/28 16:45:16 adcroft Exp $
2 C $Name: $
3
4 #include "CPP_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: INI_CURVILINEAR_GRID
8 C !INTERFACE:
9 SUBROUTINE INI_CURVILINEAR_GRID( myThid )
10 C !DESCRIPTION: \bv
11 C *==========================================================*
12 C | SUBROUTINE INI_CURVILINEAR_GRID
13 C | o Initialise curvilinear coordinate system
14 C *==========================================================*
15 C | Curvilinear grid settings are read from a file rather
16 C | than coded in-line as for cartesian and spherical polar.
17 C | This is more general but you have to create the grid
18 C | yourself.
19 C *==========================================================*
20 C \ev
21
22 C !USES:
23 IMPLICIT NONE
24 C === Global variables ===
25 #include "SIZE.h"
26 #include "EEPARAMS.h"
27 #include "PARAMS.h"
28 #include "GRID.h"
29
30 C !INPUT/OUTPUT PARAMETERS:
31 C == Routine arguments ==
32 C myThid - Number of this instance of INI_CARTESIAN_GRID
33 INTEGER myThid
34
35 C !LOCAL VARIABLES:
36 C == Local variables ==
37 INTEGER bi,bj
38 INTEGER I,J
39 CEOP
40
41 C-- Set everything to zero everywhere
42 DO bj = myByLo(myThid), myByHi(myThid)
43 DO bi = myBxLo(myThid), myBxHi(myThid)
44
45 DO J=1-Oly,sNy+Oly
46 DO I=1-Olx,sNx+Olx
47 XC(i,j,bi,bj)=0.
48 YC(i,j,bi,bj)=0.
49 XG(i,j,bi,bj)=0.
50 YG(i,j,bi,bj)=0.
51 DXC(i,j,bi,bj)=0.
52 DYC(i,j,bi,bj)=0.
53 DXG(i,j,bi,bj)=0.
54 DYG(i,j,bi,bj)=0.
55 DXF(i,j,bi,bj)=0.
56 DYF(i,j,bi,bj)=0.
57 DXV(i,j,bi,bj)=0.
58 DYU(i,j,bi,bj)=0.
59 RA(i,j,bi,bj)=0.
60 RAZ(i,j,bi,bj)=0.
61 RAW(i,j,bi,bj)=0.
62 RAS(i,j,bi,bj)=0.
63 tanPhiAtU(i,j,bi,bj)=0.
64 tanPhiAtV(i,j,bi,bj)=0.
65 cosFacU(J,bi,bj)=1.
66 cosFacV(J,bi,bj)=1.
67 sqcosFacU(J,bi,bj)=1.
68 sqcosFacV(J,bi,bj)=1.
69 ENDDO
70 ENDDO
71
72 ENDDO ! bi
73 ENDDO ! bj
74
75 C Here we make no assumptions about grid symmetry and simply
76 C read the raw grid data from files
77
78 C- Cell centered quantities
79 CALL MDSREADFIELD('LONC.bin',readBinaryPrec,'RS',1,XC, 1,myThid)
80 CALL MDSREADFIELD('LATC.bin',readBinaryPrec,'RS',1,YC, 1,myThid)
81 _EXCH_XY_R4(XC,myThid)
82 _EXCH_XY_R4(YC,myThid)
83
84 CALL MDSREADFIELD('DXF.bin',readBinaryPrec,'RS',1,DXF, 1,myThid)
85 CALL MDSREADFIELD('DYF.bin',readBinaryPrec,'RS',1,DYF, 1,myThid)
86 C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned, myThid )
87 cs! this is not correct! <= need paired exchange for DXF,DYF
88 _EXCH_XY_R4(DXF,myThid)
89 _EXCH_XY_R4(DYF,myThid)
90 cs! fix overlaps:
91 DO bj = myByLo(myThid), myByHi(myThid)
92 DO bi = myBxLo(myThid), myBxHi(myThid)
93 DO j=1,sNy
94 DO i=1,Olx
95 DXF(1-i,j,bi,bj)=DXF(i,j,bi,bj)
96 DXF(sNx+i,j,bi,bj)=DXF(sNx+1-i,j,bi,bj)
97 DYF(1-i,j,bi,bj)=DYF(i,j,bi,bj)
98 DYF(sNx+i,j,bi,bj)=DYF(sNx+1-i,j,bi,bj)
99 ENDDO
100 ENDDO
101 DO j=1,Oly
102 DO i=1,sNx
103 DXF(i,1-j,bi,bj)=DXF(i,j,bi,bj)
104 DXF(i,sNy+j,bi,bj)=DXF(i,sNy+1-j,bi,bj)
105 DYF(i,1-j,bi,bj)=DYF(i,j,bi,bj)
106 DYF(i,sNy+j,bi,bj)=DYF(i,sNy+1-j,bi,bj)
107 ENDDO
108 ENDDO
109 ENDDO
110 ENDDO
111 cs
112
113 CALL MDSREADFIELD('RA.bin',readBinaryPrec,'RS',1,RA, 1,myThid)
114 _EXCH_XY_R4(RA,myThid )
115
116 C- Corner quantities
117 C *********** this are not degbugged ************
118 CALL MDSREADFIELD('LONG.bin',readBinaryPrec,'RS',1,XG, 1,myThid)
119 CALL MDSREADFIELD('LATG.bin',readBinaryPrec,'RS',1,YG, 1,myThid)
120 cs- this block needed by cubed sphere until we write more useful I/O routines
121 bi=3
122 bj=1
123 YG(1,sNy+1,bj,1)=YG(1,1,bi,1)
124 bj=bj+2
125 YG(1,sNy+1,bj,1)=YG(1,1,bi,1)
126 bj=bj+2
127 YG(1,sNy+1,bj,1)=YG(1,1,bi,1)
128 bi=6
129 bj=2
130 YG(sNx+1,1,bj,1)=YG(1,1,bi,1)
131 bj=bj+2
132 YG(sNx+1,1,bj,1)=YG(1,1,bi,1)
133 bj=bj+2
134 YG(sNx+1,1,bj,1)=YG(1,1,bi,1)
135 cs- end block
136 CALL EXCH_Z_XY_RS(XG,myThid)
137 CALL EXCH_Z_XY_RS(YG,myThid)
138
139 CALL MDSREADFIELD('DXV.bin',readBinaryPrec,'RS',1,DXV, 1,myThid)
140 CALL MDSREADFIELD('DYU.bin',readBinaryPrec,'RS',1,DYU, 1,myThid)
141 cs- this block needed by cubed sphere until we write more useful I/O routines
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 DO bj = myByLo(myThid), myByHi(myThid)
147 DO bi = myBxLo(myThid), myBxHi(myThid)
148 DXV(sNx+1,1,bi,bj)=DXV(1,1,bi,bj)
149 DXV(1,sNy+1,bi,bj)=DXV(1,1,bi,bj)
150 DYU(sNx+1,1,bi,bj)=DYU(1,1,bi,bj)
151 DYU(1,sNy+1,bi,bj)=DYU(1,1,bi,bj)
152 cs! fix overlaps:
153 DO j=1,sNy
154 DO i=1,Olx
155 DXV(1-i,j,bi,bj)=DXV(1+i,j,bi,bj)
156 DXV(sNx+i,j,bi,bj)=DXV(sNx-i,j,bi,bj)
157 DYU(1-i,j,bi,bj)=DYU(1+i,j,bi,bj)
158 DYU(sNx+i,j,bi,bj)=DYU(sNx-i,j,bi,bj)
159 ENDDO
160 ENDDO
161 DO j=1,Oly
162 DO i=1,sNx
163 DXV(i,1-j,bi,bj)=DXV(i,1+j,bi,bj)
164 DXV(i,sNy+j,bi,bj)=DXV(i,sNy-j,bi,bj)
165 DYU(i,1-j,bi,bj)=DYU(i,1+j,bi,bj)
166 DYU(i,sNy+j,bi,bj)=DYU(i,sNy-j,bi,bj)
167 ENDDO
168 ENDDO
169 ENDDO
170 ENDDO
171 cs- end block
172 C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)
173 cs! this is not correct <= need paired exchange for dxv,dyu
174 cs CALL EXCH_Z_XY_RS(DXV,myThid)
175 cs CALL EXCH_Z_XY_RS(DYU,myThid)
176
177 CALL MDSREADFIELD('RAZ.bin',readBinaryPrec,'RS',1,RAZ, 1,myThid)
178 cs- this block needed by cubed sphere until we write more useful I/O routines
179 CALL EXCH_Z_XY_RS(RAZ , myThid )
180 DO bj = myByLo(myThid), myByHi(myThid)
181 DO bi = myBxLo(myThid), myBxHi(myThid)
182 RAZ(sNx+1,1,bi,bj)=RAZ(1,1,bi,bj)
183 RAZ(1,sNy+1,bi,bj)=RAZ(1,1,bi,bj)
184 ENDDO
185 ENDDO
186 cs- end block
187 CALL EXCH_Z_XY_RS(RAZ,myThid)
188
189 C- Staggered (u,v pairs) quantities
190 CALL MDSREADFIELD('DXC.bin',readBinaryPrec,'RS',1,DXC, 1,myThid)
191 CALL MDSREADFIELD('DYC.bin',readBinaryPrec,'RS',1,DYC, 1,myThid)
192 CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)
193
194 CALL MDSREADFIELD('RAW.bin',readBinaryPrec,'RS',1,RAW, 1,myThid)
195 CALL MDSREADFIELD('RAS.bin',readBinaryPrec,'RS',1,RAS, 1,myThid)
196 cs- this block needed by cubed sphere until we write more useful I/O routines
197 DO bj = myByLo(myThid), myByHi(myThid)
198 DO bi = myBxLo(myThid), myBxHi(myThid)
199 DO J = 1,sNy
200 c RAW(sNx+1,J,bi,bj)=RAW(1,J,bi,bj)
201 c RAS(J,sNy+1,bi,bj)=RAS(J,1,bi,bj)
202 ENDDO
203 ENDDO
204 ENDDO
205 cs- end block
206 CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)
207
208 CALL MDSREADFIELD('DXG.bin',readBinaryPrec,'RS',1,DXG, 1,myThid)
209 CALL MDSREADFIELD('DYG.bin',readBinaryPrec,'RS',1,DYG, 1,myThid)
210 cs- this block needed by cubed sphere until we write more useful I/O routines
211 DO bj = myByLo(myThid), myByHi(myThid)
212 DO bi = myBxLo(myThid), myBxHi(myThid)
213 DO J = 1,sNy
214 c DYG(sNx+1,J,bi,bj)=DYG(1,J,bi,bj)
215 c DXG(J,sNy+1,bi,bj)=DXG(J,1,bi,bj)
216 ENDDO
217 ENDDO
218 ENDDO
219 cs- end block
220 CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)
221
222 c write(10) XC
223 c write(10) YC
224 c write(10) DXF
225 c write(10) DYF
226 c write(10) RA
227 c write(10) XG
228 c write(10) YG
229 c write(10) DXV
230 c write(10) DYU
231 c write(10) RAZ
232 c write(10) DXC
233 c write(10) DYC
234 c write(10) RAW
235 c write(10) RAS
236 c write(10) DXG
237 c write(10) DYG
238
239 RETURN
240 END
  ViewVC Help
Powered by ViewVC 1.1.22