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

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

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


Revision 1.5 - (hide annotations) (download)
Wed May 23 23:40:19 2007 UTC (17 years ago) by jmc
Branch: MAIN
CVS Tags: checkpoint59e, checkpoint59d, checkpoint59c
Changes since 1.4: +2 -1 lines
need to be more carefull to get the right fluxes saved in the overlap
 try this fix.

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

  ViewVC Help
Powered by ViewVC 1.1.22