/[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.31 by jmc, Sun Aug 27 18:30:47 2006 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"
6    C- note: default is to use "new" grid files (OLD_GRID_IO undef)
7    C   but can still use (on 1 cpu, with MDSIO) OLD_GRID_IO and EXCH2 independently
8    #undef OLD_GRID_IO
9    
10  CBOP  CBOP
11  C     !ROUTINE: INI_CURVILINEAR_GRID  C     !ROUTINE: INI_CURVILINEAR_GRID
# Line 10  C     !INTERFACE: Line 13  C     !INTERFACE:
13        SUBROUTINE INI_CURVILINEAR_GRID( myThid )        SUBROUTINE INI_CURVILINEAR_GRID( myThid )
14  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
15  C     *==========================================================*  C     *==========================================================*
16  C     | SUBROUTINE INI_CURVILINEAR_GRID                            C     | SUBROUTINE INI_CURVILINEAR_GRID
17  C     | o Initialise curvilinear coordinate system                  C     | o Initialise curvilinear coordinate system
18  C     *==========================================================*  C     *==========================================================*
19  C     | Curvilinear grid settings are read from a file rather  C     | Curvilinear grid settings are read from a file rather
20  C     | than coded in-line as for cartesian and spherical polar.  C     | than coded in-line as for cartesian and spherical polar.
# Line 35  C     === Global variables === Line 38  C     === Global variables ===
38  #include "MNC_PARAMS.h"  #include "MNC_PARAMS.h"
39  #endif  #endif
40    
 #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 */  
   
41  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
42  C     == Routine arguments ==  C     == Routine arguments ==
43  C     myThid -  Number of this instance of INI_CURVILINEAR_GRID  C     myThid -  Number of this instance of INI_CURVILINEAR_GRID
# Line 52  C     !LOCAL VARIABLES: Line 47  C     !LOCAL VARIABLES:
47  C     == Local variables ==  C     == Local variables ==
48        INTEGER bi,bj, myIter        INTEGER bi,bj, myIter
49        INTEGER I,J        INTEGER I,J
50        CHARACTER*(MAX_LEN_FNAM) fName        CHARACTER*(MAX_LEN_MBUF) msgBuf
51          LOGICAL anglesAreSet
52  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
53        CHARACTER*(80) mncFn        CHARACTER*(80) mncFn
54  #endif  #endif
55  #ifdef ALLOW_EXCH2  #ifndef OLD_GRID_IO
56    # ifdef ALLOW_EXCH2
57        _RL buf(sNx*nSx*nPx+1)        _RL buf(sNx*nSx*nPx+1)
58        INTEGER myTile        INTEGER myTile
59  #else  # else
60        _RL buf(sNx+1,sNy+1)        _RL buf(sNx+1,sNy+1)
61  #endif  # endif
62        INTEGER iG, iL, iLen        INTEGER iG, iL, iLen
63        CHARACTER*(MAX_LEN_MBUF) msgBuf, tmpBuf        CHARACTER*(MAX_LEN_FNAM) fName
64          CHARACTER*(MAX_LEN_MBUF) tmpBuf
65        INTEGER  ILNBLNK        INTEGER  ILNBLNK
66        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
67    #endif
68  CEOP  CEOP
69    
70  C--   Set everything to zero everywhere  C--   Set everything to zero everywhere
# Line 74  C--   Set everything to zero everywhere Line 73  C--   Set everything to zero everywhere
73    
74          DO J=1-Oly,sNy+Oly          DO J=1-Oly,sNy+Oly
75           DO I=1-Olx,sNx+Olx           DO I=1-Olx,sNx+Olx
76            XC(i,j,bi,bj)=0.            xC(i,j,bi,bj)=0.
77            YC(i,j,bi,bj)=0.            yC(i,j,bi,bj)=0.
78            XG(i,j,bi,bj)=0.            xG(i,j,bi,bj)=0.
79            YG(i,j,bi,bj)=0.            yG(i,j,bi,bj)=0.
80            DXC(i,j,bi,bj)=0.            dxC(i,j,bi,bj)=0.
81            DYC(i,j,bi,bj)=0.            dyC(i,j,bi,bj)=0.
82            DXG(i,j,bi,bj)=0.            dxG(i,j,bi,bj)=0.
83            DYG(i,j,bi,bj)=0.            dyG(i,j,bi,bj)=0.
84            DXF(i,j,bi,bj)=0.            dxF(i,j,bi,bj)=0.
85            DYF(i,j,bi,bj)=0.            dyF(i,j,bi,bj)=0.
86            DXV(i,j,bi,bj)=0.            dxV(i,j,bi,bj)=0.
87            DYU(i,j,bi,bj)=0.            dyU(i,j,bi,bj)=0.
88            RA(i,j,bi,bj)=0.            rA(i,j,bi,bj)=0.
89            RAZ(i,j,bi,bj)=0.            rAz(i,j,bi,bj)=0.
90            RAW(i,j,bi,bj)=0.            rAw(i,j,bi,bj)=0.
91            RAS(i,j,bi,bj)=0.            rAs(i,j,bi,bj)=0.
92            tanPhiAtU(i,j,bi,bj)=0.            tanPhiAtU(i,j,bi,bj)=0.
93            tanPhiAtV(i,j,bi,bj)=0.            tanPhiAtV(i,j,bi,bj)=0.
94            angleCosC(i,j,bi,bj)=1.            angleCosC(i,j,bi,bj)=1.
95            angleSinC(i,j,bi,bj)=0.            angleSinC(i,j,bi,bj)=0.
96            cosFacU(J,bi,bj)=1.            cosFacU(J,bi,bj)=1.
97            cosFacV(J,bi,bj)=1.            cosFacV(J,bi,bj)=1.
98            sqcosFacU(J,bi,bj)=1.            sqCosFacU(J,bi,bj)=1.
99            sqcosFacV(J,bi,bj)=1.            sqCosFacV(J,bi,bj)=1.
100           ENDDO           ENDDO
101          ENDDO          ENDDO
102    
103         ENDDO         ENDDO
104        ENDDO        ENDDO
105    
106    C--   Everyone must wait for the initialisation to be done
107  #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  
108    
109  C     Here we make no assumptions about grid symmetry and simply  C     Here we make no assumptions about grid symmetry and simply
110  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 112  C     read the raw grid data from files
112  #ifdef OLD_GRID_IO  #ifdef OLD_GRID_IO
113    
114  C-    Cell centered quantities  C-    Cell centered quantities
115        CALL MDSREADFIELD('LONC.bin',readBinaryPrec,'RS',1,XC,  1,myThid)        CALL MDSREADFIELD('LONC.bin',readBinaryPrec,'RS',1,xC,  1,myThid)
116        CALL MDSREADFIELD('LATC.bin',readBinaryPrec,'RS',1,YC,  1,myThid)        CALL MDSREADFIELD('LATC.bin',readBinaryPrec,'RS',1,yC,  1,myThid)
117        _EXCH_XY_R4(XC,myThid)        _EXCH_XY_R4(xC,myThid)
118        _EXCH_XY_R4(YC,myThid)        _EXCH_XY_R4(yC,myThid)
119    
120        CALL MDSREADFIELD('DXF.bin',readBinaryPrec,'RS',1,DXF,  1,myThid)        CALL MDSREADFIELD('DXF.bin',readBinaryPrec,'RS',1,dxF,  1,myThid)
121        CALL MDSREADFIELD('DYF.bin',readBinaryPrec,'RS',1,DYF,  1,myThid)        CALL MDSREADFIELD('DYF.bin',readBinaryPrec,'RS',1,dyF,  1,myThid)
122  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  
123    
124        CALL MDSREADFIELD('RA.bin',readBinaryPrec,'RS',1,RA,  1,myThid)        CALL MDSREADFIELD('RA.bin',readBinaryPrec,'RS',1,rA,  1,myThid)
125        _EXCH_XY_R4(RA,myThid )        _EXCH_XY_R4(rA,myThid )
126    
127  C-    Corner quantities  C-    Corner quantities
128  C       *********** this are not degbugged ************        CALL MDSREADFIELD('LONG.bin',readBinaryPrec,'RS',1,xG,  1,myThid)
129        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)  
130        IF (useCubedSphereExchange) THEN        IF (useCubedSphereExchange) THEN
131  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
132        bi=3        bi=3
133        bj=1        bj=1
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        bj=bj+2        bj=bj+2
138        YG(1,sNy+1,bj,1)=YG(1,1,bi,1)        yG(1,sNy+1,bj,1)=yG(1,1,bi,1)
139        bi=6        bi=6
140        bj=2        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        bj=bj+2        bj=bj+2
145        YG(sNx+1,1,bj,1)=YG(1,1,bi,1)        yG(sNx+1,1,bj,1)=yG(1,1,bi,1)
146  cs-   end block  cs-   end block
147        ENDIF        ENDIF
148        CALL EXCH_Z_XY_RS(XG,myThid)        CALL EXCH_Z_3D_RS( xG, 1, myThid )
149        CALL EXCH_Z_XY_RS(YG,myThid)        CALL EXCH_Z_3D_RS( yG, 1, myThid )
150    
151        CALL MDSREADFIELD('DXV.bin',readBinaryPrec,'RS',1,DXV,  1,myThid)        CALL MDSREADFIELD('DXV.bin',readBinaryPrec,'RS',1,dxV,  1,myThid)
152        CALL MDSREADFIELD('DYU.bin',readBinaryPrec,'RS',1,DYU,  1,myThid)        CALL MDSREADFIELD('DYU.bin',readBinaryPrec,'RS',1,dyU,  1,myThid)
153  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
154  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)  C !!! _EXCH_ZUV_XY_R4(dxV, dyU, unSigned, myThid)
155  cs!   this is not correct <= need paired exchange for dxv,dyu  cs!   this is not correct <= need paired exchange for dxv,dyu
156        IF (.NOT.useCubedSphereExchange) THEN        IF (.NOT.useCubedSphereExchange) THEN
157        CALL EXCH_Z_XY_RS(DXV,myThid)        CALL EXCH_Z_3D_RS( dxV, 1, myThid )
158        CALL EXCH_Z_XY_RS(DYU,myThid)        CALL EXCH_Z_3D_RS( dyU, 1, myThid )
159        ELSE        ELSE
160        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
161         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
162  cs! fix overlaps:  cs! fix overlaps:
163          DO j=1,sNy          DO j=1,sNy
164           DO i=1,Olx           DO i=1,Olx
165            DXV(1-i,j,bi,bj)=DXV(1+i,j,bi,bj)            dxV(1-i,j,bi,bj)=dxV(1+i,j,bi,bj)
166            DXV(sNx+i,j,bi,bj)=DXV(i,j,bi,bj)            dxV(sNx+i,j,bi,bj)=dxV(i,j,bi,bj)
167            DYU(1-i,j,bi,bj)=DYU(1+i,j,bi,bj)            dyU(1-i,j,bi,bj)=dyU(1+i,j,bi,bj)
168            DYU(sNx+i,j,bi,bj)=DYU(i,j,bi,bj)            dyU(sNx+i,j,bi,bj)=dyU(i,j,bi,bj)
169           ENDDO           ENDDO
170          ENDDO          ENDDO
171          DO j=1,Oly          DO j=1,Oly
172           DO i=1-Olx,sNx+Olx           DO i=1-Olx,sNx+Olx
173            DXV(i,1-j,bi,bj)=DXV(i,1+j,bi,bj)            dxV(i,1-j,bi,bj)=dxV(i,1+j,bi,bj)
174            DXV(i,sNy+j,bi,bj)=DXV(i,j,bi,bj)            dxV(i,sNy+j,bi,bj)=dxV(i,j,bi,bj)
175            DYU(i,1-j,bi,bj)=DYU(i,1+j,bi,bj)            dyU(i,1-j,bi,bj)=dyU(i,1+j,bi,bj)
176            DYU(i,sNy+j,bi,bj)=DYU(i,j,bi,bj)            dyU(i,sNy+j,bi,bj)=dyU(i,j,bi,bj)
177           ENDDO           ENDDO
178          ENDDO          ENDDO
179         ENDDO         ENDDO
# Line 261  cs! fix overlaps: Line 181  cs! fix overlaps:
181  cs-   end block  cs-   end block
182        ENDIF        ENDIF
183    
184        CALL MDSREADFIELD('RAZ.bin',readBinaryPrec,'RS',1,RAZ,  1,myThid)        CALL MDSREADFIELD('RAZ.bin',readBinaryPrec,'RS',1,rAz,  1,myThid)
185        IF (useCubedSphereExchange) THEN        IF (useCubedSphereExchange) THEN
186  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
187        CALL EXCH_Z_XY_RS(RAZ , myThid )        CALL EXCH_Z_3D_RS( rAz, 1, myThid )
188        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
189         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
190          RAZ(sNx+1,1,bi,bj)=RAZ(1,1,bi,bj)          rAz(sNx+1,1,bi,bj)=rAz(1,1,bi,bj)
191          RAZ(1,sNy+1,bi,bj)=RAZ(1,1,bi,bj)          rAz(1,sNy+1,bi,bj)=rAz(1,1,bi,bj)
192         ENDDO         ENDDO
193        ENDDO        ENDDO
194  cs-   end block  cs-   end block
195        ENDIF        ENDIF
196        CALL EXCH_Z_XY_RS(RAZ,myThid)        CALL EXCH_Z_3D_RS( rAz, 1, myThid )
197    
198  C-    Staggered (u,v pairs) quantities  C-    Staggered (u,v pairs) quantities
199        CALL MDSREADFIELD('DXC.bin',readBinaryPrec,'RS',1,DXC,  1,myThid)        CALL MDSREADFIELD('DXC.bin',readBinaryPrec,'RS',1,dxC,  1,myThid)
200        CALL MDSREADFIELD('DYC.bin',readBinaryPrec,'RS',1,DYC,  1,myThid)        CALL MDSREADFIELD('DYC.bin',readBinaryPrec,'RS',1,dyC,  1,myThid)
201        CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(dxC,dyC,.FALSE.,myThid)
202    
203        CALL MDSREADFIELD('RAW.bin',readBinaryPrec,'RS',1,RAW,  1,myThid)        CALL MDSREADFIELD('RAW.bin',readBinaryPrec,'RS',1,rAw,  1,myThid)
204        CALL MDSREADFIELD('RAS.bin',readBinaryPrec,'RS',1,RAS,  1,myThid)        CALL MDSREADFIELD('RAS.bin',readBinaryPrec,'RS',1,rAs,  1,myThid)
205        IF (useCubedSphereExchange) THEN        CALL EXCH_UV_XY_RS(rAw,rAs,.FALSE.,myThid)
206  cs-   this block needed by cubed sphere until we write more useful I/O routines  
207        DO bj = myByLo(myThid), myByHi(myThid)        CALL MDSREADFIELD('DXG.bin',readBinaryPrec,'RS',1,dxG,  1,myThid)
208         DO bi = myBxLo(myThid), myBxHi(myThid)        CALL MDSREADFIELD('DYG.bin',readBinaryPrec,'RS',1,dyG,  1,myThid)
209          DO J = 1,sNy        CALL EXCH_UV_XY_RS(dyG,dxG,.FALSE.,myThid)
210  c        RAW(sNx+1,J,bi,bj)=RAW(1,J,bi,bj)        CALL EXCH_UV_AGRID_3D_RS(angleSinC,angleCosC,.TRUE., 1, myThid)
211  c        RAS(J,sNy+1,bi,bj)=RAS(J,1,bi,bj)        anglesAreSet = .FALSE.
212          ENDDO  
213         ENDDO  c     write(10) xC
214        ENDDO  c     write(10) yC
215  cs-   end block  c     write(10) dxF
216        ENDIF  c     write(10) dyF
217        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)  c     write(10) rA
218    c     write(10) xG
219        CALL MDSREADFIELD('DXG.bin',readBinaryPrec,'RS',1,DXG,  1,myThid)  c     write(10) yG
220        CALL MDSREADFIELD('DYG.bin',readBinaryPrec,'RS',1,DYG,  1,myThid)  c     write(10) dxV
221        IF (useCubedSphereExchange) THEN  c     write(10) dyU
222  cs-   this block needed by cubed sphere until we write more useful I/O routines  c     write(10) rAz
223        DO bj = myByLo(myThid), myByHi(myThid)  c     write(10) dxC
224         DO bi = myBxLo(myThid), myBxHi(myThid)  c     write(10) dyC
225          DO J = 1,sNy  c     write(10) rAw
226  c        DYG(sNx+1,J,bi,bj)=DYG(1,J,bi,bj)  c     write(10) rAs
227  c        DXG(J,sNy+1,bi,bj)=DXG(J,1,bi,bj)  c     write(10) dxG
228          ENDDO  c     write(10) dyG
        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  
229    
230  #else /* ifndef OLD_GRID_IO */  #else /* ifndef OLD_GRID_IO */
231    
232  C--   Only do I/O if I am the master thread  C--   Only do I/O if I am the master thread
233        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
234    
235    #ifdef ALLOW_MNC
236          IF (useMNC .AND. readgrid_mnc) THEN
237    C--   read NetCDF files:
238    
239            DO i = 1,80
240              mncFn(i:i) = ' '
241            ENDDO
242            write(mncFn,'(a)') 'mitgrid'
243            DO i = 1,MAX_LEN_MBUF
244              msgBuf(i:i) = ' '
245            ENDDO
246            WRITE(msgBuf,'(2A)') msgBuf,' ; Reading grid info using MNC'
247            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
248         &       SQUEEZE_RIGHT , myThid)
249            CALL MNC_FILE_CLOSE_ALL_MATCHING(mncFn, myThid)
250            CALL MNC_CW_SET_UDIM(mncFn, 1, myThid)
251            CALL MNC_CW_SET_CITER(mncFn, 2, -1, -1, -1, myThid)
252            CALL MNC_CW_SET_UDIM(mncFn, 1, myThid)
253            CALL MNC_CW_RS_R('D',mncFn,0,0,'XC', xC,  myThid)
254            CALL MNC_CW_RS_R('D',mncFn,0,0,'XG', xG,  myThid)
255            CALL MNC_CW_RS_R('D',mncFn,0,0,'YC', yC,  myThid)
256            CALL MNC_CW_RS_R('D',mncFn,0,0,'YG', yG,  myThid)
257            CALL MNC_CW_RS_R('D',mncFn,0,0,'dxC',dxC, myThid)
258            CALL MNC_CW_RS_R('D',mncFn,0,0,'dyC',dyC, myThid)
259            CALL MNC_CW_RS_R('D',mncFn,0,0,'dxF',dxF, myThid)
260            CALL MNC_CW_RS_R('D',mncFn,0,0,'dyF',dyF, myThid)
261            CALL MNC_CW_RS_R('D',mncFn,0,0,'dxG',dxG, myThid)
262            CALL MNC_CW_RS_R('D',mncFn,0,0,'dyG',dyG, myThid)
263            CALL MNC_CW_RS_R('D',mncFn,0,0,'dxV',dxV, myThid)
264            CALL MNC_CW_RS_R('D',mncFn,0,0,'dyU',dyU, myThid)
265            CALL MNC_CW_RS_R('D',mncFn,0,0,'rA', rA,  myThid)
266            CALL MNC_CW_RS_R('D',mncFn,0,0,'rAz',rAz, myThid)
267            CALL MNC_CW_RS_R('D',mncFn,0,0,'rAw',rAw, myThid)
268            CALL MNC_CW_RS_R('D',mncFn,0,0,'rAs',rAs, myThid)
269            CALL MNC_CW_RS_R('D',mncFn,0,0,'AngleCS',angleCosC,myThid)
270            CALL MNC_CW_RS_R('D',mncFn,0,0,'AngleSN',angleSinC,myThid)
271            anglesAreSet = .TRUE.
272    
273          ELSE
274    C--   read Binary files:
275    #endif /* ALLOW_MNC */
276    
277        DO bj = 1,nSy        DO bj = 1,nSy
278         DO bi = 1,nSx         DO bi = 1,nSx
279          iG=bi+(myXGlobalLo-1)/sNx          iG=bi+(myXGlobalLo-1)/sNx
# Line 359  C--   Only do I/O if I am the master thr Line 298  C--   Only do I/O if I am the master thr
298       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
299          WRITE(msgBuf,'(A)') '  =>'          WRITE(msgBuf,'(A)') '  =>'
300    
301          CALL READSYMTILE_RS(fName,1,XC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,1,xC,buf,bi,bj,myThid)
302          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
303          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'XC'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'xC'
304          CALL READSYMTILE_RS(fName,2,YC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,2,yC,buf,bi,bj,myThid)
305          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
306          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'YC'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'yC'
307          CALL READSYMTILE_RS(fName,3,DXF,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,3,dxF,buf,bi,bj,myThid)
308          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
309          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DXF'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dxF'
310          CALL READSYMTILE_RS(fName,4,DYF,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,4,dyF,buf,bi,bj,myThid)
311          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
312          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DYF'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dyF'
313          CALL READSYMTILE_RS(fName,5,RA,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,5,rA,buf,bi,bj,myThid)
314          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
315          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'RA'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'rA'
316          CALL READSYMTILE_RS(fName,6,XG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,6,xG,buf,bi,bj,myThid)
317          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
318          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'XG'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'xG'
319          CALL READSYMTILE_RS(fName,7,YG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,7,yG,buf,bi,bj,myThid)
320          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
321          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'YG'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'yG'
322          CALL READSYMTILE_RS(fName,8,DXV,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,8,dxV,buf,bi,bj,myThid)
323          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
324          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DXV'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dxV'
325          CALL READSYMTILE_RS(fName,9,DYU,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,9,dyU,buf,bi,bj,myThid)
326          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
327          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DYU'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dyU'
328          CALL READSYMTILE_RS(fName,10,RAZ,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,10,rAz,buf,bi,bj,myThid)
329          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
330          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'RAZ'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'rAz'
331          CALL READSYMTILE_RS(fName,11,DXC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,11,dxC,buf,bi,bj,myThid)
332          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
333          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DXC'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dxC'
334          CALL READSYMTILE_RS(fName,12,DYC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,12,dyC,buf,bi,bj,myThid)
335          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
336          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DYC'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dyC'
337          CALL READSYMTILE_RS(fName,13,RAW,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,13,rAw,buf,bi,bj,myThid)
338          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
339          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'RAW'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'rAw'
340          CALL READSYMTILE_RS(fName,14,RAS,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,14,rAs,buf,bi,bj,myThid)
341          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
342          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'RAS'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'rAs'
343          CALL READSYMTILE_RS(fName,15,DXG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,15,dxG,buf,bi,bj,myThid)
344          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
345          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DXG'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dxG'
346          CALL READSYMTILE_RS(fName,16,DYG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,16,dyG,buf,bi,bj,myThid)
347          iL = ILNBLNK(tmpBuf)          iL = ILNBLNK(tmpBuf)
348          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DYG'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dyG'
349    
350          iLen = ILNBLNK(horizGridFile)          iLen = ILNBLNK(horizGridFile)
351          IF ( iLen.GT.0 ) THEN          IF ( iLen.GT.0 ) THEN
352           CALL READSYMTILE_RS(fName,17,angleCosC,bi,bj,buf,myThid)           CALL READSYMTILE_RS(fName,17,angleCosC,buf,bi,bj,myThid)
353           iL = ILNBLNK(msgBuf)           iL = ILNBLNK(msgBuf)
354           WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'AngleCS'           WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'AngleCS'
355           CALL READSYMTILE_RS(fName,18,angleSinC,bi,bj,buf,myThid)           CALL READSYMTILE_RS(fName,18,angleSinC,buf,bi,bj,myThid)
356           iL = ILNBLNK(tmpBuf)           iL = ILNBLNK(tmpBuf)
357           WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'AngleSN'           WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'AngleSN'
358             anglesAreSet = .TRUE.
359            ELSE
360             anglesAreSet = .FALSE.
361          ENDIF          ENDIF
362    
363          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
# Line 424  C--   Only do I/O if I am the master thr Line 366  C--   Only do I/O if I am the master thr
366         ENDDO         ENDDO
367        ENDDO        ENDDO
368    
369    #ifdef ALLOW_MNC
370          ENDIF
371    #endif /* ALLOW_MNC */
372    
373        _END_MASTER(myThid)        _END_MASTER(myThid)
374    
375        CALL EXCH_XY_RS(XC,myThid)        CALL EXCH_XY_RS(xC,myThid)
376        CALL EXCH_XY_RS(YC,myThid)        CALL EXCH_XY_RS(yC,myThid)
377  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned, myThid )        CALL EXCH_UV_AGRID_3D_RS( dxF, dyF, .FALSE., 1, myThid )
378  #ifdef HRCUBE        CALL EXCH_XY_RS(rA,myThid )
379        CALL EXCH_XY_RS(DXF,myThid)        CALL EXCH_Z_3D_RS( xG, 1, myThid )
380        CALL EXCH_XY_RS(DYF,myThid)        CALL EXCH_Z_3D_RS( yG, 1, myThid )
381  #endif  C !!! _EXCH_ZUV_XY_R4(dxV, dyU, unSigned, myThid)
382        CALL EXCH_XY_RS(RA,myThid )  c     CALL EXCH_Z_3D_RS( dxV, 1, myThid )
383        CALL EXCH_Z_XY_RS(XG,myThid)  c     CALL EXCH_Z_3D_RS( dyU, 1, myThid )
384        CALL EXCH_Z_XY_RS(YG,myThid)        CALL EXCH_Z_3D_RS( rAz, 1, myThid )
385  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)        CALL EXCH_UV_XY_RS(dxC,dyC,.FALSE.,myThid)
386  c     CALL EXCH_Z_XY_RS(DXV,myThid)        CALL EXCH_UV_XY_RS(rAw,rAs,.FALSE.,myThid)
387  c     CALL EXCH_Z_XY_RS(DYU,myThid)        CALL EXCH_UV_XY_RS(dyG,dxG,.FALSE.,myThid)
388        CALL EXCH_Z_XY_RS(RAZ,myThid)        CALL EXCH_UV_AGRID_3D_RS(angleSinC,angleCosC,.TRUE., 1, 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)  
389    
390  #endif /* OLD_GRID_IO */  #endif /* OLD_GRID_IO */
391    
392  #ifdef ALLOW_MNC  C--   Stop if Angle have not been loaded but are needed :
393          _BEGIN_MASTER(myThid)
394          IF ( .NOT.anglesAreSet .AND. use3dCoriolis ) THEN
395            WRITE(msgBuf,'(2A)')
396         &   'INI_CURVILINEAR_GRID: Angle of CurvilinearGrid not set',
397         &   ' but needed for 3-D Coriolis'
398            CALL PRINT_ERROR( msgBuf , myThid)
399            STOP 'ABNORMAL END: S/R INI_CURVILINEAR_GRID'
400        ENDIF        ENDIF
401  #endif /* ALLOW_MNC */        _END_MASTER(myThid)
402    
403  c     CALL WRITE_FULLARRAY_RL('DXV',DXV,1,0,0,0,myThid)  c     CALL WRITE_FULLARRAY_RL('dxV',dxV,1,0,0,0,myThid)
404  c     CALL WRITE_FULLARRAY_RL('DYU',DYU,1,0,0,0,myThid)  c     CALL WRITE_FULLARRAY_RL('dyU',dyU,1,0,0,0,myThid)
405  c     CALL WRITE_FULLARRAY_RL('RAZ',RAZ,1,0,0,0,myThid)  c     CALL WRITE_FULLARRAY_RL('rAz',rAz,1,0,0,0,myThid)
406  c     CALL WRITE_FULLARRAY_RL('XG',XG,1,0,0,0,myThid)  c     CALL WRITE_FULLARRAY_RL('xG',xG,1,0,0,0,myThid)
407  c     CALL WRITE_FULLARRAY_RL('YG',YG,1,0,0,0,myThid)  c     CALL WRITE_FULLARRAY_RL('yG',yG,1,0,0,0,myThid)
   
 C--   Require that 0 <= longitude < 360 if using exf package  
 #ifdef ALLOW_EXF  
       DO bj = 1,nSy  
        DO bi = 1,nSx  
         DO J=1-Oly,sNy+Oly  
          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 */  
408    
409  C--   Now let's look at all these beasts  C--   Now let's look at all these beasts
410        IF ( debugLevel .GE. debLevB ) THEN        IF ( debugLevel .GE. debLevB ) THEN
411           myIter = 1           myIter = 1
412           CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,           CALL PLOT_FIELD_XYRL( xC      , 'Current xC      ' ,
413       &        myIter, myThid )       &        myIter, myThid )
414           CALL PLOT_FIELD_XYRL( YC      , 'Current YC      ' ,           CALL PLOT_FIELD_XYRL( yC      , 'Current yC      ' ,
415       &        myIter, myThid )       &        myIter, myThid )
416           CALL PLOT_FIELD_XYRL( DXF     , 'Current DXF     ' ,           CALL PLOT_FIELD_XYRL( dxF     , 'Current dxF     ' ,
417       &        myIter, myThid )       &        myIter, myThid )
418           CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,           CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,
419       &        myIter, myThid )       &        myIter, myThid )
420           CALL PLOT_FIELD_XYRL( DYF     , 'Current DYF     ' ,           CALL PLOT_FIELD_XYRL( dyF     , 'Current dyF     ' ,
421       &        myIter, myThid )       &        myIter, myThid )
422           CALL PLOT_FIELD_XYRL( RA      , 'Current RA      ' ,           CALL PLOT_FIELD_XYRL( rA      , 'Current rA      ' ,
423       &        myIter, myThid )       &        myIter, myThid )
424           CALL PLOT_FIELD_XYRL( XG      , 'Current XG      ' ,           CALL PLOT_FIELD_XYRL( xG      , 'Current xG      ' ,
425       &        myIter, myThid )       &        myIter, myThid )
426           CALL PLOT_FIELD_XYRL( YG      , 'Current YG      ' ,           CALL PLOT_FIELD_XYRL( yG      , 'Current yG      ' ,
427       &        myIter, myThid )       &        myIter, myThid )
428           CALL PLOT_FIELD_XYRL( DXV     , 'Current DXV     ' ,           CALL PLOT_FIELD_XYRL( dxV     , 'Current dxV     ' ,
429       &        myIter, myThid )       &        myIter, myThid )
430           CALL PLOT_FIELD_XYRL( DYU     , 'Current DYU     ' ,           CALL PLOT_FIELD_XYRL( dyU     , 'Current dyU     ' ,
431       &        myIter, myThid )       &        myIter, myThid )
432           CALL PLOT_FIELD_XYRL( RAZ     , 'Current RAZ     ' ,           CALL PLOT_FIELD_XYRL( rAz     , 'Current rAz     ' ,
433       &        myIter, myThid )       &        myIter, myThid )
434           CALL PLOT_FIELD_XYRL( DXC     , 'Current DXC     ' ,           CALL PLOT_FIELD_XYRL( dxC     , 'Current dxC     ' ,
435       &        myIter, myThid )       &        myIter, myThid )
436           CALL PLOT_FIELD_XYRL( DYC     , 'Current DYC     ' ,           CALL PLOT_FIELD_XYRL( dyC     , 'Current dyC     ' ,
437       &        myIter, myThid )       &        myIter, myThid )
438           CALL PLOT_FIELD_XYRL( RAW     , 'Current RAW     ' ,           CALL PLOT_FIELD_XYRL( rAw     , 'Current rAw     ' ,
439       &        myIter, myThid )       &        myIter, myThid )
440           CALL PLOT_FIELD_XYRL( RAS     , 'Current RAS     ' ,           CALL PLOT_FIELD_XYRL( rAs     , 'Current rAs     ' ,
441       &        myIter, myThid )       &        myIter, myThid )
442           CALL PLOT_FIELD_XYRL( DXG     , 'Current DXG     ' ,           CALL PLOT_FIELD_XYRL( dxG     , 'Current dxG     ' ,
443       &        myIter, myThid )       &        myIter, myThid )
444           CALL PLOT_FIELD_XYRL( DYG     , 'Current DYG     ' ,           CALL PLOT_FIELD_XYRL( dyG     , 'Current dyG     ' ,
445       &        myIter, myThid )       &        myIter, myThid )
446           CALL PLOT_FIELD_XYRL(angleCosC, 'Current AngleCS ' ,           CALL PLOT_FIELD_XYRL(angleCosC, 'Current AngleCS ' ,
447       &        myIter, myThid )       &        myIter, myThid )
# Line 517  C--   Now let's look at all these beasts Line 452  C--   Now let's look at all these beasts
452        RETURN        RETURN
453        END        END
454    
455  C --------------------------------------------------------------------------  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
456    
457        SUBROUTINE READSYMTILE_RS(fName,irec,array,bi,bj,buf,myThid)  CBOP
458  C     /==========================================================\  C     !ROUTINE: READSYMTILE_RS
459  C     | SUBROUTINE READSYMTILE_RS                                |  C     !INTERFACE:
460  C     |==========================================================|        SUBROUTINE READSYMTILE_RS(
461  C     \==========================================================/       I                           fName, irec,
462        IMPLICIT NONE       U                           array, buf,
463         I                           bi,bj, myThid )
464    C     !DESCRIPTION: \bv
465    C     *==========================================================*
466    C     | SUBROUTINE READSYMTILE_RS
467    C     *==========================================================*
468    C     *==========================================================*
469    C     \ev
470    
471    C     !USES:
472          IMPLICIT NONE
473  C     === Global variables ===  C     === Global variables ===
474  #include "SIZE.h"  #include "SIZE.h"
475  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 534  C     === Global variables === Line 478  C     === Global variables ===
478  #include "W2_EXCH2_PARAMS.h"  #include "W2_EXCH2_PARAMS.h"
479  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
480    
481    C     !INPUT/OUTPUT PARAMETERS:
482  C     == Routine arguments ==  C     == Routine arguments ==
483        CHARACTER*(*) fName        CHARACTER*(*) fName
484        INTEGER irec        INTEGER irec
485        _RS array(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy)        _RS array(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy)
       INTEGER bi,bj,myThid  
486  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
487        _RL buf(1:sNx*nSx*nPx+1)        _RL buf(1:sNx*nSx*nPx+1)
488  #else  #else
489        _RL buf(1:sNx+1,1:sNy+1)        _RL buf(1:sNx+1,1:sNy+1)
490  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
491          INTEGER bi,bj, myThid
492    CEOP
493    
494    C     !LOCAL VARIABLES:
495  C     == Local variables ==  C     == Local variables ==
496        INTEGER I,J,dUnit, iLen        INTEGER I,J,dUnit, iLen
497        INTEGER length_of_rec        INTEGER length_of_rec
# Line 587  C     Figure out offset of tile within f Line 534  C     Figure out offset of tile within f
534         ENDDO         ENDDO
535        ENDDO        ENDDO
536        CLOSE( dUnit )        CLOSE( dUnit )
537          
538  #else /* ALLOW_EXCH2 */  #else /* ALLOW_EXCH2 */
539    
540        CALL MDSFINDUNIT( dUnit, myThid )        CALL MDSFINDUNIT( dUnit, myThid )
Legend:
Removed from v.1.21  
changed lines
  Added in v.1.31
  ViewVC Help
Powered by ViewVC 1.1.22