/[MITgcm]/MITgcm/pkg/seaice/seaice_advection.F
ViewVC logotype

Annotation of /MITgcm/pkg/seaice/seaice_advection.F

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


Revision 1.5 - (hide annotations) (download)
Wed Apr 4 01:40:58 2007 UTC (17 years, 1 month ago) by jmc
Branch: MAIN
CVS Tags: checkpoint59, checkpoint58y_post
Changes since 1.4: +17 -17 lines
add a logical argument "calcCFL" to DST horizontal Advection S/R
(if false, assume that uFld,vFld are already CFL number in x,y dir)

1 jmc 1.5 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_advection.F,v 1.4 2006/11/01 01:56:23 jmc Exp $
2 mlosch 1.1 C $Name: $
3    
4 jmc 1.4 #include "SEAICE_OPTIONS.h"
5     #ifdef ALLOW_GENERIC_ADVDIFF
6     # include "GAD_OPTIONS.h"
7     #endif
8 mlosch 1.1
9     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
10     CBOP
11     C !ROUTINE: SEAICE_ADVECTION
12    
13     C !INTERFACE: ==========================================================
14     SUBROUTINE SEAICE_ADVECTION(
15 jmc 1.4 I tracerIdentity,
16 mlosch 1.1 I advectionScheme,
17 jmc 1.4 I extensiveFld,
18     I uFld, vFld, uTrans, vTrans, iceFld, r_hFld,
19     O gFld, afx, afy,
20 mlosch 1.1 I bi, bj, myTime, myIter, myThid)
21    
22     C !DESCRIPTION:
23 jmc 1.4 C Calculates the tendency of a sea-ice field due to advection.
24 mlosch 1.1 C It uses the multi-dimensional method given in \ref{sect:multiDimAdvection}
25     C and can only be used for the non-linear advection schemes such as the
26 jmc 1.4 C direct-space-time method and flux-limiters.
27 mlosch 1.1 C
28     C This routine is an adaption of the GAD_ADVECTION for 2D-fields.
29 jmc 1.4 C for Area, effective thickness or other "extensive" sea-ice field,
30     C the contribution iceFld*div(u) (that is present in gad_advection)
31     C is not included here.
32 mlosch 1.1 C
33     C The algorithm is as follows:
34     C \begin{itemize}
35     C \item{$\theta^{(n+1/2)} = \theta^{(n)}
36     C - \Delta t \partial_x (u\theta^{(n)}) + \theta^{(n)} \partial_x u$}
37     C \item{$\theta^{(n+2/2)} = \theta^{(n+1/2)}
38     C - \Delta t \partial_y (v\theta^{(n+1/2)}) + \theta^{(n)} \partial_y v$}
39     C \item{$G_\theta = ( \theta^{(n+2/2)} - \theta^{(n)} )/\Delta t$}
40     C \end{itemize}
41     C
42     C The tendency (output) is over-written by this routine.
43    
44     C !USES: ===============================================================
45     IMPLICIT NONE
46     #include "SIZE.h"
47     #include "EEPARAMS.h"
48     #include "PARAMS.h"
49     #include "GRID.h"
50     #include "SEAICE_PARAMS.h"
51 jmc 1.4 #ifdef ALLOW_GENERIC_ADVDIFF
52     # include "GAD.h"
53     #endif
54 mlosch 1.1 #ifdef ALLOW_AUTODIFF_TAMC
55     # include "tamc.h"
56     # include "tamc_keys.h"
57     #endif
58     #ifdef ALLOW_EXCH2
59     #include "W2_EXCH2_TOPOLOGY.h"
60     #include "W2_EXCH2_PARAMS.h"
61     #endif /* ALLOW_EXCH2 */
62    
63     C !INPUT PARAMETERS: ===================================================
64 jmc 1.4 C tracerIdentity :: tracer identifier (required only for OBCS)
65     C advectionScheme :: advection scheme to use (Horizontal plane)
66     C extensiveFld :: indicates to advect an "extensive" type of ice field
67     C uFld :: velocity, zonal component
68     C vFld :: velocity, meridional component
69     C uTrans,vTrans :: volume transports at U,V points
70     C iceFld :: sea-ice field
71     C r_hFld :: reciprol of ice-thickness (only used for "intensive"
72     C type of sea-ice field)
73     C bi,bj :: tile indices
74     C myTime :: current time
75     C myIter :: iteration number
76     C myThid :: thread number
77     INTEGER tracerIdentity
78 mlosch 1.1 INTEGER advectionScheme
79 jmc 1.4 LOGICAL extensiveFld
80     _RL uFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
81     _RL vFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
82     _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
83     _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
84     _RL iceFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
85     _RL r_hFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
86 mlosch 1.1 INTEGER bi,bj
87     _RL myTime
88     INTEGER myIter
89     INTEGER myThid
90    
91     C !OUTPUT PARAMETERS: ==================================================
92 jmc 1.4 C gFld :: tendency array
93     C afx :: horizontal advective flux, x direction
94     C afy :: horizontal advective flux, y direction
95     _RL gFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
96     _RL afx (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
97     _RL afy (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
98 mlosch 1.1
99     C !LOCAL VARIABLES: ====================================================
100     C maskLocW :: 2-D array for mask at West points
101     C maskLocS :: 2-D array for mask at South points
102     C iMin,iMax, :: loop range for called routines
103     C jMin,jMax :: loop range for called routines
104 jmc 1.4 C [iMin,iMax]Upd :: loop range to update sea-ice field
105     C [jMin,jMax]Upd :: loop range to update sea-ice field
106 mlosch 1.1 C i,j,k :: loop indices
107     C af :: 2-D array for horizontal advective flux
108 jmc 1.4 C localTij :: 2-D array, temporary local copy of sea-ice fld
109 mlosch 1.1 C calc_fluxes_X :: logical to indicate to calculate fluxes in X dir
110     C calc_fluxes_Y :: logical to indicate to calculate fluxes in Y dir
111     C interiorOnly :: only update the interior of myTile, but not the edges
112     C overlapOnly :: only update the edges of myTile, but not the interior
113     C nipass :: number of passes in multi-dimensional method
114     C ipass :: number of the current pass being made
115 jmc 1.4 C myTile :: variables used to determine which cube face
116 mlosch 1.1 C nCFace :: owns a tile for cube grid runs using
117     C :: multi-dim advection.
118     C [N,S,E,W]_edge :: true if N,S,E,W edge of myTile is an Edge of the cube
119     _RS maskLocW(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
120     _RS maskLocS(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
121     INTEGER iMin,iMax,jMin,jMax
122     INTEGER iMinUpd,iMaxUpd,jMinUpd,jMaxUpd
123     INTEGER i,j,k
124     _RL af (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
125     _RL localTij(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
126     LOGICAL calc_fluxes_X, calc_fluxes_Y, withSigns
127     LOGICAL interiorOnly, overlapOnly
128     INTEGER nipass,ipass
129     INTEGER nCFace
130     LOGICAL N_edge, S_edge, E_edge, W_edge
131     #ifdef ALLOW_EXCH2
132     INTEGER myTile
133     #endif
134     #ifdef ALLOW_DIAGNOSTICS
135     CHARACTER*8 diagName
136     CHARACTER*4 GAD_DIAG_SUFX, diagSufx
137     EXTERNAL GAD_DIAG_SUFX
138     #endif
139 jmc 1.4 LOGICAL dBug
140     _RL tmpFac
141 mlosch 1.1 CEOP
142    
143     #ifdef ALLOW_AUTODIFF_TAMC
144     act0 = tracerIdentity - 1
145     max0 = maxpass
146     act1 = bi - myBxLo(myThid)
147     max1 = myBxHi(myThid) - myBxLo(myThid) + 1
148     act2 = bj - myByLo(myThid)
149     max2 = myByHi(myThid) - myByLo(myThid) + 1
150     act3 = myThid - 1
151     max3 = nTx*nTy
152     act4 = ikey_dynamics - 1
153 jmc 1.4 igadkey = (act0 + 1)
154 mlosch 1.1 & + act1*max0
155     & + act2*max0*max1
156     & + act3*max0*max1*max2
157     & + act4*max0*max1*max2*max3
158     if (tracerIdentity.GT.maxpass) then
159     print *, 'ph-pass gad_advection ', maxpass, tracerIdentity
160     STOP 'maxpass seems smaller than tracerIdentity'
161     endif
162     #endif /* ALLOW_AUTODIFF_TAMC */
163    
164     CML#ifdef ALLOW_DIAGNOSTICS
165 jmc 1.4 CMLC-- Set diagnostic suffix for the current tracer
166 mlosch 1.1 CML IF ( useDiagnostics ) THEN
167     CML diagSufx = GAD_DIAG_SUFX( tracerIdentity, myThid )
168     CML ENDIF
169     CML#endif
170    
171 jmc 1.4 dBug = debugLevel.GE.debLevB
172     & .AND. myIter.EQ.nIter0
173     & .AND. ( tracerIdentity.EQ.GAD_HEFF .OR.
174     & tracerIdentity.EQ.GAD_QICE2 )
175     c & .AND. tracerIdentity.EQ.GAD_HEFF
176    
177 mlosch 1.1 C-- Set up work arrays with valid (i.e. not NaN) values
178     C These inital values do not alter the numerical results. They
179     C just ensure that all memory references are to valid floating
180     C point numbers. This prevents spurious hardware signals due to
181     C uninitialised but inert locations.
182 jmc 1.4 #ifdef ALLOW_AUTODIFF_TAMC
183 mlosch 1.1 DO j=1-OLy,sNy+OLy
184     DO i=1-OLx,sNx+OLx
185     localTij(i,j) = 0. _d 0
186     ENDDO
187     ENDDO
188 jmc 1.4 #endif
189 mlosch 1.1
190     C-- Set tile-specific parameters for horizontal fluxes
191     IF (useCubedSphereExchange) THEN
192     nipass=3
193     #ifdef ALLOW_AUTODIFF_TAMC
194     IF ( nipass.GT.maxcube ) STOP 'maxcube needs to be = 3'
195     #endif
196     #ifdef ALLOW_EXCH2
197     myTile = W2_myTileList(bi)
198     nCFace = exch2_myFace(myTile)
199     N_edge = exch2_isNedge(myTile).EQ.1
200     S_edge = exch2_isSedge(myTile).EQ.1
201     E_edge = exch2_isEedge(myTile).EQ.1
202     W_edge = exch2_isWedge(myTile).EQ.1
203     #else
204     nCFace = bi
205     N_edge = .TRUE.
206     S_edge = .TRUE.
207     E_edge = .TRUE.
208     W_edge = .TRUE.
209     #endif
210     ELSE
211     nipass=2
212     nCFace = bi
213     N_edge = .FALSE.
214     S_edge = .FALSE.
215     E_edge = .FALSE.
216     W_edge = .FALSE.
217     ENDIF
218    
219     iMin = 1-OLx
220     iMax = sNx+OLx
221     jMin = 1-OLy
222     jMax = sNy+OLy
223    
224 jmc 1.4 k = 1
225 mlosch 1.1 C-- Start of k loop for horizontal fluxes
226 jmc 1.4 #ifdef ALLOW_AUTODIFF_TAMC
227 mlosch 1.1 kkey = (igadkey-1)*Nr + k
228 jmc 1.4 CADJ STORE iceFld =
229 mlosch 1.1 CADJ & comlev1_bibj_k_gad, key=kkey, byte=isbyte
230     #endif /* ALLOW_AUTODIFF_TAMC */
231    
232     C Content of CALC_COMMON_FACTORS, adapted for 2D fields
233     C-- Get temporary terms used by tendency routines
234    
235 jmc 1.4 C-- Make local copy of sea-ice field and mask West & South
236 mlosch 1.1 DO j=1-OLy,sNy+OLy
237     DO i=1-OLx,sNx+OLx
238 jmc 1.4 localTij(i,j)=iceFld(i,j)
239 mlosch 1.1 maskLocW(i,j)=maskW(i,j,k,bi,bj)
240     maskLocS(i,j)=maskS(i,j,k,bi,bj)
241     ENDDO
242     ENDDO
243 jmc 1.4
244     #ifdef ALLOW_AUTODIFF_TAMC
245     C- Initialise Advective flux in X & Y
246     DO j=1-OLy,sNy+OLy
247     DO i=1-OLx,sNx+OLx
248     afx(i,j) = 0.
249     afy(i,j) = 0.
250     ENDDO
251     ENDDO
252     #endif
253    
254 mlosch 1.1 #ifndef ALLOW_AUTODIFF_TAMC
255     IF (useCubedSphereExchange) THEN
256     withSigns = .FALSE.
257 jmc 1.4 CALL FILL_CS_CORNER_UV_RS(
258 mlosch 1.1 & withSigns, maskLocW,maskLocS, bi,bj, myThid )
259     ENDIF
260     #endif
261    
262     C-- Multiple passes for different directions on different tiles
263     C-- For cube need one pass for each of red, green and blue axes.
264     DO ipass=1,nipass
265     #ifdef ALLOW_AUTODIFF_TAMC
266     passkey = ipass + (k-1) *maxcube
267     & + (igadkey-1)*maxcube*Nr
268     IF (nipass .GT. maxpass) THEN
269     STOP 'SEAICE_ADVECTION: nipass > maxcube. check tamc.h'
270     ENDIF
271     #endif /* ALLOW_AUTODIFF_TAMC */
272    
273     interiorOnly = .FALSE.
274     overlapOnly = .FALSE.
275     IF (useCubedSphereExchange) THEN
276 jmc 1.4 C-- CubedSphere : pass 3 times, with partial update of local seaice field
277 mlosch 1.1 IF (ipass.EQ.1) THEN
278     overlapOnly = MOD(nCFace,3).EQ.0
279     interiorOnly = MOD(nCFace,3).NE.0
280     calc_fluxes_X = nCFace.EQ.6 .OR. nCFace.EQ.1 .OR. nCFace.EQ.2
281     calc_fluxes_Y = nCFace.EQ.3 .OR. nCFace.EQ.4 .OR. nCFace.EQ.5
282     ELSEIF (ipass.EQ.2) THEN
283     overlapOnly = MOD(nCFace,3).EQ.2
284     calc_fluxes_X = nCFace.EQ.2 .OR. nCFace.EQ.3 .OR. nCFace.EQ.4
285     calc_fluxes_Y = nCFace.EQ.5 .OR. nCFace.EQ.6 .OR. nCFace.EQ.1
286     ELSE
287     calc_fluxes_X = nCFace.EQ.5 .OR. nCFace.EQ.6
288     calc_fluxes_Y = nCFace.EQ.2 .OR. nCFace.EQ.3
289     ENDIF
290     ELSE
291     C-- not CubedSphere
292     calc_fluxes_X = MOD(ipass,2).EQ.1
293     calc_fluxes_Y = .NOT.calc_fluxes_X
294     ENDIF
295 jmc 1.4 IF (dBug.AND.bi.EQ.3 ) WRITE(6,*) 'ICE_adv:',tracerIdentity,
296     & ipass,calc_fluxes_X,calc_fluxes_Y,overlapOnly,interiorOnly
297    
298 mlosch 1.1 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
299     C-- X direction
300 jmc 1.4
301 mlosch 1.1 #ifdef ALLOW_AUTODIFF_TAMC
302 jmc 1.4 CADJ STORE localTij(:,:) =
303 mlosch 1.1 CADJ & comlev1_bibj_k_gad_pass, key=passkey, byte=isbyte
304 heimbach 1.2 # ifndef DISABLE_MULTIDIM_ADVECTION
305 jmc 1.4 CADJ STORE af(:,:) =
306 mlosch 1.1 CADJ & comlev1_bibj_k_gad_pass, key=passkey, byte=isbyte
307 heimbach 1.2 # endif
308 mlosch 1.1 #endif /* ALLOW_AUTODIFF_TAMC */
309     C
310     IF (calc_fluxes_X) THEN
311 jmc 1.4
312 mlosch 1.1 C- Do not compute fluxes if
313 jmc 1.4 C a) needed in overlap only
314 mlosch 1.1 C and b) the overlap of myTile are not cube-face Edges
315     IF ( .NOT.overlapOnly .OR. N_edge .OR. S_edge ) THEN
316    
317 jmc 1.4 C- Advective flux in X
318     DO j=1-Oly,sNy+Oly
319     DO i=1-Olx,sNx+Olx
320     af(i,j) = 0.
321     ENDDO
322     ENDDO
323    
324 mlosch 1.1 #ifndef ALLOW_AUTODIFF_TAMC
325     C- Internal exchange for calculations in X
326     #ifdef MULTIDIM_OLD_VERSION
327     IF ( useCubedSphereExchange ) THEN
328     #else
329     IF ( useCubedSphereExchange .AND.
330     & ( overlapOnly .OR. ipass.EQ.1 ) ) THEN
331     #endif
332     CALL FILL_CS_CORNER_TR_RL( .TRUE., localTij, bi,bj, myThid )
333     ENDIF
334     #endif
335    
336     #ifdef ALLOW_AUTODIFF_TAMC
337     # ifndef DISABLE_MULTIDIM_ADVECTION
338 jmc 1.4 CADJ STORE localTij(:,:) =
339 mlosch 1.1 CADJ & comlev1_bibj_k_gad_pass, key=passkey, byte=isbyte
340     # endif
341     #endif /* ALLOW_AUTODIFF_TAMC */
342    
343     IF ( advectionScheme.EQ.ENUM_UPWIND_1RST
344     & .OR. advectionScheme.EQ.ENUM_DST2 ) THEN
345 jmc 1.5 CALL GAD_DST2U1_ADV_X( bi,bj,k, advectionScheme, .TRUE.,
346     I SEAICE_deltaTtherm, uTrans, uFld, localTij,
347 mlosch 1.1 O af, myThid )
348 jmc 1.4 IF (dBug.AND. bi.EQ.3) WRITE(6,'(A,1P4E14.6)')
349     & 'ICE_adv: xFx=',af(13,11),localTij(12,11),uTrans(13,11),
350     & af(13,11)/uTrans(13,11)
351 mlosch 1.1 ELSEIF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN
352 jmc 1.5 CALL GAD_FLUXLIMIT_ADV_X( bi,bj,k, .TRUE.,
353     I SEAICE_deltaTtherm, uTrans, uFld, maskLocW, localTij,
354 mlosch 1.1 O af, myThid )
355     ELSEIF (advectionScheme.EQ.ENUM_DST3 ) THEN
356 jmc 1.5 CALL GAD_DST3_ADV_X( bi,bj,k, .TRUE.,
357     I SEAICE_deltaTtherm, uTrans, uFld, maskLocW, localTij,
358 mlosch 1.1 O af, myThid )
359     ELSEIF (advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN
360 jmc 1.5 CALL GAD_DST3FL_ADV_X( bi,bj,k, .TRUE.,
361     I SEAICE_deltaTtherm, uTrans, uFld, maskLocW, localTij,
362 mlosch 1.1 O af, myThid )
363     ELSE
364 jmc 1.4 STOP
365 mlosch 1.1 & 'SEAICE_ADVECTION: adv. scheme incompatibale with multi-dim'
366     ENDIF
367 jmc 1.4
368 mlosch 1.1 C-- Advective flux in X : done
369     ENDIF
370 jmc 1.4
371 mlosch 1.1 #ifndef ALLOW_AUTODIFF_TAMC
372     C-- Internal exchange for next calculations in Y
373     IF ( overlapOnly .AND. ipass.EQ.1 ) THEN
374     CALL FILL_CS_CORNER_TR_RL(.FALSE., localTij, bi,bj, myThid )
375     ENDIF
376     #endif
377    
378 jmc 1.4 C- Update the local seaice field where needed:
379 mlosch 1.1
380     C update in overlap-Only
381     IF ( overlapOnly ) THEN
382 jmc 1.4 iMinUpd = 1-OLx+1
383     iMaxUpd = sNx+OLx-1
384     C-- notes: these 2 lines below have no real effect (because recip_hFac=0
385 mlosch 1.1 C in corner region) but safer to keep them.
386     IF ( W_edge ) iMinUpd = 1
387     IF ( E_edge ) iMaxUpd = sNx
388 jmc 1.4
389     IF ( S_edge .AND. extensiveFld ) THEN
390     DO j=1-OLy,0
391 mlosch 1.1 DO i=iMinUpd,iMaxUpd
392 jmc 1.4 localTij(i,j)=localTij(i,j)
393     & -SEAICE_deltaTtherm*maskC(i,j,k,bi,bj)
394 mlosch 1.1 & *recip_rA(i,j,bi,bj)
395 jmc 1.4 & *( af(i+1,j)-af(i,j)
396     & )
397     ENDDO
398     ENDDO
399     ELSEIF ( S_edge ) THEN
400     DO j=1-OLy,0
401     DO i=iMinUpd,iMaxUpd
402     localTij(i,j)=localTij(i,j)
403     & -SEAICE_deltaTtherm*maskC(i,j,k,bi,bj)
404     & *recip_rA(i,j,bi,bj)*r_hFld(i,j)
405     & *( (af(i+1,j)-af(i,j))
406     & -(uTrans(i+1,j)-uTrans(i,j))*iceFld(i,j)
407     & )
408 mlosch 1.1 ENDDO
409     ENDDO
410     ENDIF
411 jmc 1.4 IF ( N_edge .AND. extensiveFld ) THEN
412     DO j=sNy+1,sNy+OLy
413 mlosch 1.1 DO i=iMinUpd,iMaxUpd
414 jmc 1.4 localTij(i,j)=localTij(i,j)
415     & -SEAICE_deltaTtherm*maskC(i,j,k,bi,bj)
416 mlosch 1.1 & *recip_rA(i,j,bi,bj)
417 jmc 1.4 & *( af(i+1,j)-af(i,j)
418     & )
419     ENDDO
420     ENDDO
421     ELSEIF ( N_edge ) THEN
422     DO j=sNy+1,sNy+OLy
423     DO i=iMinUpd,iMaxUpd
424     localTij(i,j)=localTij(i,j)
425     & -SEAICE_deltaTtherm*maskC(i,j,k,bi,bj)
426     & *recip_rA(i,j,bi,bj)*r_hFld(i,j)
427     & *( (af(i+1,j)-af(i,j))
428     & -(uTrans(i+1,j)-uTrans(i,j))*iceFld(i,j)
429     & )
430 mlosch 1.1 ENDDO
431     ENDDO
432     ENDIF
433 jmc 1.4 C-- keep advective flux (for diagnostics)
434     IF ( S_edge ) THEN
435     DO j=1-OLy,0
436     DO i=1-OLx+1,sNx+OLx
437     afx(i,j) = af(i,j)
438     ENDDO
439     ENDDO
440     ENDIF
441     IF ( N_edge ) THEN
442     DO j=sNy+1,sNy+OLy
443     DO i=1-OLx+1,sNx+OLx
444     afx(i,j) = af(i,j)
445     ENDDO
446     ENDDO
447     ENDIF
448    
449 mlosch 1.1 ELSE
450     C do not only update the overlap
451 jmc 1.4 jMinUpd = 1-OLy
452     jMaxUpd = sNy+OLy
453 mlosch 1.1 IF ( interiorOnly .AND. S_edge ) jMinUpd = 1
454     IF ( interiorOnly .AND. N_edge ) jMaxUpd = sNy
455 jmc 1.4 IF ( extensiveFld ) THEN
456     DO j=jMinUpd,jMaxUpd
457     DO i=1-OLx+1,sNx+OLx-1
458     localTij(i,j)=localTij(i,j)
459     & -SEAICE_deltaTtherm*maskC(i,j,k,bi,bj)
460     & *recip_rA(i,j,bi,bj)
461     & *( af(i+1,j)-af(i,j)
462     & )
463     ENDDO
464     ENDDO
465     ELSE
466     DO j=jMinUpd,jMaxUpd
467     DO i=1-OLx+1,sNx+OLx-1
468     localTij(i,j)=localTij(i,j)
469     & -SEAICE_deltaTtherm*maskC(i,j,k,bi,bj)
470     & *recip_rA(i,j,bi,bj)*r_hFld(i,j)
471     & *( (af(i+1,j)-af(i,j))
472     & -(uTrans(i+1,j)-uTrans(i,j))*iceFld(i,j)
473     & )
474     ENDDO
475 mlosch 1.1 ENDDO
476 jmc 1.4 ENDIF
477 mlosch 1.1 C-- keep advective flux (for diagnostics)
478 jmc 1.4 DO j=jMinUpd,jMaxUpd
479     DO i=1-OLx+1,sNx+OLx
480     afx(i,j) = af(i,j)
481     ENDDO
482 mlosch 1.1 ENDDO
483    
484     C This is for later
485     CML#ifdef ALLOW_OBCS
486     CMLC- Apply open boundary conditions
487     CML IF ( useOBCS ) THEN
488     CML IF (tracerIdentity.EQ.GAD_HEFF) THEN
489     CML CALL OBCS_APPLY_HEFF( bi, bj, k, localTij, myThid )
490     CML ELSEIF (tracerIdentity.EQ.GAD_AREA) THEN
491     CML CALL OBCS_APPLY_AREA( bi, bj, k, localTij, myThid )
492     CML ENDIF
493     CML ENDIF
494     CML#endif /* ALLOW_OBCS */
495    
496     C- end if/else update overlap-Only
497     ENDIF
498 jmc 1.4
499 mlosch 1.1 C-- End of X direction
500     ENDIF
501 jmc 1.4
502 mlosch 1.1 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
503     C-- Y direction
504 jmc 1.4
505 mlosch 1.1 #ifdef ALLOW_AUTODIFF_TAMC
506 heimbach 1.2 # ifndef DISABLE_MULTIDIM_ADVECTION
507 jmc 1.4 CADJ STORE localTij(:,:) =
508 mlosch 1.1 CADJ & comlev1_bibj_k_gad_pass, key=passkey, byte=isbyte
509 jmc 1.4 CADJ STORE af(:,:) =
510 mlosch 1.1 CADJ & comlev1_bibj_k_gad_pass, key=passkey, byte=isbyte
511 heimbach 1.2 # endif
512 mlosch 1.1 #endif /* ALLOW_AUTODIFF_TAMC */
513 jmc 1.4
514 mlosch 1.1 IF (calc_fluxes_Y) THEN
515    
516     C- Do not compute fluxes if
517     C a) needed in overlap only
518     C and b) the overlap of myTile are not cube-face edges
519     IF ( .NOT.overlapOnly .OR. E_edge .OR. W_edge ) THEN
520    
521 jmc 1.4 C- Advective flux in Y
522     DO j=1-OLy,sNy+OLy
523     DO i=1-OLx,sNx+OLx
524     af(i,j) = 0.
525     ENDDO
526     ENDDO
527    
528 mlosch 1.1 #ifndef ALLOW_AUTODIFF_TAMC
529     C- Internal exchange for calculations in Y
530     #ifdef MULTIDIM_OLD_VERSION
531     IF ( useCubedSphereExchange ) THEN
532 jmc 1.4 #else
533 mlosch 1.1 IF ( useCubedSphereExchange .AND.
534     & ( overlapOnly .OR. ipass.EQ.1 ) ) THEN
535     #endif
536     CALL FILL_CS_CORNER_TR_RL(.FALSE., localTij, bi,bj, myThid )
537     ENDIF
538     #endif
539    
540 jmc 1.4 #ifdef ALLOW_AUTODIFF_TAMC
541 mlosch 1.1 #ifndef DISABLE_MULTIDIM_ADVECTION
542 jmc 1.4 CADJ STORE localTij(:,:) =
543 mlosch 1.1 CADJ & comlev1_bibj_k_gad_pass, key=passkey, byte=isbyte
544     #endif
545     #endif /* ALLOW_AUTODIFF_TAMC */
546    
547     IF ( advectionScheme.EQ.ENUM_UPWIND_1RST
548     & .OR. advectionScheme.EQ.ENUM_DST2 ) THEN
549 jmc 1.5 CALL GAD_DST2U1_ADV_Y( bi,bj,k, advectionScheme, .TRUE.,
550     I SEAICE_deltaTtherm, vTrans, vFld, localTij,
551 mlosch 1.1 O af, myThid )
552 jmc 1.4 IF (dBug.AND. bi.EQ.3) WRITE(6,'(A,1P4E14.6)')
553     & 'ICE_adv: yFx=',af(12,12),localTij(12,11),vTrans(12,12),
554     & af(12,12)/vTrans(12,12)
555 mlosch 1.1 ELSEIF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN
556 jmc 1.5 CALL GAD_FLUXLIMIT_ADV_Y( bi,bj,k, .TRUE.,
557     I SEAICE_deltaTtherm, vTrans, vFld, maskLocS, localTij,
558 mlosch 1.1 O af, myThid )
559     ELSEIF (advectionScheme.EQ.ENUM_DST3 ) THEN
560 jmc 1.5 CALL GAD_DST3_ADV_Y( bi,bj,k, .TRUE.,
561     I SEAICE_deltaTtherm, vTrans, vFld, maskLocS, localTij,
562 mlosch 1.1 O af, myThid )
563     ELSEIF (advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN
564 jmc 1.5 CALL GAD_DST3FL_ADV_Y( bi,bj,k, .TRUE.,
565     I SEAICE_deltaTtherm, vTrans, vFld, maskLocS, localTij,
566 mlosch 1.1 O af, myThid )
567     ELSE
568 jmc 1.4 STOP
569 mlosch 1.1 & 'SEAICE_ADVECTION: adv. scheme incompatibale with mutli-dim'
570     ENDIF
571    
572     C- Advective flux in Y : done
573     ENDIF
574    
575     #ifndef ALLOW_AUTODIFF_TAMC
576     C- Internal exchange for next calculations in X
577     IF ( overlapOnly .AND. ipass.EQ.1 ) THEN
578     CALL FILL_CS_CORNER_TR_RL( .TRUE., localTij, bi,bj, myThid )
579     ENDIF
580     #endif
581    
582 jmc 1.4 C- Update the local seaice field where needed:
583 mlosch 1.1
584     C update in overlap-Only
585     IF ( overlapOnly ) THEN
586 jmc 1.4 jMinUpd = 1-OLy+1
587     jMaxUpd = sNy+OLy-1
588     C- notes: these 2 lines below have no real effect (because recip_hFac=0
589 mlosch 1.1 C in corner region) but safer to keep them.
590     IF ( S_edge ) jMinUpd = 1
591     IF ( N_edge ) jMaxUpd = sNy
592 jmc 1.4
593     IF ( W_edge .AND. extensiveFld ) THEN
594 mlosch 1.1 DO j=jMinUpd,jMaxUpd
595 jmc 1.4 DO i=1-OLx,0
596     localTij(i,j)=localTij(i,j)
597     & -SEAICE_deltaTtherm*maskC(i,j,k,bi,bj)
598 mlosch 1.1 & *recip_rA(i,j,bi,bj)
599 jmc 1.4 & *( af(i,j+1)-af(i,j)
600     & )
601     ENDDO
602     ENDDO
603     ELSEIF ( W_edge ) THEN
604     DO j=jMinUpd,jMaxUpd
605     DO i=1-OLx,0
606     localTij(i,j)=localTij(i,j)
607     & -SEAICE_deltaTtherm*maskC(i,j,k,bi,bj)
608     & *recip_rA(i,j,bi,bj)*r_hFld(i,j)
609     & *( (af(i,j+1)-af(i,j))
610     & -(vTrans(i,j+1)-vTrans(i,j))*iceFld(i,j)
611     & )
612 mlosch 1.1 ENDDO
613     ENDDO
614     ENDIF
615 jmc 1.4 IF ( E_edge .AND. extensiveFld ) THEN
616 mlosch 1.1 DO j=jMinUpd,jMaxUpd
617 jmc 1.4 DO i=sNx+1,sNx+OLx
618     localTij(i,j)=localTij(i,j)
619     & -SEAICE_deltaTtherm*maskC(i,j,k,bi,bj)
620 mlosch 1.1 & *recip_rA(i,j,bi,bj)
621 jmc 1.4 & *( af(i,j+1)-af(i,j)
622     & )
623     ENDDO
624     ENDDO
625     ELSEIF ( E_edge ) THEN
626     DO j=jMinUpd,jMaxUpd
627     DO i=sNx+1,sNx+OLx
628     localTij(i,j)=localTij(i,j)
629     & -SEAICE_deltaTtherm*maskC(i,j,k,bi,bj)
630     & *recip_rA(i,j,bi,bj)*r_hFld(i,j)
631     & *( (af(i,j+1)-af(i,j))
632     & -(vTrans(i,j+1)-vTrans(i,j))*iceFld(i,j)
633     & )
634 mlosch 1.1 ENDDO
635     ENDDO
636     ENDIF
637 jmc 1.4 C-- keep advective flux (for diagnostics)
638     IF ( W_edge ) THEN
639     DO j=1-OLy+1,sNy+OLy
640     DO i=1-OLx,0
641     afy(i,j) = af(i,j)
642     ENDDO
643     ENDDO
644     ENDIF
645     IF ( E_edge ) THEN
646     DO j=1-OLy+1,sNy+OLy
647     DO i=sNx+1,sNx+OLx
648     afy(i,j) = af(i,j)
649     ENDDO
650     ENDDO
651     ENDIF
652    
653 mlosch 1.1 ELSE
654     C do not only update the overlap
655 jmc 1.4 iMinUpd = 1-OLx
656     iMaxUpd = sNx+OLx
657 mlosch 1.1 IF ( interiorOnly .AND. W_edge ) iMinUpd = 1
658     IF ( interiorOnly .AND. E_edge ) iMaxUpd = sNx
659 jmc 1.4 IF ( extensiveFld ) THEN
660     DO j=1-OLy+1,sNy+OLy-1
661     DO i=iMinUpd,iMaxUpd
662     localTij(i,j)=localTij(i,j)
663     & -SEAICE_deltaTtherm*maskC(i,j,k,bi,bj)
664     & *recip_rA(i,j,bi,bj)
665     & *( af(i,j+1)-af(i,j)
666     & )
667     ENDDO
668 mlosch 1.1 ENDDO
669 jmc 1.4 ELSE
670     DO j=1-OLy+1,sNy+OLy-1
671     DO i=iMinUpd,iMaxUpd
672     localTij(i,j)=localTij(i,j)
673     & -SEAICE_deltaTtherm*maskC(i,j,k,bi,bj)
674     & *recip_rA(i,j,bi,bj)*r_hFld(i,j)
675     & *( (af(i,j+1)-af(i,j))
676     & -(vTrans(i,j+1)-vTrans(i,j))*iceFld(i,j)
677     & )
678     ENDDO
679     ENDDO
680     ENDIF
681 mlosch 1.1 C-- keep advective flux (for diagnostics)
682 jmc 1.4 DO j=1-OLy+1,sNy+OLy
683     DO i=iMinUpd,iMaxUpd
684     afy(i,j) = af(i,j)
685     ENDDO
686 mlosch 1.1 ENDDO
687    
688     C-- Save this for later
689     CML#ifdef ALLOW_OBCS
690     CMLC- Apply open boundary conditions
691     CML IF (useOBCS) THEN
692     CML IF (tracerIdentity.EQ.GAD_HEFF) THEN
693     CML CALL OBCS_APPLY_HEFF( bi, bj, k, localTij, myThid )
694     CML ELSEIF (tracerIdentity.EQ.GAD_AREA) THEN
695     CML CALL OBCS_APPLY_AREA( bi, bj, k, localTij, myThid )
696     CML ENDIF
697     CML ENDIF
698     CML#endif /* ALLOW_OBCS */
699    
700     C end if/else update overlap-Only
701     ENDIF
702    
703     C-- End of Y direction
704     ENDIF
705    
706     C-- End of ipass loop
707     ENDDO
708    
709 jmc 1.4 C- explicit advection is done ; store tendency in gFld:
710     DO j=1-OLy,sNy+OLy
711     DO i=1-OLx,sNx+OLx
712     gFld(i,j)=
713     & (localTij(i,j)-iceFld(i,j))/SEAICE_deltaTtherm
714     IF ( dBug
715     & .AND. i.EQ.12 .AND. j.EQ.11 .AND. bi.EQ.3 ) THEN
716     tmpFac= SEAICE_deltaTtherm*recip_rA(i,j,bi,bj)
717     WRITE(6,'(A,1P4E14.6)') 'ICE_adv:',
718     & afx(i,j)*tmpFac,afx(i+1,j)*tmpFac,
719     & afy(i,j)*tmpFac,afy(i,j+1)*tmpFac
720     ENDIF
721 mlosch 1.1 ENDDO
722     ENDDO
723 jmc 1.4
724 mlosch 1.1 CML#ifdef ALLOW_DIAGNOSTICS
725     CML IF ( useDiagnostics ) THEN
726     CML diagName = 'ADVx'//diagSufx
727     CML CALL DIAGNOSTICS_FILL(afx,diagName, k,1, 2,bi,bj, myThid)
728     CML diagName = 'ADVy'//diagSufx
729     CML CALL DIAGNOSTICS_FILL(afy,diagName, k,1, 2,bi,bj, myThid)
730     CML ENDIF
731     CML#endif
732    
733     #ifdef ALLOW_DEBUG
734     IF ( debugLevel .GE. debLevB
735     & .AND. tracerIdentity.EQ.GAD_HEFF
736     & .AND. k.LE.3 .AND. myIter.EQ.1+nIter0
737     & .AND. nPx.EQ.1 .AND. nPy.EQ.1
738     & .AND. useCubedSphereExchange ) THEN
739     CALL DEBUG_CS_CORNER_UV( ' afx,afy from SEAICE_ADVECTION',
740     & afx,afy, k, standardMessageUnit,bi,bj,myThid )
741     ENDIF
742     #endif /* ALLOW_DEBUG */
743    
744     RETURN
745     END

  ViewVC Help
Powered by ViewVC 1.1.22