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

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

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


Revision 1.4 - (hide annotations) (download)
Fri Sep 21 13:11:43 2001 UTC (22 years, 8 months ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint47e_post, checkpoint44e_post, checkpoint46l_post, checkpoint46g_pre, checkpoint47c_post, release1_p13_pre, checkpoint46f_post, checkpoint48e_post, checkpoint50c_pre, checkpoint44f_post, checkpoint46b_post, checkpoint43a-release1mods, ecco_c50_e32, ecco_c50_e33, ecco_c50_e30, ecco_c50_e31, release1_p13, checkpoint48i_post, checkpoint46l_pre, chkpt44d_post, checkpoint50, release1_p8, release1_p9, release1_p1, release1_p2, release1_p3, release1_p4, release1_p5, release1_p6, release1_p7, checkpoint50b_pre, checkpoint44e_pre, release1_b1, checkpoint48b_post, checkpoint43, checkpoint48c_pre, checkpoint47d_pre, release1_chkpt44d_post, checkpoint47a_post, checkpoint48d_pre, checkpoint47i_post, release1_p11, checkpoint47d_post, icebear5, icebear4, icebear3, icebear2, checkpoint46d_pre, checkpoint48d_post, release1-branch_tutorials, checkpoint48f_post, checkpoint45d_post, checkpoint46j_pre, chkpt44a_post, checkpoint44h_pre, checkpoint48h_post, ecco_c50_e29, checkpoint46a_post, checkpoint47g_post, checkpoint46j_post, checkpoint46k_post, ecco_c50_e28, chkpt44c_pre, checkpoint48a_post, checkpoint45a_post, checkpoint50a_post, ecco_c44_e19, ecco_c44_e18, ecco_c44_e17, ecco_c44_e16, release1_p12, release1_p10, release1_p16, release1_p17, release1_p14, release1_p15, checkpoint47j_post, ecco_c50_e33a, branch-exfmods-tag, checkpoint44g_post, checkpoint46e_pre, checkpoint48c_post, checkpoint45b_post, checkpoint46b_pre, release1-branch-end, release1_final_v1, checkpoint46c_pre, checkpoint46, checkpoint47b_post, checkpoint44b_post, checkpoint46h_pre, checkpoint46m_post, checkpoint46a_pre, checkpoint45c_post, ecco_ice2, ecco_ice1, checkpoint44h_post, checkpoint46g_post, release1_p12_pre, ecco_c44_e22, ecco_c44_e25, checkpoint47f_post, chkpt44a_pre, checkpoint46i_post, ecco_c44_e23, ecco_c44_e20, ecco_c44_e21, ecco_c44_e26, ecco_c44_e27, ecco_c44_e24, checkpoint46c_post, ecco-branch-mod1, ecco-branch-mod2, ecco-branch-mod3, ecco-branch-mod4, ecco-branch-mod5, checkpoint46e_post, release1_beta1, checkpoint44b_pre, checkpoint42, checkpoint41, checkpoint47, checkpoint44, checkpoint45, checkpoint48, checkpoint49, checkpoint46h_post, chkpt44c_post, checkpoint48g_post, checkpoint47h_post, checkpoint44f_pre, checkpoint46d_post, checkpoint50b_post, release1-branch_branchpoint
Branch point for: c24_e25_ice, branch-exfmods-curt, release1_final, release1-branch, release1, ecco-branch, release1_50yr, icebear, release1_coupled
Changes since 1.3: +36 -12 lines
Added comments in form compatible with "protex".

1 adcroft 1.4 C $Header: /u/gcmpack/models/MITgcmUV/pkg/generic_advdiff/gad_c4_adv_r.F,v 1.3 2001/08/20 20:45:15 jmc Exp $
2 jmc 1.2 C $Name: $
3 adcroft 1.1
4     #include "GAD_OPTIONS.h"
5    
6 adcroft 1.4 CBOP
7     C !ROUTINE: GAD_C4_ADV_R
8    
9     C !INTERFACE: ==========================================================
10 adcroft 1.1 SUBROUTINE GAD_C4_ADV_R(
11     I bi,bj,k,
12     I rTrans,
13     I tracer,
14     O wT,
15     I myThid )
16 adcroft 1.4
17     C !DESCRIPTION:
18     C Calculates the area integrated vertical flux due to advection of a tracer
19     C using centered fourth-order interpolation:
20     C \begin{equation*}
21     C F^r_{adv} = W \overline{ \theta - \frac{1}{6} \delta_{kk} \theta }^k
22     C \end{equation*}
23     C Near boundaries, the scheme reduces to a second if the flow is away
24     C from the boundary and to third order if the flow is towards
25     C the boundary.
26    
27     C !USES: ===============================================================
28 adcroft 1.1 IMPLICIT NONE
29     #include "SIZE.h"
30     #include "GRID.h"
31     #include "GAD.h"
32    
33 adcroft 1.4 C !INPUT PARAMETERS: ===================================================
34     C bi,bj :: tile indices
35     C k :: vertical level
36     C rTrans :: vertical volume transport
37     C tracer :: tracer field
38     C myThid :: thread number
39 adcroft 1.1 INTEGER bi,bj,k
40     _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
41     _RL tracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
42 adcroft 1.4 INTEGER myThid
43    
44     C !OUTPUT PARAMETERS: ==================================================
45     C wT :: vertical advective flux
46 adcroft 1.1 _RL wT (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
47    
48 adcroft 1.4 C !LOCAL VARIABLES: ====================================================
49     C i,j :: loop indices
50     C kp1 :: =min( k+1 , Nr )
51     C km1 :: =max( k-1 , 1 )
52     C km2 :: =max( k-2 , 1 )
53     C Rjm,Rj,Rjp :: differences at i-1,i,i+1
54     C Rjjm,Rjjp :: second differences at i-1,i
55     C maskP1 :: =1 for k<Nr, =0 for k>=Nr
56 adcroft 1.1 INTEGER i,j,kp1,km1,km2
57 jmc 1.3 _RL Rjm,Rj,Rjp,Rjjm,Rjjp
58     _RL maskP1
59 adcroft 1.4 CEOP
60 adcroft 1.1
61     km2=MAX(1,k-2)
62     km1=MAX(1,k-1)
63     kp1=MIN(Nr,k+1)
64 jmc 1.3 maskP1 = 1.
65     IF (k.GE.Nr) maskP1 = 0.
66 adcroft 1.1
67 jmc 1.2 IF ( k.EQ.1 .OR. k.GT.Nr) THEN
68 adcroft 1.1 DO j=1-Oly,sNy+Oly
69     DO i=1-Olx,sNx+Olx
70     wT(i,j) = 0.
71     ENDDO
72     ENDDO
73 jmc 1.3 ELSEIF ( k.EQ.2 ) THEN
74     Rjjm= 0.
75     DO j=1-Oly,sNy+Oly
76     DO i=1-Olx,sNx+Olx
77     Rjp=(tracer(i,j,kp1,bi,bj)-tracer(i,j,k,bi,bj))
78     Rj =(tracer(i,j,k,bi,bj)-tracer(i,j,km1,bi,bj))
79     Rjjp=(Rjp-Rj)*maskC(i,j,kp1,bi,bj)*maskP1
80     wT(i,j) = maskC(i,j,km1,bi,bj)*(
81     & rTrans(i,j)*(
82     & (Tracer(i,j,k,bi,bj)+Tracer(i,j,km1,bi,bj))*0.5 _d 0
83     & -oneSixth*(Rjjm+Rjjp)*0.5 _d 0 )
84     & +ABS(rTrans(i,j))*
85     & oneSixth*(Rjjm-Rjjp)*0.5 _d 0
86     & )
87     ENDDO
88     ENDDO
89     ELSEIF ( k.EQ.Nr ) THEN
90     Rjjp= 0.
91     DO j=1-Oly,sNy+Oly
92     DO i=1-Olx,sNx+Olx
93     Rj =(tracer(i,j,k,bi,bj)-tracer(i,j,km1,bi,bj))
94     Rjm=(tracer(i,j,km1,bi,bj)-tracer(i,j,km2,bi,bj))
95     Rjjm=(Rj-Rjm)*maskC(i,j,km2,bi,bj)
96     wT(i,j) = maskC(i,j,km1,bi,bj)*(
97     & rTrans(i,j)*(
98     & (Tracer(i,j,k,bi,bj)+Tracer(i,j,km1,bi,bj))*0.5 _d 0
99     & -oneSixth*(Rjjm+Rjjp)*0.5 _d 0 )
100     & +ABS(rTrans(i,j))*
101     & oneSixth*(Rjjm-Rjjp)*0.5 _d 0
102     & )
103     ENDDO
104     ENDDO
105 adcroft 1.1 ELSE
106     DO j=1-Oly,sNy+Oly
107     DO i=1-Olx,sNx+Olx
108     Rjp=(tracer(i,j,kp1,bi,bj)-tracer(i,j,k,bi,bj))
109 jmc 1.2 Rj =(tracer(i,j,k,bi,bj)-tracer(i,j,km1,bi,bj))
110     Rjm=(tracer(i,j,km1,bi,bj)-tracer(i,j,km2,bi,bj))
111 jmc 1.3 Rjjp=(Rjp-Rj)*maskC(i,j,kp1,bi,bj)
112     Rjjm=(Rj-Rjm)*maskC(i,j,km2,bi,bj)
113     wT(i,j) = maskC(i,j,km1,bi,bj)*(
114 adcroft 1.1 & rTrans(i,j)*(
115 jmc 1.3 & (Tracer(i,j,k,bi,bj)+Tracer(i,j,km1,bi,bj))*0.5 _d 0
116 jmc 1.2 & -oneSixth*(Rjjm+Rjjp)*0.5 _d 0 )
117 jmc 1.3 & +ABS(rTrans(i,j))*
118     & oneSixth*(Rjjm-Rjjp)*0.5 _d 0
119     & *( 1. _d 0 - maskC(i,j,km2,bi,bj)*maskC(i,j,kp1,bi,bj) )
120     & )
121 adcroft 1.1 ENDDO
122     ENDDO
123     ENDIF
124    
125     RETURN
126     END

  ViewVC Help
Powered by ViewVC 1.1.22