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

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

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

Revision 1.14 - (hide annotations) (download)
Fri Sep 17 23:02:01 2004 UTC (19 years, 9 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint57m_post, checkpoint57g_pre, checkpoint57s_post, checkpoint58b_post, checkpoint57b_post, checkpoint57g_post, checkpoint56b_post, checkpoint57y_post, checkpoint57r_post, checkpoint57d_post, checkpoint57i_post, checkpoint58, checkpoint55, checkpoint57, checkpoint56, checkpoint58f_post, checkpoint57n_post, checkpoint58d_post, checkpoint58a_post, checkpoint57z_post, checkpoint58t_post, checkpoint55i_post, checkpoint58m_post, checkpoint57l_post, checkpoint57t_post, checkpoint55c_post, checkpoint57v_post, checkpoint57f_post, checkpoint57a_post, checkpoint57h_pre, checkpoint57h_post, checkpoint57y_pre, checkpoint55g_post, checkpoint58o_post, checkpoint57c_post, checkpoint58p_post, checkpoint58q_post, checkpoint55d_post, checkpoint58e_post, mitgcm_mapl_00, checkpoint55d_pre, checkpoint57c_pre, checkpoint58r_post, checkpoint55j_post, checkpoint55h_post, checkpoint58n_post, checkpoint57e_post, checkpoint55b_post, checkpoint55f_post, checkpoint57p_post, checkpint57u_post, checkpoint57q_post, eckpoint57e_pre, checkpoint58k_post, checkpoint56a_post, checkpoint58l_post, checkpoint57h_done, checkpoint57j_post, checkpoint57f_pre, checkpoint58g_post, checkpoint58h_post, checkpoint56c_post, checkpoint58j_post, checkpoint57a_pre, checkpoint55a_post, checkpoint57o_post, checkpoint57k_post, checkpoint57w_post, checkpoint58i_post, checkpoint57x_post, checkpoint58c_post, checkpoint58u_post, checkpoint58s_post, checkpoint55e_post
Changes since 1.13: +6 -3 lines 
o bringing adjoint up to date for sheduled c55
1 heimbach 1.14 C $Header: /u/gcmpack/MITgcm/pkg/gmredi/gmredi_xtransport.F,v 1.13 2003/06/27 01:55:08 heimbach Exp $
2 jmc 1.11 C $Name: $
3 adcroft 1.1
4     #include "GMREDI_OPTIONS.h"
5    
6     subroutine GMREDI_XTRANSPORT(
7     I iMin,iMax,jMin,jMax,bi,bj,K,
8 heimbach 1.8 I xA,Tracer,tracerIdentity,
9 adcroft 1.1 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 heimbach 1.7 #ifdef ALLOW_AUTODIFF_TAMC
27 heimbach 1.14 # include "tamc.h"
28     # include "tamc_keys.h"
29     # ifdef ALLOW_PTRACERS
30     # include "PTRACERS_SIZE.h"
31     # endif
32 heimbach 1.7 #endif /* ALLOW_AUTODIFF_TAMC */
33    
34 adcroft 1.1 C == Routine arguments ==
35     C iMin,iMax,jMin, - Range of points for which calculation
36     C jMax,bi,bj,k results will be set.
37     C xA - Area of X face
38     C Tracer - 3D Tracer field
39     C df - Diffusive flux component work array.
40     INTEGER iMin,iMax,jMin,jMax,bi,bj,k
41     _RS xA(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
42     _RL Tracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
43 heimbach 1.9 integer tracerIdentity
44 adcroft 1.1 _RL df (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
45     INTEGER myThid
46    
47     #ifdef ALLOW_GMREDI
48    
49     C == Local variables ==
50     C I, J - Loop counters
51     INTEGER I, J
52 jmc 1.5 INTEGER km1,kp1
53 heimbach 1.12 _RL maskp1
54     #ifdef GM_EXTRA_DIAGONAL
55     _RL dTdz (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
56     #endif
57     #ifdef GM_BOLUS_ADVEC
58     _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
59     #endif
60 adcroft 1.1
61 heimbach 1.7 #ifdef ALLOW_AUTODIFF_TAMC
62 heimbach 1.8 act0 = tracerIdentity - 1
63     max0 = maxpass
64 heimbach 1.7 act1 = bi - myBxLo(myThid)
65     max1 = myBxHi(myThid) - myBxLo(myThid) + 1
66     act2 = bj - myByLo(myThid)
67     max2 = myByHi(myThid) - myByLo(myThid) + 1
68     act3 = myThid - 1
69     max3 = nTx*nTy
70     act4 = ikey_dynamics - 1
71 heimbach 1.8 igadkey = (act0 + 1)
72     & + act1*max0
73     & + act2*max0*max1
74     & + act3*max0*max1*max2
75     & + act4*max0*max1*max2*max3
76     kkey = (igadkey-1)*Nr + k
77 heimbach 1.13 if (tracerIdentity.GT.maxpass) then
78     print *, 'ph-pass gmredi_xtrans ', maxpass, tracerIdentity
79     STOP 'maxpass seems smaller than tracerIdentity'
80     endif
81 heimbach 1.7 #endif /* ALLOW_AUTODIFF_TAMC */
82    
83 heimbach 1.2 IF (useGMRedi) THEN
84 heimbach 1.7
85     #ifdef ALLOW_AUTODIFF_TAMC
86 heimbach 1.8 # ifdef GM_NON_UNITY_DIAGONAL
87     CADJ STORE Kux(:,:,k,bi,bj) =
88     CADJ & comlev1_gmredi_k_gad, key=kkey, byte=isbyte
89     # endif
90     # ifdef GM_EXTRA_DIAGONAL
91     CADJ STORE Kuz(:,:,k,bi,bj) =
92     CADJ & comlev1_gmredi_k_gad, key=kkey, byte=isbyte
93     # endif
94 heimbach 1.7 #endif
95 adcroft 1.1
96     C-- Area integrated zonal flux
97     DO j=jMin,jMax
98     DO i=iMin,iMax
99     df(i,j) = df(i,j)
100 jmc 1.5 & -xA(i,j)
101     #ifdef GM_NON_UNITY_DIAGONAL
102     & *Kux(i,j,k,bi,bj)
103     #else
104     & *(GM_isopycK
105 adcroft 1.1 #ifdef GM_VISBECK_VARIABLE_K
106 jmc 1.11 & +op5*(VisbeckK(i,j,bi,bj)+VisbeckK(i-1,j,bi,bj))
107 adcroft 1.1 #endif
108     & )
109 jmc 1.5 #endif /* GM_NON_UNITY_DIAGONAL */
110 adcroft 1.1 & *_recip_dxC(i,j,bi,bj)
111     & *(Tracer(i,j,k,bi,bj)-Tracer(i-1,j,k,bi,bj))
112     ENDDO
113     ENDDO
114 jmc 1.5
115     #ifdef GM_EXTRA_DIAGONAL
116     IF (GM_ExtraDiag) THEN
117     km1 = MAX(k-1,1)
118     kp1 = MIN(k+1,Nr)
119    
120     DO j=jMin,jMax
121     DO i=iMin,iMax
122 heimbach 1.12 C- Vertical gradients interpolated to U points
123     dTdz(i,j) = op5*(
124 heimbach 1.10 & +op5*recip_drC(k)*
125 jmc 1.5 & ( maskC(i-1,j,k,bi,bj)*
126     & (Tracer(i-1,j,km1,bi,bj)-Tracer(i-1,j,k,bi,bj))
127     & +maskC( i ,j,k,bi,bj)*
128     & (Tracer( i ,j,km1,bi,bj)-Tracer( i ,j,k,bi,bj))
129     & )
130 heimbach 1.10 & +op5*recip_drC(kp1)*
131 jmc 1.5 & ( maskC(i-1,j,kp1,bi,bj)*
132     & (Tracer(i-1,j,k,bi,bj)-Tracer(i-1,j,kp1,bi,bj))
133     & +maskC( i ,j,kp1,bi,bj)*
134     & (Tracer( i ,j,k,bi,bj)-Tracer( i ,j,kp1,bi,bj))
135     & ) )
136    
137    
138     ENDDO
139     ENDDO
140 heimbach 1.12 #ifdef GM_AUTODIFF_EXCESSIVE_STORE
141     CADJ STORE dtdz(:,:) =
142     CADJ & comlev1_gmredi_k_gad, key=kkey, byte=isbyte
143     #endif
144     DO j=jMin,jMax
145     DO i=iMin,iMax
146     C- Off-diagonal components of horizontal flux
147     df(i,j) = df(i,j) - xA(i,j)*Kuz(i,j,k,bi,bj)*dTdz(i,j)
148     ENDDO
149     ENDDO
150 jmc 1.5 ENDIF
151     #endif /* GM_EXTRA_DIAGONAL */
152    
153     #ifdef GM_BOLUS_ADVEC
154 jmc 1.6 IF (GM_AdvForm .AND. GM_AdvSeparate) THEN
155 jmc 1.5 kp1 = MIN(k+1,Nr)
156     maskp1 = 1.
157     IF (k.GE.Nr) maskp1 = 0.
158     DO j=jMin,jMax
159     DO i=iMin,iMax
160 heimbach 1.12 uTrans(i,j) = dyG(i,j,bi,bj)*( GM_PsiX(i,j,kp1,bi,bj)*maskp1
161     & -GM_PsiX(i,j,k,bi,bj) )
162     & *maskW(i,j,k,bi,bj)
163     ENDDO
164     ENDDO
165     #ifdef GM_AUTODIFF_EXCESSIVE_STORE
166     CADJ STORE utrans(:,:) =
167     CADJ & comlev1_gmredi_k_gad, key=kkey, byte=isbyte
168     #endif
169     DO j=jMin,jMax
170     DO i=iMin,iMax
171 jmc 1.5 df(i,j) = df(i,j)
172 heimbach 1.12 & +uTrans(i,j)*op5*(Tracer(i,j,k,bi,bj)+Tracer(i-1,j,k,bi,bj))
173 jmc 1.5 ENDDO
174     ENDDO
175     ENDIF
176     #endif /* GM_BOLUS_ADVEC */
177 adcroft 1.1
178     ENDIF
179     #endif /* ALLOW_GMREDI */
180    
181     RETURN
182     END
  ViewVC Help
Powered by ViewVC 1.1.22