/[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.21 by jmc, Mon Aug 22 23:07:14 2005 UTC revision 1.28 by jmc, Thu Jul 20 23:11:48 2006 UTC
# Line 10  C     !INTERFACE: Line 10  C     !INTERFACE:
10        SUBROUTINE INI_CURVILINEAR_GRID( myThid )        SUBROUTINE INI_CURVILINEAR_GRID( myThid )
11  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
12  C     *==========================================================*  C     *==========================================================*
13  C     | SUBROUTINE INI_CURVILINEAR_GRID                            C     | SUBROUTINE INI_CURVILINEAR_GRID
14  C     | o Initialise curvilinear coordinate system                  C     | o Initialise curvilinear coordinate system
15  C     *==========================================================*  C     *==========================================================*
16  C     | Curvilinear grid settings are read from a file rather  C     | Curvilinear grid settings are read from a file rather
17  C     | than coded in-line as for cartesian and spherical polar.  C     | than coded in-line as for cartesian and spherical polar.
# Line 52  C     !LOCAL VARIABLES: Line 52  C     !LOCAL VARIABLES:
52  C     == Local variables ==  C     == Local variables ==
53        INTEGER bi,bj, myIter        INTEGER bi,bj, myIter
54        INTEGER I,J        INTEGER I,J
55        CHARACTER*(MAX_LEN_FNAM) fName        CHARACTER*(MAX_LEN_MBUF) msgBuf
56          LOGICAL anglesAreSet
57  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
58        CHARACTER*(80) mncFn        CHARACTER*(80) mncFn
59  #endif  #endif
60  #ifdef ALLOW_EXCH2  #ifndef OLD_GRID_IO
61    # ifdef ALLOW_EXCH2
62        _RL buf(sNx*nSx*nPx+1)        _RL buf(sNx*nSx*nPx+1)
63        INTEGER myTile        INTEGER myTile
64  #else  # else
65        _RL buf(sNx+1,sNy+1)        _RL buf(sNx+1,sNy+1)
66  #endif  # endif
67        INTEGER iG, iL, iLen        INTEGER iG, iL, iLen
68        CHARACTER*(MAX_LEN_MBUF) msgBuf, tmpBuf        CHARACTER*(MAX_LEN_FNAM) fName
69          CHARACTER*(MAX_LEN_MBUF) tmpBuf
70        INTEGER  ILNBLNK        INTEGER  ILNBLNK
71        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
72    #endif
73  CEOP  CEOP
74    
75  C--   Set everything to zero everywhere  C--   Set everything to zero everywhere
# Line 74  C--   Set everything to zero everywhere Line 78  C--   Set everything to zero everywhere
78    
79          DO J=1-Oly,sNy+Oly          DO J=1-Oly,sNy+Oly
80           DO I=1-Olx,sNx+Olx           DO I=1-Olx,sNx+Olx
81            XC(i,j,bi,bj)=0.            xC(i,j,bi,bj)=0.
82            YC(i,j,bi,bj)=0.            yC(i,j,bi,bj)=0.
83            XG(i,j,bi,bj)=0.            xG(i,j,bi,bj)=0.
84            YG(i,j,bi,bj)=0.            yG(i,j,bi,bj)=0.
85            DXC(i,j,bi,bj)=0.            dxC(i,j,bi,bj)=0.
86            DYC(i,j,bi,bj)=0.            dyC(i,j,bi,bj)=0.
87            DXG(i,j,bi,bj)=0.            dxG(i,j,bi,bj)=0.
88            DYG(i,j,bi,bj)=0.            dyG(i,j,bi,bj)=0.
89            DXF(i,j,bi,bj)=0.            dxF(i,j,bi,bj)=0.
90            DYF(i,j,bi,bj)=0.            dyF(i,j,bi,bj)=0.
91            DXV(i,j,bi,bj)=0.            dxV(i,j,bi,bj)=0.
92            DYU(i,j,bi,bj)=0.            dyU(i,j,bi,bj)=0.
93            RA(i,j,bi,bj)=0.            rA(i,j,bi,bj)=0.
94            RAZ(i,j,bi,bj)=0.            rAz(i,j,bi,bj)=0.
95            RAW(i,j,bi,bj)=0.            rAw(i,j,bi,bj)=0.
96            RAS(i,j,bi,bj)=0.            rAs(i,j,bi,bj)=0.
97            tanPhiAtU(i,j,bi,bj)=0.            tanPhiAtU(i,j,bi,bj)=0.
98            tanPhiAtV(i,j,bi,bj)=0.            tanPhiAtV(i,j,bi,bj)=0.
99            angleCosC(i,j,bi,bj)=1.            angleCosC(i,j,bi,bj)=1.
100            angleSinC(i,j,bi,bj)=0.            angleSinC(i,j,bi,bj)=0.
101            cosFacU(J,bi,bj)=1.            cosFacU(J,bi,bj)=1.
102            cosFacV(J,bi,bj)=1.            cosFacV(J,bi,bj)=1.
103            sqcosFacU(J,bi,bj)=1.            sqCosFacU(J,bi,bj)=1.
104            sqcosFacV(J,bi,bj)=1.            sqCosFacV(J,bi,bj)=1.
105           ENDDO           ENDDO
106          ENDDO          ENDDO
107    
# Line 121  C--   Set everything to zero everywhere Line 125  C--   Set everything to zero everywhere
125       &       SQUEEZE_RIGHT , myThid)       &       SQUEEZE_RIGHT , myThid)
126          CALL MNC_FILE_CLOSE_ALL_MATCHING(mncFn, myThid)          CALL MNC_FILE_CLOSE_ALL_MATCHING(mncFn, myThid)
127          CALL MNC_CW_SET_UDIM(mncFn, 1, myThid)          CALL MNC_CW_SET_UDIM(mncFn, 1, myThid)
128          CALL MNC_CW_RS_R('R',mncFn,0,0,'XC', XC,  myThid)          CALL MNC_CW_SET_CITER(mncFn, 2, -1, -1, -1, myThid)
129          CALL MNC_CW_RS_R('R',mncFn,0,0,'XG', XG,  myThid)          CALL MNC_CW_SET_UDIM(mncFn, 1, myThid)
130          CALL MNC_CW_RS_R('R',mncFn,0,0,'YC', YC,  myThid)          CALL MNC_CW_RS_R('D',mncFn,0,0,'XC', xC,  myThid)
131          CALL MNC_CW_RS_R('R',mncFn,0,0,'YG', YG,  myThid)          CALL MNC_CW_RS_R('D',mncFn,0,0,'XG', xG,  myThid)
132          CALL MNC_CW_RS_R('R',mncFn,0,0,'dxC',DXC, myThid)          CALL MNC_CW_RS_R('D',mncFn,0,0,'YC', yC,  myThid)
133          CALL MNC_CW_RS_R('R',mncFn,0,0,'dyC',DYC, myThid)          CALL MNC_CW_RS_R('D',mncFn,0,0,'YG', yG,  myThid)
134          CALL MNC_CW_RS_R('R',mncFn,0,0,'dxF',DXF, myThid)          CALL MNC_CW_RS_R('D',mncFn,0,0,'dxC',dxC, myThid)
135          CALL MNC_CW_RS_R('R',mncFn,0,0,'dyF',DYF, myThid)          CALL MNC_CW_RS_R('D',mncFn,0,0,'dyC',dyC, myThid)
136          CALL MNC_CW_RS_R('R',mncFn,0,0,'dxG',DXG, myThid)          CALL MNC_CW_RS_R('D',mncFn,0,0,'dxF',dxF, myThid)
137          CALL MNC_CW_RS_R('R',mncFn,0,0,'dyG',DYG, myThid)          CALL MNC_CW_RS_R('D',mncFn,0,0,'dyF',dyF, myThid)
138          CALL MNC_CW_RS_R('R',mncFn,0,0,'dxV',DXV, myThid)          CALL MNC_CW_RS_R('D',mncFn,0,0,'dxG',dxG, myThid)
139          CALL MNC_CW_RS_R('R',mncFn,0,0,'dyU',DYU, myThid)          CALL MNC_CW_RS_R('D',mncFn,0,0,'dyG',dyG, myThid)
140          CALL MNC_CW_RS_R('R',mncFn,0,0,'rA', RA,  myThid)          CALL MNC_CW_RS_R('D',mncFn,0,0,'dxV',dxV, myThid)
141          CALL MNC_CW_RS_R('R',mncFn,0,0,'rAz',RAZ, myThid)          CALL MNC_CW_RS_R('D',mncFn,0,0,'dyU',dyU, myThid)
142          CALL MNC_CW_RS_R('R',mncFn,0,0,'rAw',RAW, myThid)          CALL MNC_CW_RS_R('D',mncFn,0,0,'rA', rA,  myThid)
143          CALL MNC_CW_RS_R('R',mncFn,0,0,'rAs',RAS, myThid)          CALL MNC_CW_RS_R('D',mncFn,0,0,'rAz',rAz, myThid)
144            CALL MNC_CW_RS_R('D',mncFn,0,0,'rAw',rAw, myThid)
145            CALL MNC_CW_RS_R('D',mncFn,0,0,'rAs',rAs, myThid)
146            CALL MNC_CW_RS_R('D',mncFn,0,0,'AngleCS',angleCosC,myThid)
147            CALL MNC_CW_RS_R('D',mncFn,0,0,'AngleSN',angleSinC,myThid)
148            anglesAreSet = .TRUE.
149    
150          _END_MASTER(myThid)          _END_MASTER(myThid)
151    
152          CALL EXCH_XY_RS(XC,myThid)          CALL EXCH_XY_RS(xC,myThid)
153          CALL EXCH_XY_RS(YC,myThid)          CALL EXCH_XY_RS(yC,myThid)
154  #ifdef HRCUBE          CALL EXCH_UV_AGRID_XY_RS( dxF, dyF, .FALSE., myThid )
155          CALL EXCH_XY_RS(DXF,myThid)          CALL EXCH_XY_RS(rA,myThid )
156          CALL EXCH_XY_RS(DYF,myThid)          CALL EXCH_Z_XY_RS(xG,myThid)
157  #endif          CALL EXCH_Z_XY_RS(yG,myThid)
158          CALL EXCH_XY_RS(RA,myThid )          CALL EXCH_Z_XY_RS(rAz,myThid)
159          CALL EXCH_Z_XY_RS(XG,myThid)          CALL EXCH_UV_XY_RS(dxC,dyC,.FALSE.,myThid)
160          CALL EXCH_Z_XY_RS(YG,myThid)          CALL EXCH_UV_XY_RS(rAw,rAs,.FALSE.,myThid)
161          CALL EXCH_Z_XY_RS(RAZ,myThid)          CALL EXCH_UV_XY_RS(dyG,dxG,.FALSE.,myThid)
         CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)  
         CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)  
         CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)  
162          CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)          CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)
163    
164        ELSE        ELSE
# Line 164  C     read the raw grid data from files Line 170  C     read the raw grid data from files
170  #ifdef OLD_GRID_IO  #ifdef OLD_GRID_IO
171    
172  C-    Cell centered quantities  C-    Cell centered quantities
173        CALL MDSREADFIELD('LONC.bin',readBinaryPrec,'RS',1,XC,  1,myThid)        CALL MDSREADFIELD('LONC.bin',readBinaryPrec,'RS',1,xC,  1,myThid)
174        CALL MDSREADFIELD('LATC.bin',readBinaryPrec,'RS',1,YC,  1,myThid)        CALL MDSREADFIELD('LATC.bin',readBinaryPrec,'RS',1,yC,  1,myThid)
175        _EXCH_XY_R4(XC,myThid)        _EXCH_XY_R4(xC,myThid)
176        _EXCH_XY_R4(YC,myThid)        _EXCH_XY_R4(yC,myThid)
177    
178        CALL MDSREADFIELD('DXF.bin',readBinaryPrec,'RS',1,DXF,  1,myThid)        CALL MDSREADFIELD('DXF.bin',readBinaryPrec,'RS',1,dxF,  1,myThid)
179        CALL MDSREADFIELD('DYF.bin',readBinaryPrec,'RS',1,DYF,  1,myThid)        CALL MDSREADFIELD('DYF.bin',readBinaryPrec,'RS',1,dyF,  1,myThid)
180  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned, myThid )        CALL EXCH_UV_AGRID_XY_RS( dxF, dyF, .FALSE., myThid )
 cs!   this is not correct! <= need paired exchange for DXF,DYF  
       _EXCH_XY_R4(DXF,myThid)  
       _EXCH_XY_R4(DYF,myThid)  
       IF (useCubedSphereExchange) THEN  
 cs! fix overlaps:  
       DO bj = myByLo(myThid), myByHi(myThid)  
        DO bi = myBxLo(myThid), myBxHi(myThid)  
         DO j=1,sNy  
          DO i=1,Olx  
           DXF(1-i,j,bi,bj)=DXF(i,j,bi,bj)  
           DXF(sNx+i,j,bi,bj)=DXF(sNx+1-i,j,bi,bj)  
           DYF(1-i,j,bi,bj)=DYF(i,j,bi,bj)  
           DYF(sNx+i,j,bi,bj)=DYF(sNx+1-i,j,bi,bj)  
          ENDDO  
         ENDDO  
         DO j=1,Oly  
          DO i=1,sNx  
           DXF(i,1-j,bi,bj)=DXF(i,j,bi,bj)  
           DXF(i,sNy+j,bi,bj)=DXF(i,sNy+1-j,bi,bj)  
           DYF(i,1-j,bi,bj)=DYF(i,j,bi,bj)  
           DYF(i,sNy+j,bi,bj)=DYF(i,sNy+1-j,bi,bj)  
          ENDDO  
         ENDDO  
        ENDDO  
       ENDDO  
       ENDIF  
 cs  
181    
182        CALL MDSREADFIELD('RA.bin',readBinaryPrec,'RS',1,RA,  1,myThid)        CALL MDSREADFIELD('RA.bin',readBinaryPrec,'RS',1,rA,  1,myThid)
183        _EXCH_XY_R4(RA,myThid )        _EXCH_XY_R4(rA,myThid )
184    
185  C-    Corner quantities  C-    Corner quantities
186  C       *********** this are not degbugged ************        CALL MDSREADFIELD('LONG.bin',readBinaryPrec,'RS',1,xG,  1,myThid)
187        CALL MDSREADFIELD('LONG.bin',readBinaryPrec,'RS',1,XG,  1,myThid)        CALL MDSREADFIELD('LATG.bin',readBinaryPrec,'RS',1,yG,  1,myThid)
       CALL MDSREADFIELD('LATG.bin',readBinaryPrec,'RS',1,YG,  1,myThid)  
188        IF (useCubedSphereExchange) THEN        IF (useCubedSphereExchange) THEN
189  cs-   this block needed by cubed sphere until we write more useful I/O routines  cs-   this block needed by cubed sphere until we write more useful I/O routines
190        bi=3        bi=3
191        bj=1        bj=1
192        YG(1,sNy+1,bj,1)=YG(1,1,bi,1)        yG(1,sNy+1,bj,1)=yG(1,1,bi,1)
193        bj=bj+2        bj=bj+2
194        YG(1,sNy+1,bj,1)=YG(1,1,bi,1)        yG(1,sNy+1,bj,1)=yG(1,1,bi,1)
195        bj=bj+2        bj=bj+2
196        YG(1,sNy+1,bj,1)=YG(1,1,bi,1)        yG(1,sNy+1,bj,1)=yG(1,1,bi,1)
197        bi=6        bi=6
198        bj=2        bj=2
199        YG(sNx+1,1,bj,1)=YG(1,1,bi,1)        yG(sNx+1,1,bj,1)=yG(1,1,bi,1)
200        bj=bj+2        bj=bj+2
201        YG(sNx+1,1,bj,1)=YG(1,1,bi,1)        yG(sNx+1,1,bj,1)=yG(1,1,bi,1)
202        bj=bj+2        bj=bj+2
203        YG(sNx+1,1,bj,1)=YG(1,1,bi,1)        yG(sNx+1,1,bj,1)=yG(1,1,bi,1)
204  cs-   end block  cs-   end block
205        ENDIF        ENDIF
206        CALL EXCH_Z_XY_RS(XG,myThid)        CALL EXCH_Z_XY_RS(xG,myThid)
207        CALL EXCH_Z_XY_RS(YG,myThid)        CALL EXCH_Z_XY_RS(yG,myThid)
208    
209        CALL MDSREADFIELD('DXV.bin',readBinaryPrec,'RS',1,DXV,  1,myThid)        CALL MDSREADFIELD('DXV.bin',readBinaryPrec,'RS',1,dxV,  1,myThid)
210        CALL MDSREADFIELD('DYU.bin',readBinaryPrec,'RS',1,DYU,  1,myThid)        CALL MDSREADFIELD('DYU.bin',readBinaryPrec,'RS',1,dyU,  1,myThid)
211  cs-   this block needed by cubed sphere until we write more useful I/O routines  cs-   this block needed by cubed sphere until we write more useful I/O routines
212  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)  C !!! _EXCH_ZUV_XY_R4(dxV, dyU, unSigned, myThid)
213  cs!   this is not correct <= need paired exchange for dxv,dyu  cs!   this is not correct <= need paired exchange for dxv,dyu
214        IF (.NOT.useCubedSphereExchange) THEN        IF (.NOT.useCubedSphereExchange) THEN
215        CALL EXCH_Z_XY_RS(DXV,myThid)        CALL EXCH_Z_XY_RS(dxV,myThid)
216        CALL EXCH_Z_XY_RS(DYU,myThid)        CALL EXCH_Z_XY_RS(dyU,myThid)
217        ELSE        ELSE
218        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
219         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
220  cs! fix overlaps:  cs! fix overlaps:
221          DO j=1,sNy          DO j=1,sNy
222           DO i=1,Olx           DO i=1,Olx
223            DXV(1-i,j,bi,bj)=DXV(1+i,j,bi,bj)            dxV(1-i,j,bi,bj)=dxV(1+i,j,bi,bj)
224            DXV(sNx+i,j,bi,bj)=DXV(i,j,bi,bj)            dxV(sNx+i,j,bi,bj)=dxV(i,j,bi,bj)
225            DYU(1-i,j,bi,bj)=DYU(1+i,j,bi,bj)            dyU(1-i,j,bi,bj)=dyU(1+i,j,bi,bj)
226            DYU(sNx+i,j,bi,bj)=DYU(i,j,bi,bj)            dyU(sNx+i,j,bi,bj)=dyU(i,j,bi,bj)
227           ENDDO           ENDDO
228          ENDDO          ENDDO
229          DO j=1,Oly          DO j=1,Oly
230           DO i=1-Olx,sNx+Olx           DO i=1-Olx,sNx+Olx
231            DXV(i,1-j,bi,bj)=DXV(i,1+j,bi,bj)            dxV(i,1-j,bi,bj)=dxV(i,1+j,bi,bj)
232            DXV(i,sNy+j,bi,bj)=DXV(i,j,bi,bj)            dxV(i,sNy+j,bi,bj)=dxV(i,j,bi,bj)
233            DYU(i,1-j,bi,bj)=DYU(i,1+j,bi,bj)            dyU(i,1-j,bi,bj)=dyU(i,1+j,bi,bj)
234            DYU(i,sNy+j,bi,bj)=DYU(i,j,bi,bj)            dyU(i,sNy+j,bi,bj)=dyU(i,j,bi,bj)
235           ENDDO           ENDDO
236          ENDDO          ENDDO
237         ENDDO         ENDDO
# Line 261  cs! fix overlaps: Line 239  cs! fix overlaps:
239  cs-   end block  cs-   end block
240        ENDIF        ENDIF
241    
242        CALL MDSREADFIELD('RAZ.bin',readBinaryPrec,'RS',1,RAZ,  1,myThid)        CALL MDSREADFIELD('RAZ.bin',readBinaryPrec,'RS',1,rAz,  1,myThid)
243        IF (useCubedSphereExchange) THEN        IF (useCubedSphereExchange) THEN
244  cs-   this block needed by cubed sphere until we write more useful I/O routines  cs-   this block needed by cubed sphere until we write more useful I/O routines
245        CALL EXCH_Z_XY_RS(RAZ , myThid )        CALL EXCH_Z_XY_RS(rAz , myThid )
246        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
247         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
248          RAZ(sNx+1,1,bi,bj)=RAZ(1,1,bi,bj)          rAz(sNx+1,1,bi,bj)=rAz(1,1,bi,bj)
249          RAZ(1,sNy+1,bi,bj)=RAZ(1,1,bi,bj)          rAz(1,sNy+1,bi,bj)=rAz(1,1,bi,bj)
250         ENDDO         ENDDO
251        ENDDO        ENDDO
252  cs-   end block  cs-   end block
253        ENDIF        ENDIF
254        CALL EXCH_Z_XY_RS(RAZ,myThid)        CALL EXCH_Z_XY_RS(rAz,myThid)
255    
256  C-    Staggered (u,v pairs) quantities  C-    Staggered (u,v pairs) quantities
257        CALL MDSREADFIELD('DXC.bin',readBinaryPrec,'RS',1,DXC,  1,myThid)        CALL MDSREADFIELD('DXC.bin',readBinaryPrec,'RS',1,dxC,  1,myThid)
258        CALL MDSREADFIELD('DYC.bin',readBinaryPrec,'RS',1,DYC,  1,myThid)        CALL MDSREADFIELD('DYC.bin',readBinaryPrec,'RS',1,dyC,  1,myThid)
259        CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(dxC,dyC,.FALSE.,myThid)
260    
261        CALL MDSREADFIELD('RAW.bin',readBinaryPrec,'RS',1,RAW,  1,myThid)        CALL MDSREADFIELD('RAW.bin',readBinaryPrec,'RS',1,rAw,  1,myThid)
262        CALL MDSREADFIELD('RAS.bin',readBinaryPrec,'RS',1,RAS,  1,myThid)        CALL MDSREADFIELD('RAS.bin',readBinaryPrec,'RS',1,rAs,  1,myThid)
263        IF (useCubedSphereExchange) THEN        IF (useCubedSphereExchange) THEN
264  cs-   this block needed by cubed sphere until we write more useful I/O routines  cs-   this block needed by cubed sphere until we write more useful I/O routines
265        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
266         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
267          DO J = 1,sNy          DO J = 1,sNy
268  c        RAW(sNx+1,J,bi,bj)=RAW(1,J,bi,bj)  c        rAw(sNx+1,J,bi,bj)=rAw(1,J,bi,bj)
269  c        RAS(J,sNy+1,bi,bj)=RAS(J,1,bi,bj)  c        rAs(J,sNy+1,bi,bj)=rAs(J,1,bi,bj)
270          ENDDO          ENDDO
271         ENDDO         ENDDO
272        ENDDO        ENDDO
273  cs-   end block  cs-   end block
274        ENDIF        ENDIF
275        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(rAw,rAs,.FALSE.,myThid)
276    
277        CALL MDSREADFIELD('DXG.bin',readBinaryPrec,'RS',1,DXG,  1,myThid)        CALL MDSREADFIELD('DXG.bin',readBinaryPrec,'RS',1,dxG,  1,myThid)
278        CALL MDSREADFIELD('DYG.bin',readBinaryPrec,'RS',1,DYG,  1,myThid)        CALL MDSREADFIELD('DYG.bin',readBinaryPrec,'RS',1,dyG,  1,myThid)
279        IF (useCubedSphereExchange) THEN        CALL EXCH_UV_XY_RS(dyG,dxG,.FALSE.,myThid)
 cs-   this block needed by cubed sphere until we write more useful I/O routines  
       DO bj = myByLo(myThid), myByHi(myThid)  
        DO bi = myBxLo(myThid), myBxHi(myThid)  
         DO J = 1,sNy  
 c        DYG(sNx+1,J,bi,bj)=DYG(1,J,bi,bj)  
 c        DXG(J,sNy+1,bi,bj)=DXG(J,1,bi,bj)  
         ENDDO  
        ENDDO  
       ENDDO  
 cs-   end block  
       ENDIF  
       CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)  
280        CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)        CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)
281          anglesAreSet = .FALSE.
282    
283  c     write(10) XC  c     write(10) xC
284  c     write(10) YC  c     write(10) yC
285  c     write(10) DXF  c     write(10) dxF
286  c     write(10) DYF  c     write(10) dyF
287  c     write(10) RA  c     write(10) rA
288  c     write(10) XG  c     write(10) xG
289  c     write(10) YG  c     write(10) yG
290  c     write(10) DXV  c     write(10) dxV
291  c     write(10) DYU  c     write(10) dyU
292  c     write(10) RAZ  c     write(10) rAz
293  c     write(10) DXC  c     write(10) dxC
294  c     write(10) DYC  c     write(10) dyC
295  c     write(10) RAW  c     write(10) rAw
296  c     write(10) RAS  c     write(10) rAs
297  c     write(10) DXG  c     write(10) dxG
298  c     write(10) DYG  c     write(10) dyG
299    
300  #else /* ifndef OLD_GRID_IO */  #else /* ifndef OLD_GRID_IO */
301    
# Line 359  C--   Only do I/O if I am the master thr Line 326  C--   Only do I/O if I am the master thr
326       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
327          WRITE(msgBuf,'(A)') '  =>'          WRITE(msgBuf,'(A)') '  =>'
328    
329          CALL READSYMTILE_RS(fName,1,XC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,1,xC,bi,bj,buf,myThid)
330          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
331          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'XC'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'xC'
332          CALL READSYMTILE_RS(fName,2,YC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,2,yC,bi,bj,buf,myThid)
333          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
334          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'YC'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'yC'
335          CALL READSYMTILE_RS(fName,3,DXF,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,3,dxF,bi,bj,buf,myThid)
336          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
337          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DXF'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dxF'
338          CALL READSYMTILE_RS(fName,4,DYF,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,4,dyF,bi,bj,buf,myThid)
339          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
340          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DYF'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dyF'
341          CALL READSYMTILE_RS(fName,5,RA,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,5,rA,bi,bj,buf,myThid)
342          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
343          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'RA'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'rA'
344          CALL READSYMTILE_RS(fName,6,XG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,6,xG,bi,bj,buf,myThid)
345          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
346          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'XG'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'xG'
347          CALL READSYMTILE_RS(fName,7,YG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,7,yG,bi,bj,buf,myThid)
348          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
349          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'YG'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'yG'
350          CALL READSYMTILE_RS(fName,8,DXV,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,8,dxV,bi,bj,buf,myThid)
351          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
352          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DXV'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dxV'
353          CALL READSYMTILE_RS(fName,9,DYU,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,9,dyU,bi,bj,buf,myThid)
354          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
355          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DYU'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dyU'
356          CALL READSYMTILE_RS(fName,10,RAZ,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,10,rAz,bi,bj,buf,myThid)
357          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
358          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'RAZ'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'rAz'
359          CALL READSYMTILE_RS(fName,11,DXC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,11,dxC,bi,bj,buf,myThid)
360          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
361          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DXC'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dxC'
362          CALL READSYMTILE_RS(fName,12,DYC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,12,dyC,bi,bj,buf,myThid)
363          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
364          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DYC'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dyC'
365          CALL READSYMTILE_RS(fName,13,RAW,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,13,rAw,bi,bj,buf,myThid)
366          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
367          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'RAW'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'rAw'
368          CALL READSYMTILE_RS(fName,14,RAS,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,14,rAs,bi,bj,buf,myThid)
369          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
370          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'RAS'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'rAs'
371          CALL READSYMTILE_RS(fName,15,DXG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,15,dxG,bi,bj,buf,myThid)
372          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
373          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DXG'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dxG'
374          CALL READSYMTILE_RS(fName,16,DYG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,16,dyG,bi,bj,buf,myThid)
375          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
376          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DYG'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dyG'
377    
378          iLen = ILNBLNK(horizGridFile)          iLen = ILNBLNK(horizGridFile)
379          IF ( iLen.GT.0 ) THEN          IF ( iLen.GT.0 ) THEN
# Line 416  C--   Only do I/O if I am the master thr Line 383  C--   Only do I/O if I am the master thr
383           CALL READSYMTILE_RS(fName,18,angleSinC,bi,bj,buf,myThid)           CALL READSYMTILE_RS(fName,18,angleSinC,bi,bj,buf,myThid)
384           iL = ILNBLNK(tmpBuf)           iL = ILNBLNK(tmpBuf)
385           WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'AngleSN'           WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'AngleSN'
386             anglesAreSet = .TRUE.
387            ELSE
388             anglesAreSet = .FALSE.
389          ENDIF          ENDIF
390    
391          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
# Line 426  C--   Only do I/O if I am the master thr Line 396  C--   Only do I/O if I am the master thr
396    
397        _END_MASTER(myThid)        _END_MASTER(myThid)
398    
399        CALL EXCH_XY_RS(XC,myThid)        CALL EXCH_XY_RS(xC,myThid)
400        CALL EXCH_XY_RS(YC,myThid)        CALL EXCH_XY_RS(yC,myThid)
401  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned, myThid )        CALL EXCH_UV_AGRID_XY_RS( dxF, dyF, .FALSE., myThid )
402  #ifdef HRCUBE        CALL EXCH_XY_RS(rA,myThid )
403        CALL EXCH_XY_RS(DXF,myThid)        CALL EXCH_Z_XY_RS(xG,myThid)
404        CALL EXCH_XY_RS(DYF,myThid)        CALL EXCH_Z_XY_RS(yG,myThid)
405  #endif  C !!! _EXCH_ZUV_XY_R4(dxV, dyU, unSigned, myThid)
406        CALL EXCH_XY_RS(RA,myThid )  c     CALL EXCH_Z_XY_RS(dxV,myThid)
407        CALL EXCH_Z_XY_RS(XG,myThid)  c     CALL EXCH_Z_XY_RS(dyU,myThid)
408        CALL EXCH_Z_XY_RS(YG,myThid)        CALL EXCH_Z_XY_RS(rAz,myThid)
409  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)        CALL EXCH_UV_XY_RS(dxC,dyC,.FALSE.,myThid)
410  c     CALL EXCH_Z_XY_RS(DXV,myThid)        CALL EXCH_UV_XY_RS(rAw,rAs,.FALSE.,myThid)
411  c     CALL EXCH_Z_XY_RS(DYU,myThid)        CALL EXCH_UV_XY_RS(dyG,dxG,.FALSE.,myThid)
       CALL EXCH_Z_XY_RS(RAZ,myThid)  
       CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)  
       CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)  
       CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)  
412        CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)        CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)
413    
414  #endif /* OLD_GRID_IO */  #endif /* OLD_GRID_IO */
# Line 451  c     CALL EXCH_Z_XY_RS(DYU,myThid) Line 417  c     CALL EXCH_Z_XY_RS(DYU,myThid)
417        ENDIF        ENDIF
418  #endif /* ALLOW_MNC */  #endif /* ALLOW_MNC */
419    
420  c     CALL WRITE_FULLARRAY_RL('DXV',DXV,1,0,0,0,myThid)  C--   Stop if Angle have not been loaded but are needed :
421  c     CALL WRITE_FULLARRAY_RL('DYU',DYU,1,0,0,0,myThid)        _BEGIN_MASTER(myThid)
422  c     CALL WRITE_FULLARRAY_RL('RAZ',RAZ,1,0,0,0,myThid)        IF ( .NOT.anglesAreSet .AND. use3dCoriolis ) THEN
423  c     CALL WRITE_FULLARRAY_RL('XG',XG,1,0,0,0,myThid)          WRITE(msgBuf,'(2A)')
424  c     CALL WRITE_FULLARRAY_RL('YG',YG,1,0,0,0,myThid)       &   'INI_CURVILINEAR_GRID: Angle of CurvilinearGrid not set',
425         &   ' but needed for 3-D Coriolis'
426            CALL PRINT_ERROR( msgBuf , myThid)
427            STOP 'ABNORMAL END: S/R INI_CURVILINEAR_GRID'
428          ENDIF
429          _END_MASTER(myThid)
430    
431  C--   Require that 0 <= longitude < 360 if using exf package  c     CALL WRITE_FULLARRAY_RL('dxV',dxV,1,0,0,0,myThid)
432  #ifdef ALLOW_EXF  c     CALL WRITE_FULLARRAY_RL('dyU',dyU,1,0,0,0,myThid)
433        DO bj = 1,nSy  c     CALL WRITE_FULLARRAY_RL('rAz',rAz,1,0,0,0,myThid)
434         DO bi = 1,nSx  c     CALL WRITE_FULLARRAY_RL('xG',xG,1,0,0,0,myThid)
435          DO J=1-Oly,sNy+Oly  c     CALL WRITE_FULLARRAY_RL('yG',yG,1,0,0,0,myThid)
          DO I=1-Olx,sNx+Olx  
           IF (XC(i,j,bi,bj).lt.0.) XC(i,j,bi,bj)=XC(i,j,bi,bj)+360.  
           IF (XG(i,j,bi,bj).lt.0.) XG(i,j,bi,bj)=XG(i,j,bi,bj)+360.  
          ENDDO  
         ENDDO  
        ENDDO  
       ENDDO  
 #endif /* ALLOW_EXF */  
436    
437  C--   Now let's look at all these beasts  C--   Now let's look at all these beasts
438        IF ( debugLevel .GE. debLevB ) THEN        IF ( debugLevel .GE. debLevB ) THEN
439           myIter = 1           myIter = 1
440           CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,           CALL PLOT_FIELD_XYRL( xC      , 'Current xC      ' ,
441       &        myIter, myThid )       &        myIter, myThid )
442           CALL PLOT_FIELD_XYRL( YC      , 'Current YC      ' ,           CALL PLOT_FIELD_XYRL( yC      , 'Current yC      ' ,
443       &        myIter, myThid )       &        myIter, myThid )
444           CALL PLOT_FIELD_XYRL( DXF     , 'Current DXF     ' ,           CALL PLOT_FIELD_XYRL( dxF     , 'Current dxF     ' ,
445       &        myIter, myThid )       &        myIter, myThid )
446           CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,           CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,
447       &        myIter, myThid )       &        myIter, myThid )
448           CALL PLOT_FIELD_XYRL( DYF     , 'Current DYF     ' ,           CALL PLOT_FIELD_XYRL( dyF     , 'Current dyF     ' ,
449       &        myIter, myThid )       &        myIter, myThid )
450           CALL PLOT_FIELD_XYRL( RA      , 'Current RA      ' ,           CALL PLOT_FIELD_XYRL( rA      , 'Current rA      ' ,
451       &        myIter, myThid )       &        myIter, myThid )
452           CALL PLOT_FIELD_XYRL( XG      , 'Current XG      ' ,           CALL PLOT_FIELD_XYRL( xG      , 'Current xG      ' ,
453       &        myIter, myThid )       &        myIter, myThid )
454           CALL PLOT_FIELD_XYRL( YG      , 'Current YG      ' ,           CALL PLOT_FIELD_XYRL( yG      , 'Current yG      ' ,
455       &        myIter, myThid )       &        myIter, myThid )
456           CALL PLOT_FIELD_XYRL( DXV     , 'Current DXV     ' ,           CALL PLOT_FIELD_XYRL( dxV     , 'Current dxV     ' ,
457       &        myIter, myThid )       &        myIter, myThid )
458           CALL PLOT_FIELD_XYRL( DYU     , 'Current DYU     ' ,           CALL PLOT_FIELD_XYRL( dyU     , 'Current dyU     ' ,
459       &        myIter, myThid )       &        myIter, myThid )
460           CALL PLOT_FIELD_XYRL( RAZ     , 'Current RAZ     ' ,           CALL PLOT_FIELD_XYRL( rAz     , 'Current rAz     ' ,
461       &        myIter, myThid )       &        myIter, myThid )
462           CALL PLOT_FIELD_XYRL( DXC     , 'Current DXC     ' ,           CALL PLOT_FIELD_XYRL( dxC     , 'Current dxC     ' ,
463       &        myIter, myThid )       &        myIter, myThid )
464           CALL PLOT_FIELD_XYRL( DYC     , 'Current DYC     ' ,           CALL PLOT_FIELD_XYRL( dyC     , 'Current dyC     ' ,
465       &        myIter, myThid )       &        myIter, myThid )
466           CALL PLOT_FIELD_XYRL( RAW     , 'Current RAW     ' ,           CALL PLOT_FIELD_XYRL( rAw     , 'Current rAw     ' ,
467       &        myIter, myThid )       &        myIter, myThid )
468           CALL PLOT_FIELD_XYRL( RAS     , 'Current RAS     ' ,           CALL PLOT_FIELD_XYRL( rAs     , 'Current rAs     ' ,
469       &        myIter, myThid )       &        myIter, myThid )
470           CALL PLOT_FIELD_XYRL( DXG     , 'Current DXG     ' ,           CALL PLOT_FIELD_XYRL( dxG     , 'Current dxG     ' ,
471       &        myIter, myThid )       &        myIter, myThid )
472           CALL PLOT_FIELD_XYRL( DYG     , 'Current DYG     ' ,           CALL PLOT_FIELD_XYRL( dyG     , 'Current dyG     ' ,
473       &        myIter, myThid )       &        myIter, myThid )
474           CALL PLOT_FIELD_XYRL(angleCosC, 'Current AngleCS ' ,           CALL PLOT_FIELD_XYRL(angleCosC, 'Current AngleCS ' ,
475       &        myIter, myThid )       &        myIter, myThid )
# Line 587  C     Figure out offset of tile within f Line 550  C     Figure out offset of tile within f
550         ENDDO         ENDDO
551        ENDDO        ENDDO
552        CLOSE( dUnit )        CLOSE( dUnit )
553          
554  #else /* ALLOW_EXCH2 */  #else /* ALLOW_EXCH2 */
555    
556        CALL MDSFINDUNIT( dUnit, myThid )        CALL MDSFINDUNIT( dUnit, myThid )
Legend:
Removed from v.1.21  
changed lines
  Added in v.1.28
  ViewVC Help
Powered by ViewVC 1.1.22