/[MITgcm]/MITgcm/verification/advect_cs/code/ini_curvilinear_grid.F
ViewVC logotype

Annotation of /MITgcm/verification/advect_cs/code/ini_curvilinear_grid.F

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

Revision 1.1 - (hide annotations) (download)
Fri Sep 28 02:30:09 2001 UTC (22 years, 7 months ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint51k_post, checkpoint47j_post, checkpoint48d_pre, checkpoint44b_post, checkpoint51j_post, branch-exfmods-tag, checkpoint46f_post, checkpoint47e_post, checkpoint43a-release1mods, checkpoint44h_pre, checkpoint47i_post, checkpoint44e_post, checkpoint52e_pre, release1_p12, release1_p13, release1_p10, release1_p11, release1_p16, release1_p17, release1_p14, release1_p15, checkpoint47f_post, checkpoint47c_post, checkpoint50e_post, release1_p13_pre, checkpoint50c_post, checkpoint46i_post, checkpoint51n_pre, checkpoint47d_post, checkpoint44f_pre, checkpoint47a_post, checkpoint52h_pre, checkpoint46l_pre, checkpoint46d_pre, release1_beta1, checkpoint48e_post, checkpoint46e_post, checkpoint48d_post, checkpoint50g_post, release1-branch_tutorials, checkpoint46c_post, checkpoint44g_post, branchpoint-genmake2, checkpoint44h_post, checkpoint46l_post, checkpoint46k_post, checkpoint46e_pre, branch-netcdf, checkpoint48f_post, checkpoint45d_post, checkpoint51r_post, checkpoint52b_pre, checkpoint51o_pre, checkpoint46j_pre, checkpoint45b_post, checkpoint46b_pre, checkpoint51i_post, checkpoint48c_post, chkpt44a_pre, release1-branch-end, release1_final_v1, checkpoint51e_post, checkpoint51b_post, checkpoint46, checkpoint51l_pre, release1_p12_pre, checkpoint46c_pre, checkpoint43, checkpoint47d_pre, checkpoint47, checkpoint44, checkpoint45, checkpoint48, checkpoint49, checkpoint44f_post, checkpoint47b_post, checkpoint51l_post, checkpoint48i_post, checkpoint51o_post, checkpoint51f_pre, release1_b1, checkpoint48h_post, checkpoint51q_post, checkpoint50d_pre, chkpt44d_post, checkpoint46h_pre, checkpoint51, checkpoint50, checkpoint47h_post, 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, chkpt44a_post, checkpoint52f_post, checkpoint44b_pre, checkpoint52c_post, release1_p1, checkpoint46m_post, checkpoint46j_post, checkpoint51h_pre, checkpoint46a_pre, checkpoint50c_pre, checkpoint45c_post, checkpoint50b_pre, release1_p5, checkpoint44e_pre, checkpoint51g_post, ecco_c52_e35, release1_p7, checkpoint46b_post, checkpoint51f_post, checkpoint46d_post, checkpoint48b_post, checkpoint50b_post, checkpoint46g_post, checkpoint52e_post, checkpoint51c_post, checkpoint45a_post, checkpoint50f_post, checkpoint50a_post, checkpoint50f_pre, checkpoint52a_pre, checkpoint51d_post, checkpoint48c_pre, release1-branch_branchpoint, checkpoint51m_post, checkpoint51t_post, checkpoint52i_post, checkpoint51a_post, checkpoint46h_post, checkpoint50e_pre, checkpoint50i_post, checkpoint51p_post, checkpoint51n_post, release1_chkpt44d_post, checkpoint48g_post, checkpoint51i_pre, chkpt44c_pre, checkpoint52i_pre, checkpoint51u_post, checkpoint48a_post, checkpoint52f_pre, checkpoint51s_post, chkpt44c_post
Branch point for: netcdf-sm0, release1_final, branch-genmake2, release1, branch-exfmods-curt, release1_coupled, branch-nonh, tg2-branch, checkpoint51n_branch, release1-branch, release1_50yr 
Adding Williamson test 1. CFL~1, dt=3600s with 40m/s winds. Cool!
 - I've been runing this for a while but it never got broken until now
   so I'm adding it to repositoryi to avoid that happening again.
1 adcroft 1.1 C $Header: /u/gcmpack/models/MITgcmUV/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