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

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

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

Revision 1.1 - (show annotations) (download)
Thu Jul 4 23:02:48 2013 UTC (10 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64o, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint64n, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint64k, checkpoint65, checkpoint64m, checkpoint64l, HEAD 
- put surface relaxation of SST & SSS in new S/R (forcing_surf_relax.F)
  which also contains balancing surface relaxation (ALLOW_BALANCE_RELAX,
  previously in file "balance_relax.F", now removed);
1 C $Header: /u/gcmpack/MITgcm/model/src/external_forcing_surf.F,v 1.56 2012/06/30 01:24:35 gforget Exp $
2 C $Name: $
3
4 #include "PACKAGES_CONFIG.h"
5 #include "CPP_OPTIONS.h"
6
7 CBOP
8 C !ROUTINE: FORCING_SURF_RELAX
9 C !INTERFACE:
10 SUBROUTINE FORCING_SURF_RELAX(
11 I iMin, iMax, jMin, jMax,
12 I myTime, myIter, myThid )
13 C !DESCRIPTION: \bv
14 C *==========================================================*
15 C | SUBROUTINE FORCING_SURF_RELAX
16 C | o Calculate relaxation surface forcing terms
17 C | for temperature and salinity
18 C *==========================================================*
19 C \ev
20
21 C !USES:
22 IMPLICIT NONE
23 C === Global variables ===
24 #include "SIZE.h"
25 #include "EEPARAMS.h"
26 #include "PARAMS.h"
27 #include "FFIELDS.h"
28 #include "DYNVARS.h"
29 #include "GRID.h"
30 #include "SURFACE.h"
31 #ifdef ALLOW_SEAICE
32 # include "SEAICE_SIZE.h"
33 # include "SEAICE_PARAMS.h"
34 # include "SEAICE.h"
35 #endif /* ALLOW_SEAICE */
36
37 C !INPUT/OUTPUT PARAMETERS:
38 C === Routine arguments ===
39 C iMin,iMax, jMin,jMax :: Range of points for calculation
40 C myTime :: Current time in simulation
41 C myIter :: Current iteration number in simulation
42 C myThid :: Thread no. that called this routine.
43 INTEGER iMin, iMax
44 INTEGER jMin, jMax
45 _RL myTime
46 INTEGER myIter
47 INTEGER myThid
48
49 C !LOCAL VARIABLES:
50 C === Local variables ===
51 C bi,bj :: tile indices
52 C i,j :: loop indices
53 C ks :: index of surface interface layer
54 INTEGER bi,bj
55 INTEGER i,j
56 INTEGER ks
57 CEOP
58 #ifdef ALLOW_DIAGNOSTICS
59 _RL tmpFac
60 #endif /* ALLOW_DIAGNOSTICS */
61 #ifdef ALLOW_BALANCE_RELAX
62 CHARACTER*(MAX_LEN_MBUF) msgBuf
63 _RL sumTile(nSx,nSy), sumGlob, globAver
64 #endif /* ALLOW_BALANCE_RELAX */
65
66 IF ( usingPCoords ) THEN
67 ks = Nr
68 ELSE
69 ks = 1
70 ENDIF
71
72 DO bj=myByLo(myThid),myByHi(myThid)
73 DO bi=myBxLo(myThid),myBxHi(myThid)
74
75 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
76
77 #ifdef ALLOW_SEAICE
78 IF ( useSEAICE .AND. (.NOT. SEAICErestoreUnderIce) ) THEN
79 C Do not restore under sea-ice
80 DO j = jMin, jMax
81 DO i = iMin, iMax
82 C Heat Flux (restoring term) :
83 surfaceForcingT(i,j,bi,bj) =
84 & -lambdaThetaClimRelax(i,j,bi,bj)*(1.-AREA(i,j,bi,bj))
85 & *(theta(i,j,ks,bi,bj)-SST(i,j,bi,bj))
86 & *drF(ks)*_hFacC(i,j,ks,bi,bj)
87 C Salt Flux (restoring term) :
88 surfaceForcingS(i,j,bi,bj) =
89 & -lambdaSaltClimRelax(i,j,bi,bj) *(1.-AREA(i,j,bi,bj))
90 & *(salt(i,j,ks,bi,bj)-SSS(i,j,bi,bj))
91 & *drF(ks)*_hFacC(i,j,ks,bi,bj)
92 ENDDO
93 ENDDO
94 ELSE
95 #endif /* ALLOW_SEAICE */
96 DO j = jMin, jMax
97 DO i = iMin, iMax
98 C Heat Flux (restoring term) :
99 surfaceForcingT(i,j,bi,bj) =
100 & -lambdaThetaClimRelax(i,j,bi,bj)
101 & *(theta(i,j,ks,bi,bj)-SST(i,j,bi,bj))
102 & *drF(ks)*_hFacC(i,j,ks,bi,bj)
103 C Salt Flux (restoring term) :
104 surfaceForcingS(i,j,bi,bj) =
105 & -lambdaSaltClimRelax(i,j,bi,bj)
106 & *(salt(i,j,ks,bi,bj)-SSS(i,j,bi,bj))
107 & *drF(ks)*_hFacC(i,j,ks,bi,bj)
108 ENDDO
109 ENDDO
110 #ifdef ALLOW_SEAICE
111 ENDIF
112 #endif /* ALLOW_SEAICE */
113
114 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
115 #ifdef NONLIN_FRSURF
116 C- T,S surface forcing will be applied (thermodynamics) after the update
117 C of surf.thickness (hFac): account for change in surf.thickness
118 IF (staggerTimeStep.AND.nonlinFreeSurf.GT.0) THEN
119 IF ( select_rStar.GT.0 ) THEN
120 # ifndef DISABLE_RSTAR_CODE
121 DO j=jMin,jMax
122 DO i=iMin,iMax
123 surfaceForcingT(i,j,bi,bj) = surfaceForcingT(i,j,bi,bj)
124 & * rStarExpC(i,j,bi,bj)
125 surfaceForcingS(i,j,bi,bj) = surfaceForcingS(i,j,bi,bj)
126 & * rStarExpC(i,j,bi,bj)
127 ENDDO
128 ENDDO
129 # endif /* DISABLE_RSTAR_CODE */
130 ELSEIF ( selectSigmaCoord.NE.0 ) THEN
131 # ifndef DISABLE_SIGMA_CODE
132 DO j=jMin,jMax
133 DO i=iMin,iMax
134 surfaceForcingT(i,j,bi,bj) = surfaceForcingT(i,j,bi,bj)
135 & *( 1. _d 0 + dEtaHdt(i,j,bi,bj)*deltaTFreeSurf
136 & *dBHybSigF(ks)*recip_drF(ks)
137 & *recip_hFacC(i,j,ks,bi,bj)
138 & )
139 surfaceForcingS(i,j,bi,bj) = surfaceForcingS(i,j,bi,bj)
140 & *( 1. _d 0 + dEtaHdt(i,j,bi,bj)*deltaTFreeSurf
141 & *dBHybSigF(ks)*recip_drF(ks)
142 & *recip_hFacC(i,j,ks,bi,bj)
143 & )
144 ENDDO
145 ENDDO
146 # endif /* DISABLE_SIGMA_CODE */
147 ELSE
148 DO j=jMin,jMax
149 DO i=iMin,iMax
150 IF (ks.EQ.kSurfC(i,j,bi,bj)) THEN
151 surfaceForcingT(i,j,bi,bj) = surfaceForcingT(i,j,bi,bj)
152 & *_recip_hFacC(i,j,ks,bi,bj)*hFac_surfC(i,j,bi,bj)
153 surfaceForcingS(i,j,bi,bj) = surfaceForcingS(i,j,bi,bj)
154 & *_recip_hFacC(i,j,ks,bi,bj)*hFac_surfC(i,j,bi,bj)
155 ENDIF
156 ENDDO
157 ENDDO
158 ENDIF
159 ENDIF
160 #endif /* NONLIN_FRSURF */
161
162 C-- end bi,bj loops.
163 ENDDO
164 ENDDO
165
166 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
167
168 #ifdef ALLOW_BALANCE_RELAX
169
170 IF ( balanceThetaClimRelax ) THEN
171 DO bj=myByLo(myThid),myByHi(myThid)
172 DO bi=myBxLo(myThid),myBxHi(myThid)
173 sumTile(bi,bj) = 0. _d 0
174 DO j=1,sNy
175 DO i=1,sNx
176 sumTile(bi,bj) = sumTile(bi,bj)
177 & + surfaceForcingT(i,j,bi,bj)
178 & *rA(i,j,bi,bj)*maskInC(i,j,bi,bj)
179 ENDDO
180 ENDDO
181 ENDDO
182 ENDDO
183 CALL GLOBAL_SUM_TILE_RL( sumTile, sumGlob, myThid )
184 globAver = sumGlob
185 IF ( globalArea.GT.zeroRL ) globAver = globAver / globalArea
186 DO bj=myByLo(myThid),myByHi(myThid)
187 DO bi=myBxLo(myThid),myBxHi(myThid)
188 DO j=1-OLy,sNy+OLy
189 DO i=1-OLx,sNx+OLx
190 surfaceForcingT(i,j,bi,bj) = surfaceForcingT(i,j,bi,bj)
191 & - globAver
192 ENDDO
193 ENDDO
194 ENDDO
195 ENDDO
196 IF ( balancePrintMean ) THEN
197 _BEGIN_MASTER( myThid )
198 WRITE(msgBuf,'(A,E24.17)')
199 & 'rm Global mean of SSTrelax =', globAver
200 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
201 & SQUEEZE_RIGHT, myThid )
202 _END_MASTER( myThid )
203 ENDIF
204 ENDIF
205
206 IF ( balanceSaltClimRelax ) THEN
207 DO bj=myByLo(myThid),myByHi(myThid)
208 DO bi=myBxLo(myThid),myBxHi(myThid)
209 sumTile(bi,bj) = 0. _d 0
210 DO j=1,sNy
211 DO i=1,sNx
212 sumTile(bi,bj) = sumTile(bi,bj)
213 & + surfaceForcingS(i,j,bi,bj)
214 & *rA(i,j,bi,bj)*maskInC(i,j,bi,bj)
215 ENDDO
216 ENDDO
217 ENDDO
218 ENDDO
219 CALL GLOBAL_SUM_TILE_RL( sumTile, sumGlob, myThid )
220 globAver = sumGlob
221 IF ( globalArea.GT.zeroRL ) globAver = globAver / globalArea
222 DO bj=myByLo(myThid),myByHi(myThid)
223 DO bi=myBxLo(myThid),myBxHi(myThid)
224 DO j=1-OLy,sNy+OLy
225 DO i=1-OLx,sNx+OLx
226 surfaceForcingS(i,j,bi,bj) = surfaceForcingS(i,j,bi,bj)
227 & - globAver
228 ENDDO
229 ENDDO
230 ENDDO
231 ENDDO
232 IF ( balancePrintMean ) THEN
233 _BEGIN_MASTER( myThid )
234 WRITE(msgBuf,'(A,E24.17)')
235 & 'rm Global mean of SSSrelax =', globAver
236 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
237 & SQUEEZE_RIGHT, myThid )
238 _END_MASTER( myThid )
239 ENDIF
240 ENDIF
241
242 #endif /* ALLOW_BALANCE_RELAX */
243
244 #ifdef ALLOW_DIAGNOSTICS
245 IF ( useDiagnostics ) THEN
246
247 C tRelax (temperature relaxation [W/m2], positive <-> increasing Theta)
248 tmpFac = HeatCapacity_Cp*rUnit2mass
249 CALL DIAGNOSTICS_SCALE_FILL( surfaceForcingT, tmpFac, 1,
250 & 'TRELAX ', 0, 1, 0,1,1, myThid )
251
252 C sRelax (salt relaxation [g/m2/s], positive <-> increasing Salt)
253 tmpFac = rUnit2mass
254 CALL DIAGNOSTICS_SCALE_FILL( surfaceForcingS, tmpFac, 1,
255 & 'SRELAX ', 0, 1, 0,1,1, myThid )
256
257 ENDIF
258 #endif /* ALLOW_DIAGNOSTICS */
259
260 RETURN
261 END
  ViewVC Help
Powered by ViewVC 1.1.22