/[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.22 by edhill, Sat Sep 10 18:30:06 2005 UTC
# 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    #include "MNC_PARAMS.h"
36    #endif
37    
38  #ifndef ALLOW_EXCH2  #ifndef ALLOW_EXCH2
39  C- note: default is to use "new" grid files (OLD_GRID_IO undef) with EXCH2  C- note: default is to use "new" grid files (OLD_GRID_IO undef) with EXCH2
40  C    but can still use (on 1 cpu) OLD_GRID_IO and EXCH2 independently  C    but can still use (on 1 cpu) OLD_GRID_IO and EXCH2 independently
41    #ifdef ALLOW_MDSIO
42  #define OLD_GRID_IO  #define OLD_GRID_IO
43    #endif
44  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
45    
46  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
47  C     == Routine arguments ==  C     == Routine arguments ==
48  C     myThid -  Number of this instance of INI_CARTESIAN_GRID  C     myThid -  Number of this instance of INI_CURVILINEAR_GRID
49        INTEGER myThid        INTEGER myThid
50    
51  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
52  C     == Local variables ==  C     == Local variables ==
53        INTEGER bi,bj, myTile, myiter        INTEGER bi,bj, myIter
54        INTEGER I,J        INTEGER I,J
55        CHARACTER*(15) fName        CHARACTER*(MAX_LEN_FNAM) fName
56    #ifdef ALLOW_MNC
57          CHARACTER*(80) mncFn
58    #endif
59    #ifdef ALLOW_EXCH2
60          _RL buf(sNx*nSx*nPx+1)
61          INTEGER myTile
62    #else
63        _RL buf(sNx+1,sNy+1)        _RL buf(sNx+1,sNy+1)
64        INTEGER iG, iL  #endif
65        CHARACTER*(MAX_LEN_MBUF) msgBuf        INTEGER iG, iL, iLen
66          CHARACTER*(MAX_LEN_MBUF) msgBuf, tmpBuf
67        INTEGER  ILNBLNK        INTEGER  ILNBLNK
68        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
69  CEOP  CEOP
# Line 79  C--   Set everything to zero everywhere Line 92  C--   Set everything to zero everywhere
92            RAS(i,j,bi,bj)=0.            RAS(i,j,bi,bj)=0.
93            tanPhiAtU(i,j,bi,bj)=0.            tanPhiAtU(i,j,bi,bj)=0.
94            tanPhiAtV(i,j,bi,bj)=0.            tanPhiAtV(i,j,bi,bj)=0.
95              angleCosC(i,j,bi,bj)=1.
96              angleSinC(i,j,bi,bj)=0.
97            cosFacU(J,bi,bj)=1.            cosFacU(J,bi,bj)=1.
98            cosFacV(J,bi,bj)=1.            cosFacV(J,bi,bj)=1.
99            sqcosFacU(J,bi,bj)=1.            sqcosFacU(J,bi,bj)=1.
# Line 89  C--   Set everything to zero everywhere Line 104  C--   Set everything to zero everywhere
104         ENDDO         ENDDO
105        ENDDO        ENDDO
106    
107    
108    #ifdef ALLOW_MNC
109          IF (useMNC .AND. readgrid_mnc) THEN
110    
111            _BEGIN_MASTER(myThid)
112            DO i = 1,80
113              mncFn(i:i) = ' '
114            ENDDO
115            write(mncFn,'(a)') 'mitgrid'
116            DO i = 1,MAX_LEN_MBUF
117              msgBuf(i:i) = ' '
118            ENDDO
119            WRITE(msgBuf,'(2A)') msgBuf,' ; Reading grid info using MNC'
120            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
121         &       SQUEEZE_RIGHT , myThid)
122            CALL MNC_FILE_CLOSE_ALL_MATCHING(mncFn, myThid)
123            CALL MNC_CW_SET_UDIM(mncFn, 1, myThid)
124            CALL MNC_CW_SET_CITER(mncFn, 2, -1, -1, -1, myThid)
125            CALL MNC_CW_RS_R('R',mncFn,0,0,'XC', XC,  myThid)
126            CALL MNC_CW_RS_R('R',mncFn,0,0,'XG', XG,  myThid)
127            CALL MNC_CW_RS_R('R',mncFn,0,0,'YC', YC,  myThid)
128            CALL MNC_CW_RS_R('R',mncFn,0,0,'YG', YG,  myThid)
129            CALL MNC_CW_RS_R('R',mncFn,0,0,'dxC',DXC, myThid)
130            CALL MNC_CW_RS_R('R',mncFn,0,0,'dyC',DYC, myThid)
131            CALL MNC_CW_RS_R('R',mncFn,0,0,'dxF',DXF, myThid)
132            CALL MNC_CW_RS_R('R',mncFn,0,0,'dyF',DYF, myThid)
133            CALL MNC_CW_RS_R('R',mncFn,0,0,'dxG',DXG, myThid)
134            CALL MNC_CW_RS_R('R',mncFn,0,0,'dyG',DYG, myThid)
135            CALL MNC_CW_RS_R('R',mncFn,0,0,'dxV',DXV, myThid)
136            CALL MNC_CW_RS_R('R',mncFn,0,0,'dyU',DYU, myThid)
137            CALL MNC_CW_RS_R('R',mncFn,0,0,'rA', RA,  myThid)
138            CALL MNC_CW_RS_R('R',mncFn,0,0,'rAz',RAZ, myThid)
139            CALL MNC_CW_RS_R('R',mncFn,0,0,'rAw',RAW, myThid)
140            CALL MNC_CW_RS_R('R',mncFn,0,0,'rAs',RAS, myThid)
141    
142            _END_MASTER(myThid)
143    
144            CALL EXCH_XY_RS(XC,myThid)
145            CALL EXCH_XY_RS(YC,myThid)
146    #ifdef HRCUBE
147            CALL EXCH_XY_RS(DXF,myThid)
148            CALL EXCH_XY_RS(DYF,myThid)
149    #endif
150            CALL EXCH_XY_RS(RA,myThid )
151            CALL EXCH_Z_XY_RS(XG,myThid)
152            CALL EXCH_Z_XY_RS(YG,myThid)
153            CALL EXCH_Z_XY_RS(RAZ,myThid)
154            CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)
155            CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)
156            CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)
157            CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)
158    
159          ELSE
160    #endif
161    
162  C     Here we make no assumptions about grid symmetry and simply  C     Here we make no assumptions about grid symmetry and simply
163  C     read the raw grid data from files  C     read the raw grid data from files
164    
# Line 242  c        DXG(J,sNy+1,bi,bj)=DXG(J,1,bi,b Line 312  c        DXG(J,sNy+1,bi,bj)=DXG(J,1,bi,b
312  cs-   end block  cs-   end block
313        ENDIF        ENDIF
314        CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)
315          CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)
316    
317  c     write(10) XC  c     write(10) XC
318  c     write(10) YC  c     write(10) YC
# Line 268  C--   Only do I/O if I am the master thr Line 339  C--   Only do I/O if I am the master thr
339        DO bj = 1,nSy        DO bj = 1,nSy
340         DO bi = 1,nSx         DO bi = 1,nSx
341          iG=bi+(myXGlobalLo-1)/sNx          iG=bi+(myXGlobalLo-1)/sNx
342          WRITE(fName(1:15),'("tile",I3.3,".mitgrid")') iG          WRITE(tmpBuf,'(A,I4)') 'tile:',iG
         WRITE(msgBuf,'(A,I4)') 'tile:',iG  
343  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
344        myTile = W2_myTileList(bi)          myTile = W2_myTileList(bi)
345        write(fName(1:15),'("tile",I3.3,".mitgrid")')          WRITE(tmpBuf,'(A,I4)') 'tile:',myTile
346       &  exch2_myface(myTile)          iG = exch2_myface(myTile)
       WRITE(msgBuf,'(A,I4)') 'tile:',myTile  
347  #endif  #endif
348          iL = ILNBLNK(msgBuf)          iLen = ILNBLNK(horizGridFile)
349          WRITE(msgBuf,'(3A)') msgBuf(1:iL),          IF ( iLen .EQ. 0 ) THEN
350       &                   ' ; Read from file ',fName(1:15)            WRITE(fName,'("tile",I3.3,".mitgrid")') iG
351            ELSE
352              WRITE(fName,'(2A,I3.3,A)') horizGridFile(1:iLen),
353         &                              '.face',iG,'.bin'
354            ENDIF
355            iLen = ILNBLNK(fName)
356            iL = ILNBLNK(tmpBuf)
357            WRITE(msgBuf,'(3A)') tmpBuf(1:iL),
358         &                   ' ; Read from file ',fName(1:iLen)
359          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
360       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
361          WRITE(msgBuf,'(A)') '  =>'          WRITE(msgBuf,'(A)') '  =>'
362    
363          CALL READSYMTILE_RS(fName,1,XC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,1,XC,bi,bj,buf,myThid)
364          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
365          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'XC'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'XC'
366          CALL READSYMTILE_RS(fName,2,YC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,2,YC,bi,bj,buf,myThid)
367          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
368          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'YC'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'YC'
369          CALL READSYMTILE_RS(fName,3,DXF,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,3,DXF,bi,bj,buf,myThid)
370          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
371          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXF'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DXF'
372          CALL READSYMTILE_RS(fName,4,DYF,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,4,DYF,bi,bj,buf,myThid)
373          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
374          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYF'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DYF'
375          CALL READSYMTILE_RS(fName,5,RA,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,5,RA,bi,bj,buf,myThid)
376          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
377          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RA'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'RA'
378          CALL READSYMTILE_RS(fName,6,XG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,6,XG,bi,bj,buf,myThid)
379          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
380          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'XG'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'XG'
381          CALL READSYMTILE_RS(fName,7,YG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,7,YG,bi,bj,buf,myThid)
382          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
383          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'YG'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'YG'
384          CALL READSYMTILE_RS(fName,8,DXV,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,8,DXV,bi,bj,buf,myThid)
385          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
386          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXV'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DXV'
387          CALL READSYMTILE_RS(fName,9,DYU,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,9,DYU,bi,bj,buf,myThid)
388          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
389          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYU'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DYU'
390          CALL READSYMTILE_RS(fName,10,RAZ,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,10,RAZ,bi,bj,buf,myThid)
391          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
392          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RAZ'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'RAZ'
393          CALL READSYMTILE_RS(fName,11,DXC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,11,DXC,bi,bj,buf,myThid)
394          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
395          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXC'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DXC'
396          CALL READSYMTILE_RS(fName,12,DYC,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,12,DYC,bi,bj,buf,myThid)
397          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
398          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYC'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DYC'
399          CALL READSYMTILE_RS(fName,13,RAW,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,13,RAW,bi,bj,buf,myThid)
400          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
401          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RAW'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'RAW'
402          CALL READSYMTILE_RS(fName,14,RAS,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,14,RAS,bi,bj,buf,myThid)
403          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
404          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'RAS'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'RAS'
405          CALL READSYMTILE_RS(fName,15,DXG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,15,DXG,bi,bj,buf,myThid)
406          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(msgBuf)
407          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DXG'          WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'DXG'
408          CALL READSYMTILE_RS(fName,16,DYG,bi,bj,buf,myThid)          CALL READSYMTILE_RS(fName,16,DYG,bi,bj,buf,myThid)
409          iL = ILNBLNK(msgBuf)          iL = ILNBLNK(tmpBuf)
410          WRITE(msgBuf,'(A,1X,A)') msgBuf(1:iL),'DYG'          WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'DYG'
411    
412            iLen = ILNBLNK(horizGridFile)
413            IF ( iLen.GT.0 ) THEN
414             CALL READSYMTILE_RS(fName,17,angleCosC,bi,bj,buf,myThid)
415             iL = ILNBLNK(msgBuf)
416             WRITE(tmpBuf,'(A,1X,A)') msgBuf(1:iL),'AngleCS'
417             CALL READSYMTILE_RS(fName,18,angleSinC,bi,bj,buf,myThid)
418             iL = ILNBLNK(tmpBuf)
419             WRITE(msgBuf,'(A,1X,A)') tmpBuf(1:iL),'AngleSN'
420            ENDIF
421    
422          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
423       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
424    
425         ENDDO         ENDDO
426        ENDDO        ENDDO
427    
428        _END_MASTER(myThid)        _END_MASTER(myThid)
429    
430        CALL EXCH_XY_RS(XC,myThid)        CALL EXCH_XY_RS(XC,myThid)
# Line 347  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned Line 435  C !!! _EXCH_OUV_XY_R4(DXF, DYF, unSigned
435        CALL EXCH_XY_RS(DYF,myThid)        CALL EXCH_XY_RS(DYF,myThid)
436  #endif  #endif
437        CALL EXCH_XY_RS(RA,myThid )        CALL EXCH_XY_RS(RA,myThid )
 #ifndef ALLOW_EXCH2  
438        CALL EXCH_Z_XY_RS(XG,myThid)        CALL EXCH_Z_XY_RS(XG,myThid)
439        CALL EXCH_Z_XY_RS(YG,myThid)        CALL EXCH_Z_XY_RS(YG,myThid)
440  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)  C !!! _EXCH_ZUV_XY_R4(DXV, DYU, unSigned, myThid)
441  c     CALL EXCH_Z_XY_RS(DXV,myThid)  c     CALL EXCH_Z_XY_RS(DXV,myThid)
442  c     CALL EXCH_Z_XY_RS(DYU,myThid)  c     CALL EXCH_Z_XY_RS(DYU,myThid)
443        CALL EXCH_Z_XY_RS(RAZ,myThid)        CALL EXCH_Z_XY_RS(RAZ,myThid)
 #endif /* ALLOW_EXCH2 */  
444        CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(DXC,DYC,.FALSE.,myThid)
445        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(RAW,RAS,.FALSE.,myThid)
446        CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(DYG,DXG,.FALSE.,myThid)
447          CALL EXCH_UV_AGRID_XY_RS(angleSinC,angleCosC,.TRUE.,myThid)
448    
449  #endif /* OLD_GRID_IO */  #endif /* OLD_GRID_IO */
450    
451  c     CALL WRITE_FULLARRAY_RL('DXV',DXV,1,0,myThid)  #ifdef ALLOW_MNC
452  c     CALL WRITE_FULLARRAY_RL('DYU',DYU,1,0,myThid)        ENDIF
453  c     CALL WRITE_FULLARRAY_RL('RAZ',RAZ,1,0,myThid)  #endif /* ALLOW_MNC */
454  c     CALL WRITE_FULLARRAY_RL('XG',XG,1,0,myThid)  
455  c     CALL WRITE_FULLARRAY_RL('YG',YG,1,0,myThid)  c     CALL WRITE_FULLARRAY_RL('DXV',DXV,1,0,0,0,myThid)
456    c     CALL WRITE_FULLARRAY_RL('DYU',DYU,1,0,0,0,myThid)
457    c     CALL WRITE_FULLARRAY_RL('RAZ',RAZ,1,0,0,0,myThid)
458    c     CALL WRITE_FULLARRAY_RL('XG',XG,1,0,0,0,myThid)
459    c     CALL WRITE_FULLARRAY_RL('YG',YG,1,0,0,0,myThid)
460    
461    C--   Require that 0 <= longitude < 360 if using exf package
462    #ifdef ALLOW_EXF
463          DO bj = 1,nSy
464           DO bi = 1,nSx
465            DO J=1-Oly,sNy+Oly
466             DO I=1-Olx,sNx+Olx
467              IF (XC(i,j,bi,bj).lt.0.) XC(i,j,bi,bj)=XC(i,j,bi,bj)+360.
468              IF (XG(i,j,bi,bj).lt.0.) XG(i,j,bi,bj)=XG(i,j,bi,bj)+360.
469             ENDDO
470            ENDDO
471           ENDDO
472          ENDDO
473    #endif /* ALLOW_EXF */
474    
475  C--   Now let's look at all these beasts  C--   Now let's look at all these beasts
476        IF ( debugLevel .GE. debLevB ) THEN        IF ( debugLevel .GE. debLevB ) THEN
477           myiter = 1           myIter = 1
478           CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,           CALL PLOT_FIELD_XYRL( XC      , 'Current XC      ' ,
479       &        myIter, myThid )       &        myIter, myThid )
480           CALL PLOT_FIELD_XYRL( YC      , 'Current YC      ' ,           CALL PLOT_FIELD_XYRL( YC      , 'Current YC      ' ,
# Line 404  C--   Now let's look at all these beasts Line 509  C--   Now let's look at all these beasts
509       &        myIter, myThid )       &        myIter, myThid )
510           CALL PLOT_FIELD_XYRL( DYG     , 'Current DYG     ' ,           CALL PLOT_FIELD_XYRL( DYG     , 'Current DYG     ' ,
511       &        myIter, myThid )       &        myIter, myThid )
512             CALL PLOT_FIELD_XYRL(angleCosC, 'Current AngleCS ' ,
513         &        myIter, myThid )
514             CALL PLOT_FIELD_XYRL(angleSinC, 'Current AngleSN ' ,
515         &        myIter, myThid )
516        ENDIF        ENDIF
517    
518        RETURN        RETURN
# Line 438  C     == Routine arguments == Line 547  C     == Routine arguments ==
547  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
548    
549  C     == Local variables ==  C     == Local variables ==
550        INTEGER I,J,dUnit        INTEGER I,J,dUnit, iLen
551        INTEGER length_of_rec        INTEGER length_of_rec
552        INTEGER MDS_RECLEN        INTEGER MDS_RECLEN
553        INTEGER TN, DNX, DNY, TBX, TBY, TNX, TNY, II, iBase  #ifdef ALLOW_EXCH2
554          INTEGER TN, dNx, dNy, TBX, TBY, TNX, TNY, II, iBase
555    #endif
556          INTEGER  ILNBLNK
557          EXTERNAL ILNBLNK
558    
559          iLen = ILNBLNK(fName)
560  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
561  C     Figure out offset of tile within face  C     Figure out offset of tile within face
562        TN  = W2_myTileList(bi)        TN  = W2_myTileList(bi)
563        DNX = exch2_mydnx(TN)        dNx = exch2_mydnx(TN)
564        DNY = exch2_mydny(TN)        dNy = exch2_mydny(TN)
565        TBX = exch2_tbasex(TN)        TBX = exch2_tbasex(TN)
566        TBY = exch2_tbasey(TN)        TBY = exch2_tbasey(TN)
567        TNX = exch2_tnx(TN)        TNX = exch2_tnx(TN)
568        TNY = exch2_tny(TN)        TNY = exch2_tny(TN)
569    
570        CALL MDSFINDUNIT( dUnit, mythid )        CALL MDSFINDUNIT( dUnit, myThid )
571        length_of_rec=MDS_RECLEN( 64, (dNx+1), myThid )        length_of_rec=MDS_RECLEN( 64, (dNx+1), myThid )
572        OPEN( dUnit, file=fName, status='old',        OPEN( dUnit, file=fName(1:iLen), status='old',
573       &        access='direct', recl=length_of_rec )       &             access='direct', recl=length_of_rec )
574        J=0        J=0
575        iBase=(irec-1)*(dny+1)        iBase=(irec-1)*(dny+1)
576        DO I=1+TBY,SNY+1+TBY        DO I=1+TBY,sNy+1+TBY
577         READ(dUnit,rec=I+iBase)(buf(ii),ii=1,dnx+1)         READ(dUnit,rec=I+iBase)(buf(ii),ii=1,dNx+1)
578  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
579  #ifdef REAL4_IS_SLOW  #ifdef REAL4_IS_SLOW
580         CALL MDS_BYTESWAPR8((dNx+1), buf)         CALL MDS_BYTESWAPR8((dNx+1), buf)
# Line 477  C     Figure out offset of tile within f Line 591  C     Figure out offset of tile within f
591                
592  #else /* ALLOW_EXCH2 */  #else /* ALLOW_EXCH2 */
593    
594        CALL MDSFINDUNIT( dUnit, mythid )        CALL MDSFINDUNIT( dUnit, myThid )
595        length_of_rec=MDS_RECLEN( 64, (sNx+1)*(sNy+1), myThid )        length_of_rec=MDS_RECLEN( 64, (sNx+1)*(sNy+1), myThid )
596        OPEN( dUnit, file=fName, status='old',        OPEN( dUnit, file=fName(1:iLen), status='old',
597       &        access='direct', recl=length_of_rec )       &             access='direct', recl=length_of_rec )
598        READ(dUnit,rec=irec) buf        READ(dUnit,rec=irec) buf
599        CLOSE( dUnit )        CLOSE( dUnit )
600    
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.22
  ViewVC Help
Powered by ViewVC 1.1.22