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

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

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


Revision 1.53 - (hide annotations) (download)
Thu Aug 7 18:43:33 2014 UTC (9 years, 10 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint65h, checkpoint65b, checkpoint65c, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e
Changes since 1.52: +15 -5 lines
Add geothermal flux forcing

1 heimbach 1.53 C $Header: /u/gcmpack/MITgcm/model/src/ini_forcing.F,v 1.52 2012/11/09 22:43:53 jmc Exp $
2 cnh 1.22 C $Name: $
3 cnh 1.1
4 edhill 1.26 #include "PACKAGES_CONFIG.h"
5 cnh 1.12 #include "CPP_OPTIONS.h"
6 cnh 1.1
7 cnh 1.22 CBOP
8     C !ROUTINE: INI_FORCING
9     C !INTERFACE:
10 cnh 1.1 SUBROUTINE INI_FORCING( myThid )
11 cnh 1.22
12     C !DESCRIPTION: \bv
13     C *==========================================================*
14 jmc 1.42 C | SUBROUTINE INI_FORCING
15     C | o Set model initial forcing fields.
16 cnh 1.22 C *==========================================================*
17     C \ev
18    
19     C !USES:
20 adcroft 1.14 IMPLICIT NONE
21 cnh 1.1 C === Global variables ===
22     #include "SIZE.h"
23     #include "EEPARAMS.h"
24     #include "PARAMS.h"
25     #include "GRID.h"
26 jmc 1.49 #include "SURFACE.h"
27 cnh 1.1 #include "FFIELDS.h"
28    
29 cnh 1.22 C !INPUT/OUTPUT PARAMETERS:
30 cnh 1.1 C == Routine arguments ==
31 jmc 1.51 C myThid :: my Thread Id number
32 cnh 1.1 INTEGER myThid
33    
34 cnh 1.22 C !LOCAL VARIABLES:
35 cnh 1.1 C == Local variables ==
36 jmc 1.51 C bi,bj :: Tile indices
37     C i, j :: Loop counters
38 cnh 1.1 INTEGER bi, bj
39 jmc 1.42 INTEGER i, j
40 jmc 1.52 #if (defined ALLOW_ADDFLUID) || (defined ALLOW_FRICTION_HEATING)
41     INTEGER k
42     #endif
43 cnh 1.22 CEOP
44 cnh 1.1
45 jmc 1.42 C- Initialise all arrays in common blocks
46 adcroft 1.10 DO bj = myByLo(myThid), myByHi(myThid)
47     DO bi = myBxLo(myThid), myBxHi(myThid)
48     DO j=1-OLy,sNy+OLy
49     DO i=1-OLx,sNx+OLx
50 heimbach 1.18 fu (i,j,bi,bj) = 0. _d 0
51     fv (i,j,bi,bj) = 0. _d 0
52     Qnet (i,j,bi,bj) = 0. _d 0
53     EmPmR (i,j,bi,bj) = 0. _d 0
54 jmc 1.27 saltFlux (i,j,bi,bj) = 0. _d 0
55 heimbach 1.18 SST (i,j,bi,bj) = 0. _d 0
56     SSS (i,j,bi,bj) = 0. _d 0
57     Qsw (i,j,bi,bj) = 0. _d 0
58 jmc 1.44 pLoad (i,j,bi,bj) = 0. _d 0
59 jmc 1.33 sIceLoad (i,j,bi,bj) = 0. _d 0
60 jmc 1.49 surfaceForcingU (i,j,bi,bj) = 0. _d 0
61     surfaceForcingV (i,j,bi,bj) = 0. _d 0
62     surfaceForcingT (i,j,bi,bj) = 0. _d 0
63     surfaceForcingS (i,j,bi,bj) = 0. _d 0
64 jmc 1.35 surfaceForcingTice(i,j,bi,bj) = 0. _d 0
65 heimbach 1.53 #ifdef ALLOW_GEOTHERMAL_FLUX
66     geothermalFlux (i,j,bi,bj) = 0. _d 0
67     #endif
68 jmc 1.44 #ifndef EXCLUDE_FFIELDS_LOAD
69 heimbach 1.24 taux0 (i,j,bi,bj) = 0. _d 0
70     taux1 (i,j,bi,bj) = 0. _d 0
71     tauy0 (i,j,bi,bj) = 0. _d 0
72     tauy1 (i,j,bi,bj) = 0. _d 0
73     Qnet0 (i,j,bi,bj) = 0. _d 0
74     Qnet1 (i,j,bi,bj) = 0. _d 0
75     EmPmR0 (i,j,bi,bj) = 0. _d 0
76     EmPmR1 (i,j,bi,bj) = 0. _d 0
77 jmc 1.37 saltFlux0 (i,j,bi,bj) = 0. _d 0
78     saltFlux1 (i,j,bi,bj) = 0. _d 0
79 heimbach 1.24 SST0 (i,j,bi,bj) = 0. _d 0
80     SST1 (i,j,bi,bj) = 0. _d 0
81     SSS0 (i,j,bi,bj) = 0. _d 0
82     SSS1 (i,j,bi,bj) = 0. _d 0
83 jmc 1.42 #ifdef SHORTWAVE_HEATING
84 heimbach 1.24 Qsw0 (i,j,bi,bj) = 0. _d 0
85     Qsw1 (i,j,bi,bj) = 0. _d 0
86     #endif
87     #ifdef ATMOSPHERIC_LOADING
88 jmc 1.44 pLoad0 (i,j,bi,bj) = 0. _d 0
89     pLoad1 (i,j,bi,bj) = 0. _d 0
90 heimbach 1.24 #endif
91 jmc 1.44 #endif /* EXCLUDE_FFIELDS_LOAD */
92 adcroft 1.10 ENDDO
93     ENDDO
94 jmc 1.51 #ifndef EXCLUDE_FFIELDS_LOAD
95     loadedRec(bi,bj) = 0
96     #endif /* EXCLUDE_FFIELDS_LOAD */
97 jmc 1.52 #ifdef ALLOW_ADDFLUID
98     DO k=1,Nr
99     DO j=1-OLy,sNy+OLy
100     DO i=1-OLx,sNx+OLx
101     addMass(i,j,k,bi,bj) = 0. _d 0
102     ENDDO
103     ENDDO
104     ENDDO
105     #endif /* ALLOW_ADDFLUID */
106     #ifdef ALLOW_FRICTION_HEATING
107     DO k=1,Nr
108     DO j=1-OLy,sNy+OLy
109     DO i=1-OLx,sNx+OLx
110     frictionHeating(i,j,k,bi,bj) = 0. _d 0
111     ENDDO
112     ENDDO
113     ENDDO
114     #endif /* ALLOW_FRICTION_HEATING */
115 adcroft 1.10 ENDDO
116     ENDDO
117 jmc 1.42
118 heimbach 1.38 DO bj = myByLo(myThid), myByHi(myThid)
119     DO bi = myBxLo(myThid), myBxHi(myThid)
120 jmc 1.52 DO j=1-OLy,sNy+OLy
121     DO i=1-OLx,sNx+OLx
122 jmc 1.42 IF ( doThetaClimRelax .AND.
123     & ABS(yC(i,j,bi,bj)).LE.latBandClimRelax ) THEN
124     lambdaThetaClimRelax(i,j,bi,bj) = 1. _d 0/tauThetaClimRelax
125 heimbach 1.38 ELSE
126 jmc 1.42 lambdaThetaClimRelax(i,j,bi,bj) = 0. _d 0
127 heimbach 1.38 ENDIF
128     IF ( doSaltClimRelax .AND.
129 jmc 1.42 & ABS(yC(i,j,bi,bj)).LE.latBandClimRelax ) THEN
130     lambdaSaltClimRelax(i,j,bi,bj) = 1. _d 0/tauSaltClimRelax
131 heimbach 1.38 ELSE
132 jmc 1.42 lambdaSaltClimRelax(i,j,bi,bj) = 0. _d 0
133 heimbach 1.38 ENDIF
134     ENDDO
135     ENDDO
136     ENDDO
137     ENDDO
138 jmc 1.42
139     C- every-one waits before master thread loads from file
140 jmc 1.50 C this is done within IO routines => no longer needed
141     c _BARRIER
142 jmc 1.42
143 adcroft 1.16 IF ( zonalWindFile .NE. ' ' ) THEN
144     CALL READ_FLD_XY_RS( zonalWindFile, ' ', fu, 0, myThid )
145     ENDIF
146     IF ( meridWindFile .NE. ' ' ) THEN
147     CALL READ_FLD_XY_RS( meridWindFile, ' ', fv, 0, myThid )
148     ENDIF
149     IF ( surfQFile .NE. ' ' ) THEN
150     CALL READ_FLD_XY_RS( surfQFile, ' ', Qnet, 0, myThid )
151 jmc 1.34 ELSEIF ( surfQnetFile .NE. ' ' ) THEN
152     CALL READ_FLD_XY_RS( surfQnetFile, ' ', Qnet, 0, myThid )
153 adcroft 1.16 ENDIF
154     IF ( EmPmRfile .NE. ' ' ) THEN
155     CALL READ_FLD_XY_RS( EmPmRfile, ' ', EmPmR, 0, myThid )
156 jmc 1.47 c IF ( convertEmP2rUnit.EQ.mass2rUnit ) THEN
157 jmc 1.46 C- EmPmR is now (after c59h) expressed in kg/m2/s (fresh water mass flux)
158     DO bj = myByLo(myThid), myByHi(myThid)
159     DO bi = myBxLo(myThid), myBxHi(myThid)
160 jmc 1.52 DO j=1-OLy,sNy+OLy
161     DO i=1-OLx,sNx+OLx
162 jmc 1.46 EmPmR(i,j,bi,bj) = EmPmR(i,j,bi,bj)*rhoConstFresh
163     ENDDO
164     ENDDO
165     ENDDO
166     ENDDO
167 jmc 1.47 c ENDIF
168 adcroft 1.16 ENDIF
169 jmc 1.37 IF ( saltFluxFile .NE. ' ' ) THEN
170     CALL READ_FLD_XY_RS( saltFluxFile, ' ', saltFlux, 0, myThid )
171     ENDIF
172 adcroft 1.16 IF ( thetaClimFile .NE. ' ' ) THEN
173     CALL READ_FLD_XY_RS( thetaClimFile, ' ', SST, 0, myThid )
174     ENDIF
175     IF ( saltClimFile .NE. ' ' ) THEN
176     CALL READ_FLD_XY_RS( saltClimFile, ' ', SSS, 0, myThid )
177     ENDIF
178 heimbach 1.38 IF ( lambdaThetaFile .NE. ' ' ) THEN
179 jmc 1.42 CALL READ_FLD_XY_RS( lambdaThetaFile, ' ',
180 heimbach 1.38 & lambdaThetaClimRelax, 0, myThid )
181     ENDIF
182     IF ( lambdaSaltFile .NE. ' ' ) THEN
183 jmc 1.42 CALL READ_FLD_XY_RS( lambdaSaltFile, ' ',
184 heimbach 1.38 & lambdaSaltClimRelax, 0, myThid )
185     ENDIF
186 heimbach 1.18 #ifdef SHORTWAVE_HEATING
187     IF ( surfQswFile .NE. ' ' ) THEN
188     CALL READ_FLD_XY_RS( surfQswFile, ' ', Qsw, 0, myThid )
189 jmc 1.34 IF ( surfQFile .NE. ' ' ) THEN
190     C- Qnet is now (after c54) the net Heat Flux (including SW)
191 jmc 1.42 DO bj = myByLo(myThid), myByHi(myThid)
192     DO bi = myBxLo(myThid), myBxHi(myThid)
193 jmc 1.36 DO j=1-OLy,sNy+OLy
194     DO i=1-OLx,sNx+OLx
195 jmc 1.34 Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj) + Qsw(i,j,bi,bj)
196 jmc 1.36 ENDDO
197 jmc 1.34 ENDDO
198     ENDDO
199 jmc 1.36 ENDDO
200 jmc 1.34 ENDIF
201 heimbach 1.18 ENDIF
202     #endif
203 mlosch 1.23 #ifdef ATMOSPHERIC_LOADING
204     IF ( pLoadFile .NE. ' ' ) THEN
205 jmc 1.44 CALL READ_FLD_XY_RS( pLoadFile, ' ', pLoad, 0, myThid )
206 mlosch 1.23 ENDIF
207     #endif
208 jmc 1.52 #ifdef ALLOW_ADDFLUID
209     IF ( addMassFile .NE. ' ' ) THEN
210     CALL READ_FLD_XYZ_RL( addMassFile, ' ', addMass, 0, myThid )
211     CALL EXCH_XYZ_RL( addMass, myThid )
212     ENDIF
213     #endif /* ALLOW_ADDFLUID */
214 heimbach 1.53 #ifdef ALLOW_GEOTHERMAL_FLUX
215     IF ( geothermalFile .NE. ' ' ) THEN
216     CALL READ_FLD_XY_RS( geothermalFile, ' ',
217     & geothermalFlux, 0, myThid )
218     CALL EXCH_XY_RS( geothermalFlux, myThid )
219     # ifdef ALLOW_MONITOR
220     CALL MON_PRINTSTATS_RS(
221     & 1,geothermalFlux,'geothermalFlux',myThid)
222     # endif
223     ENDIF
224     #endif /* ALLOW_GEOTHERMAL_FLUX */
225 heimbach 1.40
226 jmc 1.43 CALL EXCH_UV_XY_RS( fu,fv, .TRUE., myThid )
227     CALL EXCH_XY_RS( Qnet , myThid )
228     CALL EXCH_XY_RS( EmPmR, myThid )
229     CALL EXCH_XY_RS( saltFlux, myThid )
230     CALL EXCH_XY_RS( SST , myThid )
231     CALL EXCH_XY_RS( SSS , myThid )
232     CALL EXCH_XY_RS( lambdaThetaClimRelax, myThid )
233     CALL EXCH_XY_RS( lambdaSaltClimRelax , myThid )
234 mlosch 1.23 #ifdef SHORTWAVE_HEATING
235 jmc 1.43 CALL EXCH_XY_RS(Qsw , myThid )
236 mlosch 1.23 #endif
237     #ifdef ATMOSPHERIC_LOADING
238 jmc 1.44 CALL EXCH_XY_RS(pLoad , myThid )
239     C CALL PLOT_FIELD_XYRS( pLoad, 'S/R INI_FORCING pLoad',1,myThid)
240 mlosch 1.23 #endif
241 adcroft 1.15 C CALL PLOT_FIELD_XYRS( fu, 'S/R INI_FORCING FU',1,myThid)
242     C CALL PLOT_FIELD_XYRS( fv, 'S/R INI_FORCING FV',1,myThid)
243 cnh 1.1
244 jmc 1.49 #ifdef ATMOSPHERIC_LOADING
245     IF ( pLoadFile .NE. ' ' .AND. usingPCoords ) THEN
246     C-- This is a hack used to read phi0surf from a file (pLoadFile)
247     C instead of computing it from bathymetry & density ref. profile.
248     C- Ocean: The true atmospheric P-loading is not yet implemented for P-coord
249     C (requires time varying dP(Nr) like dP(k-bottom) with NonLin FS).
250     C- Atmos: sometime usefull to overwrite phi0surf with fixed-in-time field
251     C read from file (and anyway, pressure loading is meaningless here)
252     DO bj = myByLo(myThid), myByHi(myThid)
253     DO bi = myBxLo(myThid), myBxHi(myThid)
254     DO j=1-OLy,sNy+OLy
255     DO i=1-OLx,sNx+OLx
256     phi0surf(i,j,bi,bj) = pLoad(i,j,bi,bj)
257     ENDDO
258     ENDDO
259     ENDDO
260     ENDDO
261     ENDIF
262     #endif /* ATMOSPHERIC_LOADING */
263    
264 cnh 1.1 RETURN
265     END

  ViewVC Help
Powered by ViewVC 1.1.22