/[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.22 - (hide annotations) (download)
Fri Nov 4 01:19:24 2005 UTC (18 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint58b_post, checkpoint57y_post, checkpoint58, checkpoint58f_post, checkpoint58d_post, checkpoint58a_post, checkpoint57z_post, checkpoint57y_pre, checkpoint58e_post, checkpoint58k_post, checkpoint58l_post, checkpoint58g_post, checkpoint58h_post, checkpoint58j_post, checkpoint58i_post, checkpoint57x_post, checkpoint58c_post
Changes since 1.21: +2 -10 lines 
remove unused variables (reduces number of compiler warning)
1 jmc 1.22 C $Header: /u/gcmpack/MITgcm/model/src/ini_cori.F,v 1.21 2005/01/26 00:45:53 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     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 edhill 1.20 #ifdef ALLOW_MNC
21     #include "MNC_PARAMS.h"
22     #endif
23 cnh 1.1 #include "GRID.h"
24     #include "DYNVARS.h"
25 edhill 1.18 #ifdef ALLOW_MONITOR
26     #include "MONITOR.h"
27     #endif
28 cnh 1.1
29 cnh 1.12 C !INPUT/OUTPUT PARAMETERS:
30 cnh 1.1 INTEGER myThid
31 edhill 1.18 CEOP
32 cnh 1.1
33 cnh 1.12 C !LOCAL VARIABLES:
34 cnh 1.1 C bi,bj - Loop counters
35     C I,J,K
36     C facGrid - Factor for grid to meter conversion
37     INTEGER bi, bj
38 jmc 1.22 INTEGER I, J
39 cnh 1.1 _RL facGrid
40    
41 edhill 1.18 C Initialise coriolis parameter
42 cnh 1.3 IF ( useConstantF ) THEN
43 edhill 1.18 C Constant F case
44     DO bj = myByLo(myThid), myByHi(myThid)
45     DO bi = myBxLo(myThid), myBxHi(myThid)
46     DO J=1-Oly,sNy+Oly
47     DO I=1-Olx,sNx+Olx
48     fCori(i,j,bi,bj)=f0
49     fCoriG(i,j,bi,bj)=f0
50     fCoriCos(i,j,bi,bj)=0.
51     ENDDO
52     ENDDO
53 cnh 1.1 ENDDO
54     ENDDO
55 cnh 1.3 ELSEIF ( useBetaPlaneF ) THEN
56 edhill 1.18 C Beta plane case
57     facGrid = 1. _d 0
58     IF ( usingSphericalPolarGrid ) facGrid = deg2rad*rSphere
59     DO bj = myByLo(myThid), myByHi(myThid)
60     DO bi = myBxLo(myThid), myBxHi(myThid)
61     DO J=1-Oly,sNy+Oly
62     DO I=1-Olx,sNx+Olx
63     fCori(i,j,bi,bj)=f0+beta*_yC(i,j,bi,bj)*facGrid
64     fCoriG(i,j,bi,bj)=f0+beta*yG(i,j,bi,bj)*facGrid
65     fCoriCos(i,j,bi,bj)=0.
66     ENDDO
67     ENDDO
68 cnh 1.3 ENDDO
69     ENDDO
70     ELSEIF ( useSphereF ) THEN
71 edhill 1.18 C Spherical case
72     C Note in this case we assume yC is in degrees.
73     DO bj = myByLo(myThid), myByHi(myThid)
74     DO bi = myBxLo(myThid), myBxHi(myThid)
75     DO J=1-Oly,sNy+Oly
76     DO I=1-Olx,sNx+Olx
77     fCori(i,j,bi,bj)=
78     & 2. _d 0*omega*sin(_yC(i,j,bi,bj)*deg2rad)
79     fCoriG(i,j,bi,bj)=
80     & 2. _d 0*omega*sin(yG(i,j,bi,bj)*deg2rad)
81     fCoriCos(i,j,bi,bj)=
82     & 2. _d 0*omega*cos(_yC(i,j,bi,bj)*deg2rad)
83     ENDDO
84     ENDDO
85 cnh 1.3 ENDDO
86     ENDDO
87 jmc 1.21 c CALL WRITE_FLD_XY_RL('fCoriC',' ',fCori , 0,myThid)
88     c CALL WRITE_FLD_XY_RL('fCoriG',' ',fCoriG , 0,myThid)
89     c CALL WRITE_FLD_XY_RL('fCorCs',' ',fCoriCos,0,myThid)
90 cnh 1.3 ELSE
91 edhill 1.18 C Special custom form
92     DO bj = myByLo(myThid), myByHi(myThid)
93     DO bi = myBxLo(myThid), myBxHi(myThid)
94     DO J=1-Oly,sNy+Oly
95     DO I=1-Olx,sNx+Olx
96     fCori(i,j,bi,bj)=0.
97     fCoriG(i,j,bi,bj)=0.
98     fCoriCos(i,j,bi,bj)=0.
99     ENDDO
100     ENDDO
101 cnh 1.3 ENDDO
102     ENDDO
103 jmc 1.21 CALL READ_REC_XY_RS( 'fCoriC.bin', fCori, 1, 0, myThid )
104     CALL READ_REC_XY_RS( 'fCoriG.bin', fCoriG, 1, 0, myThid )
105     CALL READ_REC_XY_RS( 'fCorCs.bin', fCoriCos,1, 0, myThid )
106     IF ( useCubedSphereExchange ) THEN
107     C- deal with the 2 missing corners (for fCoriG):
108     DO bj = myByLo(myThid), myByHi(myThid)
109     DO bi = myBxLo(myThid), myBxHi(myThid)
110     C- Notes: this will only works with 6 tiles (1 per face) and
111     C with 2 polar faces + 4 equatorials:
112     IF (bi.LE.3 .OR. bi.GE.5) THEN
113     fCoriG(sNx+1,1,bi,bj) = fCoriG(1,1,bi,bj)
114     ELSE
115     fCoriG(sNx+1,1,bi,bj) = -fCoriG(1,1,bi,bj)
116     ENDIF
117     IF (bi.GE.3) THEN
118     fCoriG(1,sNy+1,bi,bj) = fCoriG(1,1,bi,bj)
119     fCoriG(sNx+1,sNy+1,bi,bj) = fCoriG(sNx+1,1,bi,bj)
120     ELSE
121     fCoriG(1,sNy+1,bi,bj) = -fCoriG(1,1,bi,bj)
122     fCoriG(sNx+1,sNy+1,bi,bj) = -fCoriG(sNx+1,1,bi,bj)
123     ENDIF
124     ENDDO
125     ENDDO
126     ENDIF
127    
128     _EXCH_XY_R4(fCori,myThid)
129     CALL EXCH_Z_XY_RS(fCoriG,myThid)
130     _EXCH_XY_R4(fCoriCos,myThid)
131 cnh 1.3 ENDIF
132 adcroft 1.11
133 edhill 1.16 #ifdef ALLOW_MONITOR
134 edhill 1.18 mon_write_stdout = .FALSE.
135     mon_write_mnc = .FALSE.
136     IF (monitor_stdio) THEN
137     mon_write_stdout = .TRUE.
138     ENDIF
139    
140     #ifdef ALLOW_MNC
141     IF (useMNC .AND. monitor_mnc) THEN
142     DO i = 1,MAX_LEN_MBUF
143     mon_fname(i:i) = ' '
144     ENDDO
145     mon_fname(1:12) = 'monitor_grid'
146     CALL MNC_CW_SET_UDIM(mon_fname, 1, myThid)
147     mon_write_mnc = .TRUE.
148     ENDIF
149     #endif /* ALLOW_MNC */
150    
151 adcroft 1.11 CALL MON_PRINTSTATS_RS(1,fCori,'fCori',myThid)
152     CALL MON_PRINTSTATS_RS(1,fCoriG,'fCoriG',myThid)
153 adcroft 1.15 CALL MON_PRINTSTATS_RS(1,fCoriCos,'fCoriCos',myThid)
154 edhill 1.18
155     mon_write_stdout = .FALSE.
156     mon_write_mnc = .FALSE.
157 heimbach 1.13 #endif
158 cnh 1.1
159     RETURN
160     END
  ViewVC Help
Powered by ViewVC 1.1.22