/[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.11 by edhill, Tue Mar 9 03:45:28 2004 UTC revision 1.16 by jmc, Wed Sep 22 15:29:49 2004 UTC
# 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)
# Line 106  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 127  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 136  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 152  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 160  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 184  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 195  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 204  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 214  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 228  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 247  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  C--   Only do I/O if I am the master thread  C--   Only do I/O if I am the master thread
266        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
# Line 329  C--   Only do I/O if I am the master thr Line 342  C--   Only do I/O if I am the master thr
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 )
 #ifndef ALLOW_EXCH2  
350        CALL EXCH_Z_XY_RS(XG,myThid)        CALL EXCH_Z_XY_RS(XG,myThid)
351        CALL EXCH_Z_XY_RS(YG,myThid)        CALL EXCH_Z_XY_RS(YG,myThid)
352  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)
353  c     CALL EXCH_Z_XY_RS(DXV,myThid)  c     CALL EXCH_Z_XY_RS(DXV,myThid)
354  c     CALL EXCH_Z_XY_RS(DYU,myThid)  c     CALL EXCH_Z_XY_RS(DYU,myThid)
355        CALL EXCH_Z_XY_RS(RAZ,myThid)        CALL EXCH_Z_XY_RS(RAZ,myThid)
 #endif /* ALLOW_EXCH2 */  
356        CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)
357        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)
358        CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)
359    
360  #endif  #endif /* OLD_GRID_IO */
361    
362  c     CALL WRITE_FULLARRAY_RL('DXV',DXV,1,0,myThid)  c     CALL WRITE_FULLARRAY_RL('DXV',DXV,1,0,myThid)
363  c     CALL WRITE_FULLARRAY_RL('DYU',DYU,1,0,myThid)  c     CALL WRITE_FULLARRAY_RL('DYU',DYU,1,0,myThid)
# Line 352  c     CALL WRITE_FULLARRAY_RL('RAZ',RAZ, Line 365  c     CALL WRITE_FULLARRAY_RL('RAZ',RAZ,
365  c     CALL WRITE_FULLARRAY_RL('XG',XG,1,0,myThid)  c     CALL WRITE_FULLARRAY_RL('XG',XG,1,0,myThid)
366  c     CALL WRITE_FULLARRAY_RL('YG',YG,1,0,myThid)  c     CALL WRITE_FULLARRAY_RL('YG',YG,1,0,myThid)
367    
368    C--   Require that 0 <= longitude < 360 if using exf package
369    #ifdef ALLOW_EXF
370          DO bj = 1,nSy
371           DO bi = 1,nSx
372            DO J=1-Oly,sNy+Oly
373             DO I=1-Olx,sNx+Olx
374              IF (XC(i,j,bi,bj).lt.0.) XC(i,j,bi,bj)=XC(i,j,bi,bj)+360.
375              IF (XG(i,j,bi,bj).lt.0.) XG(i,j,bi,bj)=XG(i,j,bi,bj)+360.
376             ENDDO
377            ENDDO
378           ENDDO
379          ENDDO
380    #endif /* ALLOW_EXF */
381    
382    C--   Now let's look at all these beasts
383          IF ( debugLevel .GE. debLevB ) THEN
384             myiter = 1
385             CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,
386         &        myIter, myThid )
387             CALL PLOT_FIELD_XYRL( YC      , 'Current YC      ' ,
388         &        myIter, myThid )
389             CALL PLOT_FIELD_XYRL( DXF     , 'Current DXF     ' ,
390         &        myIter, myThid )
391             CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,
392         &        myIter, myThid )
393             CALL PLOT_FIELD_XYRL( DYF     , 'Current DYF     ' ,
394         &        myIter, myThid )
395             CALL PLOT_FIELD_XYRL( RA      , 'Current RA      ' ,
396         &        myIter, myThid )
397             CALL PLOT_FIELD_XYRL( XG      , 'Current XG      ' ,
398         &        myIter, myThid )
399             CALL PLOT_FIELD_XYRL( YG      , 'Current YG      ' ,
400         &        myIter, myThid )
401             CALL PLOT_FIELD_XYRL( DXV     , 'Current DXV     ' ,
402         &        myIter, myThid )
403             CALL PLOT_FIELD_XYRL( DYU     , 'Current DYU     ' ,
404         &        myIter, myThid )
405             CALL PLOT_FIELD_XYRL( RAZ     , 'Current RAZ     ' ,
406         &        myIter, myThid )
407             CALL PLOT_FIELD_XYRL( DXC     , 'Current DXC     ' ,
408         &        myIter, myThid )
409             CALL PLOT_FIELD_XYRL( DYC     , 'Current DYC     ' ,
410         &        myIter, myThid )
411             CALL PLOT_FIELD_XYRL( RAW     , 'Current RAW     ' ,
412         &        myIter, myThid )
413             CALL PLOT_FIELD_XYRL( RAS     , 'Current RAS     ' ,
414         &        myIter, myThid )
415             CALL PLOT_FIELD_XYRL( DXG     , 'Current DXG     ' ,
416         &        myIter, myThid )
417             CALL PLOT_FIELD_XYRL( DYG     , 'Current DYG     ' ,
418         &        myIter, myThid )
419          ENDIF
420    
421        RETURN        RETURN
422        END        END
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.16
  ViewVC Help
Powered by ViewVC 1.1.22