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

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

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

Revision 1.33 - (hide annotations) (download)
Fri Nov 12 03:16:16 2010 UTC (13 years, 6 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 jmc 1.33 C $Header: /u/gcmpack/MITgcm/model/src/ini_cori.F,v 1.32 2010/04/19 15:10:05 jmc Exp $
2 adcroft 1.10 C $Name: $
3 cnh 1.1
4 jmc 1.17 #include "PACKAGES_CONFIG.h"
5 cnh 1.6 #include "CPP_OPTIONS.h"
6 cnh 1.1
7 cnh 1.12 CBOP
8     C !ROUTINE: INI_CORI
9 edhill 1.18
10 cnh 1.12 C !INTERFACE:
11 cnh 1.1 SUBROUTINE INI_CORI( myThid )
12 edhill 1.18 C !DESCRIPTION:
13 jmc 1.23 C Initialise coriolis term.
14 cnh 1.12
15     C !USES:
16 adcroft 1.7 IMPLICIT NONE
17 cnh 1.1 #include "SIZE.h"
18     #include "EEPARAMS.h"
19     #include "PARAMS.h"
20 jmc 1.23 #include "GRID.h"
21 jmc 1.27 #ifdef ALLOW_EXCH2
22 jmc 1.28 # include "W2_EXCH2_SIZE.h"
23 jmc 1.27 # include "W2_EXCH2_TOPOLOGY.h"
24     #endif
25 edhill 1.20 #ifdef ALLOW_MNC
26 jmc 1.27 # include "MNC_PARAMS.h"
27 edhill 1.20 #endif
28 edhill 1.18 #ifdef ALLOW_MONITOR
29 jmc 1.27 # include "MONITOR.h"
30 edhill 1.18 #endif
31 cnh 1.1
32 cnh 1.12 C !INPUT/OUTPUT PARAMETERS:
33 jmc 1.33 C myThid :: my Thread Id number
34 cnh 1.1 INTEGER myThid
35 edhill 1.18 CEOP
36 cnh 1.1
37 jmc 1.26 C === Functions ====
38     LOGICAL MASTER_CPU_IO
39     EXTERNAL MASTER_CPU_IO
40    
41 cnh 1.12 C !LOCAL VARIABLES:
42 jmc 1.23 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 cnh 1.1 _RL facGrid
48 jmc 1.27 #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 cnh 1.1
57 edhill 1.18 C Initialise coriolis parameter
58 jmc 1.33 IF ( selectCoriMap.EQ.0 ) THEN
59 edhill 1.18 C Constant F case
60     DO bj = myByLo(myThid), myByHi(myThid)
61     DO bi = myBxLo(myThid), myBxHi(myThid)
62 jmc 1.23 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 jmc 1.33 fCoriCos(i,j,bi,bj)=fPrime
67 edhill 1.18 ENDDO
68 jmc 1.23 ENDDO
69 cnh 1.1 ENDDO
70     ENDDO
71 jmc 1.33 ELSEIF ( selectCoriMap.EQ.1 ) THEN
72 edhill 1.18 C Beta plane case
73     facGrid = 1. _d 0
74 jmc 1.23 IF ( usingSphericalPolarGrid
75     & .OR. usingCurvilinearGrid ) facGrid = deg2rad*rSphere
76 edhill 1.18 DO bj = myByLo(myThid), myByHi(myThid)
77     DO bi = myBxLo(myThid), myBxHi(myThid)
78 jmc 1.23 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 jmc 1.33 fCoriCos(i,j,bi,bj)=fPrime
83 edhill 1.18 ENDDO
84 jmc 1.23 ENDDO
85 cnh 1.3 ENDDO
86     ENDDO
87 jmc 1.33 ELSEIF ( selectCoriMap.EQ.2 ) THEN
88 edhill 1.18 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 jmc 1.23 DO j=1-Oly,sNy+Oly
93     DO i=1-Olx,sNx+Olx
94     fCori(i,j,bi,bj) =
95 edhill 1.18 & 2. _d 0*omega*sin(_yC(i,j,bi,bj)*deg2rad)
96 jmc 1.23 fCoriG(i,j,bi,bj) =
97 edhill 1.18 & 2. _d 0*omega*sin(yG(i,j,bi,bj)*deg2rad)
98 jmc 1.23 fCoriCos(i,j,bi,bj)=
99 edhill 1.18 & 2. _d 0*omega*cos(_yC(i,j,bi,bj)*deg2rad)
100     ENDDO
101 jmc 1.23 ENDDO
102 cnh 1.3 ENDDO
103     ENDDO
104 jmc 1.21 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 cnh 1.3 ELSE
108 jmc 1.33 C Initialise to zero
109 edhill 1.18 DO bj = myByLo(myThid), myByHi(myThid)
110     DO bi = myBxLo(myThid), myBxHi(myThid)
111 jmc 1.23 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 edhill 1.18 ENDDO
117 jmc 1.23 ENDDO
118 cnh 1.3 ENDDO
119     ENDDO
120 jmc 1.33 ENDIF
121    
122     IF ( selectCoriMap.EQ.3 ) THEN
123     C Special custom form: read from files
124 jmc 1.21 CALL READ_REC_XY_RS( 'fCoriC.bin', fCori, 1, 0, myThid )
125     CALL READ_REC_XY_RS( 'fCorCs.bin', fCoriCos,1, 0, myThid )
126 jmc 1.27 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 jmc 1.21 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 jmc 1.27 #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 jmc 1.30 myTile = W2_myTileList(bi,bj)
158 jmc 1.27 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 jmc 1.21 ENDIF
180    
181 jmc 1.24 CALL EXCH_XY_RS( fCori, myThid )
182     CALL EXCH_XY_RS( fCoriCos, myThid )
183     CALL EXCH_Z_3D_RS( fCoriG, 1, myThid )
184 cnh 1.3 ENDIF
185 adcroft 1.11
186 edhill 1.16 #ifdef ALLOW_MONITOR
187 jmc 1.26 IF ( MASTER_CPU_IO(myThid) ) THEN
188 jmc 1.23 C-- only the master thread is allowed to switch On/Off mon_write_stdout
189 jmc 1.31 C & mon_write_mnc (since it is the only thread that uses those flags):
190 jmc 1.23
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 edhill 1.18 #ifdef ALLOW_MNC
198 jmc 1.23 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 edhill 1.18 ENDIF
209 jmc 1.23
210 jmc 1.32 CALL MON_SET_PREF( mon_string_none, myThid )
211 adcroft 1.11 CALL MON_PRINTSTATS_RS(1,fCori,'fCori',myThid)
212     CALL MON_PRINTSTATS_RS(1,fCoriG,'fCoriG',myThid)
213 adcroft 1.15 CALL MON_PRINTSTATS_RS(1,fCoriCos,'fCoriCos',myThid)
214 edhill 1.18
215 jmc 1.26 IF ( MASTER_CPU_IO(myThid) ) THEN
216 jmc 1.23 mon_write_stdout = .FALSE.
217     mon_write_mnc = .FALSE.
218     ENDIF
219     #endif /* ALLOW_MONITOR */
220 cnh 1.1
221     RETURN
222     END
  ViewVC Help
Powered by ViewVC 1.1.22