/[MITgcm]/MITgcm/pkg/generic_advdiff/gad_som_adv_y.F
ViewVC logotype

Diff of /MITgcm/pkg/generic_advdiff/gad_som_adv_y.F

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

revision 1.5 by jmc, Fri May 9 21:43:16 2008 UTC revision 1.6 by jmc, Mon Mar 5 17:59:15 2012 UTC
# Line 11  C !INTERFACE: ========================== Line 11  C !INTERFACE: ==========================
11       I           bi,bj,k, limiter,       I           bi,bj,k, limiter,
12       I           overlapOnly, interiorOnly,       I           overlapOnly, interiorOnly,
13       I           N_edge, S_edge, E_edge, W_edge,       I           N_edge, S_edge, E_edge, W_edge,
14       I           deltaTloc, vTrans,       I           deltaTloc, vTrans, maskIn,
15       U           sm_v, sm_o, sm_x, sm_y, sm_z,       U           sm_v, sm_o, sm_x, sm_y, sm_z,
16       U           sm_xx, sm_yy, sm_zz, sm_xy, sm_xz, sm_yz,       U           sm_xx, sm_yy, sm_zz, sm_xy, sm_xz, sm_yz,
17       O           vT,       O           vT,
# Line 46  C  overlapOnly   :: only update the edge Line 46  C  overlapOnly   :: only update the edge
46  C  interiorOnly  :: only update the interior of myTile, but not the edges  C  interiorOnly  :: only update the interior of myTile, but not the edges
47  C [N,S,E,W]_edge :: true if N,S,E,W edge of myTile is an Edge of the cube  C [N,S,E,W]_edge :: true if N,S,E,W edge of myTile is an Edge of the cube
48  C  vTrans        :: zonal volume transport  C  vTrans        :: zonal volume transport
49    C  maskIn        :: 2-D array Interior mask
50  C  myThid        :: my Thread Id. number  C  myThid        :: my Thread Id. number
51        INTEGER bi,bj,k        INTEGER bi,bj,k
52        INTEGER limiter        INTEGER limiter
# Line 53  C  myThid        :: my Thread Id. number Line 54  C  myThid        :: my Thread Id. number
54        LOGICAL N_edge, S_edge, E_edge, W_edge        LOGICAL N_edge, S_edge, E_edge, W_edge
55        _RL deltaTloc        _RL deltaTloc
56        _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
57          _RS maskIn(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
58        INTEGER myThid        INTEGER myThid
59    
60  C !OUTPUT PARAMETERS: ==================================================  C !OUTPUT PARAMETERS: ==================================================
# Line 123  CEOP Line 125  CEOP
125    
126  C-    Set loop ranges for updating tracer field (splitted in 2 strips)  C-    Set loop ranges for updating tracer field (splitted in 2 strips)
127        nbStrips   = 1        nbStrips   = 1
128        iMinUpd(1) = 1-Olx        iMinUpd(1) = 1-OLx
129        iMaxUpd(1) = sNx+Olx        iMaxUpd(1) = sNx+OLx
130        jMinUpd(1) = 1-Oly+1        jMinUpd(1) = 1-OLy+1
131        jMaxUpd(1) = sNy+Oly-1        jMaxUpd(1) = sNy+OLy-1
132        IF ( overlapOnly ) THEN        IF ( overlapOnly ) THEN
133  C     update in overlap-Only  C     update in overlap-Only
134          IF ( S_edge ) jMinUpd(1) = 1          IF ( S_edge ) jMinUpd(1) = 1
135          IF ( N_edge ) jMaxUpd(1) = sNy          IF ( N_edge ) jMaxUpd(1) = sNy
136          IF ( W_edge ) THEN          IF ( W_edge ) THEN
137            iMinUpd(1) = 1-Olx            iMinUpd(1) = 1-OLx
138            iMaxUpd(1) = 0            iMaxUpd(1) = 0
139          ENDIF          ENDIF
140          IF ( E_edge ) THEN          IF ( E_edge ) THEN
141            IF ( W_edge ) nbStrips = 2            IF ( W_edge ) nbStrips = 2
142            iMinUpd(nbStrips) = sNx+1            iMinUpd(nbStrips) = sNx+1
143            iMaxUpd(nbStrips) = sNx+Olx            iMaxUpd(nbStrips) = sNx+OLx
144          ENDIF          ENDIF
145        ELSE        ELSE
146  C     do not only update the overlap  C     do not only update the overlap
# Line 146  C     do not only update the overlap Line 148  C     do not only update the overlap
148          IF ( interiorOnly .AND. E_edge ) iMaxUpd(1) = sNx          IF ( interiorOnly .AND. E_edge ) iMaxUpd(1) = sNx
149        ENDIF        ENDIF
150    
 C-    Internal exchange for calculations in Y  
 c     IF ( overlapOnly ) THEN  
 c         CALL GAD_SOM_FILL_CS_CORNER( .FALSE.,  
 c    U           sm_v,  sm_o,  sm_x,  sm_y,  sm_z,  
 c    U           sm_xx, sm_yy, sm_zz, sm_xy, sm_xz, sm_yz,  
 c    I           bi, bj, myThid )  
 c     ENDIF  
   
151  C--   start 1rst loop on strip number "ns"  C--   start 1rst loop on strip number "ns"
152        DO ns=1,nbStrips        DO ns=1,nbStrips
153    
# Line 228  C--    Save zero-order flux: Line 222  C--    Save zero-order flux:
222  C--   end 1rst loop on strip number "ns"  C--   end 1rst loop on strip number "ns"
223  c     ENDDO  c     ENDDO
224    
 C-    Internal exchange for next calculations in X  
 c     IF ( overlapOnly ) THEN  
 c         CALL GAD_SOM_FILL_CS_CORNER( .TRUE.,  
 c    U           sm_v,  sm_o,  sm_x,  sm_y,  sm_z,  
 c    U           sm_xx, sm_yy, sm_zz, sm_xy, sm_xz, sm_yz,  
 c    I           bi, bj, myThid )  
 c     ENDIF  
   
225  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
226  C--   start 2nd loop on strip number "ns"  C--   start 2nd loop on strip number "ns"
227  c     DO ns=1,nbStrips  c     DO ns=1,nbStrips
# Line 244  C---  part.2 : re-adjust moments remaini Line 230  C---  part.2 : re-adjust moments remaini
230  C      take off from grid box (j): negative V(j) and positive V(j+1)  C      take off from grid box (j): negative V(j) and positive V(j+1)
231        DO j=jMinUpd(1),jMaxUpd(1)        DO j=jMinUpd(1),jMaxUpd(1)
232         DO i=iMinUpd(ns),iMaxUpd(ns)         DO i=iMinUpd(ns),iMaxUpd(ns)
233    #ifdef ALLOW_OBCS
234            IF ( maskIn(i,j).NE.0. ) THEN
235    #endif /* ALLOW_OBCS */
236          alf1  = 1. _d 0 - aln(i,j) - alp(i,j+1)          alf1  = 1. _d 0 - aln(i,j) - alp(i,j+1)
237          alf1q = alf1*alf1          alf1q = alf1*alf1
238          alpmn = alp(i,j+1) - aln(i,j)          alpmn = alp(i,j+1) - aln(i,j)
# Line 258  C      take off from grid box (j): negat Line 247  C      take off from grid box (j): negat
247          sm_z (i,j) = sm_z (i,j) - fn_z (i,j) - fp_z (i,j+1)          sm_z (i,j) = sm_z (i,j) - fn_z (i,j) - fp_z (i,j+1)
248          sm_zz(i,j) = sm_zz(i,j) - fn_zz(i,j) - fp_zz(i,j+1)          sm_zz(i,j) = sm_zz(i,j) - fn_zz(i,j) - fp_zz(i,j+1)
249          sm_xz(i,j) = sm_xz(i,j) - fn_xz(i,j) - fp_xz(i,j+1)          sm_xz(i,j) = sm_xz(i,j) - fn_xz(i,j) - fp_xz(i,j+1)
250    #ifdef ALLOW_OBCS
251            ENDIF
252    #endif /* ALLOW_OBCS */
253         ENDDO         ENDDO
254        ENDDO        ENDDO
255    
# Line 266  C---  part.3 : Put the temporary moments Line 258  C---  part.3 : Put the temporary moments
258  C      add into grid box (j): positive V(j) and negative V(j+1)  C      add into grid box (j): positive V(j) and negative V(j+1)
259        DO j=jMinUpd(1),jMaxUpd(1)        DO j=jMinUpd(1),jMaxUpd(1)
260         DO i=iMinUpd(ns),iMaxUpd(ns)         DO i=iMinUpd(ns),iMaxUpd(ns)
261    #ifdef ALLOW_OBCS
262            IF ( maskIn(i,j).NE.0. ) THEN
263    #endif /* ALLOW_OBCS */
264          sm_v (i,j) = sm_v (i,j) + fp_v (i,j) + fn_v (i,j+1)          sm_v (i,j) = sm_v (i,j) + fp_v (i,j) + fn_v (i,j+1)
265          alfp = fp_v(i, j )/sm_v(i,j)          alfp = fp_v(i, j )/sm_v(i,j)
266          alfn = fn_v(i,j+1)/sm_v(i,j)          alfn = fn_v(i,j+1)/sm_v(i,j)
# Line 300  C      add into grid box (j): positive V Line 295  C      add into grid box (j): positive V
295          sm_z (i,j) = sm_z (i,j) + fp_z (i,j) + fn_z (i,j+1)          sm_z (i,j) = sm_z (i,j) + fp_z (i,j) + fn_z (i,j+1)
296          sm_zz(i,j) = sm_zz(i,j) + fp_zz(i,j) + fn_zz(i,j+1)          sm_zz(i,j) = sm_zz(i,j) + fp_zz(i,j) + fn_zz(i,j+1)
297          sm_xz(i,j) = sm_xz(i,j) + fp_xz(i,j) + fn_xz(i,j+1)          sm_xz(i,j) = sm_xz(i,j) + fp_xz(i,j) + fn_xz(i,j+1)
298    #ifdef ALLOW_OBCS
299            ENDIF
300    #endif /* ALLOW_OBCS */
301         ENDDO         ENDDO
302        ENDDO        ENDDO
303    
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22