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

Annotation of /MITgcm/pkg/generic_advdiff/gad_fluxlimit_impl_r.F

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


Revision 1.2 - (hide annotations) (download)
Wed Mar 24 15:20:35 2004 UTC (20 years, 2 months ago) by adcroft
Branch: MAIN
Changes since 1.1: +1 -3 lines
Deleting declaration of unused variable

1 adcroft 1.2 C $Header: /u/gcmpack/MITgcm/pkg/generic_advdiff/gad_fluxlimit_impl_r.F,v 1.1 2004/01/07 21:37:59 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "GAD_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: GAD_FLUXLIMIT_IMPL_R
8     C !INTERFACE:
9     SUBROUTINE GAD_FLUXLIMIT_IMPL_R(
10     I bi,bj,k, iMin,iMax,jMin,jMax,
11     I deltaTarg, rTrans, tFld,
12     O a3d, b3d, c3d,
13     I myThid )
14    
15     C !DESCRIPTION: \bv
16     C *==========================================================*
17     C | S/R GAD_FLUXLIMIT_IMPL_R
18     C | o Compute matrix element to solve vertical advection
19     C | implicitly using flux-limiter advection scheme
20     C *==========================================================*
21     C | o contribution of vertical transport at interface k
22     C | is added to matrix lines k & k-1
23     C *==========================================================*
24     C \ev
25    
26     C !USES:
27     IMPLICIT NONE
28    
29     C == Global variables ===
30     #include "SIZE.h"
31     #include "GRID.h"
32     #include "EEPARAMS.h"
33     #include "PARAMS.h"
34    
35     C !INPUT/OUTPUT PARAMETERS:
36     C == Routine Arguments ==
37     C bi,bj :: tile indices
38     C k :: vertical level
39     C iMin,iMax,jMin,jMax :: computation domain
40     C deltaTarg :: time step
41     C rTrans :: vertical volume transport
42     C tFld :: tracer field
43     C a3d :: lower diagonal of the tridiagonal matrix
44     C b3d :: main diagonal of the tridiagonal matrix
45     C c3d :: upper diagonal of the tridiagonal matrix
46     C myThid :: thread number
47     INTEGER bi,bj,k
48     INTEGER iMin,iMax,jMin,jMax
49     _RL deltaTarg
50     _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
51     _RL tFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
52     _RL a3d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
53     _RL b3d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
54     _RL c3d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
55     INTEGER myThid
56    
57     C == Local Variables ==
58     C i,j :: loop indices
59     C kp1 :: =min( k+1 , Nr )
60     C km1 :: =max( k-1 , 1 )
61     C km2 :: =max( k-2 , 1 )
62     C Cr :: slope ratio
63     C Rjm,Rj,Rjp :: differences at i-1,i,i+1
64     C w_CFL :: Courant-Friedrich-Levy number
65     C upwindFac :: upwind factor
66     C rCenter :: centered contribution
67     C rUpwind :: upwind contribution
68     INTEGER i,j,kp1,km1,km2
69     _RL Cr,Rjm,Rj,Rjp, w_CFL
70     _RL upwindFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
71     _RL rCenter, rUpwind
72    
73     C Statement function provides Limiter(Cr)
74     #include "GAD_FLUX_LIMITER.h"
75     CEOP
76    
77     km2=MAX(1,k-2)
78     km1=MAX(1,k-1)
79     kp1=MIN(Nr,k+1)
80    
81     IF ( k.GT.Nr .OR. k.LT.2 ) RETURN
82    
83     C-- Compute the upwind fraction:
84     DO j=jMin,jMax
85     DO i=iMin,iMax
86     w_CFL = rTrans(i,j)*recip_rA(i,j,bi,bj)*deltaTarg*recip_drC(k)
87     Rjp=(tFld(i,j,kp1)-tFld(i,j,k) )*maskC(i,j,kp1,bi,bj)
88     Rj =(tFld(i,j,k) -tFld(i,j,km1))
89     Rjm=(tFld(i,j,km1)-tFld(i,j,km2))*maskC(i,j,km2,bi,bj)
90    
91     IF ( Rj.NE.0. _d 0) THEN
92     IF (rTrans(i,j).LT.0. _d 0) THEN
93     Cr=Rjm/Rj
94     ELSE
95     Cr=Rjp/Rj
96     ENDIF
97     upwindFac(i,j) = 1. _d 0
98     & - Limiter(Cr) * ( 1. _d 0 + abs(w_CFL) )
99     upwindFac(i,j) = max( -1. _d 0, upwindFac(i,j) )
100     ELSE
101     upwindFac(i,j) = 0. _d 0
102     ENDIF
103     ENDDO
104     ENDDO
105    
106     C-- Add centered & upwind contributions
107     DO j=jMin,jMax
108     DO i=iMin,iMax
109     rCenter = 0.5 _d 0 *deltaTtracer*rTrans(i,j)
110     & *recip_rA(i,j,bi,bj)*rkFac
111     rUpwind = abs(rCenter)*upwindFac(i,j)
112     a3d(i,j,k) = a3d(i,j,k)
113     & + (rCenter-rUpwind)
114     & *recip_hFacC(i,j,k,bi,bj)*recip_drF(k)
115     b3d(i,j,k) = b3d(i,j,k)
116     & + (rCenter+rUpwind)
117     & *recip_hFacC(i,j,k,bi,bj)*recip_drF(k)
118     b3d(i,j,k-1) = b3d(i,j,k-1)
119     & - (rCenter-rUpwind)
120     & *recip_hFacC(i,j,k-1,bi,bj)*recip_drF(k-1)
121     c3d(i,j,k-1) = c3d(i,j,k-1)
122     & - (rCenter+rUpwind)
123     & *recip_hFacC(i,j,k-1,bi,bj)*recip_drF(k-1)
124     ENDDO
125     ENDDO
126    
127     RETURN
128     END

  ViewVC Help
Powered by ViewVC 1.1.22