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

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

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

Revision 1.33 - (show annotations) (download)
Fri Nov 12 03:16:16 2010 UTC (13 years, 5 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62v, checkpoint62u, checkpoint62t, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62o, checkpoint62w, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint63g, checkpoint64, checkpoint65, checkpoint63, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint65o, checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, HEAD
Changes since 1.32: +12 -7 lines 
- remove useConstantF, useBetaPlaneF, useSphereF and replace them
  with integer parameter "selectCoriMap" (=0,1,2).
- add parameter "fPrime" for constant second Coriolis coeff (default=0).
1 C $Header: /u/gcmpack/MITgcm/model/src/ini_cori.F,v 1.32 2010/04/19 15:10:05 jmc Exp $
2 C $Name: $
3
4 #include "PACKAGES_CONFIG.h"
5 #include "CPP_OPTIONS.h"
6
7 CBOP
8 C !ROUTINE: INI_CORI
9
10 C !INTERFACE:
11 SUBROUTINE INI_CORI( myThid )
12 C !DESCRIPTION:
13 C Initialise coriolis term.
14
15 C !USES:
16 IMPLICIT NONE
17 #include "SIZE.h"
18 #include "EEPARAMS.h"
19 #include "PARAMS.h"
20 #include "GRID.h"
21 #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 !INPUT/OUTPUT PARAMETERS:
33 C myThid :: my Thread Id number
34 INTEGER myThid
35 CEOP
36
37 C === Functions ====
38 LOGICAL MASTER_CPU_IO
39 EXTERNAL MASTER_CPU_IO
40
41 C !LOCAL VARIABLES:
42 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
48 #ifndef OLD_GRID_IO
49 INTEGER myTile, iG, iLen
50 CHARACTER*(MAX_LEN_FNAM) fName
51 CHARACTER*(MAX_LEN_MBUF) msgBuf
52 INTEGER ILNBLNK
53 EXTERNAL ILNBLNK
54 #endif
55
56
57 C Initialise coriolis parameter
58 IF ( selectCoriMap.EQ.0 ) THEN
59 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
70 ENDDO
71 ELSEIF ( selectCoriMap.EQ.1 ) THEN
72 C Beta plane case
73 facGrid = 1. _d 0
74 IF ( usingSphericalPolarGrid
75 & .OR. usingCurvilinearGrid ) facGrid = deg2rad*rSphere
76 DO bj = myByLo(myThid), myByHi(myThid)
77 DO bi = myBxLo(myThid), myBxHi(myThid)
78 DO j=1-Oly,sNy+Oly
79 DO i=1-Olx,sNx+Olx
80 fCori(i,j,bi,bj) = f0+beta*_yC(i,j,bi,bj)*facGrid
81 fCoriG(i,j,bi,bj) = f0+beta* yG(i,j,bi,bj)*facGrid
82 fCoriCos(i,j,bi,bj)=fPrime
83 ENDDO
84 ENDDO
85 ENDDO
86 ENDDO
87 ELSEIF ( selectCoriMap.EQ.2 ) THEN
88 C Spherical case
89 C Note in this case we assume yC is in degrees.
90 DO bj = myByLo(myThid), myByHi(myThid)
91 DO bi = myBxLo(myThid), myBxHi(myThid)
92 DO j=1-Oly,sNy+Oly
93 DO i=1-Olx,sNx+Olx
94 fCori(i,j,bi,bj) =
95 & 2. _d 0*omega*sin(_yC(i,j,bi,bj)*deg2rad)
96 fCoriG(i,j,bi,bj) =
97 & 2. _d 0*omega*sin(yG(i,j,bi,bj)*deg2rad)
98 fCoriCos(i,j,bi,bj)=
99 & 2. _d 0*omega*cos(_yC(i,j,bi,bj)*deg2rad)
100 ENDDO
101 ENDDO
102 ENDDO
103 ENDDO
104 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
108 C Initialise to zero
109 DO bj = myByLo(myThid), myByHi(myThid)
110 DO bi = myBxLo(myThid), myBxHi(myThid)
111 DO j=1-Oly,sNy+Oly
112 DO i=1-Olx,sNx+Olx
113 fCori(i,j,bi,bj) = 0. _d 0
114 fCoriG(i,j,bi,bj) = 0. _d 0
115 fCoriCos(i,j,bi,bj)=0. _d 0
116 ENDDO
117 ENDDO
118 ENDDO
119 ENDDO
120 ENDIF
121
122 IF ( selectCoriMap.EQ.3 ) THEN
123 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
222 END
  ViewVC Help
Powered by ViewVC 1.1.22