/[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.14 by dimitri, Fri Jun 25 02:49:49 2004 UTC revision 1.34 by dimitri, Tue Jan 9 23:27:43 2007 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 31  C     === Global variables === Line 31  C     === Global variables ===
31  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
32  #include "W2_EXCH2_PARAMS.h"  #include "W2_EXCH2_PARAMS.h"
33  #endif  #endif
34    #ifdef ALLOW_MNC
35  #ifndef ALLOW_EXCH2  #include "MNC_PARAMS.h"
36  C- note: default is to use "new" grid files (OLD_GRID_IO undef) with EXCH2  #endif
 C    but can still use (on 1 cpu) OLD_GRID_IO and EXCH2 independently  
 #define OLD_GRID_IO  
 #endif /* ALLOW_EXCH2 */  
37    
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_CARTESIAN_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     == Local variables ==  C     == Local variables ==
45        INTEGER bi,bj, myTile, myiter        INTEGER bi,bj
46        INTEGER I,J        INTEGER I,J
       CHARACTER*(15) fName  
       _RL buf(sNx+1,sNy+1)  
       INTEGER iG, iL  
47        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
48          LOGICAL anglesAreSet
49    #ifdef ALLOW_MNC
50          CHARACTER*(80) mncFn
51    #endif
52    #ifndef OLD_GRID_IO
53    # ifdef ALLOW_EXCH2
54          _RL buf(sNx*nSx*nPx+1)
55          INTEGER myTile
56    # else
57          _RL buf(sNx+1,sNy+1)
58    # endif
59          INTEGER iG, iL, iLen
60          CHARACTER*(MAX_LEN_FNAM) fName
61          CHARACTER*(MAX_LEN_MBUF) tmpBuf
62        INTEGER  ILNBLNK        INTEGER  ILNBLNK
63        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
64    #endif
65  CEOP  CEOP
66    
67  C--   Set everything to zero everywhere  C--   Set everything to zero everywhere
# Line 61  C--   Set everything to zero everywhere Line 70  C--   Set everything to zero everywhere
70    
71          DO J=1-Oly,sNy+Oly          DO J=1-Oly,sNy+Oly
72           DO I=1-Olx,sNx+Olx           DO I=1-Olx,sNx+Olx
73            XC(i,j,bi,bj)=0.            xC(i,j,bi,bj)=0.
74            YC(i,j,bi,bj)=0.            yC(i,j,bi,bj)=0.
75            XG(i,j,bi,bj)=0.            xG(i,j,bi,bj)=0.
76            YG(i,j,bi,bj)=0.            yG(i,j,bi,bj)=0.
77            DXC(i,j,bi,bj)=0.            dxC(i,j,bi,bj)=0.
78            DYC(i,j,bi,bj)=0.            dyC(i,j,bi,bj)=0.
79            DXG(i,j,bi,bj)=0.            dxG(i,j,bi,bj)=0.
80            DYG(i,j,bi,bj)=0.            dyG(i,j,bi,bj)=0.
81            DXF(i,j,bi,bj)=0.            dxF(i,j,bi,bj)=0.
82            DYF(i,j,bi,bj)=0.            dyF(i,j,bi,bj)=0.
83            DXV(i,j,bi,bj)=0.            dxV(i,j,bi,bj)=0.
84            DYU(i,j,bi,bj)=0.            dyU(i,j,bi,bj)=0.
85            RA(i,j,bi,bj)=0.            rA(i,j,bi,bj)=0.
86            RAZ(i,j,bi,bj)=0.            rAz(i,j,bi,bj)=0.
87            RAW(i,j,bi,bj)=0.            rAw(i,j,bi,bj)=0.
88            RAS(i,j,bi,bj)=0.            rAs(i,j,bi,bj)=0.
89            tanPhiAtU(i,j,bi,bj)=0.            tanPhiAtU(i,j,bi,bj)=0.
90            tanPhiAtV(i,j,bi,bj)=0.            tanPhiAtV(i,j,bi,bj)=0.
91              angleCosC(i,j,bi,bj)=1.
92              angleSinC(i,j,bi,bj)=0.
93            cosFacU(J,bi,bj)=1.            cosFacU(J,bi,bj)=1.
94            cosFacV(J,bi,bj)=1.            cosFacV(J,bi,bj)=1.
95            sqcosFacU(J,bi,bj)=1.            sqCosFacU(J,bi,bj)=1.
96            sqcosFacV(J,bi,bj)=1.            sqCosFacV(J,bi,bj)=1.
97           ENDDO           ENDDO
98          ENDDO          ENDDO
99    
100         ENDDO         ENDDO
101        ENDDO        ENDDO
102    
103    C--   Everyone must wait for the initialisation to be done
104          _BARRIER
105    
106  C     Here we make no assumptions about grid symmetry and simply  C     Here we make no assumptions about grid symmetry and simply
107  C     read the raw grid data from files  C     read the raw grid data from files
108    
109  #ifdef OLD_GRID_IO  #ifdef OLD_GRID_IO
110    
111  C-    Cell centered quantities  C-    Cell centered quantities
112        CALL MDSREADFIELD('LONC.bin',readBinaryPrec,'RS',1,XC,  1,myThid)        CALL MDSREADFIELD('LONC.bin',readBinaryPrec,'RS',1,xC,  1,myThid)
113        CALL MDSREADFIELD('LATC.bin',readBinaryPrec,'RS',1,YC,  1,myThid)        CALL MDSREADFIELD('LATC.bin',readBinaryPrec,'RS',1,yC,  1,myThid)
114        _EXCH_XY_R4(XC,myThid)        _EXCH_XY_R4(xC,myThid)
115        _EXCH_XY_R4(YC,myThid)        _EXCH_XY_R4(yC,myThid)
116    
117        CALL MDSREADFIELD('DXF.bin',readBinaryPrec,'RS',1,DXF,  1,myThid)        CALL MDSREADFIELD('DXF.bin',readBinaryPrec,'RS',1,dxF,  1,myThid)
118        CALL MDSREADFIELD('DYF.bin',readBinaryPrec,'RS',1,DYF,  1,myThid)        CALL MDSREADFIELD('DYF.bin',readBinaryPrec,'RS',1,dyF,  1,myThid)
119  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  
120    
121        CALL MDSREADFIELD('RA.bin',readBinaryPrec,'RS',1,RA,  1,myThid)        CALL MDSREADFIELD('RA.bin',readBinaryPrec,'RS',1,rA,  1,myThid)
122        _EXCH_XY_R4(RA,myThid )        _EXCH_XY_R4(rA,myThid )
123    
124  C-    Corner quantities  C-    Corner quantities
125  C       *********** this are not degbugged ************        CALL MDSREADFIELD('LONG.bin',readBinaryPrec,'RS',1,xG,  1,myThid)
126        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)  
127        IF (useCubedSphereExchange) THEN        IF (useCubedSphereExchange) THEN
128  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
129        bi=3        bi=3
130        bj=1        bj=1
131        YG(1,sNy+1,bj,1)=YG(1,1,bi,1)        yG(1,sNy+1,bj,1)=yG(1,1,bi,1)
132        bj=bj+2        bj=bj+2
133        YG(1,sNy+1,bj,1)=YG(1,1,bi,1)        yG(1,sNy+1,bj,1)=yG(1,1,bi,1)
134        bj=bj+2        bj=bj+2
135        YG(1,sNy+1,bj,1)=YG(1,1,bi,1)        yG(1,sNy+1,bj,1)=yG(1,1,bi,1)
136        bi=6        bi=6
137        bj=2        bj=2
138        YG(sNx+1,1,bj,1)=YG(1,1,bi,1)        yG(sNx+1,1,bj,1)=yG(1,1,bi,1)
139        bj=bj+2        bj=bj+2
140        YG(sNx+1,1,bj,1)=YG(1,1,bi,1)        yG(sNx+1,1,bj,1)=yG(1,1,bi,1)
141        bj=bj+2        bj=bj+2
142        YG(sNx+1,1,bj,1)=YG(1,1,bi,1)        yG(sNx+1,1,bj,1)=yG(1,1,bi,1)
143  cs-   end block  cs-   end block
144        ENDIF        ENDIF
145        CALL EXCH_Z_XY_RS(XG,myThid)        CALL EXCH_Z_3D_RS( xG, 1, myThid )
146        CALL EXCH_Z_XY_RS(YG,myThid)        CALL EXCH_Z_3D_RS( yG, 1, myThid )
147    
148        CALL MDSREADFIELD('DXV.bin',readBinaryPrec,'RS',1,DXV,  1,myThid)        CALL MDSREADFIELD('DXV.bin',readBinaryPrec,'RS',1,dxV,  1,myThid)
149        CALL MDSREADFIELD('DYU.bin',readBinaryPrec,'RS',1,DYU,  1,myThid)        CALL MDSREADFIELD('DYU.bin',readBinaryPrec,'RS',1,dyU,  1,myThid)
150  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
151  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)  C !!! _EXCH_ZUV_XY_R4(dxV, dyU, unSigned, myThid)
152  cs!   this is not correct <= need paired exchange for dxv,dyu  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 192  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)        CALL EXCH_UV_AGRID_3D_RS(angleSinC,angleCosC,.TRUE., 1, myThid)
208  c        RAS(J,sNy+1,bi,bj)=RAS(J,1,bi,bj)        anglesAreSet = .FALSE.
209          ENDDO  
210         ENDDO  c     write(10) xC
211        ENDDO  c     write(10) yC
212  cs-   end block  c     write(10) dxF
213        ENDIF  c     write(10) dyF
214        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)  c     write(10) rA
215    c     write(10) xG
216        CALL MDSREADFIELD('DXG.bin',readBinaryPrec,'RS',1,DXG,  1,myThid)  c     write(10) yG
217        CALL MDSREADFIELD('DYG.bin',readBinaryPrec,'RS',1,DYG,  1,myThid)  c     write(10) dxV
218        IF (useCubedSphereExchange) THEN  c     write(10) dyU
219  cs-   this block needed by cubed sphere until we write more useful I/O routines  c     write(10) rAz
220        DO bj = myByLo(myThid), myByHi(myThid)  c     write(10) dxC
221         DO bi = myBxLo(myThid), myBxHi(myThid)  c     write(10) dyC
222          DO J = 1,sNy  c     write(10) rAw
223  c        DYG(sNx+1,J,bi,bj)=DYG(1,J,bi,bj)  c     write(10) rAs
224  c        DXG(J,sNy+1,bi,bj)=DXG(J,1,bi,bj)  c     write(10) dxG
225          ENDDO  c     write(10) dyG
        ENDDO  
       ENDDO  
 cs-   end block  
       ENDIF  
       CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,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  
226    
227  #else /* ifndef OLD_GRID_IO */  #else /* ifndef OLD_GRID_IO */
228    
229  C--   Only do I/O if I am the master thread  C--   Only do I/O if I am the master thread
230        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
231    
232    #ifdef ALLOW_MNC
233          IF (useMNC .AND. readgrid_mnc) THEN
234    C--   read NetCDF files:
235    
236            DO i = 1,80
237              mncFn(i:i) = ' '
238            ENDDO
239            write(mncFn,'(a)') 'mitgrid'
240            DO i = 1,MAX_LEN_MBUF
241              msgBuf(i:i) = ' '
242            ENDDO
243            WRITE(msgBuf,'(2A)') msgBuf,' ; Reading grid info using MNC'
244            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
245         &       SQUEEZE_RIGHT , myThid)
246            CALL MNC_FILE_CLOSE_ALL_MATCHING(mncFn, myThid)
247            CALL MNC_CW_SET_UDIM(mncFn, 1, myThid)
248            CALL MNC_CW_SET_CITER(mncFn, 2, -1, -1, -1, myThid)
249            CALL MNC_CW_SET_UDIM(mncFn, 1, myThid)
250            CALL MNC_CW_RS_R('D',mncFn,0,0,'XC', xC,  myThid)
251            CALL MNC_CW_RS_R('D',mncFn,0,0,'XG', xG,  myThid)
252            CALL MNC_CW_RS_R('D',mncFn,0,0,'YC', yC,  myThid)
253            CALL MNC_CW_RS_R('D',mncFn,0,0,'YG', yG,  myThid)
254            CALL MNC_CW_RS_R('D',mncFn,0,0,'dxC',dxC, myThid)
255            CALL MNC_CW_RS_R('D',mncFn,0,0,'dyC',dyC, myThid)
256            CALL MNC_CW_RS_R('D',mncFn,0,0,'dxF',dxF, myThid)
257            CALL MNC_CW_RS_R('D',mncFn,0,0,'dyF',dyF, myThid)
258            CALL MNC_CW_RS_R('D',mncFn,0,0,'dxG',dxG, myThid)
259            CALL MNC_CW_RS_R('D',mncFn,0,0,'dyG',dyG, myThid)
260            CALL MNC_CW_RS_R('D',mncFn,0,0,'dxV',dxV, myThid)
261            CALL MNC_CW_RS_R('D',mncFn,0,0,'dyU',dyU, myThid)
262            CALL MNC_CW_RS_R('D',mncFn,0,0,'rA', rA,  myThid)
263            CALL MNC_CW_RS_R('D',mncFn,0,0,'rAz',rAz, myThid)
264            CALL MNC_CW_RS_R('D',mncFn,0,0,'rAw',rAw, myThid)
265            CALL MNC_CW_RS_R('D',mncFn,0,0,'rAs',rAs, myThid)
266            CALL MNC_CW_RS_R('D',mncFn,0,0,'AngleCS',angleCosC,myThid)
267            CALL MNC_CW_RS_R('D',mncFn,0,0,'AngleSN',angleSinC,myThid)
268            anglesAreSet = .TRUE.
269    
270          ELSE
271    C--   read Binary files:
272    #endif /* ALLOW_MNC */
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(fName(1:15),'("tile",I3.3,".mitgrid")') iG          WRITE(tmpBuf,'(A,I4)') 'tile:',iG
         WRITE(msgBuf,'(A,I4)') 'tile:',iG  
278  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
279        myTile = W2_myTileList(bi)          myTile = W2_myTileList(bi)
280        write(fName(1:15),'("tile",I3.3,".mitgrid")')          WRITE(tmpBuf,'(A,I4)') 'tile:',myTile
281       &  exch2_myface(myTile)          iG = exch2_myface(myTile)
       WRITE(msgBuf,'(A,I4)') 'tile:',myTile  
282  #endif  #endif
283          iL = ILNBLNK(msgBuf)          iLen = ILNBLNK(horizGridFile)
284          WRITE(msgBuf,'(3A)') msgBuf(1:iL),          IF ( iLen .EQ. 0 ) THEN
285       &                   ' ; Read from file ',fName(1:15)            WRITE(fName,'("tile",I3.3,".mitgrid")') iG
286            ELSE
287              WRITE(fName,'(2A,I3.3,A)') horizGridFile(1:iLen),
288         &                              '.face',iG,'.bin'
289            ENDIF
290            iLen = ILNBLNK(fName)
291            iL = ILNBLNK(tmpBuf)
292            WRITE(msgBuf,'(3A)') tmpBuf(1:iL),
293         &                   ' ; Read from file ',fName(1:iLen)
294          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
295       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
296          WRITE(msgBuf,'(A)') '  =>'          WRITE(msgBuf,'(A)') '  =>'
297    
298          CALL READSYMTILE_RS(fName,1,XC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,1,xC,buf,bi,bj,myThid)
         iL = ILNBLNK(msgBuf)  
         WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'XC'  
         CALL READSYMTILE_RS(fName,2,YC,bi,bj,buf,myThid)  
         iL = ILNBLNK(msgBuf)  
         WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'YC'  
         CALL READSYMTILE_RS(fName,3,DXF,bi,bj,buf,myThid)  
         iL = ILNBLNK(msgBuf)  
         WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXF'  
         CALL READSYMTILE_RS(fName,4,DYF,bi,bj,buf,myThid)  
         iL = ILNBLNK(msgBuf)  
         WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYF'  
         CALL READSYMTILE_RS(fName,5,RA,bi,bj,buf,myThid)  
         iL = ILNBLNK(msgBuf)  
         WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RA'  
         CALL READSYMTILE_RS(fName,6,XG,bi,bj,buf,myThid)  
         iL = ILNBLNK(msgBuf)  
         WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'XG'  
         CALL READSYMTILE_RS(fName,7,YG,bi,bj,buf,myThid)  
         iL = ILNBLNK(msgBuf)  
         WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'YG'  
         CALL READSYMTILE_RS(fName,8,DXV,bi,bj,buf,myThid)  
299          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
300          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXV'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'xC'
301          CALL READSYMTILE_RS(fName,9,DYU,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,2,yC,buf,bi,bj,myThid)
302          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
303          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYU'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'yC'
304          CALL READSYMTILE_RS(fName,10,RAZ,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,3,dxF,buf,bi,bj,myThid)
305          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
306          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RAZ'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dxF'
307          CALL READSYMTILE_RS(fName,11,DXC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,4,dyF,buf,bi,bj,myThid)
308          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
309          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXC'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dyF'
310          CALL READSYMTILE_RS(fName,12,DYC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,5,rA,buf,bi,bj,myThid)
311          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
312          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYC'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'rA'
313          CALL READSYMTILE_RS(fName,13,RAW,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,6,xG,buf,bi,bj,myThid)
314          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
315          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RAW'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'xG'
316          CALL READSYMTILE_RS(fName,14,RAS,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,7,yG,buf,bi,bj,myThid)
317          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
318          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RAS'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'yG'
319          CALL READSYMTILE_RS(fName,15,DXG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,8,dxV,buf,bi,bj,myThid)
320          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
321          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXG'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dxV'
322          CALL READSYMTILE_RS(fName,16,DYG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,9,dyU,buf,bi,bj,myThid)
323          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
324          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYG'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dyU'
325            CALL READSYMTILE_RS(fName,10,rAz,buf,bi,bj,myThid)
326            iL = ILNBLNK(tmpBuf)
327            WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'rAz'
328            CALL READSYMTILE_RS(fName,11,dxC,buf,bi,bj,myThid)
329            iL = ILNBLNK(msgBuf)
330            WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dxC'
331            CALL READSYMTILE_RS(fName,12,dyC,buf,bi,bj,myThid)
332            iL = ILNBLNK(tmpBuf)
333            WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dyC'
334            CALL READSYMTILE_RS(fName,13,rAw,buf,bi,bj,myThid)
335            iL = ILNBLNK(msgBuf)
336            WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'rAw'
337            CALL READSYMTILE_RS(fName,14,rAs,buf,bi,bj,myThid)
338            iL = ILNBLNK(tmpBuf)
339            WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'rAs'
340            CALL READSYMTILE_RS(fName,15,dxG,buf,bi,bj,myThid)
341            iL = ILNBLNK(msgBuf)
342            WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'dxG'
343            CALL READSYMTILE_RS(fName,16,dyG,buf,bi,bj,myThid)
344            iL = ILNBLNK(tmpBuf)
345            WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'dyG'
346    
347            iLen = ILNBLNK(horizGridFile)
348            IF ( iLen.GT.0 ) THEN
349             CALL READSYMTILE_RS(fName,17,angleCosC,buf,bi,bj,myThid)
350             iL = ILNBLNK(msgBuf)
351             WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'AngleCS'
352             CALL READSYMTILE_RS(fName,18,angleSinC,buf,bi,bj,myThid)
353             iL = ILNBLNK(tmpBuf)
354             WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'AngleSN'
355             anglesAreSet = .TRUE.
356            ELSE
357             anglesAreSet = .FALSE.
358            ENDIF
359    
360          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
361       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
362    
363         ENDDO         ENDDO
364        ENDDO        ENDDO
365    
366    #ifdef ALLOW_MNC
367          ENDIF
368    #endif /* ALLOW_MNC */
369    
370        _END_MASTER(myThid)        _END_MASTER(myThid)
371    
372        CALL EXCH_XY_RS(XC,myThid)        CALL EXCH_XY_RS(xC,myThid)
373        CALL EXCH_XY_RS(YC,myThid)        CALL EXCH_XY_RS(yC,myThid)
374  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned, myThid )        CALL EXCH_UV_AGRID_3D_RS( dxF, dyF, .FALSE., 1, myThid )
375  #ifdef HRCUBE        CALL EXCH_XY_RS(rA,myThid )
376        CALL EXCH_XY_RS(DXF,myThid)        CALL EXCH_Z_3D_RS( xG, 1, myThid )
377        CALL EXCH_XY_RS(DYF,myThid)        CALL EXCH_Z_3D_RS( yG, 1, myThid )
378  #endif  C !!! _EXCH_ZUV_XY_R4(dxV, dyU, unSigned, myThid)
379        CALL EXCH_XY_RS(RA,myThid )  c     CALL EXCH_Z_3D_RS( dxV, 1, myThid )
380  #ifndef ALLOW_EXCH2  c     CALL EXCH_Z_3D_RS( dyU, 1, myThid )
381        CALL EXCH_Z_XY_RS(XG,myThid)        CALL EXCH_Z_3D_RS( rAz, 1, myThid )
382        CALL EXCH_Z_XY_RS(YG,myThid)        CALL EXCH_UV_XY_RS(dxC,dyC,.FALSE.,myThid)
383  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)        CALL EXCH_UV_XY_RS(rAw,rAs,.FALSE.,myThid)
384  c     CALL EXCH_Z_XY_RS(DXV,myThid)        CALL EXCH_UV_XY_RS(dyG,dxG,.FALSE.,myThid)
385  c     CALL EXCH_Z_XY_RS(DYU,myThid)        CALL EXCH_UV_AGRID_3D_RS(angleSinC,angleCosC,.TRUE., 1, myThid)
       CALL EXCH_Z_XY_RS(RAZ,myThid)  
 #endif /* ALLOW_EXCH2 */  
       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)  
386    
387  #endif /* OLD_GRID_IO */  #endif /* OLD_GRID_IO */
388    
389  c     CALL WRITE_FULLARRAY_RL('DXV',DXV,1,0,myThid)  C--   Stop if Angle have not been loaded but are needed :
390  c     CALL WRITE_FULLARRAY_RL('DYU',DYU,1,0,myThid)        _BEGIN_MASTER(myThid)
391  c     CALL WRITE_FULLARRAY_RL('RAZ',RAZ,1,0,myThid)        IF ( .NOT.anglesAreSet .AND. use3dCoriolis ) THEN
392  c     CALL WRITE_FULLARRAY_RL('XG',XG,1,0,myThid)          WRITE(msgBuf,'(2A)')
393  c     CALL WRITE_FULLARRAY_RL('YG',YG,1,0,myThid)       &   'INI_CURVILINEAR_GRID: Angle of CurvilinearGrid not set',
394         &   ' but needed for 3-D Coriolis'
395            CALL PRINT_ERROR( msgBuf , myThid)
396            STOP 'ABNORMAL END: S/R INI_CURVILINEAR_GRID'
397          ENDIF
398          _END_MASTER(myThid)
399    
400    c     CALL WRITE_FULLARRAY_RL('dxV',dxV,1,0,0,0,myThid)
401    c     CALL WRITE_FULLARRAY_RL('dyU',dyU,1,0,0,0,myThid)
402    c     CALL WRITE_FULLARRAY_RL('rAz',rAz,1,0,0,0,myThid)
403    c     CALL WRITE_FULLARRAY_RL('xG',xG,1,0,0,0,myThid)
404    c     CALL WRITE_FULLARRAY_RL('yG',yG,1,0,0,0,myThid)
405    
406  C--   Now let's look at all these beasts  C--   Now let's look at all these beasts
407        IF ( debugLevel .GE. debLevB ) THEN        IF ( debugLevel .GE. debLevB ) THEN
408           myiter = 1          CALL PLOT_FIELD_XYRS( xC      , 'Current xC      ', 0, myThid )
409           CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,          CALL PLOT_FIELD_XYRS( yC      , 'Current yC      ', 0, myThid )
410       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( dxF     , 'Current dxF     ', 0, myThid )
411           CALL PLOT_FIELD_XYRL( YC      , 'Current YC      ' ,          CALL PLOT_FIELD_XYRS( dyF     , 'Current dyF     ', 0, myThid )
412       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( rA      , 'Current rA      ', 0, myThid )
413           CALL PLOT_FIELD_XYRL( DXF     , 'Current DXF     ' ,          CALL PLOT_FIELD_XYRS( xG      , 'Current xG      ', 0, myThid )
414       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( yG      , 'Current yG      ', 0, myThid )
415           CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,          CALL PLOT_FIELD_XYRS( dxV     , 'Current dxV     ', 0, myThid )
416       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( dyU     , 'Current dyU     ', 0, myThid )
417           CALL PLOT_FIELD_XYRL( DYF     , 'Current DYF     ' ,          CALL PLOT_FIELD_XYRS( rAz     , 'Current rAz     ', 0, myThid )
418       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( dxC     , 'Current dxC     ', 0, myThid )
419           CALL PLOT_FIELD_XYRL( RA      , 'Current RA      ' ,          CALL PLOT_FIELD_XYRS( dyC     , 'Current dyC     ', 0, myThid )
420       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( rAw     , 'Current rAw     ', 0, myThid )
421           CALL PLOT_FIELD_XYRL( XG      , 'Current XG      ' ,          CALL PLOT_FIELD_XYRS( rAs     , 'Current rAs     ', 0, myThid )
422       &        myIter, myThid )          CALL PLOT_FIELD_XYRS( dxG     , 'Current dxG     ', 0, myThid )
423           CALL PLOT_FIELD_XYRL( YG      , 'Current YG      ' ,          CALL PLOT_FIELD_XYRS( dyG     , 'Current dyG     ', 0, myThid )
424       &        myIter, myThid )          CALL PLOT_FIELD_XYRS(angleCosC, 'Current AngleCS ', 0, myThid )
425           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 )  
426        ENDIF        ENDIF
427    
428        RETURN        RETURN
429        END        END
430    
431  C --------------------------------------------------------------------------  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
432    
433        SUBROUTINE READSYMTILE_RS(fName,irec,array,bi,bj,buf,myThid)  CBOP
434  C     /==========================================================\  C     !ROUTINE: READSYMTILE_RS
435  C     | SUBROUTINE READSYMTILE_RS                                |  C     !INTERFACE:
436  C     |==========================================================|        SUBROUTINE READSYMTILE_RS(
437  C     \==========================================================/       I                           fName, irec,
438        IMPLICIT NONE       U                           array, buf,
439         I                           bi,bj, myThid )
440    C     !DESCRIPTION: \bv
441    C     *==========================================================*
442    C     | SUBROUTINE READSYMTILE_RS
443    C     *==========================================================*
444    C     *==========================================================*
445    C     \ev
446    
447    C     !USES:
448          IMPLICIT NONE
449  C     === Global variables ===  C     === Global variables ===
450  #include "SIZE.h"  #include "SIZE.h"
451  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 426  C     === Global variables === Line 454  C     === Global variables ===
454  #include "W2_EXCH2_PARAMS.h"  #include "W2_EXCH2_PARAMS.h"
455  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
456    
457    C     !INPUT/OUTPUT PARAMETERS:
458  C     == Routine arguments ==  C     == Routine arguments ==
459        CHARACTER*(*) fName        CHARACTER*(*) fName
460        INTEGER irec        INTEGER irec
461        _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  
462  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
463        _RL buf(1:sNx*nSx*nPx+1)        _RL buf(1:sNx*nSx*nPx+1)
464  #else  #else
465        _RL buf(1:sNx+1,1:sNy+1)        _RL buf(1:sNx+1,1:sNy+1)
466  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
467          INTEGER bi,bj, myThid
468    CEOP
469    
470    C     !LOCAL VARIABLES:
471  C     == Local variables ==  C     == Local variables ==
472        INTEGER I,J,dUnit        INTEGER I,J,dUnit, iLen
473        INTEGER length_of_rec        INTEGER length_of_rec
474        INTEGER MDS_RECLEN        INTEGER MDS_RECLEN
475        INTEGER TN, DNX, DNY, TBX, TBY, TNX, TNY, II, iBase  #ifdef ALLOW_EXCH2
476          INTEGER TN, dNx, dNy, TBX, TBY, TNX, TNY, II, iBase
477    #endif
478          INTEGER  ILNBLNK
479          EXTERNAL ILNBLNK
480    
481          iLen = ILNBLNK(fName)
482  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
483  C     Figure out offset of tile within face  C     Figure out offset of tile within face
484        TN  = W2_myTileList(bi)        TN  = W2_myTileList(bi)
485        DNX = exch2_mydnx(TN)        dNx = exch2_mydnx(TN)
486        DNY = exch2_mydny(TN)        dNy = exch2_mydny(TN)
487        TBX = exch2_tbasex(TN)        TBX = exch2_tbasex(TN)
488        TBY = exch2_tbasey(TN)        TBY = exch2_tbasey(TN)
489        TNX = exch2_tnx(TN)        TNX = exch2_tnx(TN)
490        TNY = exch2_tny(TN)        TNY = exch2_tny(TN)
491    
492        CALL MDSFINDUNIT( dUnit, mythid )        CALL MDSFINDUNIT( dUnit, myThid )
493        length_of_rec=MDS_RECLEN( 64, (dNx+1), myThid )        length_of_rec=MDS_RECLEN( 64, (dNx+1), myThid )
494        OPEN( dUnit, file=fName, status='old',        OPEN( dUnit, file=fName(1:iLen), status='old',
495       &        access='direct', recl=length_of_rec )       &             access='direct', recl=length_of_rec )
496        J=0        J=0
497        iBase=(irec-1)*(dny+1)        iBase=(irec-1)*(dny+1)
498        DO I=1+TBY,SNY+1+TBY        DO I=1+TBY,sNy+1+TBY
499         READ(dUnit,rec=I+iBase)(buf(ii),ii=1,dnx+1)         READ(dUnit,rec=I+iBase)(buf(ii),ii=1,dNx+1)
500  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
501  #ifdef REAL4_IS_SLOW  #ifdef REAL4_IS_SLOW
502         CALL MDS_BYTESWAPR8((dNx+1), buf)         CALL MDS_BYTESWAPR8((dNx+1), buf)
# Line 474  C     Figure out offset of tile within f Line 510  C     Figure out offset of tile within f
510         ENDDO         ENDDO
511        ENDDO        ENDDO
512        CLOSE( dUnit )        CLOSE( dUnit )
513          
514  #else /* ALLOW_EXCH2 */  #else /* ALLOW_EXCH2 */
515    
516        CALL MDSFINDUNIT( dUnit, mythid )        CALL MDSFINDUNIT( dUnit, myThid )
517        length_of_rec=MDS_RECLEN( 64, (sNx+1)*(sNy+1), myThid )        length_of_rec=MDS_RECLEN( 64, (sNx+1)*(sNy+1), myThid )
518        OPEN( dUnit, file=fName, status='old',        OPEN( dUnit, file=fName(1:iLen), status='old',
519       &        access='direct', recl=length_of_rec )       &             access='direct', recl=length_of_rec )
520        READ(dUnit,rec=irec) buf        READ(dUnit,rec=irec) buf
521        CLOSE( dUnit )        CLOSE( dUnit )
522    
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.34
  ViewVC Help
Powered by ViewVC 1.1.22