pkg/generic_advdiff/gad_c2_impl_r.F

7b4413ef94 Jean*0001 #include "GAD_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: GAD_C2_IMPL_R
                0005 C     !INTERFACE:
ec0db5c1b3 Jean*0006       SUBROUTINE GAD_C2_IMPL_R(
                0007      I           bi,bj,k, iMin,iMax,jMin,jMax,
                0008      I           deltaTarg, rTrans, recip_hFac,
7b4413ef94 Jean*0009      O           a3d, b3d, c3d,
                0010      I           myThid )
                0011
1b5fb69d21 Ed H*0012 C     !DESCRIPTION:
                0013 C     Compute matrix element to solve vertical advection implicitly
                0014 C     using centered second-order scheme The contribution of vertical
                0015 C     transport at interface k is added to matrix lines k and k-1.
7b4413ef94 Jean*0016
                0017 C     !USES:
                0018       IMPLICIT NONE
                0019
                0020 C     == Global variables ===
                0021 #include "SIZE.h"
                0022 #include "GRID.h"
                0023 #include "EEPARAMS.h"
                0024 #include "PARAMS.h"
                0025
                0026 C     !INPUT/OUTPUT PARAMETERS:
                0027 C     == Routine Arguments ==
ec0db5c1b3 Jean*0028 C     bi,bj        :: tile indices
                0029 C     k            :: vertical level
                0030 C     iMin,iMax    :: computation domain
                0031 C     jMin,jMax    :: computation domain
                0032 C     deltaTarg    :: time step
                0033 C     rTrans       :: vertical volume transport
                0034 C     recip_hFac   :: inverse of cell open-depth factor
                0035 C     a3d          :: lower diagonal of the tridiagonal matrix
                0036 C     b3d          :: main  diagonal of the tridiagonal matrix
                0037 C     c3d          :: upper diagonal of the tridiagonal matrix
                0038 C     myThid       :: thread number
7b4413ef94 Jean*0039       INTEGER bi,bj,k
                0040       INTEGER iMin,iMax,jMin,jMax
ec0db5c1b3 Jean*0041       _RL     deltaTarg(Nr)
                0042       _RL     rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0043       _RS recip_hFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0044       _RL     a3d   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0045       _RL     b3d   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0046       _RL     c3d   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
7b4413ef94 Jean*0047       INTEGER myThid
                0048
                0049 C     == Local Variables ==
ec0db5c1b3 Jean*0050 C     i,j          :: loop indices
                0051 C     rCenter      :: centered contribution
7b4413ef94 Jean*0052       INTEGER i,j
                0053       _RL rCenter
                0054 CEOP
                0055
9de7a55d87 Jean*0056 C--   process interior interface only:
                0057       IF ( k.GT.1 .AND. k.LE.Nr ) THEN
7b4413ef94 Jean*0058
                0059 C--    Add centered contribution
                0060        DO j=jMin,jMax
                0061          DO i=iMin,iMax
bb6c554092 Jean*0062            rCenter = 0.5 _d 0 *rTrans(i,j)*recip_rA(i,j,bi,bj)*rkSign
7b4413ef94 Jean*0063            a3d(i,j,k)   = a3d(i,j,k)
bb6c554092 Jean*0064      &                  - rCenter*deltaTarg(k)
ec0db5c1b3 Jean*0065      &                   *recip_hFac(i,j,k)*recip_drF(k)
a7ec469280 Jean*0066      &                   *recip_deepFac2C(k)*recip_rhoFacC(k)
7b4413ef94 Jean*0067            b3d(i,j,k)   = b3d(i,j,k)
bb6c554092 Jean*0068      &                  - rCenter*deltaTarg(k)
ec0db5c1b3 Jean*0069      &                   *recip_hFac(i,j,k)*recip_drF(k)
a7ec469280 Jean*0070      &                   *recip_deepFac2C(k)*recip_rhoFacC(k)
7b4413ef94 Jean*0071            b3d(i,j,k-1) = b3d(i,j,k-1)
bb6c554092 Jean*0072      &                  + rCenter*deltaTarg(k-1)
ec0db5c1b3 Jean*0073      &                   *recip_hFac(i,j,k-1)*recip_drF(k-1)
a7ec469280 Jean*0074      &                   *recip_deepFac2C(k-1)*recip_rhoFacC(k-1)
7b4413ef94 Jean*0075            c3d(i,j,k-1) = c3d(i,j,k-1)
bb6c554092 Jean*0076      &                  + rCenter*deltaTarg(k-1)
ec0db5c1b3 Jean*0077      &                   *recip_hFac(i,j,k-1)*recip_drF(k-1)
a7ec469280 Jean*0078      &                   *recip_deepFac2C(k-1)*recip_rhoFacC(k-1)
7b4413ef94 Jean*0079          ENDDO
                0080        ENDDO
                0081
9de7a55d87 Jean*0082 C--   process interior interface only: end
                0083       ENDIF
                0084
7b4413ef94 Jean*0085       RETURN
                0086       END