/[MITgcm]/MITgcm_contrib/CS_ADJOINT_TESTS/diffuse/code/diffuse_theta.F
ViewVC logotype

Contents of /MITgcm_contrib/CS_ADJOINT_TESTS/diffuse/code/diffuse_theta.F

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


Revision 1.1 - (show annotations) (download)
Wed Jul 7 03:12:36 2004 UTC (21 years, 1 month ago) by cnh
Branch: MAIN
CVS Tags: HEAD
Test code for use in developing and maintaining exch2 adjoints

1 C $Header: $
2 C $Name: $
3
4 #include "PACKAGES_CONFIG.h"
5 #include "CPP_OPTIONS.h"
6
7 CBOP
8 C !ROUTINE: DIFFUSE_THETA
9 C !INTERFACE:
10 SUBROUTINE DIFFUSE_THETA(myTime, myIter, myThid)
11
12 C !USES:
13 IMPLICIT NONE
14 C == Global variables ===
15 #include "SIZE.h"
16 #include "EEPARAMS.h"
17 #include "PARAMS.h"
18 #include "DYNVARS.h"
19 #include "GRID.h"
20 #include "GAD.h"
21
22 C !INPUT/OUTPUT PARAMETERS:
23 C == Routine arguments ==
24 C myTime - Current time in simulation
25 C myIter - Current iteration number in simulation
26 C myThid - Thread number for this instance of the routine.
27 _RL myTime
28 INTEGER myIter
29 INTEGER myThid
30
31 C !LOCAL VARIABLES:
32 C == Local variables
33 C xA, yA - Per block temporaries holding face areas
34 C uTrans, vTrans - Per block temporaries holding flow
35 C transport
36 C o uTrans: Zonal transport
37 C o vTrans: Meridional transport
38 C maskUp o maskUp: land/water mask for W points
39 C fVer o fVer: Vertical flux term - note fVer
40 C is "pipelined" in the vertical
41 C so we need an fVer for each
42 C variable.
43 C iMin, iMax - Ranges and sub-block indices on which calculations
44 C jMin, jMax are applied.
45 C bi, bj
46 C k, kup, - Index for layer above and below. kup and kDown
47 C kDown, km1 are switched with layer to be the appropriate
48 C index into fVerTerm.
49 _RS xA (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
50 _RS yA (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
51 _RL uTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
52 _RL vTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
53 _RL rTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
54 _RS maskUp (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
55 _RL fVer (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
56 INTEGER iMin, iMax
57 INTEGER jMin, jMax
58 INTEGER bi, bj
59 INTEGER i, j
60 INTEGER k, km1, kup, kDown
61
62 _RL df (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
63 _RL localT(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
64 _RL fZon (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
65 _RL fMer (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
66 CEOP
67
68 DO bj=myByLo(myThid),myByHi(myThid)
69 DO bi=myBxLo(myThid),myBxHi(myThid)
70 DO j=1-OLy,sNy+OLy
71 DO i=1-OLx,sNx+OLx
72 xA(i,j) = 0. _d 0
73 yA(i,j) = 0. _d 0
74 uTrans(i,j) = 0. _d 0
75 vTrans(i,j) = 0. _d 0
76 rTrans (i,j) = 0. _d 0
77 fVer (i,j,1) = 0. _d 0
78 fVer (i,j,2) = 0. _d 0
79 ENDDO
80 ENDDO
81
82 DO k=1,Nr
83 DO j=1-OLy,sNy+OLy
84 DO i=1-OLx,sNx+OLx
85 gT(i,j,k,bi,bj) = 0. _d 0
86 ENDDO
87 ENDDO
88 ENDDO
89
90 DO k=Nr,1,-1
91
92 km1 = MAX(1,k-1)
93 kup = 1+MOD(k+1,2)
94 kDown= 1+MOD(k,2)
95
96 iMin = 1-OLx
97 iMax = sNx+OLx
98 jMin = 1-OLy
99 jMax = sNy+OLy
100 C-- Get temporary terms used by tendency routines
101 CALL CALC_COMMON_FACTORS (
102 I bi,bj,iMin,iMax,jMin,jMax,k,
103 O xA,yA,uTrans,vTrans,rTrans,maskUp,
104 I myThid)
105
106 C-- Make local copy of tracer array
107 DO j=1-OLy,sNy+OLy
108 DO i=1-OLx,sNx+OLx
109 localT(i,j) =theta(i,j,k,bi,bj)
110 ENDDO
111 ENDDO
112 C-- Zero out work arrays
113 DO j=1-OLy,sNy+OLy
114 DO i=1-OLx,sNx+OLx
115 fZon(i,j) = 0. _d 0
116 fMer(i,j) = 0. _d 0
117 df(i,j) = 0. _d 0
118 ENDDO
119 ENDDO
120
121 C-- Diffusive fluxes
122 CALL GAD_DIFF_X(bi,bj,k,xA,diffKhT,localT,df,myThid)
123 DO j=1-Oly,sNy+Oly
124 DO i=1-Olx,sNx+Olx
125 fZon(i,j) = fZon(i,j) + df(i,j)
126 ENDDO
127 ENDDO
128 CALL GAD_DIFF_Y(bi,bj,k,yA,diffKhT,localT,df,myThid)
129 DO j=1-Oly,sNy+Oly
130 DO i=1-Olx,sNx+Olx
131 fMer(i,j) = fMer(i,j) + df(i,j)
132 ENDDO
133 ENDDO
134
135 C-- Divergence of fluxes
136 DO j=1-Oly,sNy+Oly-1
137 DO i=1-Olx,sNx+Olx-1
138 gT(i,j,k,bi,bj)=gT(i,j,k,bi,bj)
139 & -_recip_hFacC(i,j,k,bi,bj)*recip_drF(k)*recip_rA(i,j,bi,bj)
140 & *( (fZon(i+1,j)-fZon(i,j))
141 & +(fMer(i,j+1)-fMer(i,j))
142 & +(fVer(i,j,kUp)-fVer(i,j,kDown))*rkFac
143 & )
144
145 ENDDO
146 ENDDO
147
148 C-- Step field forward
149 CALL ADAMS_BASHFORTH2(
150 I bi, bj, K,
151 U gT, gTnm1,
152 I myIter, myThid )
153 CALL TIMESTEP_TRACER(
154 I bi,bj,iMin,iMax,jMin,jMax,k,tempAdvScheme,
155 I theta, gT,
156 I myIter, myThid)
157
158 ENDDO
159 ENDDO
160 ENDDO
161
162 C-- Update halo regions
163 _EXCH_XYZ_R8( gTNM1 , myThid )
164 _EXCH_XYZ_R8( gT , myThid )
165
166 C-- Cycle timestepping arrays
167 DO bj=myByLo(myThid),myByHi(myThid)
168 DO bi=myBxLo(myThid),myBxHi(myThid)
169 DO k=1,Nr
170 DO j=1-OLy,sNy+OLy
171 DO i=1-OLx,sNx+OLx
172 theta(i,j,k,bi,bj)=gT(i,j,k,bi,bj)
173 ENDDO
174 ENDDO
175 ENDDO
176 ENDDO
177 ENDDO
178
179 CALL PLOT_FIELD_XYZRL( theta, 'Theta after diffuse' ,
180 & Nr, myIter, myThid )
181
182 RETURN
183 END

  ViewVC Help
Powered by ViewVC 1.1.22