/[MITgcm]/MITgcm/pkg/gmredi/gmredi_xtransport.F
ViewVC logotype

Contents of /MITgcm/pkg/gmredi/gmredi_xtransport.F

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


Revision 1.9 - (show annotations) (download)
Thu Nov 14 22:43:49 2002 UTC (21 years, 5 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint47e_post, checkpoint47c_post, checkpoint47d_pre, checkpoint47a_post, checkpoint47d_post, branch-exfmods-tag, checkpoint47b_post, checkpoint47f_post, checkpoint47
Branch point for: branch-exfmods-curt
Changes since 1.8: +2 -4 lines
o * "clean" adjoint code (in terms of extensive recomputations)
    can now be obtained for all GMREDI options (i.e. for
    - GM_VISBECK_VARIABLE_K
    - GM_NON_UNITY_DIAGONAL
    - GM_EXTRA_DIAGONAL
    - GM_BOLUS_ADVEC )
  * However, wrong gradient check problem remains unsolved.
  * New CPP options have been introduced for different
    tapering schemes

1
2 #include "GMREDI_OPTIONS.h"
3
4 subroutine GMREDI_XTRANSPORT(
5 I iMin,iMax,jMin,jMax,bi,bj,K,
6 I xA,Tracer,tracerIdentity,
7 U df,
8 I myThid)
9 C /==========================================================\
10 C | o SUBROUTINE GMREDI_XTRANSPORT |
11 C | Add horizontal x transport terms from GM/Redi |
12 C | parameterization. |
13 C |==========================================================|
14 C \==========================================================/
15 IMPLICIT NONE
16
17 C == GLobal variables ==
18 #include "SIZE.h"
19 #include "EEPARAMS.h"
20 #include "PARAMS.h"
21 #include "GRID.h"
22 #include "GMREDI.h"
23
24 #ifdef ALLOW_AUTODIFF_TAMC
25 #include "tamc.h"
26 #include "tamc_keys.h"
27 #endif /* ALLOW_AUTODIFF_TAMC */
28
29 C == Routine arguments ==
30 C iMin,iMax,jMin, - Range of points for which calculation
31 C jMax,bi,bj,k results will be set.
32 C xA - Area of X face
33 C Tracer - 3D Tracer field
34 C df - Diffusive flux component work array.
35 INTEGER iMin,iMax,jMin,jMax,bi,bj,k
36 _RS xA(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
37 _RL Tracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
38 integer tracerIdentity
39 _RL df (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
40 INTEGER myThid
41
42 #ifdef ALLOW_GMREDI
43
44 C == Local variables ==
45 C I, J - Loop counters
46 INTEGER I, J
47 INTEGER km1,kp1
48 _RL uTrans, maskp1, dTdz
49
50 #ifdef ALLOW_AUTODIFF_TAMC
51 act0 = tracerIdentity - 1
52 max0 = maxpass
53 act1 = bi - myBxLo(myThid)
54 max1 = myBxHi(myThid) - myBxLo(myThid) + 1
55 act2 = bj - myByLo(myThid)
56 max2 = myByHi(myThid) - myByLo(myThid) + 1
57 act3 = myThid - 1
58 max3 = nTx*nTy
59 act4 = ikey_dynamics - 1
60 igadkey = (act0 + 1)
61 & + act1*max0
62 & + act2*max0*max1
63 & + act3*max0*max1*max2
64 & + act4*max0*max1*max2*max3
65 kkey = (igadkey-1)*Nr + k
66 if (tracerIdentity.GT.maxpass)
67 & STOP 'maxpass seems smaller than tracerIdentity'
68 #endif /* ALLOW_AUTODIFF_TAMC */
69
70 IF (useGMRedi) THEN
71
72 #ifdef ALLOW_AUTODIFF_TAMC
73 # ifdef GM_NON_UNITY_DIAGONAL
74 CADJ STORE Kux(:,:,k,bi,bj) =
75 CADJ & comlev1_gmredi_k_gad, key=kkey, byte=isbyte
76 # endif
77 # ifdef GM_EXTRA_DIAGONAL
78 CADJ STORE Kuz(:,:,k,bi,bj) =
79 CADJ & comlev1_gmredi_k_gad, key=kkey, byte=isbyte
80 # endif
81 #endif
82
83 C-- Area integrated zonal flux
84 DO j=jMin,jMax
85 DO i=iMin,iMax
86 df(i,j) = df(i,j)
87 & -xA(i,j)
88 #ifdef GM_NON_UNITY_DIAGONAL
89 & *Kux(i,j,k,bi,bj)
90 #else
91 & *(GM_isopycK
92 #ifdef GM_VISBECK_VARIABLE_K
93 cph & +0.5*(VisbeckK(i,j,bi,bj)+VisbeckK(i-1,j,bi,bj))
94 #endif
95 & )
96 #endif /* GM_NON_UNITY_DIAGONAL */
97 & *_recip_dxC(i,j,bi,bj)
98 & *(Tracer(i,j,k,bi,bj)-Tracer(i-1,j,k,bi,bj))
99 ENDDO
100 ENDDO
101
102 #ifdef GM_EXTRA_DIAGONAL
103 IF (GM_ExtraDiag) THEN
104 km1 = MAX(k-1,1)
105 kp1 = MIN(k+1,Nr)
106
107 DO j=jMin,jMax
108 DO i=iMin,iMax
109
110 C- Vertical gradients interpolated to U points
111 dTdz = 0.5*(
112 & +0.5*recip_drC(k)*
113 & ( maskC(i-1,j,k,bi,bj)*
114 & (Tracer(i-1,j,km1,bi,bj)-Tracer(i-1,j,k,bi,bj))
115 & +maskC( i ,j,k,bi,bj)*
116 & (Tracer( i ,j,km1,bi,bj)-Tracer( i ,j,k,bi,bj))
117 & )
118 & +0.5*recip_drC(kp1)*
119 & ( maskC(i-1,j,kp1,bi,bj)*
120 & (Tracer(i-1,j,k,bi,bj)-Tracer(i-1,j,kp1,bi,bj))
121 & +maskC( i ,j,kp1,bi,bj)*
122 & (Tracer( i ,j,k,bi,bj)-Tracer( i ,j,kp1,bi,bj))
123 & ) )
124
125 C- Off-diagonal components of horizontal flux
126 df(i,j) = df(i,j) - xA(i,j)*Kuz(i,j,k,bi,bj)*dTdz
127
128 ENDDO
129 ENDDO
130 ENDIF
131 #endif /* GM_EXTRA_DIAGONAL */
132
133 #ifdef GM_BOLUS_ADVEC
134 IF (GM_AdvForm .AND. GM_AdvSeparate) THEN
135 kp1 = MIN(k+1,Nr)
136 maskp1 = 1.
137 IF (k.GE.Nr) maskp1 = 0.
138 DO j=jMin,jMax
139 DO i=iMin,iMax
140 uTrans = dyG(i,j,bi,bj)*( GM_PsiX(i,j,kp1,bi,bj)*maskp1
141 & -GM_PsiX(i,j,k,bi,bj) )
142 & *maskW(i,j,k,bi,bj)
143 df(i,j) = df(i,j)
144 & +uTrans*0.5*(Tracer(i,j,k,bi,bj)+Tracer(i-1,j,k,bi,bj))
145 ENDDO
146 ENDDO
147 ENDIF
148 #endif /* GM_BOLUS_ADVEC */
149
150 ENDIF
151 #endif /* ALLOW_GMREDI */
152
153 RETURN
154 END

  ViewVC Help
Powered by ViewVC 1.1.22