/[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.26 - (hide annotations) (download)
Tue Oct 17 18:20:18 2006 UTC (17 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint59, checkpoint58y_post, checkpoint58t_post, checkpoint58w_post, checkpoint58q_post, mitgcm_mapl_00, checkpoint58r_post, checkpoint59q, checkpoint59p, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint58v_post, checkpoint58x_post, checkpoint59j, checkpoint58u_post, checkpoint58s_post
Changes since 1.25: +9 -23 lines
use function "MASTER_CPU_IO" to hide EESUPPORT.h from TAF.

1 jmc 1.26 C $Header: /u/gcmpack/MITgcm/model/src/ini_cori.F,v 1.25 2006/09/06 02:44:11 heimbach 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 edhill 1.20 #ifdef ALLOW_MNC
22     #include "MNC_PARAMS.h"
23     #endif
24 edhill 1.18 #ifdef ALLOW_MONITOR
25     #include "MONITOR.h"
26     #endif
27 cnh 1.1
28 cnh 1.12 C !INPUT/OUTPUT PARAMETERS:
29 cnh 1.1 INTEGER myThid
30 edhill 1.18 CEOP
31 cnh 1.1
32 jmc 1.26 C === Functions ====
33     LOGICAL MASTER_CPU_IO
34     EXTERNAL MASTER_CPU_IO
35    
36 cnh 1.12 C !LOCAL VARIABLES:
37 jmc 1.23 C bi,bj :: Tile Indices counters
38     C i, j :: Loop counters
39     C facGrid :: Factor for grid to meter conversion
40     INTEGER bi,bj
41     INTEGER i, j
42 cnh 1.1 _RL facGrid
43    
44 edhill 1.18 C Initialise coriolis parameter
45 cnh 1.3 IF ( useConstantF ) THEN
46 edhill 1.18 C Constant F case
47     DO bj = myByLo(myThid), myByHi(myThid)
48     DO bi = myBxLo(myThid), myBxHi(myThid)
49 jmc 1.23 DO j=1-Oly,sNy+Oly
50     DO i=1-Olx,sNx+Olx
51     fCori(i,j,bi,bj) = f0
52     fCoriG(i,j,bi,bj) = f0
53     fCoriCos(i,j,bi,bj)=0. _d 0
54 edhill 1.18 ENDDO
55 jmc 1.23 ENDDO
56 cnh 1.1 ENDDO
57     ENDDO
58 cnh 1.3 ELSEIF ( useBetaPlaneF ) THEN
59 edhill 1.18 C Beta plane case
60     facGrid = 1. _d 0
61 jmc 1.23 IF ( usingSphericalPolarGrid
62     & .OR. usingCurvilinearGrid ) facGrid = deg2rad*rSphere
63 edhill 1.18 DO bj = myByLo(myThid), myByHi(myThid)
64     DO bi = myBxLo(myThid), myBxHi(myThid)
65 jmc 1.23 DO j=1-Oly,sNy+Oly
66     DO i=1-Olx,sNx+Olx
67     fCori(i,j,bi,bj) = f0+beta*_yC(i,j,bi,bj)*facGrid
68     fCoriG(i,j,bi,bj) = f0+beta* yG(i,j,bi,bj)*facGrid
69     fCoriCos(i,j,bi,bj)=0. _d 0
70 edhill 1.18 ENDDO
71 jmc 1.23 ENDDO
72 cnh 1.3 ENDDO
73     ENDDO
74     ELSEIF ( useSphereF ) THEN
75 edhill 1.18 C Spherical case
76     C Note in this case we assume yC is in degrees.
77     DO bj = myByLo(myThid), myByHi(myThid)
78     DO bi = myBxLo(myThid), myBxHi(myThid)
79 jmc 1.23 DO j=1-Oly,sNy+Oly
80     DO i=1-Olx,sNx+Olx
81     fCori(i,j,bi,bj) =
82 edhill 1.18 & 2. _d 0*omega*sin(_yC(i,j,bi,bj)*deg2rad)
83 jmc 1.23 fCoriG(i,j,bi,bj) =
84 edhill 1.18 & 2. _d 0*omega*sin(yG(i,j,bi,bj)*deg2rad)
85 jmc 1.23 fCoriCos(i,j,bi,bj)=
86 edhill 1.18 & 2. _d 0*omega*cos(_yC(i,j,bi,bj)*deg2rad)
87     ENDDO
88 jmc 1.23 ENDDO
89 cnh 1.3 ENDDO
90     ENDDO
91 jmc 1.21 c CALL WRITE_FLD_XY_RL('fCoriC',' ',fCori , 0,myThid)
92     c CALL WRITE_FLD_XY_RL('fCoriG',' ',fCoriG , 0,myThid)
93     c CALL WRITE_FLD_XY_RL('fCorCs',' ',fCoriCos,0,myThid)
94 cnh 1.3 ELSE
95 edhill 1.18 C Special custom form
96     DO bj = myByLo(myThid), myByHi(myThid)
97     DO bi = myBxLo(myThid), myBxHi(myThid)
98 jmc 1.23 DO j=1-Oly,sNy+Oly
99     DO i=1-Olx,sNx+Olx
100     fCori(i,j,bi,bj) = 0. _d 0
101     fCoriG(i,j,bi,bj) = 0. _d 0
102     fCoriCos(i,j,bi,bj)=0. _d 0
103 edhill 1.18 ENDDO
104 jmc 1.23 ENDDO
105 cnh 1.3 ENDDO
106     ENDDO
107 jmc 1.26 _BARRIER
108 jmc 1.21 CALL READ_REC_XY_RS( 'fCoriC.bin', fCori, 1, 0, myThid )
109     CALL READ_REC_XY_RS( 'fCoriG.bin', fCoriG, 1, 0, myThid )
110     CALL READ_REC_XY_RS( 'fCorCs.bin', fCoriCos,1, 0, myThid )
111     IF ( useCubedSphereExchange ) THEN
112 jmc 1.26 _BARRIER
113 jmc 1.21 C- deal with the 2 missing corners (for fCoriG):
114     DO bj = myByLo(myThid), myByHi(myThid)
115     DO bi = myBxLo(myThid), myBxHi(myThid)
116     C- Notes: this will only works with 6 tiles (1 per face) and
117     C with 2 polar faces + 4 equatorials:
118     IF (bi.LE.3 .OR. bi.GE.5) THEN
119     fCoriG(sNx+1,1,bi,bj) = fCoriG(1,1,bi,bj)
120     ELSE
121     fCoriG(sNx+1,1,bi,bj) = -fCoriG(1,1,bi,bj)
122     ENDIF
123     IF (bi.GE.3) THEN
124     fCoriG(1,sNy+1,bi,bj) = fCoriG(1,1,bi,bj)
125     fCoriG(sNx+1,sNy+1,bi,bj) = fCoriG(sNx+1,1,bi,bj)
126     ELSE
127     fCoriG(1,sNy+1,bi,bj) = -fCoriG(1,1,bi,bj)
128     fCoriG(sNx+1,sNy+1,bi,bj) = -fCoriG(sNx+1,1,bi,bj)
129     ENDIF
130     ENDDO
131     ENDDO
132     ENDIF
133    
134 jmc 1.24 CALL EXCH_XY_RS( fCori, myThid )
135     CALL EXCH_XY_RS( fCoriCos, myThid )
136     CALL EXCH_Z_3D_RS( fCoriG, 1, myThid )
137 cnh 1.3 ENDIF
138 adcroft 1.11
139 edhill 1.16 #ifdef ALLOW_MONITOR
140 jmc 1.26 IF ( MASTER_CPU_IO(myThid) ) THEN
141 jmc 1.23 C-- only the master thread is allowed to switch On/Off mon_write_stdout
142     C & mon_write_mnc (since it's the only thread that uses those flags):
143    
144     IF (monitor_stdio) THEN
145     mon_write_stdout = .TRUE.
146     ELSE
147     mon_write_stdout = .FALSE.
148     ENDIF
149     mon_write_mnc = .FALSE.
150 edhill 1.18 #ifdef ALLOW_MNC
151 jmc 1.23 IF (useMNC .AND. monitor_mnc) THEN
152     DO i = 1,MAX_LEN_MBUF
153     mon_fname(i:i) = ' '
154     ENDDO
155     mon_fname(1:12) = 'monitor_grid'
156     CALL MNC_CW_SET_UDIM(mon_fname, 1, myThid)
157     mon_write_mnc = .TRUE.
158     ENDIF
159     #endif /* ALLOW_MNC */
160    
161 edhill 1.18 ENDIF
162 jmc 1.23
163 adcroft 1.11 CALL MON_PRINTSTATS_RS(1,fCori,'fCori',myThid)
164     CALL MON_PRINTSTATS_RS(1,fCoriG,'fCoriG',myThid)
165 adcroft 1.15 CALL MON_PRINTSTATS_RS(1,fCoriCos,'fCoriCos',myThid)
166 edhill 1.18
167 jmc 1.26 IF ( MASTER_CPU_IO(myThid) ) THEN
168 jmc 1.23 mon_write_stdout = .FALSE.
169     mon_write_mnc = .FALSE.
170     ENDIF
171     #endif /* ALLOW_MONITOR */
172 cnh 1.1
173     RETURN
174     END

  ViewVC Help
Powered by ViewVC 1.1.22