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

Annotation of /MITgcm_contrib/CS_ADJOINT_TESTS/diffuse/code_ad/diffuse_theta.F

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


Revision 1.1 - (hide annotations) (download)
Sun Jul 25 22:51:38 2004 UTC (21 years ago) by heimbach
Branch: MAIN
CVS Tags: HEAD
adjoint for advect_and_diffuse_theta.F

1 heimbach 1.1 C $Header: /u/gcmpack/MITgcm_contrib/CS_ADJOINT_TESTS/diffuse/code/diffuse_theta.F,v 1.1 2004/07/07 03:12:36 cnh Exp $
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