/[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.30 by jmc, Wed Jul 26 23:52:24 2006 UTC revision 1.36 by jmc, Wed May 28 03:02:43 2008 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "PACKAGES_CONFIG.h"  #include "PACKAGES_CONFIG.h"
5  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
 C- note: default is to use "new" grid files (OLD_GRID_IO undef)  
 C   but can still use (on 1 cpu, with MDSIO) OLD_GRID_IO and EXCH2 independently  
 #undef OLD_GRID_IO  
6    
7  CBOP  CBOP
8  C     !ROUTINE: INI_CURVILINEAR_GRID  C     !ROUTINE: INI_CURVILINEAR_GRID
# Line 45  C     myThid -  Number of this instance Line 42  C     myThid -  Number of this instance
42    
43  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
44  C     == Local variables ==  C     == Local variables ==
45        INTEGER bi,bj, myIter        INTEGER bi,bj
46        INTEGER I,J        INTEGER i,j
47        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
48        LOGICAL anglesAreSet        LOGICAL anglesAreSet
49  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
50        CHARACTER*(80) mncFn        CHARACTER*(80) mncFn
51  #endif  #endif
52  #ifndef OLD_GRID_IO  #ifndef OLD_GRID_IO
53  # ifdef ALLOW_EXCH2        INTEGER fp
       _RL buf(sNx*nSx*nPx+1)  
54        INTEGER myTile        INTEGER myTile
 # else  
       _RL buf(sNx+1,sNy+1)  
 # endif  
55        INTEGER iG, iL, iLen        INTEGER iG, iL, iLen
56        CHARACTER*(MAX_LEN_FNAM) fName        CHARACTER*(MAX_LEN_FNAM) fName
57        CHARACTER*(MAX_LEN_MBUF) tmpBuf        CHARACTER*(MAX_LEN_MBUF) tmpBuf
# Line 71  C--   Set everything to zero everywhere Line 64  C--   Set everything to zero everywhere
64        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
65         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
66    
67          DO J=1-Oly,sNy+Oly          DO j=1-Oly,sNy+Oly
68           DO I=1-Olx,sNx+Olx           DO i=1-Olx,sNx+Olx
69            xC(i,j,bi,bj)=0.            xC(i,j,bi,bj)=0.
70            yC(i,j,bi,bj)=0.            yC(i,j,bi,bj)=0.
71            xG(i,j,bi,bj)=0.            xG(i,j,bi,bj)=0.
# Line 93  C--   Set everything to zero everywhere Line 86  C--   Set everything to zero everywhere
86            tanPhiAtV(i,j,bi,bj)=0.            tanPhiAtV(i,j,bi,bj)=0.
87            angleCosC(i,j,bi,bj)=1.            angleCosC(i,j,bi,bj)=1.
88            angleSinC(i,j,bi,bj)=0.            angleSinC(i,j,bi,bj)=0.
89            cosFacU(J,bi,bj)=1.            cosFacU(j,bi,bj)=1.
90            cosFacV(J,bi,bj)=1.            cosFacV(j,bi,bj)=1.
91            sqCosFacU(J,bi,bj)=1.            sqCosFacU(j,bi,bj)=1.
92            sqCosFacV(J,bi,bj)=1.            sqCosFacV(j,bi,bj)=1.
93           ENDDO           ENDDO
94          ENDDO          ENDDO
95    
# Line 119  C-    Cell centered quantities Line 112  C-    Cell centered quantities
112    
113        CALL MDSREADFIELD('DXF.bin',readBinaryPrec,'RS',1,dxF,  1,myThid)        CALL MDSREADFIELD('DXF.bin',readBinaryPrec,'RS',1,dxF,  1,myThid)
114        CALL MDSREADFIELD('DYF.bin',readBinaryPrec,'RS',1,dyF,  1,myThid)        CALL MDSREADFIELD('DYF.bin',readBinaryPrec,'RS',1,dyF,  1,myThid)
115        CALL EXCH_UV_AGRID_XY_RS( dxF, dyF, .FALSE., myThid )        CALL EXCH_UV_AGRID_3D_RS( dxF, dyF, .FALSE., 1, myThid )
116    
117        CALL MDSREADFIELD('RA.bin',readBinaryPrec,'RS',1,rA,  1,myThid)        CALL MDSREADFIELD('RA.bin',readBinaryPrec,'RS',1,rA,  1,myThid)
118        _EXCH_XY_R4(rA,myThid )        _EXCH_XY_R4(rA,myThid )
# Line 145  cs-   this block needed by cubed sphere Line 138  cs-   this block needed by cubed sphere
138        yG(sNx+1,1,bj,1)=yG(1,1,bi,1)        yG(sNx+1,1,bj,1)=yG(1,1,bi,1)
139  cs-   end block  cs-   end block
140        ENDIF        ENDIF
141        CALL EXCH_Z_XY_RS(xG,myThid)        CALL EXCH_Z_3D_RS( xG, 1, myThid )
142        CALL EXCH_Z_XY_RS(yG,myThid)        CALL EXCH_Z_3D_RS( yG, 1, myThid )
143    
144        CALL MDSREADFIELD('DXV.bin',readBinaryPrec,'RS',1,dxV,  1,myThid)        CALL MDSREADFIELD('DXV.bin',readBinaryPrec,'RS',1,dxV,  1,myThid)
145        CALL MDSREADFIELD('DYU.bin',readBinaryPrec,'RS',1,dyU,  1,myThid)        CALL MDSREADFIELD('DYU.bin',readBinaryPrec,'RS',1,dyU,  1,myThid)
146    c     CALL EXCH_UV_BGRID_3D_RS( dxV, dyU, .FALSE., 1, myThid)
147  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
 C !!! _EXCH_ZUV_XY_R4(dxV, dyU, unSigned, myThid)  
 cs!   this is not correct <= need paired exchange for dxv,dyu  
148        IF (.NOT.useCubedSphereExchange) THEN        IF (.NOT.useCubedSphereExchange) THEN
149        CALL EXCH_Z_XY_RS(dxV,myThid)        CALL EXCH_Z_3D_RS( dxV, 1, myThid )
150        CALL EXCH_Z_XY_RS(dyU,myThid)        CALL EXCH_Z_3D_RS( dyU, 1, myThid )
151        ELSE        ELSE
152        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
153         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
# Line 184  cs-   end block Line 176  cs-   end block
176        CALL MDSREADFIELD('RAZ.bin',readBinaryPrec,'RS',1,rAz,  1,myThid)        CALL MDSREADFIELD('RAZ.bin',readBinaryPrec,'RS',1,rAz,  1,myThid)
177        IF (useCubedSphereExchange) THEN        IF (useCubedSphereExchange) THEN
178  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
179        CALL EXCH_Z_XY_RS(rAz , myThid )        CALL EXCH_Z_3D_RS( rAz, 1, myThid )
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)
182          rAz(sNx+1,1,bi,bj)=rAz(1,1,bi,bj)          rAz(sNx+1,1,bi,bj)=rAz(1,1,bi,bj)
# Line 193  cs-   this block needed by cubed sphere Line 185  cs-   this block needed by cubed sphere
185        ENDDO        ENDDO
186  cs-   end block  cs-   end block
187        ENDIF        ENDIF
188        CALL EXCH_Z_XY_RS(rAz,myThid)        CALL EXCH_Z_3D_RS( rAz, 1, myThid )
189    
190  C-    Staggered (u,v pairs) quantities  C-    Staggered (u,v pairs) quantities
191        CALL MDSREADFIELD('DXC.bin',readBinaryPrec,'RS',1,dxC,  1,myThid)        CALL MDSREADFIELD('DXC.bin',readBinaryPrec,'RS',1,dxC,  1,myThid)
# Line 207  C-    Staggered (u,v pairs) quantities Line 199  C-    Staggered (u,v pairs) quantities
199        CALL MDSREADFIELD('DXG.bin',readBinaryPrec,'RS',1,dxG,  1,myThid)        CALL MDSREADFIELD('DXG.bin',readBinaryPrec,'RS',1,dxG,  1,myThid)
200        CALL MDSREADFIELD('DYG.bin',readBinaryPrec,'RS',1,dyG,  1,myThid)        CALL MDSREADFIELD('DYG.bin',readBinaryPrec,'RS',1,dyG,  1,myThid)
201        CALL EXCH_UV_XY_RS(dyG,dxG,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(dyG,dxG,.FALSE.,myThid)
202        CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)        CALL EXCH_UV_AGRID_3D_RS(angleSinC,angleCosC,.TRUE., 1, myThid)
203        anglesAreSet = .FALSE.        anglesAreSet = .FALSE.
204    
205  c     write(10) xC  c     write(10) xC
# Line 274  C--   read NetCDF files: Line 266  C--   read NetCDF files:
266  C--   read Binary files:  C--   read Binary files:
267  #endif /* ALLOW_MNC */  #endif /* ALLOW_MNC */
268    
269    C--   File Precision: keep 64-bits precision (as it used to be)
270    C     but should probably change it to the standard file-prec (= readBinaryPrec)
271          fp = precFloat64
272    c     fp = readBinaryPrec
273    
274        DO bj = 1,nSy        DO bj = 1,nSy
275         DO bi = 1,nSx         DO bi = 1,nSx
276          iG=bi+(myXGlobalLo-1)/sNx          iG = bi+(myXGlobalLo-1)/sNx
277          WRITE(tmpBuf,'(A,I4)') 'tile:',iG          myTile = iG
278  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
279          myTile = W2_myTileList(bi)          myTile = W2_myTileList(bi)
         WRITE(tmpBuf,'(A,I4)') 'tile:',myTile  
280          iG = exch2_myface(myTile)          iG = exch2_myface(myTile)
281  #endif  #endif
282            WRITE(tmpBuf,'(A,I4)') 'tile:',myTile
283    
284          iLen = ILNBLNK(horizGridFile)          iLen = ILNBLNK(horizGridFile)
285          IF ( iLen .EQ. 0 ) THEN          IF ( iLen .EQ. 0 ) THEN
286            WRITE(fName,'("tile",I3.3,".mitgrid")') iG            WRITE(fName,'("tile",I3.3,".mitgrid")') iG
# Line 298  C--   read Binary files: Line 296  C--   read Binary files:
296       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
297          WRITE(msgBuf,'(A)') '  =>'          WRITE(msgBuf,'(A)') '  =>'
298    
299          CALL READSYMTILE_RS(fName,1,xC,buf,bi,bj,myThid)  #ifdef ALLOW_MDSIO
300            CALL MDS_FACEF_READ_RS( fName, fp, 1,  xC, bi, bj, myThid )
301          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
302          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'xC'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'xC'
303          CALL READSYMTILE_RS(fName,2,yC,buf,bi,bj,myThid)          CALL MDS_FACEF_READ_RS( fName, fp, 2,  yC, bi, bj, myThid )
304          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
305          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'yC'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'yC'
306          CALL READSYMTILE_RS(fName,3,dxF,buf,bi,bj,myThid)          CALL MDS_FACEF_READ_RS( fName, fp, 3, dxF, bi, bj, myThid )
307          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
308          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dxF'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dxF'
309          CALL READSYMTILE_RS(fName,4,dyF,buf,bi,bj,myThid)          CALL MDS_FACEF_READ_RS( fName, fp, 4, dyF, bi, bj, myThid )
310          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
311          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dyF'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dyF'
312          CALL READSYMTILE_RS(fName,5,rA,buf,bi,bj,myThid)          CALL MDS_FACEF_READ_RS( fName, fp, 5,  rA, bi, bj, myThid )
313          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
314          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'rA'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'rA'
315          CALL READSYMTILE_RS(fName,6,xG,buf,bi,bj,myThid)          CALL MDS_FACEF_READ_RS( fName, fp, 6,  xG, bi, bj, myThid )
316          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
317          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'xG'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'xG'
318          CALL READSYMTILE_RS(fName,7,yG,buf,bi,bj,myThid)          CALL MDS_FACEF_READ_RS( fName, fp, 7,  yG, bi, bj, myThid )
319          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
320          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'yG'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'yG'
321          CALL READSYMTILE_RS(fName,8,dxV,buf,bi,bj,myThid)          CALL MDS_FACEF_READ_RS( fName, fp, 8, dxV, bi, bj, myThid )
322          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
323          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dxV'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dxV'
324          CALL READSYMTILE_RS(fName,9,dyU,buf,bi,bj,myThid)          CALL MDS_FACEF_READ_RS( fName, fp, 9, dyU, bi, bj, myThid )
325          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
326          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dyU'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dyU'
327          CALL READSYMTILE_RS(fName,10,rAz,buf,bi,bj,myThid)          CALL MDS_FACEF_READ_RS( fName, fp,10, rAz, bi, bj, myThid )
328          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
329          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'rAz'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'rAz'
330          CALL READSYMTILE_RS(fName,11,dxC,buf,bi,bj,myThid)          CALL MDS_FACEF_READ_RS( fName, fp,11, dxC, bi, bj, myThid )
331          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
332          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dxC'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dxC'
333          CALL READSYMTILE_RS(fName,12,dyC,buf,bi,bj,myThid)          CALL MDS_FACEF_READ_RS( fName, fp,12, dyC, bi, bj, myThid )
334          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
335          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dyC'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dyC'
336          CALL READSYMTILE_RS(fName,13,rAw,buf,bi,bj,myThid)          CALL MDS_FACEF_READ_RS( fName, fp,13, rAw, bi, bj, myThid )
337          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
338          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'rAw'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'rAw'
339          CALL READSYMTILE_RS(fName,14,rAs,buf,bi,bj,myThid)          CALL MDS_FACEF_READ_RS( fName, fp,14, rAs, bi, bj, myThid )
340          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
341          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'rAs'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'rAs'
342          CALL READSYMTILE_RS(fName,15,dxG,buf,bi,bj,myThid)          CALL MDS_FACEF_READ_RS( fName, fp,15, dxG, bi, bj, myThid )
343          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
344          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dxG'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dxG'
345          CALL READSYMTILE_RS(fName,16,dyG,buf,bi,bj,myThid)          CALL MDS_FACEF_READ_RS( fName, fp,16, dyG, bi, bj, myThid )
346          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
347          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dyG'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dyG'
348    
349          iLen = ILNBLNK(horizGridFile)          iLen = ILNBLNK(horizGridFile)
350          IF ( iLen.GT.0 ) THEN          IF ( iLen.GT.0 ) THEN
351           CALL READSYMTILE_RS(fName,17,angleCosC,buf,bi,bj,myThid)           CALL MDS_FACEF_READ_RS(fName,fp,17,angleCosC,bi,bj,myThid)
352           iL = ILNBLNK(msgBuf)           iL = ILNBLNK(msgBuf)
353           WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'AngleCS'           WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'AngleCS'
354           CALL READSYMTILE_RS(fName,18,angleSinC,buf,bi,bj,myThid)           CALL MDS_FACEF_READ_RS(fName,fp,18,angleSinC,bi,bj,myThid)
355           iL = ILNBLNK(tmpBuf)           iL = ILNBLNK(tmpBuf)
356           WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'AngleSN'           WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'AngleSN'
357           anglesAreSet = .TRUE.           anglesAreSet = .TRUE.
358          ELSE          ELSE
359           anglesAreSet = .FALSE.           anglesAreSet = .FALSE.
360          ENDIF          ENDIF
361    #else /* ALLOW_MDSIO */
362            WRITE(msgBuf,'(2A)')
363         &   'INI_CURVILINEAR_GRID: Needs to compile MDSIO pkg'
364            CALL PRINT_ERROR( msgBuf, myThid )
365            STOP 'ABNORMAL END: S/R INI_CURVILINEAR_GRID'
366    #endif /* ALLOW_MDSIO */
367    
368          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
369       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
# Line 374  C--   read Binary files: Line 379  C--   read Binary files:
379    
380        CALL EXCH_XY_RS(xC,myThid)        CALL EXCH_XY_RS(xC,myThid)
381        CALL EXCH_XY_RS(yC,myThid)        CALL EXCH_XY_RS(yC,myThid)
382        CALL EXCH_UV_AGRID_XY_RS( dxF, dyF, .FALSE., myThid )        CALL EXCH_UV_AGRID_3D_RS( dxF, dyF, .FALSE., 1, myThid )
383        CALL EXCH_XY_RS(rA,myThid )        CALL EXCH_XY_RS(rA,myThid )
384        CALL EXCH_Z_XY_RS(xG,myThid)        CALL EXCH_Z_3D_RS( xG, 1, myThid )
385        CALL EXCH_Z_XY_RS(yG,myThid)        CALL EXCH_Z_3D_RS( yG, 1, myThid )
386  C !!! _EXCH_ZUV_XY_R4(dxV, dyU, unSigned, myThid)  #ifdef ALLOW_EXCH2
387  c     CALL EXCH_Z_XY_RS(dxV,myThid)  # ifndef ALLOW_AUTODIFF_TAMC
388  c     CALL EXCH_Z_XY_RS(dyU,myThid)        CALL EXCH2_UV_BGRID_3D_RS( dxV, dyU, .FALSE., 1, myThid)
389        CALL EXCH_Z_XY_RS(rAz,myThid)  # endif
390    #endif
391          CALL EXCH_Z_3D_RS( rAz, 1, myThid )
392        CALL EXCH_UV_XY_RS(dxC,dyC,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(dxC,dyC,.FALSE.,myThid)
393        CALL EXCH_UV_XY_RS(rAw,rAs,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(rAw,rAs,.FALSE.,myThid)
394        CALL EXCH_UV_XY_RS(dyG,dxG,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(dyG,dxG,.FALSE.,myThid)
395        CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)        CALL EXCH_UV_AGRID_3D_RS(angleSinC,angleCosC,.TRUE., 1, myThid)
396    
397  #endif /* OLD_GRID_IO */  #endif /* OLD_GRID_IO */
398    
# Line 395  C--   Stop if Angle have not been loaded Line 402  C--   Stop if Angle have not been loaded
402          WRITE(msgBuf,'(2A)')          WRITE(msgBuf,'(2A)')
403       &   'INI_CURVILINEAR_GRID: Angle of CurvilinearGrid not set',       &   'INI_CURVILINEAR_GRID: Angle of CurvilinearGrid not set',
404       &   ' but needed for 3-D Coriolis'       &   ' but needed for 3-D Coriolis'
405          CALL PRINT_ERROR( msgBuf , myThid)          CALL PRINT_ERROR( msgBuf, myThid )
406          STOP 'ABNORMAL END: S/R INI_CURVILINEAR_GRID'          STOP 'ABNORMAL END: S/R INI_CURVILINEAR_GRID'
407        ENDIF        ENDIF
408        _END_MASTER(myThid)        _END_MASTER(myThid)
# Line 408  c     CALL WRITE_FULLARRAY_RL('yG',yG,1, Line 415  c     CALL WRITE_FULLARRAY_RL('yG',yG,1,
415    
416  C--   Now let's look at all these beasts  C--   Now let's look at all these beasts
417        IF ( debugLevel .GE. debLevB ) THEN        IF ( debugLevel .GE. debLevB ) THEN
418           myIter = 1          CALL PLOT_FIELD_XYRS( xC      , 'Current xC      ', 0, myThid )
419           CALL PLOT_FIELD_XYRL( xC      , 'Current xC      ' ,          CALL PLOT_FIELD_XYRS( yC      , 'Current yC      ', 0, myThid )
420       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( dxF     , 'Current dxF     ', 0, myThid )
421           CALL PLOT_FIELD_XYRL( yC      , 'Current yC      ' ,          CALL PLOT_FIELD_XYRS( dyF     , 'Current dyF     ', 0, myThid )
422       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( rA      , 'Current rA      ', 0, myThid )
423           CALL PLOT_FIELD_XYRL( dxF     , 'Current dxF     ' ,          CALL PLOT_FIELD_XYRS( xG      , 'Current xG      ', 0, myThid )
424       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( yG      , 'Current yG      ', 0, myThid )
425           CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,          CALL PLOT_FIELD_XYRS( dxV     , 'Current dxV     ', 0, myThid )
426       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( dyU     , 'Current dyU     ', 0, myThid )
427           CALL PLOT_FIELD_XYRL( dyF     , 'Current dyF     ' ,          CALL PLOT_FIELD_XYRS( rAz     , 'Current rAz     ', 0, myThid )
428       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( dxC     , 'Current dxC     ', 0, myThid )
429           CALL PLOT_FIELD_XYRL( rA      , 'Current rA      ' ,          CALL PLOT_FIELD_XYRS( dyC     , 'Current dyC     ', 0, myThid )
430       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( rAw     , 'Current rAw     ', 0, myThid )
431           CALL PLOT_FIELD_XYRL( xG      , 'Current xG      ' ,          CALL PLOT_FIELD_XYRS( rAs     , 'Current rAs     ', 0, myThid )
432       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( dxG     , 'Current dxG     ', 0, myThid )
433           CALL PLOT_FIELD_XYRL( yG      , 'Current yG      ' ,          CALL PLOT_FIELD_XYRS( dyG     , 'Current dyG     ', 0, myThid )
434       &        myIter, myThid )          CALL PLOT_FIELD_XYRS(angleCosC, 'Current AngleCS ', 0, myThid )
435           CALL PLOT_FIELD_XYRL( dxV     , 'Current dxV     ' ,          CALL PLOT_FIELD_XYRS(angleSinC, 'Current AngleSN ', 0, myThid )
      &        myIter, myThid )  
          CALL PLOT_FIELD_XYRL( dyU     , 'Current dyU     ' ,  
      &        myIter, myThid )  
          CALL PLOT_FIELD_XYRL( rAz     , 'Current rAz     ' ,  
      &        myIter, myThid )  
          CALL PLOT_FIELD_XYRL( dxC     , 'Current dxC     ' ,  
      &        myIter, myThid )  
          CALL PLOT_FIELD_XYRL( dyC     , 'Current dyC     ' ,  
      &        myIter, myThid )  
          CALL PLOT_FIELD_XYRL( rAw     , 'Current rAw     ' ,  
      &        myIter, myThid )  
          CALL PLOT_FIELD_XYRL( rAs     , 'Current rAs     ' ,  
      &        myIter, myThid )  
          CALL PLOT_FIELD_XYRL( dxG     , 'Current dxG     ' ,  
      &        myIter, myThid )  
          CALL PLOT_FIELD_XYRL( dyG     , 'Current dyG     ' ,  
      &        myIter, myThid )  
          CALL PLOT_FIELD_XYRL(angleCosC, 'Current AngleCS ' ,  
      &        myIter, myThid )  
          CALL PLOT_FIELD_XYRL(angleSinC, 'Current AngleSN ' ,  
      &        myIter, myThid )  
436        ENDIF        ENDIF
437    
438        RETURN        RETURN
439        END        END
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
   
 CBOP  
 C     !ROUTINE: READSYMTILE_RS  
 C     !INTERFACE:  
       SUBROUTINE READSYMTILE_RS(  
      I                           fName, irec,  
      U                           array, buf,  
      I                           bi,bj, myThid )  
 C     !DESCRIPTION: \bv  
 C     *==========================================================*  
 C     | SUBROUTINE READSYMTILE_RS  
 C     *==========================================================*  
 C     *==========================================================*  
 C     \ev  
   
 C     !USES:  
       IMPLICIT NONE  
 C     === Global variables ===  
 #include "SIZE.h"  
 #include "EEPARAMS.h"  
 #ifdef ALLOW_EXCH2  
 #include "W2_EXCH2_TOPOLOGY.h"  
 #include "W2_EXCH2_PARAMS.h"  
 #endif /* ALLOW_EXCH2 */  
   
 C     !INPUT/OUTPUT PARAMETERS:  
 C     == Routine arguments ==  
       CHARACTER*(*) fName  
       INTEGER irec  
       _RS array(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy)  
 #ifdef ALLOW_EXCH2  
       _RL buf(1:sNx*nSx*nPx+1)  
 #else  
       _RL buf(1:sNx+1,1:sNy+1)  
 #endif /* ALLOW_EXCH2 */  
       INTEGER bi,bj, myThid  
 CEOP  
   
 C     !LOCAL VARIABLES:  
 C     == Local variables ==  
       INTEGER I,J,dUnit, iLen  
       INTEGER length_of_rec  
       INTEGER MDS_RECLEN  
 #ifdef ALLOW_EXCH2  
       INTEGER TN, dNx, dNy, TBX, TBY, TNX, TNY, II, iBase  
 #endif  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
   
       iLen = ILNBLNK(fName)  
 #ifdef ALLOW_EXCH2  
 C     Figure out offset of tile within face  
       TN  = W2_myTileList(bi)  
       dNx = exch2_mydnx(TN)  
       dNy = exch2_mydny(TN)  
       TBX = exch2_tbasex(TN)  
       TBY = exch2_tbasey(TN)  
       TNX = exch2_tnx(TN)  
       TNY = exch2_tny(TN)  
   
       CALL MDSFINDUNIT( dUnit, myThid )  
       length_of_rec=MDS_RECLEN( 64, (dNx+1), myThid )  
       OPEN( dUnit, file=fName(1:iLen), status='old',  
      &             access='direct', recl=length_of_rec )  
       J=0  
       iBase=(irec-1)*(dny+1)  
       DO I=1+TBY,sNy+1+TBY  
        READ(dUnit,rec=I+iBase)(buf(ii),ii=1,dNx+1)  
 #ifdef _BYTESWAPIO  
 #ifdef REAL4_IS_SLOW  
        CALL MDS_BYTESWAPR8((dNx+1), buf)  
 #else  
        CALL MDS_BYTESWAPR4((dNx+1), buf)  
 #endif  
 #endif  
        J=J+1  
        DO II=1,sNx+1  
         array(II,J,bi,bj)=buf(II+TBX)  
        ENDDO  
       ENDDO  
       CLOSE( dUnit )  
   
 #else /* ALLOW_EXCH2 */  
   
       CALL MDSFINDUNIT( dUnit, myThid )  
       length_of_rec=MDS_RECLEN( 64, (sNx+1)*(sNy+1), myThid )  
       OPEN( dUnit, file=fName(1:iLen), status='old',  
      &             access='direct', recl=length_of_rec )  
       READ(dUnit,rec=irec) buf  
       CLOSE( dUnit )  
   
 #ifdef _BYTESWAPIO  
 #ifdef REAL4_IS_SLOW  
       CALL MDS_BYTESWAPR8((sNx+1)*(sNy+1), buf)  
 #else  
       CALL MDS_BYTESWAPR4((sNx+1)*(sNy+1), buf)  
 #endif  
 #endif  
   
       DO J=1,sNy+1  
        DO I=1,sNx+1  
         array(I,J,bi,bj)=buf(I,J)  
        ENDDO  
       ENDDO  
 c       write(0,*) irec,buf(1,1),array(1,1,1,1)  
   
 #endif /* ALLOW_EXCH2 */  
   
       RETURN  
       END  
Legend:
Removed from v.1.30  
changed lines
  Added in v.1.36
  ViewVC Help
Powered by ViewVC 1.1.22