/[MITgcm]/MITgcm/model/src/ini_cori.F
ViewVC logotype

Diff of /MITgcm/model/src/ini_cori.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.26 by jmc, Tue Oct 17 18:20:18 2006 UTC revision 1.27 by jmc, Wed May 28 03:06:57 2008 UTC
# Line 18  C     !USES: Line 18  C     !USES:
18  #include "EEPARAMS.h"  #include "EEPARAMS.h"
19  #include "PARAMS.h"  #include "PARAMS.h"
20  #include "GRID.h"  #include "GRID.h"
21    #ifdef ALLOW_EXCH2
22    # include "W2_EXCH2_TOPOLOGY.h"
23    # include "W2_EXCH2_PARAMS.h"
24    #endif
25  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
26  #include "MNC_PARAMS.h"  # include "MNC_PARAMS.h"
27  #endif  #endif
28  #ifdef ALLOW_MONITOR  #ifdef ALLOW_MONITOR
29  #include "MONITOR.h"  # include "MONITOR.h"
30  #endif  #endif
31    
32  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
# Line 40  C     facGrid :: Factor for grid to mete Line 44  C     facGrid :: Factor for grid to mete
44        INTEGER bi,bj        INTEGER bi,bj
45        INTEGER i, j        INTEGER i, j
46        _RL facGrid        _RL facGrid
47    #ifndef OLD_GRID_IO
48          INTEGER myTile, iG, iLen
49          CHARACTER*(MAX_LEN_FNAM) fName
50          CHARACTER*(MAX_LEN_MBUF) msgBuf
51          INTEGER  ILNBLNK
52          EXTERNAL ILNBLNK
53    #endif
54    
55    
56  C     Initialise coriolis parameter  C     Initialise coriolis parameter
57        IF     ( useConstantF ) THEN        IF     ( useConstantF ) THEN
# Line 106  C       Special custom form Line 118  C       Special custom form
118          ENDDO          ENDDO
119          _BARRIER          _BARRIER
120          CALL READ_REC_XY_RS( 'fCoriC.bin', fCori,   1, 0, myThid )          CALL READ_REC_XY_RS( 'fCoriC.bin', fCori,   1, 0, myThid )
         CALL READ_REC_XY_RS( 'fCoriG.bin', fCoriG,  1, 0, myThid )  
121          CALL READ_REC_XY_RS( 'fCorCs.bin', fCoriCos,1, 0, myThid )          CALL READ_REC_XY_RS( 'fCorCs.bin', fCoriCos,1, 0, myThid )
122          IF ( useCubedSphereExchange ) THEN          IF ( .NOT.useCubedSphereExchange ) THEN
123             CALL READ_REC_XY_RS('fCoriG.bin', fCoriG,  1, 0, myThid )
124            ELSE
125    #ifdef OLD_GRID_IO
126             CALL READ_REC_XY_RS('fCoriG.bin', fCoriG,  1, 0, myThid )
127           _BARRIER           _BARRIER
128  C-       deal with the 2 missing corners (for fCoriG):  C-       deal with the 2 missing corners (for fCoriG):
129           DO bj = myByLo(myThid), myByHi(myThid)           DO bj = myByLo(myThid), myByHi(myThid)
# Line 129  C    with 2 polar faces + 4 equatorials: Line 144  C    with 2 polar faces + 4 equatorials:
144             ENDIF             ENDIF
145            ENDDO            ENDDO
146           ENDDO           ENDDO
147    #else  /* OLD_GRID_IO */
148             _BEGIN_MASTER(myThid)
149             DO bj = 1,nSy
150              DO bi = 1,nSx
151               iG = bi+(myXGlobalLo-1)/sNx
152               myTile = iG
153    #ifdef ALLOW_EXCH2
154               myTile = W2_myTileList(bi)
155               iG = exch2_myface(myTile)
156    #endif
157               WRITE(fName,'(2A,I3.3,A)') 'fCoriG','.face',iG,'.bin'
158               iLen = ILNBLNK(fName)
159               WRITE(msgBuf,'(A,I6,2A)')
160         &       ' Reading tile:', myTile, ' from file ', fName(1:iLen)
161               CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
162         &                         SQUEEZE_RIGHT , myThid )
163    #ifdef ALLOW_MDSIO
164               CALL MDS_FACEF_READ_RS( fName, readBinaryPrec, 1,
165         &                             fCoriG, bi, bj, myThid )
166    #else /* ALLOW_MDSIO */
167               WRITE(msgBuf,'(A)') 'INI_CORI: Needs to compile MDSIO pkg'
168               CALL PRINT_ERROR( msgBuf, myThid )
169               STOP 'ABNORMAL END: S/R INI_CORI'
170    #endif /* ALLOW_MDSIO */
171    
172              ENDDO
173             ENDDO
174             _END_MASTER(myThid)
175    #endif /* OLD_GRID_IO */
176          ENDIF          ENDIF
177    
178          CALL EXCH_XY_RS( fCori, myThid )          CALL EXCH_XY_RS( fCori, myThid )
Legend:
Removed from v.1.26  
changed lines
  Added in v.1.27
  ViewVC Help
Powered by ViewVC 1.1.22