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

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

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

revision 1.1 by adcroft, Tue Apr 3 02:42:25 2001 UTC revision 1.2 by adcroft, Tue May 29 14:01:37 2001 UTC
# Line 0  Line 1 
1    C $Header$
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
26          INTEGER I,J
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           ENDDO ! bi
60          ENDDO ! bj
61    
62    C     Here we make no assumptions about grid symmetry and simply
63    C     read the raw grid data from files
64    
65    C-    Cell centered quantities
66          CALL MDSREADFIELD('LONC.bin',readBinaryPrec,'RL',1,XC,  1,myThid)
67          CALL MDSREADFIELD('LATC.bin',readBinaryPrec,'RL',1,YC,  1,myThid)
68          _EXCH_XY_R4(XC,myThid)
69          _EXCH_XY_R4(YC,myThid)
70    
71          CALL MDSREADFIELD('DXF.bin',readBinaryPrec,'RL',1,DXF,  1,myThid)
72          CALL MDSREADFIELD('DYF.bin',readBinaryPrec,'RL',1,DYF,  1,myThid)
73    C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned, myThid )
74    cs!   this is not correct! <= need paired exchange for DXF,DYF
75          _EXCH_XY_R4(DXF,myThid)
76          _EXCH_XY_R4(DYF,myThid)
77    
78          CALL MDSREADFIELD('RA.bin',readBinaryPrec,'RL',1,RA,  1,myThid)
79          _EXCH_XY_R4(RA,myThid )
80    
81    C-    Corner quantities
82    C       *********** this are not degbugged ************
83          CALL MDSREADFIELD('LONG.bin',readBinaryPrec,'RL',1,XG,  1,myThid)
84          CALL MDSREADFIELD('LATG.bin',readBinaryPrec,'RL',1,YG,  1,myThid)
85    cs-   this block needed by cubed sphere until we write more useful I/O routines
86          bi=3
87          bj=1
88          YG(1,sNy+1,bj,1)=YG(1,1,bi,1)
89          bj=bj+2
90          YG(1,sNy+1,bj,1)=YG(1,1,bi,1)
91          bj=bj+2
92          YG(1,sNy+1,bj,1)=YG(1,1,bi,1)
93          bi=6
94          bj=2
95          YG(sNx+1,1,bj,1)=YG(1,1,bi,1)
96          bj=bj+2
97          YG(sNx+1,1,bj,1)=YG(1,1,bi,1)
98          bj=bj+2
99          YG(sNx+1,1,bj,1)=YG(1,1,bi,1)
100    cs-   end block
101          CALL EXCH_Z_XY_RS(XG,myThid)
102          CALL EXCH_Z_XY_RS(YG,myThid)
103    
104          CALL MDSREADFIELD('DXV.bin',readBinaryPrec,'RL',1,DXV,  1,myThid)
105          CALL MDSREADFIELD('DYU.bin',readBinaryPrec,'RL',1,DYU,  1,myThid)
106    cs-   this block needed by cubed sphere until we write more useful I/O routines
107    C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)
108    cs!   this is not correct <= need paired exchange for dxv,dyu
109          CALL EXCH_Z_XY_RS(DXV,myThid)
110          CALL EXCH_Z_XY_RS(DYU,myThid)
111          DO bj = myByLo(myThid), myByHi(myThid)
112           DO bi = myBxLo(myThid), myBxHi(myThid)
113            DXV(sNx+1,1,bi,bj)=DXV(1,1,bi,bj)
114            DXV(1,sNy+1,bi,bj)=DXV(1,1,bi,bj)
115            DYU(sNx+1,1,bi,bj)=DYU(1,1,bi,bj)
116            DYU(1,sNy+1,bi,bj)=DYU(1,1,bi,bj)
117           ENDDO
118          ENDDO
119    cs-   end block
120    C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)
121    cs!   this is not correct <= need paired exchange for dxv,dyu
122          CALL EXCH_Z_XY_RS(DXV,myThid)
123          CALL EXCH_Z_XY_RS(DYU,myThid)
124    
125          CALL MDSREADFIELD('RAZ.bin',readBinaryPrec,'RL',1,RAZ,  1,myThid)
126    cs-   this block needed by cubed sphere until we write more useful I/O routines
127          CALL EXCH_Z_XY_RS(RAZ , myThid )
128          DO bj = myByLo(myThid), myByHi(myThid)
129           DO bi = myBxLo(myThid), myBxHi(myThid)
130            RAZ(sNx+1,1,bi,bj)=RAZ(1,1,bi,bj)
131            RAZ(1,sNy+1,bi,bj)=RAZ(1,1,bi,bj)
132           ENDDO
133          ENDDO
134    cs-   end block
135          CALL EXCH_Z_XY_RS(RAZ,myThid)
136    
137    C-    Staggered (u,v pairs) quantities
138          CALL MDSREADFIELD('DXC.bin',readBinaryPrec,'RL',1,DXC,  1,myThid)
139          CALL MDSREADFIELD('DYC.bin',readBinaryPrec,'RL',1,DYC,  1,myThid)
140          CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)
141    
142          CALL MDSREADFIELD('RAW.bin',readBinaryPrec,'RL',1,RAW,  1,myThid)
143          CALL MDSREADFIELD('RAS.bin',readBinaryPrec,'RL',1,RAS,  1,myThid)
144    cs-   this block needed by cubed sphere until we write more useful I/O routines
145          DO bj = myByLo(myThid), myByHi(myThid)
146           DO bi = myBxLo(myThid), myBxHi(myThid)
147            DO J = 1,sNy
148    c        RAW(sNx+1,J,bi,bj)=RAW(1,J,bi,bj)
149    c        RAS(J,sNy+1,bi,bj)=RAS(J,1,bi,bj)
150            ENDDO
151           ENDDO
152          ENDDO
153    cs-   end block
154          CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)
155    
156          CALL MDSREADFIELD('DXG.bin',readBinaryPrec,'RL',1,DXG,  1,myThid)
157          CALL MDSREADFIELD('DYG.bin',readBinaryPrec,'RL',1,DYG,  1,myThid)
158    cs-   this block needed by cubed sphere until we write more useful I/O routines
159          DO bj = myByLo(myThid), myByHi(myThid)
160           DO bi = myBxLo(myThid), myBxHi(myThid)
161            DO J = 1,sNy
162    c        DYG(sNx+1,J,bi,bj)=DYG(1,J,bi,bj)
163    c        DXG(J,sNy+1,bi,bj)=DXG(J,1,bi,bj)
164            ENDDO
165           ENDDO
166          ENDDO
167    cs-   end block
168          CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)
169    
170    c     write(10) XC
171    c     write(10) YC
172    c     write(10) DXF
173    c     write(10) DYF
174    c     write(10) RA
175    c     write(10) XG
176    c     write(10) YG
177    c     write(10) DXV
178    c     write(10) DYU
179    c     write(10) RAZ
180    c     write(10) DXC
181    c     write(10) DYC
182    c     write(10) RAW
183    c     write(10) RAS
184    c     write(10) DXG
185    c     write(10) DYG
186    
187          RETURN
188          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22