/[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.9.2.2 by adcroft, Mon Apr 9 19:13:42 2001 UTC revision 1.33 by jmc, Fri Nov 12 03:16:16 2010 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4    #include "PACKAGES_CONFIG.h"
5  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
6    
7  CStartOfInterface  CBOP
8    C     !ROUTINE: INI_CORI
9    
10    C     !INTERFACE:
11        SUBROUTINE INI_CORI( myThid )        SUBROUTINE INI_CORI( myThid )
12  C     /==========================================================\  C     !DESCRIPTION:
13  C     | SUBROUTINE INI_CORI                                      |  C     Initialise coriolis term.
 C     | o Initialise coriolis term.                              |  
 C     \==========================================================/  
       IMPLICIT NONE  
14    
15  C     === Global variables ===  C     !USES:
16          IMPLICIT NONE
17  #include "SIZE.h"  #include "SIZE.h"
18  #include "EEPARAMS.h"  #include "EEPARAMS.h"
19  #include "PARAMS.h"  #include "PARAMS.h"
20  #include "GRID.h"  #include "GRID.h"
21  #include "DYNVARS.h"  #ifdef ALLOW_EXCH2
22    # include "W2_EXCH2_SIZE.h"
23    # include "W2_EXCH2_TOPOLOGY.h"
24    #endif
25    #ifdef ALLOW_MNC
26    # include "MNC_PARAMS.h"
27    #endif
28    #ifdef ALLOW_MONITOR
29    # include "MONITOR.h"
30    #endif
31    
32  C     == Routine arguments ==  C     !INPUT/OUTPUT PARAMETERS:
33  C     myThid -  Number of this instance of INI_CORI  C     myThid  :: my Thread Id number
34        INTEGER myThid        INTEGER myThid
35  CEndOfInterface  CEOP
36    
37  C     == Local variables ==  C     === Functions ====
38  C     bi,bj  - Loop counters        LOGICAL  MASTER_CPU_IO
39  C     I,J,K        EXTERNAL MASTER_CPU_IO
40  C     facGrid - Factor for grid to meter conversion  
41        INTEGER bi, bj  C     !LOCAL VARIABLES:
42        INTEGER  I,  J, K  C     bi,bj   :: Tile Indices counters
43    C     i, j    :: Loop counters
44    C     facGrid :: Factor for grid to meter conversion
45          INTEGER bi,bj
46          INTEGER i, j
47        _RL facGrid        _RL facGrid
48    #ifndef OLD_GRID_IO
49  C--   Initialise coriolis parameter        INTEGER myTile, iG, iLen
50        IF     ( useConstantF ) THEN        CHARACTER*(MAX_LEN_FNAM) fName
51  C      o Constant F case        CHARACTER*(MAX_LEN_MBUF) msgBuf
52         DO bj = myByLo(myThid), myByHi(myThid)        INTEGER  ILNBLNK
53          DO bi = myBxLo(myThid), myBxHi(myThid)        EXTERNAL ILNBLNK
54           DO K=1,Nr  #endif
55            DO J=1-Oly,sNy+Oly  
56             DO I=1-Olx,sNx+Olx  
57              fCori(i,j,bi,bj)=f0  C     Initialise coriolis parameter
58              fCoriG(i,j,bi,bj)=f0        IF     ( selectCoriMap.EQ.0 ) THEN
59             ENDDO  C       Constant F case
60            DO bj = myByLo(myThid), myByHi(myThid)
61              DO bi = myBxLo(myThid), myBxHi(myThid)
62                DO j=1-Oly,sNy+Oly
63                  DO i=1-Olx,sNx+Olx
64                    fCori(i,j,bi,bj)  = f0
65                    fCoriG(i,j,bi,bj) = f0
66                    fCoriCos(i,j,bi,bj)=fPrime
67                  ENDDO
68                ENDDO
69            ENDDO            ENDDO
          ENDDO  
70          ENDDO          ENDDO
71         ENDDO        ELSEIF ( selectCoriMap.EQ.1 ) THEN
72        ELSEIF ( useBetaPlaneF ) THEN  C       Beta plane case
73  C      o Beta plane case          facGrid = 1. _d 0
74         facGrid = 1. _d 0          IF ( usingSphericalPolarGrid
75         IF ( usingSphericalPolarGrid ) facGrid = deg2rad*rSphere       &     .OR. usingCurvilinearGrid ) facGrid = deg2rad*rSphere
76         DO bj = myByLo(myThid), myByHi(myThid)          DO bj = myByLo(myThid), myByHi(myThid)
77          DO bi = myBxLo(myThid), myBxHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
78           DO K=1,Nr              DO j=1-Oly,sNy+Oly
79            DO J=1-Oly,sNy+Oly                DO i=1-Olx,sNx+Olx
80             DO I=1-Olx,sNx+Olx                  fCori(i,j,bi,bj)  = f0+beta*_yC(i,j,bi,bj)*facGrid
81              fCori(i,j,bi,bj)=f0+beta*_yC(i,j,bi,bj)*facGrid                  fCoriG(i,j,bi,bj) = f0+beta* yG(i,j,bi,bj)*facGrid
82              fCoriG(i,j,bi,bj)=f0+beta*yG(i,j,bi,bj)*facGrid                  fCoriCos(i,j,bi,bj)=fPrime
83             ENDDO                ENDDO
84                ENDDO
85            ENDDO            ENDDO
          ENDDO  
86          ENDDO          ENDDO
87         ENDDO        ELSEIF ( selectCoriMap.EQ.2 ) THEN
88        ELSEIF ( useSphereF ) THEN  C       Spherical case
89  C      o Spherical case  C       Note in this case we assume yC is in degrees.
90  C        Note in this case we assume yC is in degrees.          DO bj = myByLo(myThid), myByHi(myThid)
91         DO bj = myByLo(myThid), myByHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
92          DO bi = myBxLo(myThid), myBxHi(myThid)              DO j=1-Oly,sNy+Oly
93           DO K=1,Nr                DO i=1-Olx,sNx+Olx
94            DO J=1-Oly,sNy+Oly                  fCori(i,j,bi,bj)  =
95             DO I=1-Olx,sNx+Olx       &                 2. _d 0*omega*sin(_yC(i,j,bi,bj)*deg2rad)
96              fCori(i,j,bi,bj)=                  fCoriG(i,j,bi,bj) =
97       &       2. _d 0*omega*sin(_yC(i,j,bi,bj)*deg2rad)       &                 2. _d 0*omega*sin(yG(i,j,bi,bj)*deg2rad)
98              fCoriG(i,j,bi,bj)=                  fCoriCos(i,j,bi,bj)=
99       &       2. _d 0*omega*sin(yG(i,j,bi,bj)*deg2rad)       &                 2. _d 0*omega*cos(_yC(i,j,bi,bj)*deg2rad)
100             ENDDO                ENDDO
101                ENDDO
102            ENDDO            ENDDO
          ENDDO  
103          ENDDO          ENDDO
104         ENDDO  c       CALL WRITE_FLD_XY_RL('fCoriC',' ',fCori ,  0,myThid)
105    c       CALL WRITE_FLD_XY_RL('fCoriG',' ',fCoriG , 0,myThid)
106    c       CALL WRITE_FLD_XY_RL('fCorCs',' ',fCoriCos,0,myThid)
107        ELSE        ELSE
108  C      o Special custom form  C       Initialise to zero
109         DO bj = myByLo(myThid), myByHi(myThid)          DO bj = myByLo(myThid), myByHi(myThid)
110          DO bi = myBxLo(myThid), myBxHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
111           DO K=1,Nr              DO j=1-Oly,sNy+Oly
112            DO J=1-Oly,sNy+Oly                DO i=1-Olx,sNx+Olx
113             DO I=1-Olx,sNx+Olx                  fCori(i,j,bi,bj)  = 0. _d 0
114              fCori(i,j,bi,bj)=0.                  fCoriG(i,j,bi,bj) = 0. _d 0
115              fCoriG(i,j,bi,bj)=0.                  fCoriCos(i,j,bi,bj)=0. _d 0
116             ENDDO                ENDDO
117                ENDDO
118            ENDDO            ENDDO
          ENDDO  
119          ENDDO          ENDDO
        ENDDO  
120        ENDIF        ENDIF
121  C  
122  c     _EXCH_XY_R4(fCori,myThid)        IF ( selectCoriMap.EQ.3 ) THEN
123  c     CALL EXCH_Z_XY_RS(fCoriG,myThid)  C     Special custom form: read from files
124            CALL READ_REC_XY_RS( 'fCoriC.bin', fCori,   1, 0, myThid )
125            CALL READ_REC_XY_RS( 'fCorCs.bin', fCoriCos,1, 0, myThid )
126            IF ( .NOT.useCubedSphereExchange ) THEN
127             CALL READ_REC_XY_RS('fCoriG.bin', fCoriG,  1, 0, myThid )
128            ELSE
129    #ifdef OLD_GRID_IO
130             CALL READ_REC_XY_RS('fCoriG.bin', fCoriG,  1, 0, myThid )
131    C-       deal with the 2 missing corners (for fCoriG):
132             DO bj = myByLo(myThid), myByHi(myThid)
133              DO bi = myBxLo(myThid), myBxHi(myThid)
134    C-  Notes: this will only works with 6 tiles (1 per face) and
135    C    with 2 polar faces + 4 equatorials:
136               IF (bi.LE.3 .OR. bi.GE.5) THEN
137                 fCoriG(sNx+1,1,bi,bj) = fCoriG(1,1,bi,bj)
138               ELSE
139                 fCoriG(sNx+1,1,bi,bj) = -fCoriG(1,1,bi,bj)
140               ENDIF
141               IF (bi.GE.3) THEN
142                 fCoriG(1,sNy+1,bi,bj) = fCoriG(1,1,bi,bj)
143                 fCoriG(sNx+1,sNy+1,bi,bj) = fCoriG(sNx+1,1,bi,bj)
144               ELSE
145                 fCoriG(1,sNy+1,bi,bj) = -fCoriG(1,1,bi,bj)
146                 fCoriG(sNx+1,sNy+1,bi,bj) = -fCoriG(sNx+1,1,bi,bj)
147               ENDIF
148              ENDDO
149             ENDDO
150    #else  /* OLD_GRID_IO */
151             _BEGIN_MASTER(myThid)
152             DO bj = 1,nSy
153              DO bi = 1,nSx
154               iG = bi+(myXGlobalLo-1)/sNx
155               myTile = iG
156    #ifdef ALLOW_EXCH2
157               myTile = W2_myTileList(bi,bj)
158               iG = exch2_myface(myTile)
159    #endif
160               WRITE(fName,'(2A,I3.3,A)') 'fCoriG','.face',iG,'.bin'
161               iLen = ILNBLNK(fName)
162               WRITE(msgBuf,'(A,I6,2A)')
163         &       ' Reading tile:', myTile, ' from file ', fName(1:iLen)
164               CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
165         &                         SQUEEZE_RIGHT , myThid )
166    #ifdef ALLOW_MDSIO
167               CALL MDS_FACEF_READ_RS( fName, readBinaryPrec, 1,
168         &                             fCoriG, bi, bj, myThid )
169    #else /* ALLOW_MDSIO */
170               WRITE(msgBuf,'(A)') 'INI_CORI: Needs to compile MDSIO pkg'
171               CALL PRINT_ERROR( msgBuf, myThid )
172               STOP 'ABNORMAL END: S/R INI_CORI'
173    #endif /* ALLOW_MDSIO */
174    
175              ENDDO
176             ENDDO
177             _END_MASTER(myThid)
178    #endif /* OLD_GRID_IO */
179            ENDIF
180    
181            CALL EXCH_XY_RS( fCori, myThid )
182            CALL EXCH_XY_RS( fCoriCos, myThid )
183            CALL EXCH_Z_3D_RS( fCoriG, 1, myThid )
184          ENDIF
185    
186    #ifdef ALLOW_MONITOR
187          IF ( MASTER_CPU_IO(myThid) ) THEN
188    C--   only the master thread is allowed to switch On/Off mon_write_stdout
189    C     & mon_write_mnc (since it is the only thread that uses those flags):
190    
191            IF (monitor_stdio) THEN
192              mon_write_stdout = .TRUE.
193            ELSE
194              mon_write_stdout = .FALSE.
195            ENDIF
196            mon_write_mnc = .FALSE.
197    #ifdef ALLOW_MNC
198            IF (useMNC .AND. monitor_mnc) THEN
199              DO i = 1,MAX_LEN_MBUF
200                mon_fname(i:i) = ' '
201              ENDDO
202              mon_fname(1:12) = 'monitor_grid'
203              CALL MNC_CW_SET_UDIM(mon_fname, 1, myThid)
204              mon_write_mnc = .TRUE.
205            ENDIF
206    #endif /*  ALLOW_MNC  */
207    
208          ENDIF
209    
210          CALL MON_SET_PREF( mon_string_none, myThid )
211          CALL MON_PRINTSTATS_RS(1,fCori,'fCori',myThid)
212          CALL MON_PRINTSTATS_RS(1,fCoriG,'fCoriG',myThid)
213          CALL MON_PRINTSTATS_RS(1,fCoriCos,'fCoriCos',myThid)
214    
215          IF ( MASTER_CPU_IO(myThid) ) THEN
216            mon_write_stdout = .FALSE.
217            mon_write_mnc    = .FALSE.
218          ENDIF
219    #endif /* ALLOW_MONITOR */
220    
221        RETURN        RETURN
222        END        END
Legend:
Removed from v.1.9.2.2  
changed lines
  Added in v.1.33
  ViewVC Help
Powered by ViewVC 1.1.22