/[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.21 by jmc, Mon Aug 22 23:07:14 2005 UTC revision 1.45 by jmc, Tue May 26 16:47:16 2009 UTC
# Line 10  C     !INTERFACE: Line 10  C     !INTERFACE:
10        SUBROUTINE INI_CURVILINEAR_GRID( myThid )        SUBROUTINE INI_CURVILINEAR_GRID( myThid )
11  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
12  C     *==========================================================*  C     *==========================================================*
13  C     | SUBROUTINE INI_CURVILINEAR_GRID                            C     | SUBROUTINE INI_CURVILINEAR_GRID
14  C     | o Initialise curvilinear coordinate system                  C     | o Initialise curvilinear coordinate system
15  C     *==========================================================*  C     *==========================================================*
16  C     | Curvilinear grid settings are read from a file rather  C     | Curvilinear grid settings are read from a file rather
17  C     | than coded in-line as for cartesian and spherical polar.  C     | than coded in-line as for cartesian and spherical polar.
# Line 28  C     === Global variables === Line 28  C     === Global variables ===
28  #include "PARAMS.h"  #include "PARAMS.h"
29  #include "GRID.h"  #include "GRID.h"
30  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
31    #include "W2_EXCH2_SIZE.h"
32  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
 #include "W2_EXCH2_PARAMS.h"  
33  #endif  #endif
34  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
35  #include "MNC_PARAMS.h"  #include "MNC_PARAMS.h"
36  #endif  #endif
37    
 #ifndef ALLOW_EXCH2  
 C- note: default is to use "new" grid files (OLD_GRID_IO undef) with EXCH2  
 C    but can still use (on 1 cpu) OLD_GRID_IO and EXCH2 independently  
 #ifdef ALLOW_MDSIO  
 #define OLD_GRID_IO  
 #endif  
 #endif /* ALLOW_EXCH2 */  
   
38  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
39  C     == Routine arguments ==  C     == Routine arguments ==
40  C     myThid -  Number of this instance of INI_CURVILINEAR_GRID  C     myThid -  Number of this instance of INI_CURVILINEAR_GRID
41        INTEGER myThid        INTEGER myThid
42    
43  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
44    C     == Shared Local variables ==
45          LOGICAL anglesAreSet
46          COMMON /LOCAL_INI_CURVILINEAR_GRID/ anglesAreSet
47  C     == Local variables ==  C     == Local variables ==
48        INTEGER bi,bj, myIter        INTEGER bi,bj
49        INTEGER I,J        INTEGER i,j
50        CHARACTER*(MAX_LEN_FNAM) fName        CHARACTER*(MAX_LEN_MBUF) msgBuf
51  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
52        CHARACTER*(80) mncFn        CHARACTER*(80) mncFn
53  #endif  #endif
54  #ifdef ALLOW_EXCH2  #ifndef OLD_GRID_IO
55        _RL buf(sNx*nSx*nPx+1)        INTEGER fp
56        INTEGER myTile        INTEGER iG, jG, iL, iLen
57  #else        CHARACTER*(MAX_LEN_FNAM) fName
58        _RL buf(sNx+1,sNy+1)        CHARACTER*(MAX_LEN_MBUF) tmpBuf
 #endif  
       INTEGER iG, iL, iLen  
       CHARACTER*(MAX_LEN_MBUF) msgBuf, tmpBuf  
59        INTEGER  ILNBLNK        INTEGER  ILNBLNK
60        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
61    #endif
62  CEOP  CEOP
63    
64  C--   Set everything to zero everywhere  C--   Set everything to zero everywhere
65        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
66         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
67    
68          DO J=1-Oly,sNy+Oly          DO j=1-Oly,sNy+Oly
69           DO I=1-Olx,sNx+Olx           DO i=1-Olx,sNx+Olx
70            XC(i,j,bi,bj)=0.            xC(i,j,bi,bj)=0.
71            YC(i,j,bi,bj)=0.            yC(i,j,bi,bj)=0.
72            XG(i,j,bi,bj)=0.            xG(i,j,bi,bj)=0.
73            YG(i,j,bi,bj)=0.            yG(i,j,bi,bj)=0.
74            DXC(i,j,bi,bj)=0.            dxC(i,j,bi,bj)=0.
75            DYC(i,j,bi,bj)=0.            dyC(i,j,bi,bj)=0.
76            DXG(i,j,bi,bj)=0.            dxG(i,j,bi,bj)=0.
77            DYG(i,j,bi,bj)=0.            dyG(i,j,bi,bj)=0.
78            DXF(i,j,bi,bj)=0.            dxF(i,j,bi,bj)=0.
79            DYF(i,j,bi,bj)=0.            dyF(i,j,bi,bj)=0.
80            DXV(i,j,bi,bj)=0.            dxV(i,j,bi,bj)=0.
81            DYU(i,j,bi,bj)=0.            dyU(i,j,bi,bj)=0.
82            RA(i,j,bi,bj)=0.            rA(i,j,bi,bj)=0.
83            RAZ(i,j,bi,bj)=0.            rAz(i,j,bi,bj)=0.
84            RAW(i,j,bi,bj)=0.            rAw(i,j,bi,bj)=0.
85            RAS(i,j,bi,bj)=0.            rAs(i,j,bi,bj)=0.
86            tanPhiAtU(i,j,bi,bj)=0.            tanPhiAtU(i,j,bi,bj)=0.
87            tanPhiAtV(i,j,bi,bj)=0.            tanPhiAtV(i,j,bi,bj)=0.
88            angleCosC(i,j,bi,bj)=1.            angleCosC(i,j,bi,bj)=1.
89            angleSinC(i,j,bi,bj)=0.            angleSinC(i,j,bi,bj)=0.
90            cosFacU(J,bi,bj)=1.            cosFacU(j,bi,bj)=1.
91            cosFacV(J,bi,bj)=1.            cosFacV(j,bi,bj)=1.
92            sqcosFacU(J,bi,bj)=1.            sqCosFacU(j,bi,bj)=1.
93            sqcosFacV(J,bi,bj)=1.            sqCosFacV(j,bi,bj)=1.
94           ENDDO           ENDDO
95          ENDDO          ENDDO
96    
97         ENDDO         ENDDO
98        ENDDO        ENDDO
99    
100    C--   Everyone must wait for the initialisation to be done
101  #ifdef ALLOW_MNC        _BARRIER
       IF (useMNC .AND. readgrid_mnc) THEN  
   
         _BEGIN_MASTER(myThid)  
         DO i = 1,80  
           mncFn(i:i) = ' '  
         ENDDO  
         write(mncFn,'(a)') 'mitgrid'  
         DO i = 1,MAX_LEN_MBUF  
           msgBuf(i:i) = ' '  
         ENDDO  
         WRITE(msgBuf,'(2A)') msgBuf,' ; Reading grid info using MNC'  
         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &       SQUEEZE_RIGHT , myThid)  
         CALL MNC_FILE_CLOSE_ALL_MATCHING(mncFn, myThid)  
         CALL MNC_CW_SET_UDIM(mncFn, 1, myThid)  
         CALL MNC_CW_RS_R('R',mncFn,0,0,'XC', XC,  myThid)  
         CALL MNC_CW_RS_R('R',mncFn,0,0,'XG', XG,  myThid)  
         CALL MNC_CW_RS_R('R',mncFn,0,0,'YC', YC,  myThid)  
         CALL MNC_CW_RS_R('R',mncFn,0,0,'YG', YG,  myThid)  
         CALL MNC_CW_RS_R('R',mncFn,0,0,'dxC',DXC, myThid)  
         CALL MNC_CW_RS_R('R',mncFn,0,0,'dyC',DYC, myThid)  
         CALL MNC_CW_RS_R('R',mncFn,0,0,'dxF',DXF, myThid)  
         CALL MNC_CW_RS_R('R',mncFn,0,0,'dyF',DYF, myThid)  
         CALL MNC_CW_RS_R('R',mncFn,0,0,'dxG',DXG, myThid)  
         CALL MNC_CW_RS_R('R',mncFn,0,0,'dyG',DYG, myThid)  
         CALL MNC_CW_RS_R('R',mncFn,0,0,'dxV',DXV, myThid)  
         CALL MNC_CW_RS_R('R',mncFn,0,0,'dyU',DYU, myThid)  
         CALL MNC_CW_RS_R('R',mncFn,0,0,'rA', RA,  myThid)  
         CALL MNC_CW_RS_R('R',mncFn,0,0,'rAz',RAZ, myThid)  
         CALL MNC_CW_RS_R('R',mncFn,0,0,'rAw',RAW, myThid)  
         CALL MNC_CW_RS_R('R',mncFn,0,0,'rAs',RAS, myThid)  
   
         _END_MASTER(myThid)  
   
         CALL EXCH_XY_RS(XC,myThid)  
         CALL EXCH_XY_RS(YC,myThid)  
 #ifdef HRCUBE  
         CALL EXCH_XY_RS(DXF,myThid)  
         CALL EXCH_XY_RS(DYF,myThid)  
 #endif  
         CALL EXCH_XY_RS(RA,myThid )  
         CALL EXCH_Z_XY_RS(XG,myThid)  
         CALL EXCH_Z_XY_RS(YG,myThid)  
         CALL EXCH_Z_XY_RS(RAZ,myThid)  
         CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)  
         CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)  
         CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)  
         CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)  
   
       ELSE  
 #endif  
102    
103  C     Here we make no assumptions about grid symmetry and simply  C     Here we make no assumptions about grid symmetry and simply
104  C     read the raw grid data from files  C     read the raw grid data from files
# Line 164  C     read the raw grid data from files Line 106  C     read the raw grid data from files
106  #ifdef OLD_GRID_IO  #ifdef OLD_GRID_IO
107    
108  C-    Cell centered quantities  C-    Cell centered quantities
109        CALL MDSREADFIELD('LONC.bin',readBinaryPrec,'RS',1,XC,  1,myThid)        CALL MDSREADFIELD('LONC.bin',readBinaryPrec,'RS',1,xC,  1,myThid)
110        CALL MDSREADFIELD('LATC.bin',readBinaryPrec,'RS',1,YC,  1,myThid)        CALL MDSREADFIELD('LATC.bin',readBinaryPrec,'RS',1,yC,  1,myThid)
111        _EXCH_XY_R4(XC,myThid)        _EXCH_XY_RS(xC,myThid)
112        _EXCH_XY_R4(YC,myThid)        _EXCH_XY_RS(yC,myThid)
113    
114        CALL MDSREADFIELD('DXF.bin',readBinaryPrec,'RS',1,DXF,  1,myThid)        CALL MDSREADFIELD('DXF.bin',readBinaryPrec,'RS',1,dxF,  1,myThid)
115        CALL MDSREADFIELD('DYF.bin',readBinaryPrec,'RS',1,DYF,  1,myThid)        CALL MDSREADFIELD('DYF.bin',readBinaryPrec,'RS',1,dyF,  1,myThid)
116  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned, myThid )        CALL EXCH_UV_AGRID_3D_RS( dxF, dyF, .FALSE., 1, myThid )
 cs!   this is not correct! <= need paired exchange for DXF,DYF  
       _EXCH_XY_R4(DXF,myThid)  
       _EXCH_XY_R4(DYF,myThid)  
       IF (useCubedSphereExchange) THEN  
 cs! fix overlaps:  
       DO bj = myByLo(myThid), myByHi(myThid)  
        DO bi = myBxLo(myThid), myBxHi(myThid)  
         DO j=1,sNy  
          DO i=1,Olx  
           DXF(1-i,j,bi,bj)=DXF(i,j,bi,bj)  
           DXF(sNx+i,j,bi,bj)=DXF(sNx+1-i,j,bi,bj)  
           DYF(1-i,j,bi,bj)=DYF(i,j,bi,bj)  
           DYF(sNx+i,j,bi,bj)=DYF(sNx+1-i,j,bi,bj)  
          ENDDO  
         ENDDO  
         DO j=1,Oly  
          DO i=1,sNx  
           DXF(i,1-j,bi,bj)=DXF(i,j,bi,bj)  
           DXF(i,sNy+j,bi,bj)=DXF(i,sNy+1-j,bi,bj)  
           DYF(i,1-j,bi,bj)=DYF(i,j,bi,bj)  
           DYF(i,sNy+j,bi,bj)=DYF(i,sNy+1-j,bi,bj)  
          ENDDO  
         ENDDO  
        ENDDO  
       ENDDO  
       ENDIF  
 cs  
117    
118        CALL MDSREADFIELD('RA.bin',readBinaryPrec,'RS',1,RA,  1,myThid)        CALL MDSREADFIELD('RA.bin',readBinaryPrec,'RS',1,rA,  1,myThid)
119        _EXCH_XY_R4(RA,myThid )        _EXCH_XY_RS(rA,myThid )
120    
121          _BEGIN_MASTER(myThid)
122          anglesAreSet = .FALSE.
123          _END_MASTER(myThid)
124    
125  C-    Corner quantities  C-    Corner quantities
126  C       *********** this are not degbugged ************        CALL MDSREADFIELD('LONG.bin',readBinaryPrec,'RS',1,xG,  1,myThid)
127        CALL MDSREADFIELD('LONG.bin',readBinaryPrec,'RS',1,XG,  1,myThid)        CALL MDSREADFIELD('LATG.bin',readBinaryPrec,'RS',1,yG,  1,myThid)
       CALL MDSREADFIELD('LATG.bin',readBinaryPrec,'RS',1,YG,  1,myThid)  
128        IF (useCubedSphereExchange) THEN        IF (useCubedSphereExchange) THEN
129  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
130        bi=3        bi=3
131        bj=1        bj=1
132        YG(1,sNy+1,bj,1)=YG(1,1,bi,1)        yG(1,sNy+1,bj,1)=yG(1,1,bi,1)
133        bj=bj+2        bj=bj+2
134        YG(1,sNy+1,bj,1)=YG(1,1,bi,1)        yG(1,sNy+1,bj,1)=yG(1,1,bi,1)
135        bj=bj+2        bj=bj+2
136        YG(1,sNy+1,bj,1)=YG(1,1,bi,1)        yG(1,sNy+1,bj,1)=yG(1,1,bi,1)
137        bi=6        bi=6
138        bj=2        bj=2
139        YG(sNx+1,1,bj,1)=YG(1,1,bi,1)        yG(sNx+1,1,bj,1)=yG(1,1,bi,1)
140        bj=bj+2        bj=bj+2
141        YG(sNx+1,1,bj,1)=YG(1,1,bi,1)        yG(sNx+1,1,bj,1)=yG(1,1,bi,1)
142        bj=bj+2        bj=bj+2
143        YG(sNx+1,1,bj,1)=YG(1,1,bi,1)        yG(sNx+1,1,bj,1)=yG(1,1,bi,1)
144  cs-   end block  cs-   end block
145        ENDIF        ENDIF
146        CALL EXCH_Z_XY_RS(XG,myThid)        CALL EXCH_Z_3D_RS( xG, 1, myThid )
147        CALL EXCH_Z_XY_RS(YG,myThid)        CALL EXCH_Z_3D_RS( yG, 1, myThid )
148    
149        CALL MDSREADFIELD('DXV.bin',readBinaryPrec,'RS',1,DXV,  1,myThid)        CALL MDSREADFIELD('DXV.bin',readBinaryPrec,'RS',1,dxV,  1,myThid)
150        CALL MDSREADFIELD('DYU.bin',readBinaryPrec,'RS',1,DYU,  1,myThid)        CALL MDSREADFIELD('DYU.bin',readBinaryPrec,'RS',1,dyU,  1,myThid)
151    c     CALL EXCH_UV_BGRID_3D_RS( dxV, dyU, .FALSE., 1, myThid)
152  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  
153        IF (.NOT.useCubedSphereExchange) THEN        IF (.NOT.useCubedSphereExchange) THEN
154        CALL EXCH_Z_XY_RS(DXV,myThid)        CALL EXCH_Z_3D_RS( dxV, 1, myThid )
155        CALL EXCH_Z_XY_RS(DYU,myThid)        CALL EXCH_Z_3D_RS( dyU, 1, myThid )
156        ELSE        ELSE
157        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
158         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
159  cs! fix overlaps:  cs! fix overlaps:
160          DO j=1,sNy          DO j=1,sNy
161           DO i=1,Olx           DO i=1,Olx
162            DXV(1-i,j,bi,bj)=DXV(1+i,j,bi,bj)            dxV(1-i,j,bi,bj)=dxV(1+i,j,bi,bj)
163            DXV(sNx+i,j,bi,bj)=DXV(i,j,bi,bj)            dxV(sNx+i,j,bi,bj)=dxV(i,j,bi,bj)
164            DYU(1-i,j,bi,bj)=DYU(1+i,j,bi,bj)            dyU(1-i,j,bi,bj)=dyU(1+i,j,bi,bj)
165            DYU(sNx+i,j,bi,bj)=DYU(i,j,bi,bj)            dyU(sNx+i,j,bi,bj)=dyU(i,j,bi,bj)
166           ENDDO           ENDDO
167          ENDDO          ENDDO
168          DO j=1,Oly          DO j=1,Oly
169           DO i=1-Olx,sNx+Olx           DO i=1-Olx,sNx+Olx
170            DXV(i,1-j,bi,bj)=DXV(i,1+j,bi,bj)            dxV(i,1-j,bi,bj)=dxV(i,1+j,bi,bj)
171            DXV(i,sNy+j,bi,bj)=DXV(i,j,bi,bj)            dxV(i,sNy+j,bi,bj)=dxV(i,j,bi,bj)
172            DYU(i,1-j,bi,bj)=DYU(i,1+j,bi,bj)            dyU(i,1-j,bi,bj)=dyU(i,1+j,bi,bj)
173            DYU(i,sNy+j,bi,bj)=DYU(i,j,bi,bj)            dyU(i,sNy+j,bi,bj)=dyU(i,j,bi,bj)
174           ENDDO           ENDDO
175          ENDDO          ENDDO
176         ENDDO         ENDDO
# Line 261  cs! fix overlaps: Line 178  cs! fix overlaps:
178  cs-   end block  cs-   end block
179        ENDIF        ENDIF
180    
181        CALL MDSREADFIELD('RAZ.bin',readBinaryPrec,'RS',1,RAZ,  1,myThid)        CALL MDSREADFIELD('RAZ.bin',readBinaryPrec,'RS',1,rAz,  1,myThid)
182        IF (useCubedSphereExchange) THEN        IF (useCubedSphereExchange) THEN
183  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
184        CALL EXCH_Z_XY_RS(RAZ , myThid )        CALL EXCH_Z_3D_RS( rAz, 1, myThid )
185        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
186         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
187          RAZ(sNx+1,1,bi,bj)=RAZ(1,1,bi,bj)          rAz(sNx+1,1,bi,bj)=rAz(1,1,bi,bj)
188          RAZ(1,sNy+1,bi,bj)=RAZ(1,1,bi,bj)          rAz(1,sNy+1,bi,bj)=rAz(1,1,bi,bj)
189         ENDDO         ENDDO
190        ENDDO        ENDDO
191  cs-   end block  cs-   end block
192        ENDIF        ENDIF
193        CALL EXCH_Z_XY_RS(RAZ,myThid)        CALL EXCH_Z_3D_RS( rAz, 1, myThid )
194    
195  C-    Staggered (u,v pairs) quantities  C-    Staggered (u,v pairs) quantities
196        CALL MDSREADFIELD('DXC.bin',readBinaryPrec,'RS',1,DXC,  1,myThid)        CALL MDSREADFIELD('DXC.bin',readBinaryPrec,'RS',1,dxC,  1,myThid)
197        CALL MDSREADFIELD('DYC.bin',readBinaryPrec,'RS',1,DYC,  1,myThid)        CALL MDSREADFIELD('DYC.bin',readBinaryPrec,'RS',1,dyC,  1,myThid)
198        CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(dxC,dyC,.FALSE.,myThid)
199    
200        CALL MDSREADFIELD('RAW.bin',readBinaryPrec,'RS',1,RAW,  1,myThid)        CALL MDSREADFIELD('RAW.bin',readBinaryPrec,'RS',1,rAw,  1,myThid)
201        CALL MDSREADFIELD('RAS.bin',readBinaryPrec,'RS',1,RAS,  1,myThid)        CALL MDSREADFIELD('RAS.bin',readBinaryPrec,'RS',1,rAs,  1,myThid)
202        IF (useCubedSphereExchange) THEN        CALL EXCH_UV_XY_RS(rAw,rAs,.FALSE.,myThid)
203  cs-   this block needed by cubed sphere until we write more useful I/O routines  
204        DO bj = myByLo(myThid), myByHi(myThid)        CALL MDSREADFIELD('DXG.bin',readBinaryPrec,'RS',1,dxG,  1,myThid)
205         DO bi = myBxLo(myThid), myBxHi(myThid)        CALL MDSREADFIELD('DYG.bin',readBinaryPrec,'RS',1,dyG,  1,myThid)
206          DO J = 1,sNy        CALL EXCH_UV_XY_RS(dyG,dxG,.FALSE.,myThid)
207  c        RAW(sNx+1,J,bi,bj)=RAW(1,J,bi,bj)  
208  c        RAS(J,sNy+1,bi,bj)=RAS(J,1,bi,bj)  c     write(10) xC
209          ENDDO  c     write(10) yC
210         ENDDO  c     write(10) dxF
211        ENDDO  c     write(10) dyF
212  cs-   end block  c     write(10) rA
213        ENDIF  c     write(10) xG
214        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)  c     write(10) yG
215    c     write(10) dxV
216        CALL MDSREADFIELD('DXG.bin',readBinaryPrec,'RS',1,DXG,  1,myThid)  c     write(10) dyU
217        CALL MDSREADFIELD('DYG.bin',readBinaryPrec,'RS',1,DYG,  1,myThid)  c     write(10) rAz
218        IF (useCubedSphereExchange) THEN  c     write(10) dxC
219  cs-   this block needed by cubed sphere until we write more useful I/O routines  c     write(10) dyC
220        DO bj = myByLo(myThid), myByHi(myThid)  c     write(10) rAw
221         DO bi = myBxLo(myThid), myBxHi(myThid)  c     write(10) rAs
222          DO J = 1,sNy  c     write(10) dxG
223  c        DYG(sNx+1,J,bi,bj)=DYG(1,J,bi,bj)  c     write(10) dyG
 c        DXG(J,sNy+1,bi,bj)=DXG(J,1,bi,bj)  
         ENDDO  
        ENDDO  
       ENDDO  
 cs-   end block  
       ENDIF  
       CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)  
       CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)  
   
 c     write(10) XC  
 c     write(10) YC  
 c     write(10) DXF  
 c     write(10) DYF  
 c     write(10) RA  
 c     write(10) XG  
 c     write(10) YG  
 c     write(10) DXV  
 c     write(10) DYU  
 c     write(10) RAZ  
 c     write(10) DXC  
 c     write(10) DYC  
 c     write(10) RAW  
 c     write(10) RAS  
 c     write(10) DXG  
 c     write(10) DYG  
224    
225  #else /* ifndef OLD_GRID_IO */  #else /* ifndef OLD_GRID_IO */
226    
227  C--   Only do I/O if I am the master thread  C--   Only do I/O if I am the master thread
228        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
229    
230    #ifdef ALLOW_MNC
231          IF (useMNC .AND. readgrid_mnc) THEN
232    C--   read NetCDF files:
233    
234            DO i = 1,80
235              mncFn(i:i) = ' '
236            ENDDO
237            write(mncFn,'(a)') 'mitgrid'
238            DO i = 1,MAX_LEN_MBUF
239              msgBuf(i:i) = ' '
240            ENDDO
241            WRITE(msgBuf,'(2A)') msgBuf,' ; Reading grid info using MNC'
242            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
243         &       SQUEEZE_RIGHT , myThid)
244            CALL MNC_FILE_CLOSE_ALL_MATCHING(mncFn, myThid)
245            CALL MNC_CW_SET_UDIM(mncFn, 1, myThid)
246            CALL MNC_CW_SET_CITER(mncFn, 2, -1, -1, -1, myThid)
247            CALL MNC_CW_SET_UDIM(mncFn, 1, myThid)
248            CALL MNC_CW_RS_R('D',mncFn,0,0,'XC', xC,  myThid)
249            CALL MNC_CW_RS_R('D',mncFn,0,0,'XG', xG,  myThid)
250            CALL MNC_CW_RS_R('D',mncFn,0,0,'YC', yC,  myThid)
251            CALL MNC_CW_RS_R('D',mncFn,0,0,'YG', yG,  myThid)
252            CALL MNC_CW_RS_R('D',mncFn,0,0,'dxC',dxC, myThid)
253            CALL MNC_CW_RS_R('D',mncFn,0,0,'dyC',dyC, myThid)
254            CALL MNC_CW_RS_R('D',mncFn,0,0,'dxF',dxF, myThid)
255            CALL MNC_CW_RS_R('D',mncFn,0,0,'dyF',dyF, myThid)
256            CALL MNC_CW_RS_R('D',mncFn,0,0,'dxG',dxG, myThid)
257            CALL MNC_CW_RS_R('D',mncFn,0,0,'dyG',dyG, myThid)
258            CALL MNC_CW_RS_R('D',mncFn,0,0,'dxV',dxV, myThid)
259            CALL MNC_CW_RS_R('D',mncFn,0,0,'dyU',dyU, myThid)
260            CALL MNC_CW_RS_R('D',mncFn,0,0,'rA', rA,  myThid)
261            CALL MNC_CW_RS_R('D',mncFn,0,0,'rAz',rAz, myThid)
262            CALL MNC_CW_RS_R('D',mncFn,0,0,'rAw',rAw, myThid)
263            CALL MNC_CW_RS_R('D',mncFn,0,0,'rAs',rAs, myThid)
264            CALL MNC_CW_RS_R('D',mncFn,0,0,'AngleCS',angleCosC,myThid)
265            CALL MNC_CW_RS_R('D',mncFn,0,0,'AngleSN',angleSinC,myThid)
266            anglesAreSet = .TRUE.
267    
268          ELSE
269    C--   read Binary files:
270    #endif /* ALLOW_MNC */
271    
272    C--   File Precision: keep 64-bits precision (as it used to be)
273    C     but should probably change it to the standard file-prec (= readBinaryPrec)
274          fp = precFloat64
275    c     fp = readBinaryPrec
276    
277        DO bj = 1,nSy        DO bj = 1,nSy
278         DO bi = 1,nSx         DO bi = 1,nSx
         iG=bi+(myXGlobalLo-1)/sNx  
         WRITE(tmpBuf,'(A,I4)') 'tile:',iG  
279  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
280          myTile = W2_myTileList(bi)  C-    Use face number:
281          WRITE(tmpBuf,'(A,I4)') 'tile:',myTile          jG = W2_myTileList(bi)
282          iG = exch2_myface(myTile)          iG = exch2_myface(jG)
283            WRITE(tmpBuf,'(A,I4)') 'tile:',jG
284    #else
285    C-    Tile Id number = Bi + (Bj-1)*(nSx*nPx)  with tile global-indices Bi,Bj
286            iG = bi+(myXGlobalLo-1)/sNx
287            jG = bj+(myYGlobalLo-1)/sNy
288            WRITE(tmpBuf,'(2(A,I3))') 'tile:',iG,' ,',jG
289            iG = iG + (jG-1)*(nSx*nPx)
290  #endif  #endif
291    
292          iLen = ILNBLNK(horizGridFile)          iLen = ILNBLNK(horizGridFile)
293          IF ( iLen .EQ. 0 ) THEN          IF ( iLen .EQ. 0 ) THEN
294            WRITE(fName,'("tile",I3.3,".mitgrid")') iG            WRITE(fName,'("tile",I3.3,".mitgrid")') iG
# Line 359  C--   Only do I/O if I am the master thr Line 304  C--   Only do I/O if I am the master thr
304       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
305          WRITE(msgBuf,'(A)') '  =>'          WRITE(msgBuf,'(A)') '  =>'
306    
307          CALL READSYMTILE_RS(fName,1,XC,bi,bj,buf,myThid)  #ifdef ALLOW_MDSIO
308            CALL MDS_FACEF_READ_RS( fName, fp, 1,  xC, bi, bj, myThid )
309          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
310          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'XC'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'xC'
311          CALL READSYMTILE_RS(fName,2,YC,bi,bj,buf,myThid)          CALL MDS_FACEF_READ_RS( fName, fp, 2,  yC, bi, bj, myThid )
312          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
313          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'YC'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'yC'
314          CALL READSYMTILE_RS(fName,3,DXF,bi,bj,buf,myThid)          CALL MDS_FACEF_READ_RS( fName, fp, 3, dxF, bi, bj, myThid )
315          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
316          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DXF'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dxF'
317          CALL READSYMTILE_RS(fName,4,DYF,bi,bj,buf,myThid)          CALL MDS_FACEF_READ_RS( fName, fp, 4, dyF, bi, bj, myThid )
318          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
319          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DYF'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dyF'
320          CALL READSYMTILE_RS(fName,5,RA,bi,bj,buf,myThid)          CALL MDS_FACEF_READ_RS( fName, fp, 5,  rA, bi, bj, myThid )
321          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
322          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'RA'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'rA'
323          CALL READSYMTILE_RS(fName,6,XG,bi,bj,buf,myThid)          CALL MDS_FACEF_READ_RS( fName, fp, 6,  xG, bi, bj, myThid )
324          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
325          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'XG'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'xG'
326          CALL READSYMTILE_RS(fName,7,YG,bi,bj,buf,myThid)          CALL MDS_FACEF_READ_RS( fName, fp, 7,  yG, bi, bj, myThid )
327          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
328          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'YG'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'yG'
329          CALL READSYMTILE_RS(fName,8,DXV,bi,bj,buf,myThid)          CALL MDS_FACEF_READ_RS( fName, fp, 8, dxV, bi, bj, myThid )
330          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
331          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DXV'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dxV'
332          CALL READSYMTILE_RS(fName,9,DYU,bi,bj,buf,myThid)          CALL MDS_FACEF_READ_RS( fName, fp, 9, dyU, bi, bj, myThid )
333          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
334          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DYU'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dyU'
335          CALL READSYMTILE_RS(fName,10,RAZ,bi,bj,buf,myThid)          CALL MDS_FACEF_READ_RS( fName, fp,10, rAz, bi, bj, myThid )
336          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
337          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'RAZ'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'rAz'
338          CALL READSYMTILE_RS(fName,11,DXC,bi,bj,buf,myThid)          CALL MDS_FACEF_READ_RS( fName, fp,11, dxC, bi, bj, myThid )
339          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
340          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DXC'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dxC'
341          CALL READSYMTILE_RS(fName,12,DYC,bi,bj,buf,myThid)          CALL MDS_FACEF_READ_RS( fName, fp,12, dyC, bi, bj, myThid )
342          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
343          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DYC'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dyC'
344          CALL READSYMTILE_RS(fName,13,RAW,bi,bj,buf,myThid)          CALL MDS_FACEF_READ_RS( fName, fp,13, rAw, bi, bj, myThid )
345          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
346          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'RAW'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'rAw'
347          CALL READSYMTILE_RS(fName,14,RAS,bi,bj,buf,myThid)          CALL MDS_FACEF_READ_RS( fName, fp,14, rAs, bi, bj, myThid )
348          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
349          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'RAS'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'rAs'
350          CALL READSYMTILE_RS(fName,15,DXG,bi,bj,buf,myThid)          CALL MDS_FACEF_READ_RS( fName, fp,15, dxG, bi, bj, myThid )
351          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
352          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DXG'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dxG'
353          CALL READSYMTILE_RS(fName,16,DYG,bi,bj,buf,myThid)          CALL MDS_FACEF_READ_RS( fName, fp,16, dyG, bi, bj, myThid )
354          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
355          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DYG'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dyG'
356    
357          iLen = ILNBLNK(horizGridFile)          iLen = ILNBLNK(horizGridFile)
358          IF ( iLen.GT.0 ) THEN          IF ( iLen.GT.0 ) THEN
359           CALL READSYMTILE_RS(fName,17,angleCosC,bi,bj,buf,myThid)           CALL MDS_FACEF_READ_RS(fName,fp,17,angleCosC,bi,bj,myThid)
360           iL = ILNBLNK(msgBuf)           iL = ILNBLNK(msgBuf)
361           WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'AngleCS'           WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'AngleCS'
362           CALL READSYMTILE_RS(fName,18,angleSinC,bi,bj,buf,myThid)           CALL MDS_FACEF_READ_RS(fName,fp,18,angleSinC,bi,bj,myThid)
363           iL = ILNBLNK(tmpBuf)           iL = ILNBLNK(tmpBuf)
364           WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'AngleSN'           WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'AngleSN'
365             anglesAreSet = .TRUE.
366            ELSE
367             anglesAreSet = .FALSE.
368          ENDIF          ENDIF
369    #else /* ALLOW_MDSIO */
370            WRITE(msgBuf,'(2A)')
371         &   'INI_CURVILINEAR_GRID: Needs to compile MDSIO pkg'
372            CALL PRINT_ERROR( msgBuf, myThid )
373            STOP 'ABNORMAL END: S/R INI_CURVILINEAR_GRID'
374    #endif /* ALLOW_MDSIO */
375    
376          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
377       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
# Line 424  C--   Only do I/O if I am the master thr Line 379  C--   Only do I/O if I am the master thr
379         ENDDO         ENDDO
380        ENDDO        ENDDO
381    
382    #ifdef ALLOW_MNC
383          ENDIF
384    #endif /* ALLOW_MNC */
385    
386        _END_MASTER(myThid)        _END_MASTER(myThid)
387    
388        CALL EXCH_XY_RS(XC,myThid)        CALL EXCH_XY_RS(xC,myThid)
389        CALL EXCH_XY_RS(YC,myThid)        CALL EXCH_XY_RS(yC,myThid)
390  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned, myThid )        CALL EXCH_UV_AGRID_3D_RS( dxF, dyF, .FALSE., 1, myThid )
391  #ifdef HRCUBE        CALL EXCH_XY_RS(rA,myThid )
392        CALL EXCH_XY_RS(DXF,myThid)        CALL EXCH_Z_3D_RS( xG, 1, myThid )
393        CALL EXCH_XY_RS(DYF,myThid)        CALL EXCH_Z_3D_RS( yG, 1, myThid )
394  #endif        CALL EXCH_UV_BGRID_3D_RS( dxV, dyU, .FALSE., 1, myThid)
395        CALL EXCH_XY_RS(RA,myThid )        CALL EXCH_Z_3D_RS( rAz, 1, myThid )
396        CALL EXCH_Z_XY_RS(XG,myThid)        CALL EXCH_UV_XY_RS(dxC,dyC,.FALSE.,myThid)
397        CALL EXCH_Z_XY_RS(YG,myThid)        CALL EXCH_UV_XY_RS(rAw,rAs,.FALSE.,myThid)
398  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)        CALL EXCH_UV_XY_RS(dyG,dxG,.FALSE.,myThid)
 c     CALL EXCH_Z_XY_RS(DXV,myThid)  
 c     CALL EXCH_Z_XY_RS(DYU,myThid)  
       CALL EXCH_Z_XY_RS(RAZ,myThid)  
       CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)  
       CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)  
       CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)  
       CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)  
399    
400  #endif /* OLD_GRID_IO */  #endif /* OLD_GRID_IO */
401    
402  #ifdef ALLOW_MNC  C--   Calculate (sines and cosines of) angles of grid north with
403    C--   geographical north when they have not been read from a file
404          IF ( .NOT.anglesAreSet ) THEN
405           CALL CALC_ANGLES( myThid )
406           _BARRIER
407           _BEGIN_MASTER(myThid)
408           anglesAreSet = .TRUE.
409           _END_MASTER(myThid)
410        ENDIF        ENDIF
411  #endif /* ALLOW_MNC */  C--   Exchange Angle (either loaded from file or computed)
412          CALL EXCH_UV_AGRID_3D_RS(angleSinC,angleCosC,.TRUE., 1, myThid)
413    
414  c     CALL WRITE_FULLARRAY_RL('DXV',DXV,1,0,0,0,myThid)  C--   Stop if Angle have not been loaded but are needed :
415  c     CALL WRITE_FULLARRAY_RL('DYU',DYU,1,0,0,0,myThid)        _BEGIN_MASTER(myThid)
416  c     CALL WRITE_FULLARRAY_RL('RAZ',RAZ,1,0,0,0,myThid)        IF ( .NOT.anglesAreSet .AND. use3dCoriolis ) THEN
417  c     CALL WRITE_FULLARRAY_RL('XG',XG,1,0,0,0,myThid)          WRITE(msgBuf,'(2A)')
418  c     CALL WRITE_FULLARRAY_RL('YG',YG,1,0,0,0,myThid)       &   'INI_CURVILINEAR_GRID: Angle of CurvilinearGrid not set',
419         &   ' but needed for 3-D Coriolis'
420            CALL PRINT_ERROR( msgBuf, myThid )
421            STOP 'ABNORMAL END: S/R INI_CURVILINEAR_GRID'
422          ENDIF
423          _END_MASTER(myThid)
424    
425  C--   Require that 0 <= longitude < 360 if using exf package  c     CALL WRITE_FULLARRAY_RL('dxV',dxV,1,0,0,1,0,myThid)
426  #ifdef ALLOW_EXF  c     CALL WRITE_FULLARRAY_RL('dyU',dyU,1,0,0,1,0,myThid)
427        DO bj = 1,nSy  c     CALL WRITE_FULLARRAY_RL('rAz',rAz,1,0,0,1,0,myThid)
428         DO bi = 1,nSx  c     CALL WRITE_FULLARRAY_RL('xG' ,xG ,1,0,0,1,0,myThid)
429          DO J=1-Oly,sNy+Oly  c     CALL WRITE_FULLARRAY_RL('yG' ,yG ,1,0,0,1,0,myThid)
          DO I=1-Olx,sNx+Olx  
           IF (XC(i,j,bi,bj).lt.0.) XC(i,j,bi,bj)=XC(i,j,bi,bj)+360.  
           IF (XG(i,j,bi,bj).lt.0.) XG(i,j,bi,bj)=XG(i,j,bi,bj)+360.  
          ENDDO  
         ENDDO  
        ENDDO  
       ENDDO  
 #endif /* ALLOW_EXF */  
430    
431  C--   Now let's look at all these beasts  C--   Now let's look at all these beasts
432        IF ( debugLevel .GE. debLevB ) THEN        IF ( debugLevel .GE. debLevB ) THEN
433           myIter = 1          CALL PLOT_FIELD_XYRS( xC      , 'Current xC      ', 0, myThid )
434           CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,          CALL PLOT_FIELD_XYRS( yC      , 'Current yC      ', 0, myThid )
435       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( dxF     , 'Current dxF     ', 0, myThid )
436           CALL PLOT_FIELD_XYRL( YC      , 'Current YC      ' ,          CALL PLOT_FIELD_XYRS( dyF     , 'Current dyF     ', 0, myThid )
437       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( rA      , 'Current rA      ', 0, myThid )
438           CALL PLOT_FIELD_XYRL( DXF     , 'Current DXF     ' ,          CALL PLOT_FIELD_XYRS( xG      , 'Current xG      ', 0, myThid )
439       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( yG      , 'Current yG      ', 0, myThid )
440           CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,          CALL PLOT_FIELD_XYRS( dxV     , 'Current dxV     ', 0, myThid )
441       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( dyU     , 'Current dyU     ', 0, myThid )
442           CALL PLOT_FIELD_XYRL( DYF     , 'Current DYF     ' ,          CALL PLOT_FIELD_XYRS( rAz     , 'Current rAz     ', 0, myThid )
443       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( dxC     , 'Current dxC     ', 0, myThid )
444           CALL PLOT_FIELD_XYRL( RA      , 'Current RA      ' ,          CALL PLOT_FIELD_XYRS( dyC     , 'Current dyC     ', 0, myThid )
445       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( rAw     , 'Current rAw     ', 0, myThid )
446           CALL PLOT_FIELD_XYRL( XG      , 'Current XG      ' ,          CALL PLOT_FIELD_XYRS( rAs     , 'Current rAs     ', 0, myThid )
447       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( dxG     , 'Current dxG     ', 0, myThid )
448           CALL PLOT_FIELD_XYRL( YG      , 'Current YG      ' ,          CALL PLOT_FIELD_XYRS( dyG     , 'Current dyG     ', 0, myThid )
449       &        myIter, myThid )          CALL PLOT_FIELD_XYRS(angleCosC, 'Current AngleCS ', 0, myThid )
450           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 )  
451        ENDIF        ENDIF
452    
453        RETURN        RETURN
454        END        END
   
 C --------------------------------------------------------------------------  
   
       SUBROUTINE READSYMTILE_RS(fName,irec,array,bi,bj,buf,myThid)  
 C     /==========================================================\  
 C     | SUBROUTINE READSYMTILE_RS                                |  
 C     |==========================================================|  
 C     \==========================================================/  
       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     == Routine arguments ==  
       CHARACTER*(*) fName  
       INTEGER irec  
       _RS array(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy)  
       INTEGER bi,bj,myThid  
 #ifdef ALLOW_EXCH2  
       _RL buf(1:sNx*nSx*nPx+1)  
 #else  
       _RL buf(1:sNx+1,1:sNy+1)  
 #endif /* ALLOW_EXCH2 */  
   
 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.21  
changed lines
  Added in v.1.45
  ViewVC Help
Powered by ViewVC 1.1.22