/[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.6 - (hide annotations) (download)
Thu Aug 16 02:20:41 2007 UTC (16 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint59g, checkpoint59f, checkpoint59m, checkpoint59l, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j
Changes since 1.5: +17 -9 lines
add argument "withSigns" to S/R FILL_CS_CORNER_TR_RL calls

1 jmc 1.6 C $Header: /u/gcmpack/MITgcm/pkg/thsice/thsice_advection.F,v 1.5 2007/05/23 23:40:19 jmc 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 jmc 1.6 CALL FILL_CS_CORNER_TR_RL( .TRUE., .FALSE.,
298     & iceFld, bi,bj, myThid )
299 jmc 1.1 IF ( .NOT.useGridVolume )
300 jmc 1.6 & CALL FILL_CS_CORNER_TR_RL( .TRUE., .FALSE.,
301     & iceVol, bi,bj, myThid )
302 jmc 1.1 ENDIF
303 heimbach 1.4 #endif
304 jmc 1.1
305     C- Compute CFL number
306     IF ( useGridVolume ) THEN
307     DO j=1-Oly,sNy+Oly
308     DO i=2-Olx,sNx+Olx
309     uCfl(i,j) = deltaTadvect*(
310     & MAX( uTrans(i,j), 0. _d 0 )*recip_rA(i-1,j,bi,bj)
311     & +MAX(-uTrans(i,j), 0. _d 0 )*recip_rA( i ,j,bi,bj)
312     & )
313     ENDDO
314     ENDDO
315     ELSE
316     DO j=1-Oly,sNy+Oly
317     DO i=2-Olx,sNx+Olx
318     uCfl(i,j) = deltaTadvect*(
319     & MAX( uTrans(i,j), 0. _d 0 )/MAX( iceVol(i-1,j), iceEps )
320     & +MAX(-uTrans(i,j), 0. _d 0 )/MAX( iceVol( i ,j), iceEps )
321     & )
322     ENDDO
323     ENDDO
324     ENDIF
325    
326     IF ( advectionScheme.EQ.ENUM_UPWIND_1RST
327     & .OR. advectionScheme.EQ.ENUM_DST2 ) THEN
328     CALL GAD_DST2U1_ADV_X( bi,bj,k, advectionScheme, .FALSE.,
329     I deltaTadvect, uTrans, uCfl, iceFld,
330     O af, myThid )
331     IF (dBug.AND. bi.EQ.3) WRITE(6,'(A,1P4E14.6)')
332     & 'ICE_adv: xFx=',af(13,11),iceFld(12,11),uTrans(13,11),
333     & af(13,11)/uTrans(13,11)
334     ELSEIF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN
335     CALL GAD_FLUXLIMIT_ADV_X( bi,bj,k, .FALSE., deltaTadvect,
336     I uTrans, uCfl, maskLocW, iceFld,
337     O af, myThid )
338     ELSEIF (advectionScheme.EQ.ENUM_DST3 ) THEN
339     CALL GAD_DST3_ADV_X( bi,bj,k, .FALSE., deltaTadvect,
340     I uTrans, uCfl, maskLocW, iceFld,
341     O af, myThid )
342     ELSEIF (advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN
343     CALL GAD_DST3FL_ADV_X( bi,bj,k, .FALSE., deltaTadvect,
344     I uTrans, uCfl, maskLocW, iceFld,
345     O af, myThid )
346     ELSE
347     STOP
348     & 'THSICE_ADVECTION: adv. scheme incompatibale with multi-dim'
349     ENDIF
350    
351     C-- Advective flux in X : done
352     ENDIF
353    
354 heimbach 1.4 #ifndef ALLOW_AUTODIFF_TAMC
355 jmc 1.1 C-- Internal exchange for next calculations in Y
356     IF ( overlapOnly .AND. ipass.EQ.1 ) THEN
357 jmc 1.6 CALL FILL_CS_CORNER_TR_RL(.FALSE., .FALSE.,
358     & iceFld, bi,bj, myThid )
359 jmc 1.1 IF ( .NOT.useGridVolume )
360 jmc 1.6 & CALL FILL_CS_CORNER_TR_RL(.FALSE., .FALSE.,
361     & iceVol, bi,bj, myThid )
362 jmc 1.1 ENDIF
363 heimbach 1.4 #endif
364 jmc 1.1
365     C- Update the local seaice field where needed:
366    
367     C update in overlap-Only
368     IF ( overlapOnly ) THEN
369     iMinUpd = 1-OLx+1
370     iMaxUpd = sNx+OLx-1
371     C-- notes: these 2 lines below have no real effect (because recip_hFac=0
372     C in corner region) but safer to keep them.
373     IF ( W_edge ) iMinUpd = 1
374     IF ( E_edge ) iMaxUpd = sNx
375    
376 heimbach 1.4 #ifdef ALLOW_AUTODIFF_TAMC
377     CADJ STORE iceFld(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
378     CADJ STORE iceVol(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
379     #endif
380 jmc 1.1 IF ( S_edge .AND. useGridVolume ) THEN
381     DO j=1-OLy,0
382     DO i=iMinUpd,iMaxUpd
383     iceFld(i,j) = iceFld(i,j)
384     & -deltaTadvect*maskOc(i,j)
385     & *recip_rA(i,j,bi,bj)
386     & *( af(i+1,j)-af(i,j) )
387     ENDDO
388     ENDDO
389     ELSEIF ( S_edge ) THEN
390     DO j=1-OLy,0
391     DO i=iMinUpd,iMaxUpd
392     tmpVol = iceVol(i,j)
393     iceVol(i,j) = iceVol(i,j)
394     & -deltaTadvect*maskOc(i,j)
395     & *( uTrans(i+1,j)-uTrans(i,j) )
396     IF ( iceVol(i,j).GT.iceEps )
397     & iceFld(i,j) = ( iceFld(i,j)*tmpVol
398     & -deltaTadvect*maskOc(i,j)
399     & *( af(i+1,j)-af(i,j) )
400     & )/iceVol(i,j)
401     ENDDO
402     ENDDO
403     ENDIF
404     IF ( N_edge .AND. useGridVolume ) THEN
405     DO j=sNy+1,sNy+OLy
406     DO i=iMinUpd,iMaxUpd
407     iceFld(i,j) = iceFld(i,j)
408     & -deltaTadvect*maskOc(i,j)
409     & *recip_rA(i,j,bi,bj)
410     & *( af(i+1,j)-af(i,j) )
411     ENDDO
412     ENDDO
413     ELSEIF ( N_edge ) THEN
414     DO j=sNy+1,sNy+OLy
415     DO i=iMinUpd,iMaxUpd
416     tmpVol = iceVol(i,j)
417     iceVol(i,j) = iceVol(i,j)
418     & -deltaTadvect*maskOc(i,j)
419     & *( uTrans(i+1,j)-uTrans(i,j) )
420     IF ( iceVol(i,j).GT.iceEps )
421     & iceFld(i,j) = ( iceFld(i,j)*tmpVol
422     & -deltaTadvect*maskOc(i,j)
423     & *( af(i+1,j)-af(i,j) )
424     & )/iceVol(i,j)
425     ENDDO
426     ENDDO
427     ENDIF
428     C-- keep advective flux (for diagnostics)
429     IF ( S_edge ) THEN
430     DO j=1-OLy,0
431     DO i=1-OLx+1,sNx+OLx
432     afx(i,j) = af(i,j)
433     ENDDO
434     ENDDO
435     ENDIF
436     IF ( N_edge ) THEN
437     DO j=sNy+1,sNy+OLy
438     DO i=1-OLx+1,sNx+OLx
439     afx(i,j) = af(i,j)
440     ENDDO
441     ENDDO
442     ENDIF
443    
444     ELSE
445     C do not only update the overlap
446     jMinUpd = 1-OLy
447     jMaxUpd = sNy+OLy
448     IF ( interiorOnly .AND. S_edge ) jMinUpd = 1
449     IF ( interiorOnly .AND. N_edge ) jMaxUpd = sNy
450     IF ( useGridVolume ) THEN
451     DO j=jMinUpd,jMaxUpd
452     DO i=1-OLx+1,sNx+OLx-1
453     iceFld(i,j) = iceFld(i,j)
454     & -deltaTadvect*maskOc(i,j)
455     & *recip_rA(i,j,bi,bj)
456     & *( af(i+1,j)-af(i,j) )
457     ENDDO
458     ENDDO
459     ELSE
460     DO j=jMinUpd,jMaxUpd
461     DO i=1-OLx+1,sNx+OLx-1
462     tmpVol = iceVol(i,j)
463     iceVol(i,j) = iceVol(i,j)
464     & -deltaTadvect*maskOc(i,j)
465     & *( uTrans(i+1,j)-uTrans(i,j) )
466     IF ( iceVol(i,j).GT.iceEps )
467     & iceFld(i,j) = ( iceFld(i,j)*tmpVol
468     & -deltaTadvect*maskOc(i,j)
469     & *( af(i+1,j)-af(i,j) )
470     & )/iceVol(i,j)
471     ENDDO
472     ENDDO
473     ENDIF
474     C-- keep advective flux (for diagnostics)
475     DO j=jMinUpd,jMaxUpd
476     DO i=1-OLx+1,sNx+OLx
477     afx(i,j) = af(i,j)
478     ENDDO
479     ENDDO
480    
481     C- end if/else update overlap-Only
482     ENDIF
483    
484     C-- End of X direction
485     ENDIF
486    
487     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
488     C-- Y direction
489    
490     IF (calc_fluxes_Y) THEN
491    
492     C- Do not compute fluxes if
493     C a) needed in overlap only
494     C and b) the overlap of myTile are not cube-face edges
495 heimbach 1.4 #ifdef ALLOW_AUTODIFF_TAMC
496     CADJ STORE iceFld(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
497     CADJ STORE iceVol(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
498     #endif
499 jmc 1.1 IF ( .NOT.overlapOnly .OR. E_edge .OR. W_edge ) THEN
500    
501     C- Advective flux in Y
502     DO j=1-OLy,sNy+OLy
503     DO i=1-OLx,sNx+OLx
504     af(i,j) = 0.
505     ENDDO
506     ENDDO
507    
508 heimbach 1.4 #ifndef ALLOW_AUTODIFF_TAMC
509 jmc 1.1 C- Internal exchange for calculations in Y
510     IF ( useCubedSphereExchange .AND.
511     & ( overlapOnly .OR. ipass.EQ.1 ) ) THEN
512 jmc 1.6 CALL FILL_CS_CORNER_TR_RL(.FALSE., .FALSE.,
513     & iceFld, bi,bj, myThid )
514 jmc 1.1 IF ( .NOT.useGridVolume )
515 jmc 1.6 & CALL FILL_CS_CORNER_TR_RL(.FALSE., .FALSE.,
516     & iceVol, bi,bj, myThid )
517 jmc 1.1 ENDIF
518 heimbach 1.4 #endif
519 jmc 1.1
520     C- Compute CFL number
521     IF ( useGridVolume ) THEN
522     DO j=2-Oly,sNy+Oly
523     DO i=1-Olx,sNx+Olx
524     vCfl(i,j) = deltaTadvect*(
525     & MAX( vTrans(i,j), 0. _d 0 )*recip_rA(i,j-1,bi,bj)
526     & +MAX(-vTrans(i,j), 0. _d 0 )*recip_rA(i, j ,bi,bj)
527     & )
528     ENDDO
529     ENDDO
530     ELSE
531     DO j=2-Oly,sNy+Oly
532     DO i=1-Olx,sNx+Olx
533     vCfl(i,j) = deltaTadvect*(
534     & MAX( vTrans(i,j), 0. _d 0 )/MAX( iceVol(i,j-1), iceEps )
535     & +MAX(-vTrans(i,j), 0. _d 0 )/MAX( iceVol(i, j ), iceEps )
536     & )
537     ENDDO
538     ENDDO
539     ENDIF
540    
541     IF ( advectionScheme.EQ.ENUM_UPWIND_1RST
542     & .OR. advectionScheme.EQ.ENUM_DST2 ) THEN
543     CALL GAD_DST2U1_ADV_Y( bi,bj,k, advectionScheme, .FALSE.,
544     I deltaTadvect, vTrans, vCfl, iceFld,
545     O af, myThid )
546     IF (dBug.AND. bi.EQ.3) WRITE(6,'(A,1P4E14.6)')
547     & 'ICE_adv: yFx=',af(12,12),iceFld(12,11),vTrans(12,12),
548     & af(12,12)/vTrans(12,12)
549     ELSEIF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN
550     CALL GAD_FLUXLIMIT_ADV_Y( bi,bj,k, .FALSE., deltaTadvect,
551     I vTrans, vCfl, maskLocS, iceFld,
552     O af, myThid )
553     ELSEIF (advectionScheme.EQ.ENUM_DST3 ) THEN
554     CALL GAD_DST3_ADV_Y( bi,bj,k, .FALSE., deltaTadvect,
555     I vTrans, vCfl, maskLocS, iceFld,
556     O af, myThid )
557     ELSEIF (advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN
558     CALL GAD_DST3FL_ADV_Y( bi,bj,k, .FALSE., deltaTadvect,
559     I vTrans, vCfl, maskLocS, iceFld,
560     O af, myThid )
561     ELSE
562     STOP
563     & 'THSICE_ADVECTION: adv. scheme incompatibale with mutli-dim'
564     ENDIF
565    
566     C- Advective flux in Y : done
567     ENDIF
568    
569 heimbach 1.4 #ifndef ALLOW_AUTODIFF_TAMC
570 jmc 1.1 IF ( overlapOnly .AND. ipass.EQ.1 ) THEN
571 jmc 1.6 CALL FILL_CS_CORNER_TR_RL( .TRUE., .FALSE.,
572     & iceFld, bi,bj, myThid )
573 jmc 1.1 IF ( .NOT.useGridVolume )
574 jmc 1.6 & CALL FILL_CS_CORNER_TR_RL( .TRUE., .FALSE.,
575     & iceVol, bi,bj, myThid )
576 jmc 1.1 ENDIF
577 heimbach 1.4 #endif
578 jmc 1.1
579     C- Update the local seaice field where needed:
580    
581     C update in overlap-Only
582     IF ( overlapOnly ) THEN
583     jMinUpd = 1-OLy+1
584     jMaxUpd = sNy+OLy-1
585     C- notes: these 2 lines below have no real effect (because recip_hFac=0
586     C in corner region) but safer to keep them.
587     IF ( S_edge ) jMinUpd = 1
588     IF ( N_edge ) jMaxUpd = sNy
589    
590 heimbach 1.4 #ifdef ALLOW_AUTODIFF_TAMC
591     CADJ STORE iceFld(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
592     CADJ STORE iceVol(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
593     #endif
594 jmc 1.1 IF ( W_edge .AND. useGridVolume ) THEN
595     DO j=jMinUpd,jMaxUpd
596     DO i=1-OLx,0
597     iceFld(i,j) = iceFld(i,j)
598     & -deltaTadvect*maskOc(i,j)
599     & *recip_rA(i,j,bi,bj)
600     & *( af(i,j+1)-af(i,j) )
601     ENDDO
602     ENDDO
603     ELSEIF ( W_edge ) THEN
604     DO j=jMinUpd,jMaxUpd
605     DO i=1-OLx,0
606     tmpVol = iceVol(i,j)
607     iceVol(i,j) = iceVol(i,j)
608     & -deltaTadvect*maskOc(i,j)
609     & *( vTrans(i,j+1)-vTrans(i,j) )
610     IF ( iceVol(i,j).GT.iceEps )
611     & iceFld(i,j) = ( iceFld(i,j)*tmpVol
612     & -deltaTadvect*maskOc(i,j)
613     & *( af(i,j+1)-af(i,j) )
614     & )/iceVol(i,j)
615     ENDDO
616     ENDDO
617     ENDIF
618     IF ( E_edge .AND. useGridVolume ) THEN
619     DO j=jMinUpd,jMaxUpd
620     DO i=sNx+1,sNx+OLx
621     iceFld(i,j) = iceFld(i,j)
622     & -deltaTadvect*maskOc(i,j)
623     & *recip_rA(i,j,bi,bj)
624     & *( af(i,j+1)-af(i,j) )
625     ENDDO
626     ENDDO
627     ELSEIF ( E_edge ) THEN
628     DO j=jMinUpd,jMaxUpd
629     DO i=sNx+1,sNx+OLx
630     tmpVol = iceVol(i,j)
631     iceVol(i,j) = iceVol(i,j)
632     & -deltaTadvect*maskOc(i,j)
633     & *( vTrans(i,j+1)-vTrans(i,j) )
634     IF ( iceVol(i,j).GT.iceEps )
635     & iceFld(i,j) = ( iceFld(i,j)*tmpVol
636     & -deltaTadvect*maskOc(i,j)
637     & *( af(i,j+1)-af(i,j) )
638     & )/iceVol(i,j)
639     ENDDO
640     ENDDO
641     ENDIF
642     C-- keep advective flux (for diagnostics)
643     IF ( W_edge ) THEN
644     DO j=1-OLy+1,sNy+OLy
645     DO i=1-OLx,0
646     afy(i,j) = af(i,j)
647     ENDDO
648     ENDDO
649     ENDIF
650     IF ( E_edge ) THEN
651     DO j=1-OLy+1,sNy+OLy
652     DO i=sNx+1,sNx+OLx
653     afy(i,j) = af(i,j)
654     ENDDO
655     ENDDO
656     ENDIF
657    
658     ELSE
659     C do not only update the overlap
660     iMinUpd = 1-OLx
661     iMaxUpd = sNx+OLx
662     IF ( interiorOnly .AND. W_edge ) iMinUpd = 1
663     IF ( interiorOnly .AND. E_edge ) iMaxUpd = sNx
664     IF ( useGridVolume ) THEN
665     DO j=1-OLy+1,sNy+OLy-1
666     DO i=iMinUpd,iMaxUpd
667     iceFld(i,j) = iceFld(i,j)
668     & -deltaTadvect*maskOc(i,j)
669     & *recip_rA(i,j,bi,bj)
670     & *( af(i,j+1)-af(i,j) )
671     ENDDO
672     ENDDO
673     ELSE
674     DO j=1-OLy+1,sNy+OLy-1
675     DO i=iMinUpd,iMaxUpd
676     tmpVol = iceVol(i,j)
677     iceVol(i,j) = iceVol(i,j)
678     & -deltaTadvect*maskOc(i,j)
679     & *( vTrans(i,j+1)-vTrans(i,j) )
680     IF ( iceVol(i,j).GT.iceEps )
681     & iceFld(i,j) = ( iceFld(i,j)*tmpVol
682     & -deltaTadvect*maskOc(i,j)
683     & *( af(i,j+1)-af(i,j) )
684     & )/iceVol(i,j)
685     ENDDO
686     ENDDO
687     ENDIF
688     C-- keep advective flux (for diagnostics)
689     DO j=1-OLy+1,sNy+OLy
690     DO i=iMinUpd,iMaxUpd
691     afy(i,j) = af(i,j)
692     ENDDO
693     ENDDO
694    
695     C end if/else update overlap-Only
696     ENDIF
697    
698     C-- End of Y direction
699     ENDIF
700    
701     C-- End of ipass loop
702     ENDDO
703    
704     C- explicit advection is done ; add some debugging print
705     IF ( dBug ) THEN
706     DO j=1-OLy,sNy+OLy
707     DO i=1-OLx,sNx+OLx
708     IF ( i.EQ.12 .AND. j.EQ.11 .AND. bi.EQ.3 ) THEN
709     tmpFac= deltaTadvect*recip_rA(i,j,bi,bj)
710     WRITE(6,'(A,1P4E14.6)') 'ICE_adv:',
711     & afx(i,j)*tmpFac,afx(i+1,j)*tmpFac,
712     & afy(i,j)*tmpFac,afy(i,j+1)*tmpFac
713     ENDIF
714     ENDDO
715     ENDDO
716     ENDIF
717    
718     #ifdef ALLOW_DEBUG
719     IF ( debugLevel .GE. debLevB
720     & .AND. tracerIdentity.EQ.GAD_SI_HICE
721     & .AND. k.LE.3 .AND. myIter.EQ.1+nIter0
722     & .AND. nPx.EQ.1 .AND. nPy.EQ.1
723     & .AND. useCubedSphereExchange ) THEN
724     CALL DEBUG_CS_CORNER_UV( ' afx,afy from THSICE_ADVECTION',
725     & afx,afy, k, standardMessageUnit,bi,bj,myThid )
726     ENDIF
727     #endif /* ALLOW_DEBUG */
728    
729 jmc 1.2 #endif /* ALLOW_GENERIC_ADVDIFF */
730    
731 jmc 1.1 RETURN
732     END

  ViewVC Help
Powered by ViewVC 1.1.22