/[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.7 by jmc, Mon Jan 26 01:17:58 2004 UTC revision 1.14 by dimitri, Fri Jun 25 02:49:49 2004 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4    #include "PACKAGES_CONFIG.h"
5  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
6    
7  CBOP  CBOP
# Line 26  C     === Global variables === Line 27  C     === Global variables ===
27  #include "EEPARAMS.h"  #include "EEPARAMS.h"
28  #include "PARAMS.h"  #include "PARAMS.h"
29  #include "GRID.h"  #include "GRID.h"
30  #include "EESUPPORT.h"  #ifdef ALLOW_EXCH2
 #ifdef USE_W2  
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    
35  #ifndef USE_W2  #ifndef ALLOW_EXCH2
36  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
37  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
38  #define OLD_GRID_IO  #define OLD_GRID_IO
39  #endif  #endif /* ALLOW_EXCH2 */
40    
41  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
42  C     == Routine arguments ==  C     == Routine arguments ==
# Line 45  C     myThid -  Number of this instance Line 45  C     myThid -  Number of this instance
45    
46  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
47  C     == Local variables ==  C     == Local variables ==
48        INTEGER bi,bj, myTile        INTEGER bi,bj, myTile, myiter
49        INTEGER I,J        INTEGER I,J
50        CHARACTER*(15) fName        CHARACTER*(15) fName
51        _RL buf(sNx+1,sNy+1)        _RL buf(sNx+1,sNy+1)
52          INTEGER iG, iL
53          CHARACTER*(MAX_LEN_MBUF) msgBuf
54          INTEGER  ILNBLNK
55          EXTERNAL ILNBLNK
56  CEOP  CEOP
57    
58  C--   Set everything to zero everywhere  C--   Set everything to zero everywhere
# Line 102  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned Line 106  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned
106  cs!   this is not correct! <= need paired exchange for DXF,DYF  cs!   this is not correct! <= need paired exchange for DXF,DYF
107        _EXCH_XY_R4(DXF,myThid)        _EXCH_XY_R4(DXF,myThid)
108        _EXCH_XY_R4(DYF,myThid)        _EXCH_XY_R4(DYF,myThid)
109          IF (useCubedSphereExchange) THEN
110  cs! fix overlaps:  cs! fix overlaps:
111        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
112         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
# Line 123  cs! fix overlaps: Line 128  cs! fix overlaps:
128          ENDDO          ENDDO
129         ENDDO         ENDDO
130        ENDDO        ENDDO
131          ENDIF
132  cs  cs
133    
134        CALL MDSREADFIELD('RA.bin',readBinaryPrec,'RS',1,RA,  1,myThid)        CALL MDSREADFIELD('RA.bin',readBinaryPrec,'RS',1,RA,  1,myThid)
# Line 132  C-    Corner quantities Line 138  C-    Corner quantities
138  C       *********** this are not degbugged ************  C       *********** this are not degbugged ************
139        CALL MDSREADFIELD('LONG.bin',readBinaryPrec,'RS',1,XG,  1,myThid)        CALL MDSREADFIELD('LONG.bin',readBinaryPrec,'RS',1,XG,  1,myThid)
140        CALL MDSREADFIELD('LATG.bin',readBinaryPrec,'RS',1,YG,  1,myThid)        CALL MDSREADFIELD('LATG.bin',readBinaryPrec,'RS',1,YG,  1,myThid)
141          IF (useCubedSphereExchange) THEN
142  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
143        bi=3        bi=3
144        bj=1        bj=1
# Line 148  cs-   this block needed by cubed sphere Line 155  cs-   this block needed by cubed sphere
155        bj=bj+2        bj=bj+2
156        YG(sNx+1,1,bj,1)=YG(1,1,bi,1)        YG(sNx+1,1,bj,1)=YG(1,1,bi,1)
157  cs-   end block  cs-   end block
158          ENDIF
159        CALL EXCH_Z_XY_RS(XG,myThid)        CALL EXCH_Z_XY_RS(XG,myThid)
160        CALL EXCH_Z_XY_RS(YG,myThid)        CALL EXCH_Z_XY_RS(YG,myThid)
161    
# Line 156  cs-   end block Line 164  cs-   end block
164  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
165  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)
166  cs!   this is not correct <= need paired exchange for dxv,dyu  cs!   this is not correct <= need paired exchange for dxv,dyu
167  cs    CALL EXCH_Z_XY_RS(DXV,myThid)        IF (.NOT.useCubedSphereExchange) THEN
168  cs    CALL EXCH_Z_XY_RS(DYU,myThid)        CALL EXCH_Z_XY_RS(DXV,myThid)
169          CALL EXCH_Z_XY_RS(DYU,myThid)
170          ELSE
171        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
172         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
173  cs! fix overlaps:  cs! fix overlaps:
# Line 180  cs! fix overlaps: Line 190  cs! fix overlaps:
190         ENDDO         ENDDO
191        ENDDO        ENDDO
192  cs-   end block  cs-   end block
193          ENDIF
194    
195        CALL MDSREADFIELD('RAZ.bin',readBinaryPrec,'RS',1,RAZ,  1,myThid)        CALL MDSREADFIELD('RAZ.bin',readBinaryPrec,'RS',1,RAZ,  1,myThid)
196          IF (useCubedSphereExchange) THEN
197  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
198        CALL EXCH_Z_XY_RS(RAZ , myThid )        CALL EXCH_Z_XY_RS(RAZ , myThid )
199        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
# Line 191  cs-   this block needed by cubed sphere Line 203  cs-   this block needed by cubed sphere
203         ENDDO         ENDDO
204        ENDDO        ENDDO
205  cs-   end block  cs-   end block
206          ENDIF
207        CALL EXCH_Z_XY_RS(RAZ,myThid)        CALL EXCH_Z_XY_RS(RAZ,myThid)
208    
209  C-    Staggered (u,v pairs) quantities  C-    Staggered (u,v pairs) quantities
# Line 200  C-    Staggered (u,v pairs) quantities Line 213  C-    Staggered (u,v pairs) quantities
213    
214        CALL MDSREADFIELD('RAW.bin',readBinaryPrec,'RS',1,RAW,  1,myThid)        CALL MDSREADFIELD('RAW.bin',readBinaryPrec,'RS',1,RAW,  1,myThid)
215        CALL MDSREADFIELD('RAS.bin',readBinaryPrec,'RS',1,RAS,  1,myThid)        CALL MDSREADFIELD('RAS.bin',readBinaryPrec,'RS',1,RAS,  1,myThid)
216          IF (useCubedSphereExchange) THEN
217  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
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)
# Line 210  c        RAS(J,sNy+1,bi,bj)=RAS(J,1,bi,b Line 224  c        RAS(J,sNy+1,bi,bj)=RAS(J,1,bi,b
224         ENDDO         ENDDO
225        ENDDO        ENDDO
226  cs-   end block  cs-   end block
227          ENDIF
228        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)
229    
230        CALL MDSREADFIELD('DXG.bin',readBinaryPrec,'RS',1,DXG,  1,myThid)        CALL MDSREADFIELD('DXG.bin',readBinaryPrec,'RS',1,DXG,  1,myThid)
231        CALL MDSREADFIELD('DYG.bin',readBinaryPrec,'RS',1,DYG,  1,myThid)        CALL MDSREADFIELD('DYG.bin',readBinaryPrec,'RS',1,DYG,  1,myThid)
232          IF (useCubedSphereExchange) THEN
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        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
235         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
# Line 224  c        DXG(J,sNy+1,bi,bj)=DXG(J,1,bi,b Line 240  c        DXG(J,sNy+1,bi,bj)=DXG(J,1,bi,b
240         ENDDO         ENDDO
241        ENDDO        ENDDO
242  cs-   end block  cs-   end block
243          ENDIF
244        CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)
245    
246  c     write(10) XC  c     write(10) XC
# Line 243  c     write(10) RAS Line 260  c     write(10) RAS
260  c     write(10) DXG  c     write(10) DXG
261  c     write(10) DYG  c     write(10) DYG
262    
263  #else  #else /* ifndef OLD_GRID_IO */
264    
265        DO bj = myByLo(myThid), myByHi(myThid)  C--   Only do I/O if I am the master thread
        DO bi = myBxLo(myThid), myBxHi(myThid)  
266        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
267  #ifdef ALLOW_USE_MPI  
268        write(fName(1:15),'("tile",I3.3,".mitgrid")') myPid+1        DO bj = 1,nSy
269  #else         DO bi = 1,nSx
270        write(fName(1:15),'("tile",I3.3,".mitgrid")') bi          iG=bi+(myXGlobalLo-1)/sNx
271  #endif          WRITE(fName(1:15),'("tile",I3.3,".mitgrid")') iG
272  #ifdef USE_W2          WRITE(msgBuf,'(A,I4)') 'tile:',iG
273    #ifdef ALLOW_EXCH2
274        myTile = W2_myTileList(bi)        myTile = W2_myTileList(bi)
275        write(fName(1:15),'("tile",I3.3,".mitgrid")')        write(fName(1:15),'("tile",I3.3,".mitgrid")')
276       &  exch2_myface(myTile)       &  exch2_myface(myTile)
277          WRITE(msgBuf,'(A,I4)') 'tile:',myTile
278  #endif  #endif
279            iL = ILNBLNK(msgBuf)
280            WRITE(msgBuf,'(3A)') msgBuf(1:iL),
281         &                   ' ; Read from file ',fName(1:15)
282            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
283         &                      SQUEEZE_RIGHT , myThid)
284            WRITE(msgBuf,'(A)') '  =>'
285    
286            CALL READSYMTILE_RS(fName,1,XC,bi,bj,buf,myThid)
287            iL = ILNBLNK(msgBuf)
288            WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'XC'
289            CALL READSYMTILE_RS(fName,2,YC,bi,bj,buf,myThid)
290            iL = ILNBLNK(msgBuf)
291            WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'YC'
292            CALL READSYMTILE_RS(fName,3,DXF,bi,bj,buf,myThid)
293            iL = ILNBLNK(msgBuf)
294            WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXF'
295            CALL READSYMTILE_RS(fName,4,DYF,bi,bj,buf,myThid)
296            iL = ILNBLNK(msgBuf)
297            WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYF'
298            CALL READSYMTILE_RS(fName,5,RA,bi,bj,buf,myThid)
299            iL = ILNBLNK(msgBuf)
300            WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RA'
301            CALL READSYMTILE_RS(fName,6,XG,bi,bj,buf,myThid)
302            iL = ILNBLNK(msgBuf)
303            WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'XG'
304            CALL READSYMTILE_RS(fName,7,YG,bi,bj,buf,myThid)
305            iL = ILNBLNK(msgBuf)
306            WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'YG'
307            CALL READSYMTILE_RS(fName,8,DXV,bi,bj,buf,myThid)
308            iL = ILNBLNK(msgBuf)
309            WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXV'
310            CALL READSYMTILE_RS(fName,9,DYU,bi,bj,buf,myThid)
311            iL = ILNBLNK(msgBuf)
312            WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYU'
313            CALL READSYMTILE_RS(fName,10,RAZ,bi,bj,buf,myThid)
314            iL = ILNBLNK(msgBuf)
315            WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RAZ'
316            CALL READSYMTILE_RS(fName,11,DXC,bi,bj,buf,myThid)
317            iL = ILNBLNK(msgBuf)
318            WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXC'
319            CALL READSYMTILE_RS(fName,12,DYC,bi,bj,buf,myThid)
320            iL = ILNBLNK(msgBuf)
321            WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYC'
322            CALL READSYMTILE_RS(fName,13,RAW,bi,bj,buf,myThid)
323            iL = ILNBLNK(msgBuf)
324            WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RAW'
325            CALL READSYMTILE_RS(fName,14,RAS,bi,bj,buf,myThid)
326            iL = ILNBLNK(msgBuf)
327            WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RAS'
328            CALL READSYMTILE_RS(fName,15,DXG,bi,bj,buf,myThid)
329            iL = ILNBLNK(msgBuf)
330            WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXG'
331            CALL READSYMTILE_RS(fName,16,DYG,bi,bj,buf,myThid)
332            iL = ILNBLNK(msgBuf)
333            WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYG'
334    
335            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
336         &                      SQUEEZE_RIGHT , myThid)
337    
       CALL READSYMTILE_RS(fName,1,XC,bi,bj,buf,myThid)  
       write(0,*) 'Read XC'  
       CALL READSYMTILE_RS(fName,2,YC,bi,bj,buf,myThid)  
       write(0,*) 'Read YC'  
       CALL READSYMTILE_RS(fName,3,DXF,bi,bj,buf,myThid)  
       write(0,*) 'Read DXF'  
       CALL READSYMTILE_RS(fName,4,DYF,bi,bj,buf,myThid)  
       write(0,*) 'Read DYF'  
       CALL READSYMTILE_RS(fName,5,RA,bi,bj,buf,myThid)  
       write(0,*) 'Read RA'  
       CALL READSYMTILE_RS(fName,6,XG,bi,bj,buf,myThid)  
       write(0,*) 'Read XG'  
       CALL READSYMTILE_RS(fName,7,YG,bi,bj,buf,myThid)  
       write(0,*) 'Read YG'  
       CALL READSYMTILE_RS(fName,8,DXV,bi,bj,buf,myThid)  
       write(0,*) 'Read DXV'  
       CALL READSYMTILE_RS(fName,9,DYU,bi,bj,buf,myThid)  
       write(0,*) 'Read DYU'  
       CALL READSYMTILE_RS(fName,10,RAZ,bi,bj,buf,myThid)  
       write(0,*) 'Read RAZ'  
       CALL READSYMTILE_RS(fName,11,DXC,bi,bj,buf,myThid)  
       write(0,*) 'Read DXC'  
       CALL READSYMTILE_RS(fName,12,DYC,bi,bj,buf,myThid)  
       write(0,*) 'Read DYC'  
       CALL READSYMTILE_RS(fName,13,RAW,bi,bj,buf,myThid)  
       write(0,*) 'Read RAW'  
       CALL READSYMTILE_RS(fName,14,RAS,bi,bj,buf,myThid)  
       write(0,*) 'Read RAS'  
       CALL READSYMTILE_RS(fName,15,DXG,bi,bj,buf,myThid)  
       write(0,*) 'Read DXG'  
       CALL READSYMTILE_RS(fName,16,DYG,bi,bj,buf,myThid)  
       write(0,*) 'Read DYG'  
       _END_MASTER(myThid)  
338         ENDDO         ENDDO
339        ENDDO        ENDDO
340          _END_MASTER(myThid)
341    
342        CALL EXCH_XY_RS(XC,myThid)        CALL EXCH_XY_RS(XC,myThid)
343        CALL EXCH_XY_RS(YC,myThid)        CALL EXCH_XY_RS(YC,myThid)
344  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned, myThid )  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned, myThid )
345  c     CALL EXCH_XY_RS(DXF,myThid)  #ifdef HRCUBE
346  c     CALL EXCH_XY_RS(DYF,myThid)        CALL EXCH_XY_RS(DXF,myThid)
347          CALL EXCH_XY_RS(DYF,myThid)
348    #endif
349        CALL EXCH_XY_RS(RA,myThid )        CALL EXCH_XY_RS(RA,myThid )
350    #ifndef ALLOW_EXCH2
351        CALL EXCH_Z_XY_RS(XG,myThid)        CALL EXCH_Z_XY_RS(XG,myThid)
352        CALL EXCH_Z_XY_RS(YG,myThid)        CALL EXCH_Z_XY_RS(YG,myThid)
353  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)
354  c     CALL EXCH_Z_XY_RS(DXV,myThid)  c     CALL EXCH_Z_XY_RS(DXV,myThid)
355  c     CALL EXCH_Z_XY_RS(DYU,myThid)  c     CALL EXCH_Z_XY_RS(DYU,myThid)
356        CALL EXCH_Z_XY_RS(RAZ,myThid)        CALL EXCH_Z_XY_RS(RAZ,myThid)
357    #endif /* ALLOW_EXCH2 */
358        CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)
359        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)
360        CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)
361    
362  #endif  #endif /* OLD_GRID_IO */
363    
364  c     CALL WRITE_FULLARRAY_RL('DXV',DXV,1,0,myThid)  c     CALL WRITE_FULLARRAY_RL('DXV',DXV,1,0,myThid)
365  c     CALL WRITE_FULLARRAY_RL('DYU',DYU,1,0,myThid)  c     CALL WRITE_FULLARRAY_RL('DYU',DYU,1,0,myThid)
# Line 319  c     CALL WRITE_FULLARRAY_RL('RAZ',RAZ, Line 367  c     CALL WRITE_FULLARRAY_RL('RAZ',RAZ,
367  c     CALL WRITE_FULLARRAY_RL('XG',XG,1,0,myThid)  c     CALL WRITE_FULLARRAY_RL('XG',XG,1,0,myThid)
368  c     CALL WRITE_FULLARRAY_RL('YG',YG,1,0,myThid)  c     CALL WRITE_FULLARRAY_RL('YG',YG,1,0,myThid)
369    
370    C--   Now let's look at all these beasts
371          IF ( debugLevel .GE. debLevB ) THEN
372             myiter = 1
373             CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,
374         &        myIter, myThid )
375             CALL PLOT_FIELD_XYRL( YC      , 'Current YC      ' ,
376         &        myIter, myThid )
377             CALL PLOT_FIELD_XYRL( DXF     , 'Current DXF     ' ,
378         &        myIter, myThid )
379             CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,
380         &        myIter, myThid )
381             CALL PLOT_FIELD_XYRL( DYF     , 'Current DYF     ' ,
382         &        myIter, myThid )
383             CALL PLOT_FIELD_XYRL( RA      , 'Current RA      ' ,
384         &        myIter, myThid )
385             CALL PLOT_FIELD_XYRL( XG      , 'Current XG      ' ,
386         &        myIter, myThid )
387             CALL PLOT_FIELD_XYRL( YG      , 'Current YG      ' ,
388         &        myIter, myThid )
389             CALL PLOT_FIELD_XYRL( DXV     , 'Current DXV     ' ,
390         &        myIter, myThid )
391             CALL PLOT_FIELD_XYRL( DYU     , 'Current DYU     ' ,
392         &        myIter, myThid )
393             CALL PLOT_FIELD_XYRL( RAZ     , 'Current RAZ     ' ,
394         &        myIter, myThid )
395             CALL PLOT_FIELD_XYRL( DXC     , 'Current DXC     ' ,
396         &        myIter, myThid )
397             CALL PLOT_FIELD_XYRL( DYC     , 'Current DYC     ' ,
398         &        myIter, myThid )
399             CALL PLOT_FIELD_XYRL( RAW     , 'Current RAW     ' ,
400         &        myIter, myThid )
401             CALL PLOT_FIELD_XYRL( RAS     , 'Current RAS     ' ,
402         &        myIter, myThid )
403             CALL PLOT_FIELD_XYRL( DXG     , 'Current DXG     ' ,
404         &        myIter, myThid )
405             CALL PLOT_FIELD_XYRL( DYG     , 'Current DYG     ' ,
406         &        myIter, myThid )
407          ENDIF
408    
409        RETURN        RETURN
410        END        END
# Line 335  C     \================================= Line 421  C     \=================================
421  C     === Global variables ===  C     === Global variables ===
422  #include "SIZE.h"  #include "SIZE.h"
423  #include "EEPARAMS.h"  #include "EEPARAMS.h"
424  #ifdef USE_W2  #ifdef ALLOW_EXCH2
425  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
426  #include "W2_EXCH2_PARAMS.h"  #include "W2_EXCH2_PARAMS.h"
427  #endif  #endif /* ALLOW_EXCH2 */
428    
429  C     == Routine arguments ==  C     == Routine arguments ==
430        CHARACTER*(*) fName        CHARACTER*(*) fName
431        INTEGER irec        INTEGER irec
432        _RS array(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy)        _RS array(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy)
433        INTEGER bi,bj,myThid        INTEGER bi,bj,myThid
434  #ifdef USE_W2  #ifdef ALLOW_EXCH2
435        _RL buf(1:sNx*nSx*nPx+1)        _RL buf(1:sNx*nSx*nPx+1)
436  #else  #else
437        _RL buf(1:sNx+1,1:sNy+1)        _RL buf(1:sNx+1,1:sNy+1)
438  #endif  #endif /* ALLOW_EXCH2 */
439    
440  C     == Local variables ==  C     == Local variables ==
441        INTEGER I,J,dUnit        INTEGER I,J,dUnit
# Line 357  C     == Local variables == Line 443  C     == Local variables ==
443        INTEGER MDS_RECLEN        INTEGER MDS_RECLEN
444        INTEGER TN, DNX, DNY, TBX, TBY, TNX, TNY, II, iBase        INTEGER TN, DNX, DNY, TBX, TBY, TNX, TNY, II, iBase
445    
446  #ifdef USE_W2  #ifdef ALLOW_EXCH2
447  C     Figure out offset of tile within face  C     Figure out offset of tile within face
448        TN  = W2_myTileList(bi)        TN  = W2_myTileList(bi)
449        DNX = exch2_mydnx(TN)        DNX = exch2_mydnx(TN)
# Line 389  C     Figure out offset of tile within f Line 475  C     Figure out offset of tile within f
475        ENDDO        ENDDO
476        CLOSE( dUnit )        CLOSE( dUnit )
477                
478  #else /* USE_W2 */  #else /* ALLOW_EXCH2 */
479    
480        CALL MDSFINDUNIT( dUnit, mythid )        CALL MDSFINDUNIT( dUnit, mythid )
481        length_of_rec=MDS_RECLEN( 64, (sNx+1)*(sNy+1), myThid )        length_of_rec=MDS_RECLEN( 64, (sNx+1)*(sNy+1), myThid )
# Line 413  C     Figure out offset of tile within f Line 499  C     Figure out offset of tile within f
499        ENDDO        ENDDO
500  c       write(0,*) irec,buf(1,1),array(1,1,1,1)  c       write(0,*) irec,buf(1,1),array(1,1,1,1)
501    
502  #endif /* USE_W2 */  #endif /* ALLOW_EXCH2 */
503    
504        RETURN        RETURN
505        END        END
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22