/[MITgcm]/MITgcm/pkg/thsice/thsice_main.F
ViewVC logotype

Annotation of /MITgcm/pkg/thsice/thsice_main.F

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


Revision 1.25 - (hide annotations) (download)
Wed Aug 1 18:22:41 2012 UTC (11 years, 9 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64a, checkpoint63r, checkpoint63s, checkpoint64
Changes since 1.24: +26 -11 lines
implement correction of ocean fresh-water flux for imbalance of Atmos+Land
 fresh-water flux: uniform correction or proportional to local precip.

1 jmc 1.25 C $Header: /u/gcmpack/MITgcm/pkg/thsice/thsice_main.F,v 1.24 2010/12/24 00:55:40 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "THSICE_OPTIONS.h"
5 jmc 1.8
6 jmc 1.2 CBOP
7 jmc 1.1 C !ROUTINE: THSICE_MAIN
8     C !INTERFACE:
9 jmc 1.8 SUBROUTINE THSICE_MAIN(
10 jmc 1.1 I myTime, myIter, myThid )
11 jmc 1.2 C !DESCRIPTION: \bv
12 jmc 1.1 C *==========================================================*
13 jmc 1.8 C | S/R THSICE_MAIN
14     C | o Therm_SeaIce main routine.
15 jmc 1.1 C | step forward Thermodynamic_SeaIce variables and modify
16     C | ocean surface forcing accordingly.
17     C *==========================================================*
18    
19     C !USES:
20     IMPLICIT NONE
21 jmc 1.2
22 jmc 1.1 C === Global variables ===
23     #include "SIZE.h"
24     #include "EEPARAMS.h"
25     #include "PARAMS.h"
26 jmc 1.2 #include "GRID.h"
27 jmc 1.3 #include "SURFACE.h"
28 jmc 1.2 #include "DYNVARS.h"
29 jmc 1.1 #include "FFIELDS.h"
30     #include "THSICE_PARAMS.h"
31 gforget 1.23 #include "THSICE_SIZE.h"
32 jmc 1.2 #include "THSICE_VARS.h"
33 heimbach 1.7 #ifdef ALLOW_AUTODIFF_TAMC
34     # include "tamc.h"
35     # include "tamc_keys.h"
36     #endif
37 jmc 1.8
38 jmc 1.1 C !INPUT/OUTPUT PARAMETERS:
39     C === Routine arguments ===
40 jmc 1.12 C myTime :: Current time in simulation (s)
41     C myIter :: Current iteration number
42     C myThid :: My Thread Id. number
43     _RL myTime
44 jmc 1.1 INTEGER myIter
45     INTEGER myThid
46 jmc 1.2 CEOP
47 jmc 1.1
48     #ifdef ALLOW_THSICE
49     C !LOCAL VARIABLES:
50     C === Local variables ===
51     INTEGER i,j
52     INTEGER bi,bj
53     INTEGER iMin, iMax
54     INTEGER jMin, jMax
55 jmc 1.25 _RL prcAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
56 jmc 1.8 c _RL evpAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
57     c _RL flxAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
58     c _RL flxSW (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
59 jmc 1.1
60     _RL tauFac
61    
62     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
63    
64 jmc 1.24 IF ( useEXF .OR. useSEAICE ) THEN
65     C- EXF does not provide valid fields in overlap
66     iMin = 1
67     iMax = sNx
68     jMin = 1
69     jMax = sNy
70     ELSEIF ( stressReduction.GT. 0. _d 0 ) THEN
71 jmc 1.5 C- needs new Ice Fraction in halo region to apply wind-stress reduction
72 jmc 1.8 iMin = 1-OLx
73     iMax = sNx+OLx-1
74     jMin = 1-OLy
75     jMax = sNy+OLy-1
76 jmc 1.5 #ifdef ATMOSPHERIC_LOADING
77 jmc 1.24 ELSEIF ( useRealFreshWaterFlux ) THEN
78 jmc 1.5 C- needs sea-ice loading in part of the halo regions for grad.Phi0surf
79     C to be valid at the boundaries ( d/dx 1:sNx+1 ; d/dy 1:sNy+1 )
80     iMin = 0
81     iMax = sNx+1
82     jMin = 0
83     jMax = sNy+1
84     #endif /* ATMOSPHERIC_LOADING */
85 jmc 1.1 ELSE
86     iMin = 1
87     iMax = sNx
88     jMin = 1
89     jMax = sNy
90     ENDIF
91    
92     DO bj=myByLo(myThid),myByHi(myThid)
93     DO bi=myBxLo(myThid),myBxHi(myThid)
94 jmc 1.2
95 heimbach 1.7 #ifdef ALLOW_AUTODIFF_TAMC
96     act1 = bi - myBxLo(myThid)
97     max1 = myBxHi(myThid) - myBxLo(myThid) + 1
98     act2 = bj - myByLo(myThid)
99     max2 = myByHi(myThid) - myByLo(myThid) + 1
100     act3 = myThid - 1
101     max3 = nTx*nTy
102     act4 = ikey_dynamics - 1
103 gforget 1.23 ticekey = (act1 + 1) + act2*max1
104 heimbach 1.7 & + act3*max1*max2
105     & + act4*max1*max2*max3
106     #endif /* ALLOW_AUTODIFF_TAMC */
107    
108 heimbach 1.13 #ifdef ALLOW_AUTODIFF_TAMC
109 gforget 1.23 CADJ STORE ocefwfx(:,:,bi,bj) = comlev1_bibj, key=ticekey, byte=isbyte
110     CADJ STORE oceqnet(:,:,bi,bj) = comlev1_bibj, key=ticekey, byte=isbyte
111     CADJ STORE ocesflx(:,:,bi,bj) = comlev1_bibj, key=ticekey, byte=isbyte
112 heimbach 1.14 # ifdef ALLOW_EXF
113 gforget 1.23 CADJ STORE qsw(:,:,bi,bj) = comlev1_bibj, key=ticekey, byte=isbyte
114 heimbach 1.14 # endif
115 heimbach 1.13 #endif
116    
117 jmc 1.3 C-- Mixed layer thickness: take the 1rst layer
118     #ifdef NONLIN_FRSURF
119     IF ( staggerTimeStep .AND. nonlinFreeSurf.GT.0 ) THEN
120     IF ( select_rStar.GT.0 ) THEN
121 jmc 1.20 DO j=1-OLy,sNy+OLy
122     DO i=1-OLx,sNx+OLx
123 jmc 1.3 hOceMxL(i,j,bi,bj) = drF(1)*h0FacC(i,j,1,bi,bj)
124 jmc 1.8 & *rStarFacC(i,j,bi,bj)
125 jmc 1.3 ENDDO
126     ENDDO
127     ELSE
128 jmc 1.20 DO j=1-OLy,sNy+OLy
129     DO i=1-OLx,sNx+OLx
130 jmc 1.25 IF ( kSurfC(i,j,bi,bj).EQ.1 ) THEN
131 jmc 1.3 hOceMxL(i,j,bi,bj) = drF(1)*hFac_surfC(i,j,bi,bj)
132     ELSE
133 jmc 1.12 hOceMxL(i,j,bi,bj) = drF(1)*hFacC(i,j,1,bi,bj)
134 jmc 1.3 ENDIF
135     ENDDO
136     ENDDO
137     ENDIF
138     ELSE
139     #else /* ndef NONLIN_FRSURF */
140     IF (.TRUE.) THEN
141     #endif /* NONLIN_FRSURF */
142 jmc 1.20 DO j=1-OLy,sNy+OLy
143     DO i=1-OLx,sNx+OLx
144 jmc 1.12 hOceMxL(i,j,bi,bj) = drF(1)*hFacC(i,j,1,bi,bj)
145 jmc 1.3 ENDDO
146     ENDDO
147     ENDIF
148    
149 heimbach 1.7 #ifdef ALLOW_AUTODIFF_TAMC
150 gforget 1.23 CADJ STORE uvel (:,:,1,bi,bj) = comlev1_bibj, key=ticekey, byte=isbyte
151     CADJ STORE vvel (:,:,1,bi,bj) = comlev1_bibj, key=ticekey, byte=isbyte
152 heimbach 1.7 #endif
153    
154 mlosch 1.10 DO j = jMin, jMax
155     DO i = iMin, iMax
156     tOceMxL(i,j,bi,bj) = theta(i,j,1,bi,bj)
157     sOceMxL(i,j,bi,bj) = salt (i,j,1,bi,bj)
158     v2ocMxL(i,j,bi,bj) =
159 jmc 1.2 & ( uvel(i,j,1,bi,bj)*uvel(i,j,1,bi,bj)
160     & + uvel(i+1,j,1,bi,bj)*uvel(i+1,j,1,bi,bj)
161     & + vvel(i,j+1,1,bi,bj)*vvel(i,j+1,1,bi,bj)
162     & + vvel(i,j,1,bi,bj)*vvel(i,j,1,bi,bj)
163     & )*0.5 _d 0
164 jmc 1.25 prcAtm (i,j,bi,bj) = 0. _d 0
165 mlosch 1.10 icFrwAtm(i,j,bi,bj) = 0. _d 0
166     icFlxAtm(i,j,bi,bj) = 0. _d 0
167     icFlxSW (i,j,bi,bj) = 0. _d 0
168 jmc 1.25 snowPrc (i,j,bi,bj) = 0. _d 0
169     siceAlb (i,j,bi,bj) = 0. _d 0
170 jmc 1.6 ENDDO
171 mlosch 1.10 ENDDO
172 heimbach 1.7
173     #ifdef ALLOW_AUTODIFF_TAMC
174 gforget 1.23 CADJ STORE iceMask(:,:,bi,bj) = comlev1_bibj, key = ticekey
175     CADJ STORE iceHeight(:,:,bi,bj) = comlev1_bibj, key = ticekey
176     CADJ STORE snowHeight(:,:,bi,bj) = comlev1_bibj, key = ticekey
177     CADJ STORE Tsrf(:,:,bi,bj) = comlev1_bibj, key = ticekey
178     CADJ STORE Qice1(:,:,bi,bj) = comlev1_bibj, key = ticekey
179     CADJ STORE Qice2(:,:,bi,bj) = comlev1_bibj, key = ticekey
180     CADJ STORE snowAge(:,:,bi,bj) = comlev1_bibj, key = ticekey
181     CADJ STORE snowPrc(:,:,bi,bj) = comlev1_bibj, key = ticekey
182    
183     CADJ STORE hOceMxL(:,:,bi,bj) = comlev1_bibj, key = ticekey
184     CADJ STORE tOceMxL(:,:,bi,bj) = comlev1_bibj, key = ticekey
185     CADJ STORE sOceMxL(:,:,bi,bj) = comlev1_bibj, key = ticekey
186     CADJ STORE v2ocMxL(:,:,bi,bj) = comlev1_bibj, key = ticekey
187 heimbach 1.7 #endif
188    
189 jmc 1.12 C- do sea-ice advection before getting surface fluxes
190     C Note: will inline this S/R once thSIce in Atmos. set-up is settled
191     IF ( thSIceAdvScheme.GT.0 )
192     & CALL THSICE_DO_ADVECT(
193     I bi,bj, myTime, myIter, myThid )
194    
195 jmc 1.2 #ifdef ALLOW_BULK_FORCE
196 mlosch 1.10 IF ( useBulkforce ) THEN
197     CALL THSICE_GET_PRECIP(
198 jmc 1.6 I iceMask,
199 jmc 1.25 O prcAtm(1-OLx,1-OLy,bi,bj),
200     O snowPrc(1-OLx,1-OLy,bi,bj),
201 jmc 1.8 O icFlxSW(1-OLx,1-OLy,bi,bj),
202 jmc 1.6 I iMin,iMax,jMin,jMax, bi,bj, myThid )
203 mlosch 1.10 ENDIF
204 jmc 1.2 #endif
205 mlosch 1.9 #ifdef ALLOW_EXF
206 mlosch 1.10 IF ( useEXF ) THEN
207     CALL THSICE_MAP_EXF(
208 mlosch 1.9 I iceMask,
209 jmc 1.25 O prcAtm(1-OLx,1-OLy,bi,bj),
210     O snowPrc(1-OLx,1-OLy,bi,bj),
211 mlosch 1.9 O icFlxSW(1-OLx,1-OLy,bi,bj),
212     I iMin,iMax,jMin,jMax, bi,bj, myThid )
213 mlosch 1.10 ENDIF
214 mlosch 1.9 #endif
215 jmc 1.2
216 heimbach 1.21 #ifdef ALLOW_AUTODIFF_TAMC
217 gforget 1.23 CADJ STORE sheating(:,:,bi,bj) = comlev1_bibj, key = ticekey
218     CADJ STORE tice1(:,:,bi,bj) = comlev1_bibj, key = ticekey
219     CADJ STORE tice2(:,:,bi,bj) = comlev1_bibj, key = ticekey
220 heimbach 1.21 #endif
221 mlosch 1.10 CALL THSICE_STEP_TEMP(
222 jmc 1.8 I bi, bj, iMin, iMax, jMin, jMax,
223     I myTime, myIter, myThid )
224    
225 heimbach 1.13 #ifdef ALLOW_AUTODIFF_TAMC
226 gforget 1.23 CADJ STORE empmr(:,:,bi,bj) = comlev1_bibj, key = ticekey
227     CADJ STORE qnet(:,:,bi,bj) = comlev1_bibj, key = ticekey
228     CADJ STORE iceMask(:,:,bi,bj) = comlev1_bibj, key = ticekey
229     CADJ STORE iceHeight(:,:,bi,bj) = comlev1_bibj, key = ticekey
230     CADJ STORE snowHeight(:,:,bi,bj) = comlev1_bibj, key = ticekey
231     cphCADJ STORE Tsrf(:,:,bi,bj) = comlev1_bibj, key = ticekey
232     CADJ STORE Qice1(:,:,bi,bj) = comlev1_bibj, key = ticekey
233     CADJ STORE Qice2(:,:,bi,bj) = comlev1_bibj, key = ticekey
234     CADJ STORE snowAge(:,:,bi,bj) = comlev1_bibj, key = ticekey
235     CADJ STORE sheating(:,:,bi,bj) = comlev1_bibj, key = ticekey
236 heimbach 1.13 #endif
237    
238 mlosch 1.10 CALL THSICE_STEP_FWD(
239 jmc 1.8 I bi, bj, iMin, iMax, jMin, jMax,
240 jmc 1.25 I prcAtm(1-OLx,1-OLy,bi,bj),
241 jmc 1.1 I myTime, myIter, myThid )
242 jmc 1.2
243 jmc 1.25 C-- end bi,bj loop
244     ENDDO
245     ENDDO
246    
247     #ifdef ALLOW_BALANCE_FLUXES
248     C-- Balance net Fresh-Water flux from Atm+Land
249     IF ( thSIceBalanceAtmFW.NE.0 ) THEN
250     CALL THSICE_BALANCE_FRW(
251     I iMin, iMax, jMin, jMax,
252     I prcAtm, myTime, myIter, myThid )
253     ENDIF
254     #endif
255    
256     DO bj=myByLo(myThid),myByHi(myThid)
257     DO bi=myBxLo(myThid),myBxHi(myThid)
258 mlosch 1.10 CALL THSICE_AVE(
259 jmc 1.8 I bi,bj, myTime, myIter, myThid )
260 jmc 1.24 ENDDO
261     ENDDO
262 jmc 1.1
263 jmc 1.24 C add a small piece of code to check AddFluid implementation:
264     c#include "thsice_test_addfluid.h"
265    
266     IF ( useSEAICE .OR. thSIceAdvScheme.GT.0 ) THEN
267     C-- Exchange fields that are advected by seaice dynamics
268     _EXCH_XY_RL( iceMask, myThid )
269     _EXCH_XY_RL( iceHeight, myThid )
270     _EXCH_XY_RL( snowHeight, myThid )
271     _EXCH_XY_RL( Qice1, myThid )
272     _EXCH_XY_RL( Qice2, myThid )
273     ELSEIF ( useEXF .AND. stressReduction.GT. 0. _d 0 ) THEN
274     _EXCH_XY_RL( iceMask, myThid )
275     ENDIF
276     #ifdef ATMOSPHERIC_LOADING
277     IF ( useRealFreshWaterFlux .AND. (useEXF.OR.useSEAICE ) )
278     & _EXCH_XY_RS( sIceLoad, myThid )
279     #endif
280    
281     DO bj=myByLo(myThid),myByHi(myThid)
282     DO bi=myBxLo(myThid),myBxHi(myThid)
283 jmc 1.11 C-- note: If useSEAICE=.true., the stress is computed in seaice_model,
284     C-- and stressReduction is always set to zero
285 heimbach 1.7 #ifdef ALLOW_AUTODIFF_TAMC
286 gforget 1.23 CADJ STORE fu(:,:,bi,bj) = comlev1_bibj, key=ticekey, byte=isbyte
287     CADJ STORE fv(:,:,bi,bj) = comlev1_bibj, key=ticekey, byte=isbyte
288 heimbach 1.7 #endif
289 jmc 1.11 IF ( stressReduction.GT. 0. _d 0 ) THEN
290 mlosch 1.10 DO j = jMin, jMax
291     DO i = iMin+1,iMax
292 jmc 1.1 tauFac = stressReduction
293     & *(iceMask(i-1,j,bi,bj)+iceMask(i,j,bi,bj))*0.5 _d 0
294     fu(i,j,bi,bj) = (1. _d 0 - tauFac)*fu(i,j,bi,bj)
295 mlosch 1.10 ENDDO
296 jmc 1.1 ENDDO
297 mlosch 1.10 DO j = jMin+1, jMax
298     DO i = iMin, iMax
299 jmc 1.1 tauFac = stressReduction
300     & *(iceMask(i,j-1,bi,bj)+iceMask(i,j,bi,bj))*0.5 _d 0
301     fv(i,j,bi,bj) = (1. _d 0 - tauFac)*fv(i,j,bi,bj)
302 mlosch 1.10 ENDDO
303 jmc 1.1 ENDDO
304     ENDIF
305    
306     C-- end bi,bj loop
307     ENDDO
308     ENDDO
309    
310     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
311     #endif /*ALLOW_THSICE*/
312    
313     RETURN
314     END

  ViewVC Help
Powered by ViewVC 1.1.22