/[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.27 by jmc, Thu Jul 13 02:59:19 2006 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
       CHARACTER*(15) fName  
       _RL buf(sNx+1,sNy+1)  
       INTEGER iG, iL  
55        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
56          LOGICAL anglesAreSet
57    #ifdef ALLOW_MNC
58          CHARACTER*(80) mncFn
59    #endif
60    #ifndef OLD_GRID_IO
61    # ifdef ALLOW_EXCH2
62          _RL buf(sNx*nSx*nPx+1)
63          INTEGER myTile
64    # else
65          _RL buf(sNx+1,sNy+1)
66    # endif
67          INTEGER iG, iL, iLen
68          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 79  C--   Set everything to zero everywhere Line 96  C--   Set everything to zero everywhere
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.
100              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.
# Line 89  C--   Set everything to zero everywhere Line 108  C--   Set everything to zero everywhere
108         ENDDO         ENDDO
109        ENDDO        ENDDO
110    
111    
112    #ifdef ALLOW_MNC
113          IF (useMNC .AND. readgrid_mnc) THEN
114    
115            _BEGIN_MASTER(myThid)
116            DO i = 1,80
117              mncFn(i:i) = ' '
118            ENDDO
119            write(mncFn,'(a)') 'mitgrid'
120            DO i = 1,MAX_LEN_MBUF
121              msgBuf(i:i) = ' '
122            ENDDO
123            WRITE(msgBuf,'(2A)') msgBuf,' ; Reading grid info using MNC'
124            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
125         &       SQUEEZE_RIGHT , myThid)
126            CALL MNC_FILE_CLOSE_ALL_MATCHING(mncFn, myThid)
127            CALL MNC_CW_SET_UDIM(mncFn, 1, myThid)
128            CALL MNC_CW_SET_CITER(mncFn, 2, -1, -1, -1, myThid)
129            CALL MNC_CW_SET_UDIM(mncFn, 1, myThid)
130            CALL MNC_CW_RS_R('D',mncFn,0,0,'XC', XC,  myThid)
131            CALL MNC_CW_RS_R('D',mncFn,0,0,'XG', XG,  myThid)
132            CALL MNC_CW_RS_R('D',mncFn,0,0,'YC', YC,  myThid)
133            CALL MNC_CW_RS_R('D',mncFn,0,0,'YG', YG,  myThid)
134            CALL MNC_CW_RS_R('D',mncFn,0,0,'dxC',DXC, myThid)
135            CALL MNC_CW_RS_R('D',mncFn,0,0,'dyC',DYC, myThid)
136            CALL MNC_CW_RS_R('D',mncFn,0,0,'dxF',DXF, myThid)
137            CALL MNC_CW_RS_R('D',mncFn,0,0,'dyF',DYF, myThid)
138            CALL MNC_CW_RS_R('D',mncFn,0,0,'dxG',DXG, myThid)
139            CALL MNC_CW_RS_R('D',mncFn,0,0,'dyG',DYG, myThid)
140            CALL MNC_CW_RS_R('D',mncFn,0,0,'dxV',DXV, myThid)
141            CALL MNC_CW_RS_R('D',mncFn,0,0,'dyU',DYU, myThid)
142            CALL MNC_CW_RS_R('D',mncFn,0,0,'rA', RA,  myThid)
143            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)
151    
152            CALL EXCH_XY_RS(XC,myThid)
153            CALL EXCH_XY_RS(YC,myThid)
154    #ifdef HRCUBE
155            CALL EXCH_XY_RS(DXF,myThid)
156            CALL EXCH_XY_RS(DYF,myThid)
157    #endif
158            CALL EXCH_XY_RS(RA,myThid )
159            CALL EXCH_Z_XY_RS(XG,myThid)
160            CALL EXCH_Z_XY_RS(YG,myThid)
161            CALL EXCH_Z_XY_RS(RAZ,myThid)
162            CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)
163            CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)
164            CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)
165            CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)
166    
167          ELSE
168    #endif
169    
170  C     Here we make no assumptions about grid symmetry and simply  C     Here we make no assumptions about grid symmetry and simply
171  C     read the raw grid data from files  C     read the raw grid data from files
172    
# Line 106  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned Line 184  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned
184  cs!   this is not correct! <= need paired exchange for DXF,DYF  cs!   this is not correct! <= need paired exchange for DXF,DYF
185        _EXCH_XY_R4(DXF,myThid)        _EXCH_XY_R4(DXF,myThid)
186        _EXCH_XY_R4(DYF,myThid)        _EXCH_XY_R4(DYF,myThid)
187          IF (useCubedSphereExchange) THEN
188  cs! fix overlaps:  cs! fix overlaps:
189        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
190         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
# Line 127  cs! fix overlaps: Line 206  cs! fix overlaps:
206          ENDDO          ENDDO
207         ENDDO         ENDDO
208        ENDDO        ENDDO
209          ENDIF
210  cs  cs
211    
212        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 216  C-    Corner quantities
216  C       *********** this are not degbugged ************  C       *********** this are not degbugged ************
217        CALL MDSREADFIELD('LONG.bin',readBinaryPrec,'RS',1,XG,  1,myThid)        CALL MDSREADFIELD('LONG.bin',readBinaryPrec,'RS',1,XG,  1,myThid)
218        CALL MDSREADFIELD('LATG.bin',readBinaryPrec,'RS',1,YG,  1,myThid)        CALL MDSREADFIELD('LATG.bin',readBinaryPrec,'RS',1,YG,  1,myThid)
219          IF (useCubedSphereExchange) THEN
220  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
221        bi=3        bi=3
222        bj=1        bj=1
# Line 152  cs-   this block needed by cubed sphere Line 233  cs-   this block needed by cubed sphere
233        bj=bj+2        bj=bj+2
234        YG(sNx+1,1,bj,1)=YG(1,1,bi,1)        YG(sNx+1,1,bj,1)=YG(1,1,bi,1)
235  cs-   end block  cs-   end block
236          ENDIF
237        CALL EXCH_Z_XY_RS(XG,myThid)        CALL EXCH_Z_XY_RS(XG,myThid)
238        CALL EXCH_Z_XY_RS(YG,myThid)        CALL EXCH_Z_XY_RS(YG,myThid)
239    
# Line 160  cs-   end block Line 242  cs-   end block
242  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
243  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)
244  cs!   this is not correct <= need paired exchange for dxv,dyu  cs!   this is not correct <= need paired exchange for dxv,dyu
245  cs    CALL EXCH_Z_XY_RS(DXV,myThid)        IF (.NOT.useCubedSphereExchange) THEN
246  cs    CALL EXCH_Z_XY_RS(DYU,myThid)        CALL EXCH_Z_XY_RS(DXV,myThid)
247          CALL EXCH_Z_XY_RS(DYU,myThid)
248          ELSE
249        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
250         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
251  cs! fix overlaps:  cs! fix overlaps:
# Line 184  cs! fix overlaps: Line 268  cs! fix overlaps:
268         ENDDO         ENDDO
269        ENDDO        ENDDO
270  cs-   end block  cs-   end block
271          ENDIF
272    
273        CALL MDSREADFIELD('RAZ.bin',readBinaryPrec,'RS',1,RAZ,  1,myThid)        CALL MDSREADFIELD('RAZ.bin',readBinaryPrec,'RS',1,RAZ,  1,myThid)
274          IF (useCubedSphereExchange) THEN
275  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
276        CALL EXCH_Z_XY_RS(RAZ , myThid )        CALL EXCH_Z_XY_RS(RAZ , myThid )
277        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
# Line 195  cs-   this block needed by cubed sphere Line 281  cs-   this block needed by cubed sphere
281         ENDDO         ENDDO
282        ENDDO        ENDDO
283  cs-   end block  cs-   end block
284          ENDIF
285        CALL EXCH_Z_XY_RS(RAZ,myThid)        CALL EXCH_Z_XY_RS(RAZ,myThid)
286    
287  C-    Staggered (u,v pairs) quantities  C-    Staggered (u,v pairs) quantities
# Line 204  C-    Staggered (u,v pairs) quantities Line 291  C-    Staggered (u,v pairs) quantities
291    
292        CALL MDSREADFIELD('RAW.bin',readBinaryPrec,'RS',1,RAW,  1,myThid)        CALL MDSREADFIELD('RAW.bin',readBinaryPrec,'RS',1,RAW,  1,myThid)
293        CALL MDSREADFIELD('RAS.bin',readBinaryPrec,'RS',1,RAS,  1,myThid)        CALL MDSREADFIELD('RAS.bin',readBinaryPrec,'RS',1,RAS,  1,myThid)
294          IF (useCubedSphereExchange) THEN
295  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
296        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
297         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 302  c        RAS(J,sNy+1,bi,bj)=RAS(J,1,bi,b
302         ENDDO         ENDDO
303        ENDDO        ENDDO
304  cs-   end block  cs-   end block
305          ENDIF
306        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)
307    
308        CALL MDSREADFIELD('DXG.bin',readBinaryPrec,'RS',1,DXG,  1,myThid)        CALL MDSREADFIELD('DXG.bin',readBinaryPrec,'RS',1,DXG,  1,myThid)
309        CALL MDSREADFIELD('DYG.bin',readBinaryPrec,'RS',1,DYG,  1,myThid)        CALL MDSREADFIELD('DYG.bin',readBinaryPrec,'RS',1,DYG,  1,myThid)
310          IF (useCubedSphereExchange) THEN
311  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
312        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
313         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 318  c        DXG(J,sNy+1,bi,bj)=DXG(J,1,bi,b
318         ENDDO         ENDDO
319        ENDDO        ENDDO
320  cs-   end block  cs-   end block
321          ENDIF
322        CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)
323          CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)
324          anglesAreSet = .FALSE.
325    
326  c     write(10) XC  c     write(10) XC
327  c     write(10) YC  c     write(10) YC
# Line 255  C--   Only do I/O if I am the master thr Line 348  C--   Only do I/O if I am the master thr
348        DO bj = 1,nSy        DO bj = 1,nSy
349         DO bi = 1,nSx         DO bi = 1,nSx
350          iG=bi+(myXGlobalLo-1)/sNx          iG=bi+(myXGlobalLo-1)/sNx
351          WRITE(fName(1:15),'("tile",I3.3,".mitgrid")') iG          WRITE(tmpBuf,'(A,I4)') 'tile:',iG
         WRITE(msgBuf,'(A,I4)') 'tile:',iG  
352  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
353        myTile = W2_myTileList(bi)          myTile = W2_myTileList(bi)
354        write(fName(1:15),'("tile",I3.3,".mitgrid")')          WRITE(tmpBuf,'(A,I4)') 'tile:',myTile
355       &  exch2_myface(myTile)          iG = exch2_myface(myTile)
       WRITE(msgBuf,'(A,I4)') 'tile:',myTile  
356  #endif  #endif
357          iL = ILNBLNK(msgBuf)          iLen = ILNBLNK(horizGridFile)
358          WRITE(msgBuf,'(3A)') msgBuf(1:iL),          IF ( iLen .EQ. 0 ) THEN
359       &                   ' ; Read from file ',fName(1:15)            WRITE(fName,'("tile",I3.3,".mitgrid")') iG
360            ELSE
361              WRITE(fName,'(2A,I3.3,A)') horizGridFile(1:iLen),
362         &                              '.face',iG,'.bin'
363            ENDIF
364            iLen = ILNBLNK(fName)
365            iL = ILNBLNK(tmpBuf)
366            WRITE(msgBuf,'(3A)') tmpBuf(1:iL),
367         &                   ' ; Read from file ',fName(1:iLen)
368          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
369       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
370          WRITE(msgBuf,'(A)') '  =>'          WRITE(msgBuf,'(A)') '  =>'
371    
372          CALL READSYMTILE_RS(fName,1,XC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,1,XC,bi,bj,buf,myThid)
373          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
374          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'XC'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'XC'
375          CALL READSYMTILE_RS(fName,2,YC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,2,YC,bi,bj,buf,myThid)
376          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
377          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'YC'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'YC'
378          CALL READSYMTILE_RS(fName,3,DXF,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,3,DXF,bi,bj,buf,myThid)
379          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
380          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXF'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DXF'
381          CALL READSYMTILE_RS(fName,4,DYF,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,4,DYF,bi,bj,buf,myThid)
382          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
383          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYF'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DYF'
384          CALL READSYMTILE_RS(fName,5,RA,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,5,RA,bi,bj,buf,myThid)
385          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
386          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RA'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'RA'
387          CALL READSYMTILE_RS(fName,6,XG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,6,XG,bi,bj,buf,myThid)
388          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
389          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'XG'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'XG'
390          CALL READSYMTILE_RS(fName,7,YG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,7,YG,bi,bj,buf,myThid)
391          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
392          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'YG'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'YG'
393          CALL READSYMTILE_RS(fName,8,DXV,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,8,DXV,bi,bj,buf,myThid)
394          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
395          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXV'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DXV'
396          CALL READSYMTILE_RS(fName,9,DYU,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,9,DYU,bi,bj,buf,myThid)
397          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
398          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYU'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DYU'
399          CALL READSYMTILE_RS(fName,10,RAZ,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,10,RAZ,bi,bj,buf,myThid)
400          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
401          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RAZ'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'RAZ'
402          CALL READSYMTILE_RS(fName,11,DXC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,11,DXC,bi,bj,buf,myThid)
403          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
404          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXC'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DXC'
405          CALL READSYMTILE_RS(fName,12,DYC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,12,DYC,bi,bj,buf,myThid)
406          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
407          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYC'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DYC'
408          CALL READSYMTILE_RS(fName,13,RAW,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,13,RAW,bi,bj,buf,myThid)
409          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
410          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RAW'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'RAW'
411          CALL READSYMTILE_RS(fName,14,RAS,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,14,RAS,bi,bj,buf,myThid)
412          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
413          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RAS'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'RAS'
414          CALL READSYMTILE_RS(fName,15,DXG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,15,DXG,bi,bj,buf,myThid)
415          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
416          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXG'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DXG'
417          CALL READSYMTILE_RS(fName,16,DYG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,16,DYG,bi,bj,buf,myThid)
418          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
419          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYG'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DYG'
420    
421            iLen = ILNBLNK(horizGridFile)
422            IF ( iLen.GT.0 ) THEN
423             CALL READSYMTILE_RS(fName,17,angleCosC,bi,bj,buf,myThid)
424             iL = ILNBLNK(msgBuf)
425             WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'AngleCS'
426             CALL READSYMTILE_RS(fName,18,angleSinC,bi,bj,buf,myThid)
427             iL = ILNBLNK(tmpBuf)
428             WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'AngleSN'
429             anglesAreSet = .TRUE.
430            ELSE
431             anglesAreSet = .FALSE.
432            ENDIF
433    
434          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
435       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
436    
437         ENDDO         ENDDO
438        ENDDO        ENDDO
439    
440        _END_MASTER(myThid)        _END_MASTER(myThid)
441    
442        CALL EXCH_XY_RS(XC,myThid)        CALL EXCH_XY_RS(XC,myThid)
# Line 334  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned Line 447  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned
447        CALL EXCH_XY_RS(DYF,myThid)        CALL EXCH_XY_RS(DYF,myThid)
448  #endif  #endif
449        CALL EXCH_XY_RS(RA,myThid )        CALL EXCH_XY_RS(RA,myThid )
 #ifndef ALLOW_EXCH2  
450        CALL EXCH_Z_XY_RS(XG,myThid)        CALL EXCH_Z_XY_RS(XG,myThid)
451        CALL EXCH_Z_XY_RS(YG,myThid)        CALL EXCH_Z_XY_RS(YG,myThid)
452  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)
453  c     CALL EXCH_Z_XY_RS(DXV,myThid)  c     CALL EXCH_Z_XY_RS(DXV,myThid)
454  c     CALL EXCH_Z_XY_RS(DYU,myThid)  c     CALL EXCH_Z_XY_RS(DYU,myThid)
455        CALL EXCH_Z_XY_RS(RAZ,myThid)        CALL EXCH_Z_XY_RS(RAZ,myThid)
 #endif /* ALLOW_EXCH2 */  
456        CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)
457        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)
458        CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)
459          CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)
460    
461  #endif /* OLD_GRID_IO */  #endif /* OLD_GRID_IO */
462    
463  c     CALL WRITE_FULLARRAY_RL('DXV',DXV,1,0,myThid)  #ifdef ALLOW_MNC
464  c     CALL WRITE_FULLARRAY_RL('DYU',DYU,1,0,myThid)        ENDIF
465  c     CALL WRITE_FULLARRAY_RL('RAZ',RAZ,1,0,myThid)  #endif /* ALLOW_MNC */
466  c     CALL WRITE_FULLARRAY_RL('XG',XG,1,0,myThid)  
467  c     CALL WRITE_FULLARRAY_RL('YG',YG,1,0,myThid)  C--   Stop if Angle have not been loaded but are needed :
468          _BEGIN_MASTER(myThid)
469          IF ( .NOT.anglesAreSet .AND. use3dCoriolis ) THEN
470            WRITE(msgBuf,'(2A)')
471         &   'INI_CURVILINEAR_GRID: Angle of CurvilinearGrid not set',
472         &   ' but needed for 3-D Coriolis'
473            CALL PRINT_ERROR( msgBuf , myThid)
474            STOP 'ABNORMAL END: S/R INI_CURVILINEAR_GRID'
475          ENDIF
476          _END_MASTER(myThid)
477    
478    c     CALL WRITE_FULLARRAY_RL('DXV',DXV,1,0,0,0,myThid)
479    c     CALL WRITE_FULLARRAY_RL('DYU',DYU,1,0,0,0,myThid)
480    c     CALL WRITE_FULLARRAY_RL('RAZ',RAZ,1,0,0,0,myThid)
481    c     CALL WRITE_FULLARRAY_RL('XG',XG,1,0,0,0,myThid)
482    c     CALL WRITE_FULLARRAY_RL('YG',YG,1,0,0,0,myThid)
483    
484    C--   Now let's look at all these beasts
485          IF ( debugLevel .GE. debLevB ) THEN
486             myIter = 1
487             CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,
488         &        myIter, myThid )
489             CALL PLOT_FIELD_XYRL( YC      , 'Current YC      ' ,
490         &        myIter, myThid )
491             CALL PLOT_FIELD_XYRL( DXF     , 'Current DXF     ' ,
492         &        myIter, myThid )
493             CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,
494         &        myIter, myThid )
495             CALL PLOT_FIELD_XYRL( DYF     , 'Current DYF     ' ,
496         &        myIter, myThid )
497             CALL PLOT_FIELD_XYRL( RA      , 'Current RA      ' ,
498         &        myIter, myThid )
499             CALL PLOT_FIELD_XYRL( XG      , 'Current XG      ' ,
500         &        myIter, myThid )
501             CALL PLOT_FIELD_XYRL( YG      , 'Current YG      ' ,
502         &        myIter, myThid )
503             CALL PLOT_FIELD_XYRL( DXV     , 'Current DXV     ' ,
504         &        myIter, myThid )
505             CALL PLOT_FIELD_XYRL( DYU     , 'Current DYU     ' ,
506         &        myIter, myThid )
507             CALL PLOT_FIELD_XYRL( RAZ     , 'Current RAZ     ' ,
508         &        myIter, myThid )
509             CALL PLOT_FIELD_XYRL( DXC     , 'Current DXC     ' ,
510         &        myIter, myThid )
511             CALL PLOT_FIELD_XYRL( DYC     , 'Current DYC     ' ,
512         &        myIter, myThid )
513             CALL PLOT_FIELD_XYRL( RAW     , 'Current RAW     ' ,
514         &        myIter, myThid )
515             CALL PLOT_FIELD_XYRL( RAS     , 'Current RAS     ' ,
516         &        myIter, myThid )
517             CALL PLOT_FIELD_XYRL( DXG     , 'Current DXG     ' ,
518         &        myIter, myThid )
519             CALL PLOT_FIELD_XYRL( DYG     , 'Current DYG     ' ,
520         &        myIter, myThid )
521             CALL PLOT_FIELD_XYRL(angleCosC, 'Current AngleCS ' ,
522         &        myIter, myThid )
523             CALL PLOT_FIELD_XYRL(angleSinC, 'Current AngleSN ' ,
524         &        myIter, myThid )
525          ENDIF
526    
527        RETURN        RETURN
528        END        END
# Line 387  C     == Routine arguments == Line 556  C     == Routine arguments ==
556  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
557    
558  C     == Local variables ==  C     == Local variables ==
559        INTEGER I,J,dUnit        INTEGER I,J,dUnit, iLen
560        INTEGER length_of_rec        INTEGER length_of_rec
561        INTEGER MDS_RECLEN        INTEGER MDS_RECLEN
562        INTEGER TN, DNX, DNY, TBX, TBY, TNX, TNY, II, iBase  #ifdef ALLOW_EXCH2
563          INTEGER TN, dNx, dNy, TBX, TBY, TNX, TNY, II, iBase
564    #endif
565          INTEGER  ILNBLNK
566          EXTERNAL ILNBLNK
567    
568          iLen = ILNBLNK(fName)
569  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
570  C     Figure out offset of tile within face  C     Figure out offset of tile within face
571        TN  = W2_myTileList(bi)        TN  = W2_myTileList(bi)
572        DNX = exch2_mydnx(TN)        dNx = exch2_mydnx(TN)
573        DNY = exch2_mydny(TN)        dNy = exch2_mydny(TN)
574        TBX = exch2_tbasex(TN)        TBX = exch2_tbasex(TN)
575        TBY = exch2_tbasey(TN)        TBY = exch2_tbasey(TN)
576        TNX = exch2_tnx(TN)        TNX = exch2_tnx(TN)
577        TNY = exch2_tny(TN)        TNY = exch2_tny(TN)
578    
579        CALL MDSFINDUNIT( dUnit, mythid )        CALL MDSFINDUNIT( dUnit, myThid )
580        length_of_rec=MDS_RECLEN( 64, (dNx+1), myThid )        length_of_rec=MDS_RECLEN( 64, (dNx+1), myThid )
581        OPEN( dUnit, file=fName, status='old',        OPEN( dUnit, file=fName(1:iLen), status='old',
582       &        access='direct', recl=length_of_rec )       &             access='direct', recl=length_of_rec )
583        J=0        J=0
584        iBase=(irec-1)*(dny+1)        iBase=(irec-1)*(dny+1)
585        DO I=1+TBY,SNY+1+TBY        DO I=1+TBY,sNy+1+TBY
586         READ(dUnit,rec=I+iBase)(buf(ii),ii=1,dnx+1)         READ(dUnit,rec=I+iBase)(buf(ii),ii=1,dNx+1)
587  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
588  #ifdef REAL4_IS_SLOW  #ifdef REAL4_IS_SLOW
589         CALL MDS_BYTESWAPR8((dNx+1), buf)         CALL MDS_BYTESWAPR8((dNx+1), buf)
# Line 426  C     Figure out offset of tile within f Line 600  C     Figure out offset of tile within f
600                
601  #else /* ALLOW_EXCH2 */  #else /* ALLOW_EXCH2 */
602    
603        CALL MDSFINDUNIT( dUnit, mythid )        CALL MDSFINDUNIT( dUnit, myThid )
604        length_of_rec=MDS_RECLEN( 64, (sNx+1)*(sNy+1), myThid )        length_of_rec=MDS_RECLEN( 64, (sNx+1)*(sNy+1), myThid )
605        OPEN( dUnit, file=fName, status='old',        OPEN( dUnit, file=fName(1:iLen), status='old',
606       &        access='direct', recl=length_of_rec )       &             access='direct', recl=length_of_rec )
607        READ(dUnit,rec=irec) buf        READ(dUnit,rec=irec) buf
608        CLOSE( dUnit )        CLOSE( dUnit )
609    
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.27
  ViewVC Help
Powered by ViewVC 1.1.22