90
91
94
95
96
97 integer, intent(in) :: ng, tile
98 integer, intent(in) :: LBi, UBi, LBj, UBj
99 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
100 integer, intent(in) :: nrhs, nnew
101
102# ifdef ASSUMED_SHAPE
103# ifdef MASKING
104 real(r8), intent(in) :: pmask(LBi:,LBj:)
105# endif
106 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
107 real(r8), intent(in) :: pm(LBi:,LBj:)
108 real(r8), intent(in) :: pmon_p(LBi:,LBj:)
109 real(r8), intent(in) :: pmon_r(LBi:,LBj:)
110 real(r8), intent(in) :: pn(LBi:,LBj:)
111 real(r8), intent(in) :: pnom_p(LBi:,LBj:)
112 real(r8), intent(in) :: pnom_r(LBi:,LBj:)
113
114 real(r8), intent(inout) :: tl_u(LBi:,LBj:,:,:)
115 real(r8), intent(inout) :: tl_v(LBi:,LBj:,:,:)
116# else
117# ifdef MASKING
118 real(r8), intent(in) :: pmask(LBi:UBi,LBj:UBj)
119# endif
120 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
121 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
122 real(r8), intent(in) :: pmon_p(LBi:UBi,LBj:UBj)
123 real(r8), intent(in) :: pmon_r(LBi:UBi,LBj:UBj)
124 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
125 real(r8), intent(in) :: pnom_p(LBi:UBi,LBj:UBj)
126 real(r8), intent(in) :: pnom_r(LBi:UBi,LBj:UBj)
127
128 real(r8), intent(inout) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
129 real(r8), intent(inout) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
130# endif
131
132
133
134 integer :: i, j, k
135
136 real(r8) :: cff
137
138 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: UFe
139 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: UFx
140 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: VFe
141 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: VFx
142
143# include "set_bounds.h"
144
145
146
147
148
149
150
151
152
153
154
155
157
158 k_loop :
DO k=1,
n(ng)
159
160
161
162
163 DO j=jstr,jend
164 DO i=istru-1,iend
166 & hz(i,j,k)* &
167 & (tl_u(i+1,j,k,nrhs)- &
168 & tl_u(i ,j,k,nrhs))
169 END DO
170 END DO
171 DO j=jstr,jend+1
172 DO i=istru,iend
174 & 0.25_r8*(hz(i,j ,k)+hz(i-1,j ,k)+ &
175 & hz(i,j-1,k)+hz(i-1,j-1,k))* &
176 & (tl_u(i,j ,k,nrhs)- &
177 & tl_u(i,j-1,k,nrhs))
178# ifdef MASKING
179 ufe(i,j)=ufe(i,j)*pmask(i,j)
180# endif
181 END DO
182 END DO
183 DO j=jstrv,jend
184 DO i=istr,iend+1
186 & 0.25_r8*(hz(i,j ,k)+hz(i-1,j ,k)+ &
187 & hz(i,j-1,k)+hz(i-1,j-1,k))* &
188 & (tl_v(i ,j,k,nrhs)- &
189 & tl_v(i-1,j,k,nrhs))
190# ifdef MASKING
191 vfx(i,j)=vfx(i,j)*pmask(i,j)
192# endif
193 END DO
194 END DO
195 DO j=jstrv-1,jend
196 DO i=istr,iend
198 & hz(i,j,k)* &
199 & (tl_v(i,j+1,k,nrhs)- &
200 & tl_v(i,j ,k,nrhs))
201 END DO
202 END DO
203
204
205
206
208 DO j=jstr,jend
209 DO i=istru,iend
210 tl_u(i,j,k,nnew)=tl_u(i,j,k,nnew)+ &
211 & cff*(pm(i-1,j)+pm(i,j))* &
212 & (pn(i-1,j)+pn(i,j))* &
213 & (ufx(i,j)-ufx(i-1,j)+ &
214 & ufe(i,j+1)-ufe(i,j))
215
216 END DO
217 END DO
218 DO j=jstrv,jend
219 DO i=istr,iend
220 tl_v(i,j,k,nnew)=tl_v(i,j,k,nnew)+ &
221 & cff*(pm(i,j)+pm(i,j-1))* &
222 & (pn(i,j)+pn(i,j-1))* &
223 & (vfx(i+1,j)-vfx(i,j)+ &
224 & vfe(i,j)-vfe(i,j-1))
225 END DO
226 END DO
227 END DO k_loop
228 END IF
229
230 RETURN
integer, dimension(:), allocatable n
real(dp), dimension(:), allocatable dt
real(r8), dimension(:), allocatable tl_m3diff