/[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.12 by dimitri, Wed Mar 10 03:46:38 2004 UTC revision 1.21 by jmc, Mon Aug 22 23:07:14 2005 UTC
# Line 31  C     === Global variables === Line 31  C     === Global variables ===
31  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
32  #include "W2_EXCH2_PARAMS.h"  #include "W2_EXCH2_PARAMS.h"
33  #endif  #endif
34    #ifdef ALLOW_MNC
35    #include "MNC_PARAMS.h"
36    #endif
37    
38  #ifndef ALLOW_EXCH2  #ifndef ALLOW_EXCH2
39  C- note: default is to use "new" grid files (OLD_GRID_IO undef) with EXCH2  C- note: default is to use "new" grid files (OLD_GRID_IO undef) with EXCH2
40  C    but can still use (on 1 cpu) OLD_GRID_IO and EXCH2 independently  C    but can still use (on 1 cpu) OLD_GRID_IO and EXCH2 independently
41    #ifdef ALLOW_MDSIO
42  #define OLD_GRID_IO  #define OLD_GRID_IO
43    #endif
44  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
45    
46  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
47  C     == Routine arguments ==  C     == Routine arguments ==
48  C     myThid -  Number of this instance of INI_CARTESIAN_GRID  C     myThid -  Number of this instance of INI_CURVILINEAR_GRID
49        INTEGER myThid        INTEGER myThid
50    
51  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
52  C     == Local variables ==  C     == Local variables ==
53        INTEGER bi,bj, myTile        INTEGER bi,bj, myIter
54        INTEGER I,J        INTEGER I,J
55        CHARACTER*(15) fName        CHARACTER*(MAX_LEN_FNAM) fName
56    #ifdef ALLOW_MNC
57          CHARACTER*(80) mncFn
58    #endif
59    #ifdef ALLOW_EXCH2
60          _RL buf(sNx*nSx*nPx+1)
61          INTEGER myTile
62    #else
63        _RL buf(sNx+1,sNy+1)        _RL buf(sNx+1,sNy+1)
64        INTEGER iG, iL  #endif
65        CHARACTER*(MAX_LEN_MBUF) msgBuf        INTEGER iG, iL, iLen
66          CHARACTER*(MAX_LEN_MBUF) msgBuf, tmpBuf
67        INTEGER  ILNBLNK        INTEGER  ILNBLNK
68        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
69  CEOP  CEOP
# Line 79  C--   Set everything to zero everywhere Line 92  C--   Set everything to zero everywhere
92            RAS(i,j,bi,bj)=0.            RAS(i,j,bi,bj)=0.
93            tanPhiAtU(i,j,bi,bj)=0.            tanPhiAtU(i,j,bi,bj)=0.
94            tanPhiAtV(i,j,bi,bj)=0.            tanPhiAtV(i,j,bi,bj)=0.
95              angleCosC(i,j,bi,bj)=1.
96              angleSinC(i,j,bi,bj)=0.
97            cosFacU(J,bi,bj)=1.            cosFacU(J,bi,bj)=1.
98            cosFacV(J,bi,bj)=1.            cosFacV(J,bi,bj)=1.
99            sqcosFacU(J,bi,bj)=1.            sqcosFacU(J,bi,bj)=1.
# Line 89  C--   Set everything to zero everywhere Line 104  C--   Set everything to zero everywhere
104         ENDDO         ENDDO
105        ENDDO        ENDDO
106    
107    
108    #ifdef ALLOW_MNC
109          IF (useMNC .AND. readgrid_mnc) THEN
110    
111            _BEGIN_MASTER(myThid)
112            DO i = 1,80
113              mncFn(i:i) = ' '
114            ENDDO
115            write(mncFn,'(a)') 'mitgrid'
116            DO i = 1,MAX_LEN_MBUF
117              msgBuf(i:i) = ' '
118            ENDDO
119            WRITE(msgBuf,'(2A)') msgBuf,' ; Reading grid info using MNC'
120            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
121         &       SQUEEZE_RIGHT , myThid)
122            CALL MNC_FILE_CLOSE_ALL_MATCHING(mncFn, myThid)
123            CALL MNC_CW_SET_UDIM(mncFn, 1, myThid)
124            CALL MNC_CW_RS_R('R',mncFn,0,0,'XC', XC,  myThid)
125            CALL MNC_CW_RS_R('R',mncFn,0,0,'XG', XG,  myThid)
126            CALL MNC_CW_RS_R('R',mncFn,0,0,'YC', YC,  myThid)
127            CALL MNC_CW_RS_R('R',mncFn,0,0,'YG', YG,  myThid)
128            CALL MNC_CW_RS_R('R',mncFn,0,0,'dxC',DXC, myThid)
129            CALL MNC_CW_RS_R('R',mncFn,0,0,'dyC',DYC, myThid)
130            CALL MNC_CW_RS_R('R',mncFn,0,0,'dxF',DXF, myThid)
131            CALL MNC_CW_RS_R('R',mncFn,0,0,'dyF',DYF, myThid)
132            CALL MNC_CW_RS_R('R',mncFn,0,0,'dxG',DXG, myThid)
133            CALL MNC_CW_RS_R('R',mncFn,0,0,'dyG',DYG, myThid)
134            CALL MNC_CW_RS_R('R',mncFn,0,0,'dxV',DXV, myThid)
135            CALL MNC_CW_RS_R('R',mncFn,0,0,'dyU',DYU, myThid)
136            CALL MNC_CW_RS_R('R',mncFn,0,0,'rA', RA,  myThid)
137            CALL MNC_CW_RS_R('R',mncFn,0,0,'rAz',RAZ, myThid)
138            CALL MNC_CW_RS_R('R',mncFn,0,0,'rAw',RAW, myThid)
139            CALL MNC_CW_RS_R('R',mncFn,0,0,'rAs',RAS, myThid)
140    
141            _END_MASTER(myThid)
142    
143            CALL EXCH_XY_RS(XC,myThid)
144            CALL EXCH_XY_RS(YC,myThid)
145    #ifdef HRCUBE
146            CALL EXCH_XY_RS(DXF,myThid)
147            CALL EXCH_XY_RS(DYF,myThid)
148    #endif
149            CALL EXCH_XY_RS(RA,myThid )
150            CALL EXCH_Z_XY_RS(XG,myThid)
151            CALL EXCH_Z_XY_RS(YG,myThid)
152            CALL EXCH_Z_XY_RS(RAZ,myThid)
153            CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)
154            CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)
155            CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)
156            CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)
157    
158          ELSE
159    #endif
160    
161  C     Here we make no assumptions about grid symmetry and simply  C     Here we make no assumptions about grid symmetry and simply
162  C     read the raw grid data from files  C     read the raw grid data from files
163    
# Line 106  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned Line 175  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned
175  cs!   this is not correct! <= need paired exchange for DXF,DYF  cs!   this is not correct! <= need paired exchange for DXF,DYF
176        _EXCH_XY_R4(DXF,myThid)        _EXCH_XY_R4(DXF,myThid)
177        _EXCH_XY_R4(DYF,myThid)        _EXCH_XY_R4(DYF,myThid)
178          IF (useCubedSphereExchange) THEN
179  cs! fix overlaps:  cs! fix overlaps:
180        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
181         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
# Line 127  cs! fix overlaps: Line 197  cs! fix overlaps:
197          ENDDO          ENDDO
198         ENDDO         ENDDO
199        ENDDO        ENDDO
200          ENDIF
201  cs  cs
202    
203        CALL MDSREADFIELD('RA.bin',readBinaryPrec,'RS',1,RA,  1,myThid)        CALL MDSREADFIELD('RA.bin',readBinaryPrec,'RS',1,RA,  1,myThid)
# Line 136  C-    Corner quantities Line 207  C-    Corner quantities
207  C       *********** this are not degbugged ************  C       *********** this are not degbugged ************
208        CALL MDSREADFIELD('LONG.bin',readBinaryPrec,'RS',1,XG,  1,myThid)        CALL MDSREADFIELD('LONG.bin',readBinaryPrec,'RS',1,XG,  1,myThid)
209        CALL MDSREADFIELD('LATG.bin',readBinaryPrec,'RS',1,YG,  1,myThid)        CALL MDSREADFIELD('LATG.bin',readBinaryPrec,'RS',1,YG,  1,myThid)
210          IF (useCubedSphereExchange) THEN
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        bi=3        bi=3
213        bj=1        bj=1
# Line 152  cs-   this block needed by cubed sphere Line 224  cs-   this block needed by cubed sphere
224        bj=bj+2        bj=bj+2
225        YG(sNx+1,1,bj,1)=YG(1,1,bi,1)        YG(sNx+1,1,bj,1)=YG(1,1,bi,1)
226  cs-   end block  cs-   end block
227          ENDIF
228        CALL EXCH_Z_XY_RS(XG,myThid)        CALL EXCH_Z_XY_RS(XG,myThid)
229        CALL EXCH_Z_XY_RS(YG,myThid)        CALL EXCH_Z_XY_RS(YG,myThid)
230    
# Line 160  cs-   end block Line 233  cs-   end block
233  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
234  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)
235  cs!   this is not correct <= need paired exchange for dxv,dyu  cs!   this is not correct <= need paired exchange for dxv,dyu
236  cs    CALL EXCH_Z_XY_RS(DXV,myThid)        IF (.NOT.useCubedSphereExchange) THEN
237  cs    CALL EXCH_Z_XY_RS(DYU,myThid)        CALL EXCH_Z_XY_RS(DXV,myThid)
238          CALL EXCH_Z_XY_RS(DYU,myThid)
239          ELSE
240        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
241         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
242  cs! fix overlaps:  cs! fix overlaps:
# Line 184  cs! fix overlaps: Line 259  cs! fix overlaps:
259         ENDDO         ENDDO
260        ENDDO        ENDDO
261  cs-   end block  cs-   end block
262          ENDIF
263    
264        CALL MDSREADFIELD('RAZ.bin',readBinaryPrec,'RS',1,RAZ,  1,myThid)        CALL MDSREADFIELD('RAZ.bin',readBinaryPrec,'RS',1,RAZ,  1,myThid)
265          IF (useCubedSphereExchange) THEN
266  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
267        CALL EXCH_Z_XY_RS(RAZ , myThid )        CALL EXCH_Z_XY_RS(RAZ , myThid )
268        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
# Line 195  cs-   this block needed by cubed sphere Line 272  cs-   this block needed by cubed sphere
272         ENDDO         ENDDO
273        ENDDO        ENDDO
274  cs-   end block  cs-   end block
275          ENDIF
276        CALL EXCH_Z_XY_RS(RAZ,myThid)        CALL EXCH_Z_XY_RS(RAZ,myThid)
277    
278  C-    Staggered (u,v pairs) quantities  C-    Staggered (u,v pairs) quantities
# Line 204  C-    Staggered (u,v pairs) quantities Line 282  C-    Staggered (u,v pairs) quantities
282    
283        CALL MDSREADFIELD('RAW.bin',readBinaryPrec,'RS',1,RAW,  1,myThid)        CALL MDSREADFIELD('RAW.bin',readBinaryPrec,'RS',1,RAW,  1,myThid)
284        CALL MDSREADFIELD('RAS.bin',readBinaryPrec,'RS',1,RAS,  1,myThid)        CALL MDSREADFIELD('RAS.bin',readBinaryPrec,'RS',1,RAS,  1,myThid)
285          IF (useCubedSphereExchange) THEN
286  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
287        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
288         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
# Line 214  c        RAS(J,sNy+1,bi,bj)=RAS(J,1,bi,b Line 293  c        RAS(J,sNy+1,bi,bj)=RAS(J,1,bi,b
293         ENDDO         ENDDO
294        ENDDO        ENDDO
295  cs-   end block  cs-   end block
296          ENDIF
297        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)
298    
299        CALL MDSREADFIELD('DXG.bin',readBinaryPrec,'RS',1,DXG,  1,myThid)        CALL MDSREADFIELD('DXG.bin',readBinaryPrec,'RS',1,DXG,  1,myThid)
300        CALL MDSREADFIELD('DYG.bin',readBinaryPrec,'RS',1,DYG,  1,myThid)        CALL MDSREADFIELD('DYG.bin',readBinaryPrec,'RS',1,DYG,  1,myThid)
301          IF (useCubedSphereExchange) THEN
302  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
303        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
304         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
# Line 228  c        DXG(J,sNy+1,bi,bj)=DXG(J,1,bi,b Line 309  c        DXG(J,sNy+1,bi,bj)=DXG(J,1,bi,b
309         ENDDO         ENDDO
310        ENDDO        ENDDO
311  cs-   end block  cs-   end block
312          ENDIF
313        CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)
314          CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)
315    
316  c     write(10) XC  c     write(10) XC
317  c     write(10) YC  c     write(10) YC
# Line 255  C--   Only do I/O if I am the master thr Line 338  C--   Only do I/O if I am the master thr
338        DO bj = 1,nSy        DO bj = 1,nSy
339         DO bi = 1,nSx         DO bi = 1,nSx
340          iG=bi+(myXGlobalLo-1)/sNx          iG=bi+(myXGlobalLo-1)/sNx
341          WRITE(fName(1:15),'("tile",I3.3,".mitgrid")') iG          WRITE(tmpBuf,'(A,I4)') 'tile:',iG
         WRITE(msgBuf,'(A,I4)') 'tile:',iG  
342  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
343        myTile = W2_myTileList(bi)          myTile = W2_myTileList(bi)
344        write(fName(1:15),'("tile",I3.3,".mitgrid")')          WRITE(tmpBuf,'(A,I4)') 'tile:',myTile
345       &  exch2_myface(myTile)          iG = exch2_myface(myTile)
       WRITE(msgBuf,'(A,I4)') 'tile:',myTile  
346  #endif  #endif
347          iL = ILNBLNK(msgBuf)          iLen = ILNBLNK(horizGridFile)
348          WRITE(msgBuf,'(3A)') msgBuf(1:iL),          IF ( iLen .EQ. 0 ) THEN
349       &                   ' ; Read from file ',fName(1:15)            WRITE(fName,'("tile",I3.3,".mitgrid")') iG
350            ELSE
351              WRITE(fName,'(2A,I3.3,A)') horizGridFile(1:iLen),
352         &                              '.face',iG,'.bin'
353            ENDIF
354            iLen = ILNBLNK(fName)
355            iL = ILNBLNK(tmpBuf)
356            WRITE(msgBuf,'(3A)') tmpBuf(1:iL),
357         &                   ' ; Read from file ',fName(1:iLen)
358          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
359       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
360          WRITE(msgBuf,'(A)') '  =>'          WRITE(msgBuf,'(A)') '  =>'
361    
362          CALL READSYMTILE_RS(fName,1,XC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,1,XC,bi,bj,buf,myThid)
363          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
364          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'XC'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'XC'
365          CALL READSYMTILE_RS(fName,2,YC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,2,YC,bi,bj,buf,myThid)
366          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
367          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'YC'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'YC'
368          CALL READSYMTILE_RS(fName,3,DXF,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,3,DXF,bi,bj,buf,myThid)
369          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
370          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXF'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DXF'
371          CALL READSYMTILE_RS(fName,4,DYF,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,4,DYF,bi,bj,buf,myThid)
372          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
373          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYF'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DYF'
374          CALL READSYMTILE_RS(fName,5,RA,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,5,RA,bi,bj,buf,myThid)
375          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
376          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RA'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'RA'
377          CALL READSYMTILE_RS(fName,6,XG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,6,XG,bi,bj,buf,myThid)
378          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
379          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'XG'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'XG'
380          CALL READSYMTILE_RS(fName,7,YG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,7,YG,bi,bj,buf,myThid)
381          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
382          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'YG'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'YG'
383          CALL READSYMTILE_RS(fName,8,DXV,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,8,DXV,bi,bj,buf,myThid)
384          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
385          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXV'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DXV'
386          CALL READSYMTILE_RS(fName,9,DYU,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,9,DYU,bi,bj,buf,myThid)
387          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
388          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYU'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DYU'
389          CALL READSYMTILE_RS(fName,10,RAZ,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,10,RAZ,bi,bj,buf,myThid)
390          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
391          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RAZ'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'RAZ'
392          CALL READSYMTILE_RS(fName,11,DXC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,11,DXC,bi,bj,buf,myThid)
393          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
394          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXC'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DXC'
395          CALL READSYMTILE_RS(fName,12,DYC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,12,DYC,bi,bj,buf,myThid)
396          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
397          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYC'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DYC'
398          CALL READSYMTILE_RS(fName,13,RAW,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,13,RAW,bi,bj,buf,myThid)
399          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
400          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RAW'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'RAW'
401          CALL READSYMTILE_RS(fName,14,RAS,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,14,RAS,bi,bj,buf,myThid)
402          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
403          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RAS'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'RAS'
404          CALL READSYMTILE_RS(fName,15,DXG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,15,DXG,bi,bj,buf,myThid)
405          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
406          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXG'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DXG'
407          CALL READSYMTILE_RS(fName,16,DYG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,16,DYG,bi,bj,buf,myThid)
408          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
409          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYG'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DYG'
410    
411            iLen = ILNBLNK(horizGridFile)
412            IF ( iLen.GT.0 ) THEN
413             CALL READSYMTILE_RS(fName,17,angleCosC,bi,bj,buf,myThid)
414             iL = ILNBLNK(msgBuf)
415             WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'AngleCS'
416             CALL READSYMTILE_RS(fName,18,angleSinC,bi,bj,buf,myThid)
417             iL = ILNBLNK(tmpBuf)
418             WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'AngleSN'
419            ENDIF
420    
421          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
422       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
423    
424         ENDDO         ENDDO
425        ENDDO        ENDDO
426    
427        _END_MASTER(myThid)        _END_MASTER(myThid)
428    
429        CALL EXCH_XY_RS(XC,myThid)        CALL EXCH_XY_RS(XC,myThid)
# Line 334  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned Line 434  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned
434        CALL EXCH_XY_RS(DYF,myThid)        CALL EXCH_XY_RS(DYF,myThid)
435  #endif  #endif
436        CALL EXCH_XY_RS(RA,myThid )        CALL EXCH_XY_RS(RA,myThid )
 #ifndef ALLOW_EXCH2  
437        CALL EXCH_Z_XY_RS(XG,myThid)        CALL EXCH_Z_XY_RS(XG,myThid)
438        CALL EXCH_Z_XY_RS(YG,myThid)        CALL EXCH_Z_XY_RS(YG,myThid)
439  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)
440  c     CALL EXCH_Z_XY_RS(DXV,myThid)  c     CALL EXCH_Z_XY_RS(DXV,myThid)
441  c     CALL EXCH_Z_XY_RS(DYU,myThid)  c     CALL EXCH_Z_XY_RS(DYU,myThid)
442        CALL EXCH_Z_XY_RS(RAZ,myThid)        CALL EXCH_Z_XY_RS(RAZ,myThid)
 #endif /* ALLOW_EXCH2 */  
443        CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)
444        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)
445        CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)
446          CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)
447    
448  #endif /* OLD_GRID_IO */  #endif /* OLD_GRID_IO */
449    
450  c     CALL WRITE_FULLARRAY_RL('DXV',DXV,1,0,myThid)  #ifdef ALLOW_MNC
451  c     CALL WRITE_FULLARRAY_RL('DYU',DYU,1,0,myThid)        ENDIF
452  c     CALL WRITE_FULLARRAY_RL('RAZ',RAZ,1,0,myThid)  #endif /* ALLOW_MNC */
453  c     CALL WRITE_FULLARRAY_RL('XG',XG,1,0,myThid)  
454  c     CALL WRITE_FULLARRAY_RL('YG',YG,1,0,myThid)  c     CALL WRITE_FULLARRAY_RL('DXV',DXV,1,0,0,0,myThid)
455    c     CALL WRITE_FULLARRAY_RL('DYU',DYU,1,0,0,0,myThid)
456    c     CALL WRITE_FULLARRAY_RL('RAZ',RAZ,1,0,0,0,myThid)
457    c     CALL WRITE_FULLARRAY_RL('XG',XG,1,0,0,0,myThid)
458    c     CALL WRITE_FULLARRAY_RL('YG',YG,1,0,0,0,myThid)
459    
460    C--   Require that 0 <= longitude < 360 if using exf package
461    #ifdef ALLOW_EXF
462          DO bj = 1,nSy
463           DO bi = 1,nSx
464            DO J=1-Oly,sNy+Oly
465             DO I=1-Olx,sNx+Olx
466              IF (XC(i,j,bi,bj).lt.0.) XC(i,j,bi,bj)=XC(i,j,bi,bj)+360.
467              IF (XG(i,j,bi,bj).lt.0.) XG(i,j,bi,bj)=XG(i,j,bi,bj)+360.
468             ENDDO
469            ENDDO
470           ENDDO
471          ENDDO
472    #endif /* ALLOW_EXF */
473    
474    C--   Now let's look at all these beasts
475          IF ( debugLevel .GE. debLevB ) THEN
476             myIter = 1
477             CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,
478         &        myIter, myThid )
479             CALL PLOT_FIELD_XYRL( YC      , 'Current YC      ' ,
480         &        myIter, myThid )
481             CALL PLOT_FIELD_XYRL( DXF     , 'Current DXF     ' ,
482         &        myIter, myThid )
483             CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,
484         &        myIter, myThid )
485             CALL PLOT_FIELD_XYRL( DYF     , 'Current DYF     ' ,
486         &        myIter, myThid )
487             CALL PLOT_FIELD_XYRL( RA      , 'Current RA      ' ,
488         &        myIter, myThid )
489             CALL PLOT_FIELD_XYRL( XG      , 'Current XG      ' ,
490         &        myIter, myThid )
491             CALL PLOT_FIELD_XYRL( YG      , 'Current YG      ' ,
492         &        myIter, myThid )
493             CALL PLOT_FIELD_XYRL( DXV     , 'Current DXV     ' ,
494         &        myIter, myThid )
495             CALL PLOT_FIELD_XYRL( DYU     , 'Current DYU     ' ,
496         &        myIter, myThid )
497             CALL PLOT_FIELD_XYRL( RAZ     , 'Current RAZ     ' ,
498         &        myIter, myThid )
499             CALL PLOT_FIELD_XYRL( DXC     , 'Current DXC     ' ,
500         &        myIter, myThid )
501             CALL PLOT_FIELD_XYRL( DYC     , 'Current DYC     ' ,
502         &        myIter, myThid )
503             CALL PLOT_FIELD_XYRL( RAW     , 'Current RAW     ' ,
504         &        myIter, myThid )
505             CALL PLOT_FIELD_XYRL( RAS     , 'Current RAS     ' ,
506         &        myIter, myThid )
507             CALL PLOT_FIELD_XYRL( DXG     , 'Current DXG     ' ,
508         &        myIter, myThid )
509             CALL PLOT_FIELD_XYRL( DYG     , 'Current DYG     ' ,
510         &        myIter, myThid )
511             CALL PLOT_FIELD_XYRL(angleCosC, 'Current AngleCS ' ,
512         &        myIter, myThid )
513             CALL PLOT_FIELD_XYRL(angleSinC, 'Current AngleSN ' ,
514         &        myIter, myThid )
515          ENDIF
516    
517        RETURN        RETURN
518        END        END
# Line 387  C     == Routine arguments == Line 546  C     == Routine arguments ==
546  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
547    
548  C     == Local variables ==  C     == Local variables ==
549        INTEGER I,J,dUnit        INTEGER I,J,dUnit, iLen
550        INTEGER length_of_rec        INTEGER length_of_rec
551        INTEGER MDS_RECLEN        INTEGER MDS_RECLEN
552        INTEGER TN, DNX, DNY, TBX, TBY, TNX, TNY, II, iBase  #ifdef ALLOW_EXCH2
553          INTEGER TN, dNx, dNy, TBX, TBY, TNX, TNY, II, iBase
554    #endif
555          INTEGER  ILNBLNK
556          EXTERNAL ILNBLNK
557    
558          iLen = ILNBLNK(fName)
559  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
560  C     Figure out offset of tile within face  C     Figure out offset of tile within face
561        TN  = W2_myTileList(bi)        TN  = W2_myTileList(bi)
562        DNX = exch2_mydnx(TN)        dNx = exch2_mydnx(TN)
563        DNY = exch2_mydny(TN)        dNy = exch2_mydny(TN)
564        TBX = exch2_tbasex(TN)        TBX = exch2_tbasex(TN)
565        TBY = exch2_tbasey(TN)        TBY = exch2_tbasey(TN)
566        TNX = exch2_tnx(TN)        TNX = exch2_tnx(TN)
567        TNY = exch2_tny(TN)        TNY = exch2_tny(TN)
568    
569        CALL MDSFINDUNIT( dUnit, mythid )        CALL MDSFINDUNIT( dUnit, myThid )
570        length_of_rec=MDS_RECLEN( 64, (dNx+1), myThid )        length_of_rec=MDS_RECLEN( 64, (dNx+1), myThid )
571        OPEN( dUnit, file=fName, status='old',        OPEN( dUnit, file=fName(1:iLen), status='old',
572       &        access='direct', recl=length_of_rec )       &             access='direct', recl=length_of_rec )
573        J=0        J=0
574        iBase=(irec-1)*(dny+1)        iBase=(irec-1)*(dny+1)
575        DO I=1+TBY,SNY+1+TBY        DO I=1+TBY,sNy+1+TBY
576         READ(dUnit,rec=I+iBase)(buf(ii),ii=1,dnx+1)         READ(dUnit,rec=I+iBase)(buf(ii),ii=1,dNx+1)
577  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
578  #ifdef REAL4_IS_SLOW  #ifdef REAL4_IS_SLOW
579         CALL MDS_BYTESWAPR8((dNx+1), buf)         CALL MDS_BYTESWAPR8((dNx+1), buf)
# Line 426  C     Figure out offset of tile within f Line 590  C     Figure out offset of tile within f
590                
591  #else /* ALLOW_EXCH2 */  #else /* ALLOW_EXCH2 */
592    
593        CALL MDSFINDUNIT( dUnit, mythid )        CALL MDSFINDUNIT( dUnit, myThid )
594        length_of_rec=MDS_RECLEN( 64, (sNx+1)*(sNy+1), myThid )        length_of_rec=MDS_RECLEN( 64, (sNx+1)*(sNy+1), myThid )
595        OPEN( dUnit, file=fName, status='old',        OPEN( dUnit, file=fName(1:iLen), status='old',
596       &        access='direct', recl=length_of_rec )       &             access='direct', recl=length_of_rec )
597        READ(dUnit,rec=irec) buf        READ(dUnit,rec=irec) buf
598        CLOSE( dUnit )        CLOSE( dUnit )
599    
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.21
  ViewVC Help
Powered by ViewVC 1.1.22