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

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

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

revision 1.8 by heimbach, Wed Jun 7 01:55:14 2006 UTC revision 1.9 by mlosch, Thu Oct 13 15:09:58 2011 UTC
# Line 68  C     rC4km, rC4kp    :: high order cont Line 68  C     rC4km, rC4kp    :: high order cont
68  C     rHigh           :: high order term factor  C     rHigh           :: high order term factor
69        LOGICAL flagC4        LOGICAL flagC4
70        INTEGER i,j,kp1,km2        INTEGER i,j,kp1,km2
71    #if (defined ALLOW_AUTODIFF_TAMC && defined TARGET_NEC_SX)
72          _RL rC4km2D  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
73          _RL rC4kp2D  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
74          _RL rCenter2D(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
75          _RL rUpwind2D(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
76    #endif
77        _RL wCFL, rCenter, rUpwind        _RL wCFL, rCenter, rUpwind
78        _RL rC4km, rC4kp, rHigh        _RL rC4km, rC4kp, rHigh
79        _RL mskM, mskP, maskM2, maskP1        _RL mskM, mskP, maskM2, maskP1
# Line 88  C--   process interior interface only: Line 94  C--   process interior interface only:
94    
95  C--    Add centered, upwind and high-order contributions  C--    Add centered, upwind and high-order contributions
96         deltaTcfl = deltaTarg(k)         deltaTcfl = deltaTarg(k)
97    #if (defined ALLOW_AUTODIFF_TAMC && defined TARGET_NEC_SX)
98           DO j=jMin,jMax
99            DO i=iMin,iMax
100             rCenter2D(i,j) =
101         &        0.5 _d 0 *rTrans(i,j)*recip_rA(i,j,bi,bj)*rkSign
102             mskM   = maskC(i,j,km2,bi,bj)*maskM2
103             mskP   = maskC(i,j,kp1,bi,bj)*maskP1
104             IF ( flagC4 .AND. mskM*mskP.GT.0. _d 0 ) THEN
105              rUpwind2D(i,j) = 0. _d 0
106              rC4km2D  (i,j) = oneSixth*rCenter*mskM
107              rC4kp2D  (i,j) = oneSixth*rCenter*mskP
108             ELSEIF ( advectionScheme.EQ.ENUM_DST3 ) THEN
109              wCFL = deltaTcfl*ABS(rTrans(i,j))
110         &         *recip_rA(i,j,bi,bj)*recip_drC(k)
111              rHigh  = (1. _d 0 -wCFL*wCFL)*oneSixth
112    c         rUpwind2D(i,j) = (2. _d 0*rHigh - wCFL)*ABS(rCenter)
113              rUpwind2D(i,j) = (2. _d 0*rHigh )*ABS(rCenter)
114              rC4km2D  (i,j) =  rHigh * (rCenter+ABS(rCenter))*mskM
115              rC4kp2D  (i,j) =  rHigh * (rCenter-ABS(rCenter))*mskP
116             ELSE
117              rUpwind2D(i,j) =  2. _d 0*oneSixth*ABS(rCenter)
118              rC4km2D  (i,j) = oneSixth*(rCenter+ABS(rCenter))*mskM
119              rC4kp2D  (i,j) = oneSixth*(rCenter-ABS(rCenter))*mskP
120             ENDIF
121            ENDDO
122           ENDDO
123    #endif /* ALLOW_AUTODIFF_TAMC and TARGET_NEC_SX */
124         DO j=jMin,jMax         DO j=jMin,jMax
125           DO i=iMin,iMax           DO i=iMin,iMax
126    #if (defined ALLOW_AUTODIFF_TAMC && defined TARGET_NEC_SX)
127               rC4km   = rC4km2D  (i,j)
128               rC4kp   = rC4kp2D  (i,j)
129               rCenter = rCenter2D(i,j)
130               rUpwind = rUpwind2D(i,j)
131    #else
132             rCenter= 0.5 _d 0 *rTrans(i,j)*recip_rA(i,j,bi,bj)*rkSign             rCenter= 0.5 _d 0 *rTrans(i,j)*recip_rA(i,j,bi,bj)*rkSign
133             mskM   = maskC(i,j,km2,bi,bj)*maskM2             mskM   = maskC(i,j,km2,bi,bj)*maskM2
134             mskP   = maskC(i,j,kp1,bi,bj)*maskP1             mskP   = maskC(i,j,kp1,bi,bj)*maskP1
# Line 110  c           rUpwind= (2. _d 0*rHigh - wC Line 149  c           rUpwind= (2. _d 0*rHigh - wC
149              rC4km  = oneSixth*(rCenter+ABS(rCenter))*mskM              rC4km  = oneSixth*(rCenter+ABS(rCenter))*mskM
150              rC4kp  = oneSixth*(rCenter-ABS(rCenter))*mskP              rC4kp  = oneSixth*(rCenter-ABS(rCenter))*mskP
151             ENDIF             ENDIF
152    #endif /* ALLOW_AUTODIFF_TAMC and TARGET_NEC_SX */
153             a5d(i,j,k)   = a5d(i,j,k)             a5d(i,j,k)   = a5d(i,j,k)
154       &                  + rC4km       &                  + rC4km
155       &                   *deltaTarg(k)       &                   *deltaTarg(k)

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

  ViewVC Help
Powered by ViewVC 1.1.22