/[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.12 - (show annotations) (download)
Tue Jan 21 19:34:13 2003 UTC (21 years, 5 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint50c_post, checkpoint48e_post, checkpoint50c_pre, checkpoint48i_post, checkpoint51, checkpoint50, checkpoint50d_post, checkpoint50b_pre, checkpoint48b_post, checkpoint48c_pre, checkpoint48d_pre, checkpoint48d_post, checkpoint48f_post, checkpoint48h_post, checkpoint51b_pre, checkpoint48a_post, checkpoint50f_post, checkpoint50a_post, checkpoint50f_pre, checkpoint47j_post, checkpoint48c_post, checkpoint50g_post, checkpoint50h_post, checkpoint50e_pre, checkpoint50i_post, checkpoint50e_post, checkpoint50d_pre, checkpoint48, checkpoint49, checkpoint48g_post, checkpoint50b_post, checkpoint51a_post
Changes since 1.11: +32 -11 lines 
Yet more changes:
o adgmredi_calc_tensor
  avoiding all recomputation of gmredi_slope_limit
o adgmredi_x/y/rtransport
  added flag for excessive storing to avoid recomp. of
  u/v/rtans, dTdx/y/z
  -> this is not really necessary and very memory-consuming
o adgmredi_slope_psi:
  consistency with gmredi_slope_limit in treatment of GM_slopeSqCutoff
o gmredi_slope_limit
  re-activated full calculation of taperfct for case 'ac02'
1 C $Header: /u/gcmpack/MITgcm/pkg/gmredi/gmredi_xtransport.F,v 1.11 2003/01/12 21:13:36 jmc Exp $
2 C $Name: $
3
4 #include "GMREDI_OPTIONS.h"
5
6 subroutine GMREDI_XTRANSPORT(
7 I iMin,iMax,jMin,jMax,bi,bj,K,
8 I xA,Tracer,tracerIdentity,
9 U df,
10 I myThid)
11 C /==========================================================\
12 C | o SUBROUTINE GMREDI_XTRANSPORT |
13 C | Add horizontal x transport terms from GM/Redi |
14 C | parameterization. |
15 C |==========================================================|
16 C \==========================================================/
17 IMPLICIT NONE
18
19 C == GLobal variables ==
20 #include "SIZE.h"
21 #include "EEPARAMS.h"
22 #include "PARAMS.h"
23 #include "GRID.h"
24 #include "GMREDI.h"
25
26 #ifdef ALLOW_AUTODIFF_TAMC
27 #include "tamc.h"
28 #include "tamc_keys.h"
29 #endif /* ALLOW_AUTODIFF_TAMC */
30
31 C == Routine arguments ==
32 C iMin,iMax,jMin, - Range of points for which calculation
33 C jMax,bi,bj,k results will be set.
34 C xA - Area of X face
35 C Tracer - 3D Tracer field
36 C df - Diffusive flux component work array.
37 INTEGER iMin,iMax,jMin,jMax,bi,bj,k
38 _RS xA(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
39 _RL Tracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
40 integer tracerIdentity
41 _RL df (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
42 INTEGER myThid
43
44 #ifdef ALLOW_GMREDI
45
46 C == Local variables ==
47 C I, J - Loop counters
48 INTEGER I, J
49 INTEGER km1,kp1
50 _RL maskp1
51 #ifdef GM_EXTRA_DIAGONAL
52 _RL dTdz (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
53 #endif
54 #ifdef GM_BOLUS_ADVEC
55 _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
56 #endif
57
58 #ifdef ALLOW_AUTODIFF_TAMC
59 act0 = tracerIdentity - 1
60 max0 = maxpass
61 act1 = bi - myBxLo(myThid)
62 max1 = myBxHi(myThid) - myBxLo(myThid) + 1
63 act2 = bj - myByLo(myThid)
64 max2 = myByHi(myThid) - myByLo(myThid) + 1
65 act3 = myThid - 1
66 max3 = nTx*nTy
67 act4 = ikey_dynamics - 1
68 igadkey = (act0 + 1)
69 & + act1*max0
70 & + act2*max0*max1
71 & + act3*max0*max1*max2
72 & + act4*max0*max1*max2*max3
73 kkey = (igadkey-1)*Nr + k
74 if (tracerIdentity.GT.maxpass)
75 & STOP 'maxpass seems smaller than tracerIdentity'
76 #endif /* ALLOW_AUTODIFF_TAMC */
77
78 IF (useGMRedi) THEN
79
80 #ifdef ALLOW_AUTODIFF_TAMC
81 # ifdef GM_NON_UNITY_DIAGONAL
82 CADJ STORE Kux(:,:,k,bi,bj) =
83 CADJ & comlev1_gmredi_k_gad, key=kkey, byte=isbyte
84 # endif
85 # ifdef GM_EXTRA_DIAGONAL
86 CADJ STORE Kuz(:,:,k,bi,bj) =
87 CADJ & comlev1_gmredi_k_gad, key=kkey, byte=isbyte
88 # endif
89 #endif
90
91 C-- Area integrated zonal flux
92 DO j=jMin,jMax
93 DO i=iMin,iMax
94 df(i,j) = df(i,j)
95 & -xA(i,j)
96 #ifdef GM_NON_UNITY_DIAGONAL
97 & *Kux(i,j,k,bi,bj)
98 #else
99 & *(GM_isopycK
100 #ifdef GM_VISBECK_VARIABLE_K
101 & +op5*(VisbeckK(i,j,bi,bj)+VisbeckK(i-1,j,bi,bj))
102 #endif
103 & )
104 #endif /* GM_NON_UNITY_DIAGONAL */
105 & *_recip_dxC(i,j,bi,bj)
106 & *(Tracer(i,j,k,bi,bj)-Tracer(i-1,j,k,bi,bj))
107 ENDDO
108 ENDDO
109
110 #ifdef GM_EXTRA_DIAGONAL
111 IF (GM_ExtraDiag) THEN
112 km1 = MAX(k-1,1)
113 kp1 = MIN(k+1,Nr)
114
115 DO j=jMin,jMax
116 DO i=iMin,iMax
117 C- Vertical gradients interpolated to U points
118 dTdz(i,j) = op5*(
119 & +op5*recip_drC(k)*
120 & ( maskC(i-1,j,k,bi,bj)*
121 & (Tracer(i-1,j,km1,bi,bj)-Tracer(i-1,j,k,bi,bj))
122 & +maskC( i ,j,k,bi,bj)*
123 & (Tracer( i ,j,km1,bi,bj)-Tracer( i ,j,k,bi,bj))
124 & )
125 & +op5*recip_drC(kp1)*
126 & ( maskC(i-1,j,kp1,bi,bj)*
127 & (Tracer(i-1,j,k,bi,bj)-Tracer(i-1,j,kp1,bi,bj))
128 & +maskC( i ,j,kp1,bi,bj)*
129 & (Tracer( i ,j,k,bi,bj)-Tracer( i ,j,kp1,bi,bj))
130 & ) )
131
132
133 ENDDO
134 ENDDO
135 #ifdef GM_AUTODIFF_EXCESSIVE_STORE
136 CADJ STORE dtdz(:,:) =
137 CADJ & comlev1_gmredi_k_gad, key=kkey, byte=isbyte
138 #endif
139 DO j=jMin,jMax
140 DO i=iMin,iMax
141 C- Off-diagonal components of horizontal flux
142 df(i,j) = df(i,j) - xA(i,j)*Kuz(i,j,k,bi,bj)*dTdz(i,j)
143 ENDDO
144 ENDDO
145 ENDIF
146 #endif /* GM_EXTRA_DIAGONAL */
147
148 #ifdef GM_BOLUS_ADVEC
149 IF (GM_AdvForm .AND. GM_AdvSeparate) THEN
150 kp1 = MIN(k+1,Nr)
151 maskp1 = 1.
152 IF (k.GE.Nr) maskp1 = 0.
153 DO j=jMin,jMax
154 DO i=iMin,iMax
155 uTrans(i,j) = dyG(i,j,bi,bj)*( GM_PsiX(i,j,kp1,bi,bj)*maskp1
156 & -GM_PsiX(i,j,k,bi,bj) )
157 & *maskW(i,j,k,bi,bj)
158 ENDDO
159 ENDDO
160 #ifdef GM_AUTODIFF_EXCESSIVE_STORE
161 CADJ STORE utrans(:,:) =
162 CADJ & comlev1_gmredi_k_gad, key=kkey, byte=isbyte
163 #endif
164 DO j=jMin,jMax
165 DO i=iMin,iMax
166 df(i,j) = df(i,j)
167 & +uTrans(i,j)*op5*(Tracer(i,j,k,bi,bj)+Tracer(i-1,j,k,bi,bj))
168 ENDDO
169 ENDDO
170 ENDIF
171 #endif /* GM_BOLUS_ADVEC */
172
173 ENDIF
174 #endif /* ALLOW_GMREDI */
175
176 RETURN
177 END
  ViewVC Help
Powered by ViewVC 1.1.22