/[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.9 by mlosch, Thu Oct 13 15:09:58 2011 UTC revision 1.10 by jmc, Thu Dec 1 14:14:44 2011 UTC
# Line 8  C     !ROUTINE: GAD_U3C4_IMPL_R Line 8  C     !ROUTINE: GAD_U3C4_IMPL_R
8  C     !INTERFACE:  C     !INTERFACE:
9        SUBROUTINE GAD_U3C4_IMPL_R(        SUBROUTINE GAD_U3C4_IMPL_R(
10       I           bi,bj,k, iMin,iMax,jMin,jMax,       I           bi,bj,k, iMin,iMax,jMin,jMax,
11       I           advectionScheme, deltaTarg, rTrans,       I           advectionScheme, deltaTarg, rTrans, recip_hFac,
12       O           a5d, b5d, c5d, d5d, e5d,       O           a5d, b5d, c5d, d5d, e5d,
13       I           myThid )       I           myThid )
14    
# Line 33  C     == Global variables === Line 33  C     == Global variables ===
33    
34  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
35  C     == Routine Arguments ==  C     == Routine Arguments ==
36  C     bi,bj           :: tile indices  C     bi,bj        :: tile indices
37  C     k               :: vertical level  C     k            :: vertical level
38  C     iMin,iMax       :: computation domain  C     iMin,iMax    :: computation domain
39  C     jMin,jMax       :: computation domain  C     jMin,jMax    :: computation domain
40  C     advectionScheme :: advection scheme to use  C  advectionScheme :: advection scheme to use
41  C     deltaTarg       :: time step  C     deltaTarg    :: time step
42  C     rTrans          :: vertical volume transport  C     rTrans       :: vertical volume transport
43  C     a5d             :: 2nd  lower diag of pentadiagonal matrix  C     recip_hFac   :: inverse of cell open-depth factor
44  C     b5d             :: 1rst lower diag of pentadiagonal matrix  C     a5d          :: 2nd  lower diag of pentadiagonal matrix
45  C     c5d             :: main diag       of pentadiagonal matrix  C     b5d          :: 1rst lower diag of pentadiagonal matrix
46  C     d5d             :: 1rst upper diag of pentadiagonal matrix  C     c5d          :: main diag       of pentadiagonal matrix
47  C     e5d             :: 2nd  upper diag of pentadiagonal matrix  C     d5d          :: 1rst upper diag of pentadiagonal matrix
48  C     myThid          :: thread number  C     e5d          :: 2nd  upper diag of pentadiagonal matrix
49    C     myThid       :: thread number
50        INTEGER bi,bj,k        INTEGER bi,bj,k
51        INTEGER iMin,iMax,jMin,jMax        INTEGER iMin,iMax,jMin,jMax
52        INTEGER advectionScheme        INTEGER advectionScheme
53        _RL deltaTarg(Nr)        _RL     deltaTarg(Nr)
54        _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL     rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
55        _RL a5d   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RS recip_hFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
56        _RL b5d   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL     a5d   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
57        _RL c5d   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL     b5d   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
58        _RL d5d   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL     c5d   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
59        _RL e5d   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL     d5d   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
60          _RL     e5d   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
61        INTEGER myThid        INTEGER myThid
62    
63  C     == Local Variables ==  C     == Local Variables ==
64  C     i,j             :: loop indices  C     i,j          :: loop indices
65  C     kp1             :: =min( k+1 , Nr )  C     kp1          :: =min( k+1 , Nr )
66  C     km2             :: =max( k-2 , 1 )  C     km2          :: =max( k-2 , 1 )
67  C     rCenter         :: centered contribution  C     rCenter      :: centered contribution
68  C     rUpwind         :: upwind   contribution  C     rUpwind      :: upwind   contribution
69  C     rC4km, rC4kp    :: high order contribution  C     rC4km, rC4kp :: high order contribution
70  C     rHigh           :: high order term factor  C     rHigh        :: high order term factor
71        LOGICAL flagC4        LOGICAL flagC4
72        INTEGER i,j,kp1,km2        INTEGER i,j,kp1,km2
73  #if (defined ALLOW_AUTODIFF_TAMC && defined TARGET_NEC_SX)  #if (defined ALLOW_AUTODIFF_TAMC && defined TARGET_NEC_SX)
74        _RL rC4km2D  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rC4km2D  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
75        _RL rC4kp2D  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rC4kp2D  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
76        _RL rCenter2D(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rCenter2D(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
77        _RL rUpwind2D(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rUpwind2D(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
# Line 97  C--    Add centered, upwind and high-ord Line 99  C--    Add centered, upwind and high-ord
99  #if (defined ALLOW_AUTODIFF_TAMC && defined TARGET_NEC_SX)  #if (defined ALLOW_AUTODIFF_TAMC && defined TARGET_NEC_SX)
100         DO j=jMin,jMax         DO j=jMin,jMax
101          DO i=iMin,iMax          DO i=iMin,iMax
102           rCenter2D(i,j) =           rCenter2D(i,j) =
103       &        0.5 _d 0 *rTrans(i,j)*recip_rA(i,j,bi,bj)*rkSign       &        0.5 _d 0 *rTrans(i,j)*recip_rA(i,j,bi,bj)*rkSign
104           mskM   = maskC(i,j,km2,bi,bj)*maskM2           mskM   = maskC(i,j,km2,bi,bj)*maskM2
105           mskP   = maskC(i,j,kp1,bi,bj)*maskP1           mskP   = maskC(i,j,kp1,bi,bj)*maskP1
# Line 153  c           rUpwind= (2. _d 0*rHigh - wC Line 155  c           rUpwind= (2. _d 0*rHigh - wC
155             a5d(i,j,k)   = a5d(i,j,k)             a5d(i,j,k)   = a5d(i,j,k)
156       &                  + rC4km       &                  + rC4km
157       &                   *deltaTarg(k)       &                   *deltaTarg(k)
158       &                   *_recip_hFacC(i,j,k,bi,bj)*recip_drF(k)       &                   *recip_hFac(i,j,k)*recip_drF(k)
159             b5d(i,j,k)   = b5d(i,j,k)             b5d(i,j,k)   = b5d(i,j,k)
160       &                  - ( (rCenter+rUpwind) + rC4km )       &                  - ( (rCenter+rUpwind) + rC4km )
161       &                   *deltaTarg(k)       &                   *deltaTarg(k)
162       &                   *_recip_hFacC(i,j,k,bi,bj)*recip_drF(k)       &                   *recip_hFac(i,j,k)*recip_drF(k)
163             c5d(i,j,k)   = c5d(i,j,k)             c5d(i,j,k)   = c5d(i,j,k)
164       &                  - ( (rCenter-rUpwind) + rC4kp )       &                  - ( (rCenter-rUpwind) + rC4kp )
165       &                   *deltaTarg(k)       &                   *deltaTarg(k)
166       &                    *_recip_hFacC(i,j,k,bi,bj)*recip_drF(k)       &                   *recip_hFac(i,j,k)*recip_drF(k)
167             d5d(i,j,k)   = d5d(i,j,k)             d5d(i,j,k)   = d5d(i,j,k)
168       &                  + rC4kp       &                  + rC4kp
169       &                   *deltaTarg(k)       &                   *deltaTarg(k)
170       &                   *_recip_hFacC(i,j,k,bi,bj)*recip_drF(k)       &                   *recip_hFac(i,j,k)*recip_drF(k)
171             b5d(i,j,k-1) = b5d(i,j,k-1)             b5d(i,j,k-1) = b5d(i,j,k-1)
172       &                  - rC4km       &                  - rC4km
173       &                   *deltaTarg(k-1)       &                   *deltaTarg(k-1)
174       &                   *_recip_hFacC(i,j,k-1,bi,bj)*recip_drF(k-1)       &                   *recip_hFac(i,j,k-1)*recip_drF(k-1)
175             c5d(i,j,k-1) = c5d(i,j,k-1)             c5d(i,j,k-1) = c5d(i,j,k-1)
176       &                  + ( (rCenter+rUpwind) + rC4km )       &                  + ( (rCenter+rUpwind) + rC4km )
177       &                   *deltaTarg(k-1)       &                   *deltaTarg(k-1)
178       &                   *_recip_hFacC(i,j,k-1,bi,bj)*recip_drF(k-1)       &                   *recip_hFac(i,j,k-1)*recip_drF(k-1)
179             d5d(i,j,k-1) = d5d(i,j,k-1)             d5d(i,j,k-1) = d5d(i,j,k-1)
180       &                  + ( (rCenter-rUpwind) + rC4kp )       &                  + ( (rCenter-rUpwind) + rC4kp )
181       &                   *deltaTarg(k-1)       &                   *deltaTarg(k-1)
182       &                   *_recip_hFacC(i,j,k-1,bi,bj)*recip_drF(k-1)       &                   *recip_hFac(i,j,k-1)*recip_drF(k-1)
183             e5d(i,j,k-1) = e5d(i,j,k-1)             e5d(i,j,k-1) = e5d(i,j,k-1)
184       &                  - rC4kp       &                  - rC4kp
185       &                   *deltaTarg(k-1)       &                   *deltaTarg(k-1)
186       &                   *_recip_hFacC(i,j,k-1,bi,bj)*recip_drF(k-1)       &                   *recip_hFac(i,j,k-1)*recip_drF(k-1)
187           ENDDO           ENDDO
188         ENDDO         ENDDO
189    
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22