137
138
142# ifdef SEDIMENT
144# endif
145
148# ifdef DISTRIBUTE
150# endif
151
152
153
154 integer, intent(in) :: ng, tile, model
155 integer, intent(in) :: LBi, UBi, LBj, UBj
156 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
157 integer, intent(in) :: nrhs
158
159# ifdef ASSUMED_SHAPE
160# ifdef MASKING
161 real(r8), intent(in) :: rmask(LBi:,LBj:)
162# endif
163# ifdef VAR_RHO_2D
164 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
165# endif
166 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
167 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
168 real(r8), intent(in) :: t(LBi:,LBj:,:,:,:)
169# ifdef VAR_RHO_2D
170 real(r8), intent(out) :: rhoA(LBi:,LBj:)
171 real(r8), intent(out) :: rhoS(LBi:,LBj:)
172# endif
173# ifdef BV_FREQUENCY
174 real(r8), intent(out) :: bvf(LBi:,LBj:,0:)
175# endif
176# if defined LMD_SKPP || defined LMD_BKPP || \
177 defined bulk_fluxes || defined balance_operator
178 real(r8), intent(out) :: alpha(LBi:,LBj:)
179 real(r8), intent(out) :: beta(LBi:,LBj:)
180# ifdef LMD_DDMIX
181 real(r8), intent(out) :: alfaobeta(LBi:,LBj:,0:)
182# endif
183# endif
184 real(r8), intent(out) :: pden(LBi:,LBj:,:)
185 real(r8), intent(out) :: rho(LBi:,LBj:,:)
186# else
187# ifdef MASKING
188 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
189# endif
190# ifdef VAR_RHO_2D
191 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
192# endif
193 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
194 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
195 real(r8), intent(in) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
196# ifdef VAR_RHO_2D
197 real(r8), intent(out) :: rhoA(LBi:UBi,LBj:UBj)
198 real(r8), intent(out) :: rhoS(LBi:UBi,LBj:UBj)
199# endif
200# ifdef BV_FREQUENCY
201 real(r8), intent(out) :: bvf(LBi:UBi,LBj:UBj,0:N(ng))
202# endif
203# if defined LMD_SKPP || defined LMD_BKPP || \
204 defined bulk_fluxes || defined balance_operator
205 real(r8), intent(out) :: alpha(LBi:UBi,LBj:UBj)
206 real(r8), intent(out) :: beta(LBi:UBi,LBj:UBj)
207# ifdef LMD_DDMIX
208 real(r8), intent(out) :: alfaobeta(LBi:UBi,LBj:UBj,0:N(ng))
209# endif
210# endif
211 real(r8), intent(out) :: pden(LBi:UBi,LBj:UBj,N(ng))
212 real(r8), intent(out) :: rho(LBi:UBi,LBj:UBj,N(ng))
213# endif
214
215
216
217 integer :: i, ised, itrc, j, k
218
219 real(r8) :: SedDen, Tp, Tpr10, Ts, Tt, sqrtTs
220# ifdef BV_FREQUENCY
221 real(r8) :: bulk_dn, bulk_up, den_dn, den_up
222# endif
223 real(r8) :: cff, cff1, cff2
224
225 real(r8), dimension(0:9) :: C
226# ifdef EOS_TDERIVATIVE
227 real(r8), dimension(0:9) :: dCdT(0:9)
228
229 real(r8), dimension(IminS:ImaxS,N(ng)) :: DbulkDS
230 real(r8), dimension(IminS:ImaxS,N(ng)) :: DbulkDT
231 real(r8), dimension(IminS:ImaxS,N(ng)) :: Dden1DS
232 real(r8), dimension(IminS:ImaxS,N(ng)) :: Dden1DT
233 real(r8), dimension(IminS:ImaxS,N(ng)) :: Scof
234 real(r8), dimension(IminS:ImaxS,N(ng)) :: Tcof
235 real(r8), dimension(IminS:ImaxS,N(ng)) :: wrk
236# endif
237 real(r8), dimension(IminS:ImaxS,N(ng)) :: bulk
238 real(r8), dimension(IminS:ImaxS,N(ng)) :: bulk0
239 real(r8), dimension(IminS:ImaxS,N(ng)) :: bulk1
240 real(r8), dimension(IminS:ImaxS,N(ng)) :: bulk2
241 real(r8), dimension(IminS:ImaxS,N(ng)) :: den
242 real(r8), dimension(IminS:ImaxS,N(ng)) :: den1
243
244# include "set_bounds.h"
245
246
247
248
249
250
251
252 DO j=jstrt,jendt
254 DO i=istrt,iendt
255
256
257
258
259 tt=max(-2.0_r8,t(i,j,k,nrhs,
itemp))
260# ifdef SALINITY
261 ts=max(0.0_r8,t(i,j,k,nrhs,
isalt))
262 sqrtts=sqrt(ts)
263# else
264 ts=0.0_r8
265 sqrtts=0.0_r8
266# endif
267 tp=z_r(i,j,k)
268 tpr10=0.1_r8*tp
269
270
271
272
273
277# ifdef EOS_TDERIVATIVE
278
279 dcdt(0)=
q01+tt*(2.0_r8*
q02+tt*(3.0_r8*
q03+tt*(4.0_r8*
q04+ &
281 dcdt(1)=
u01+tt*(2.0_r8*
u02+tt*(3.0_r8*
u03+tt*4.0_r8*
u04))
283# endif
284
285 den1(i,k)=c(0)+ts*(c(1)+sqrtts*c(2)+ts*
w00)
286
287# ifdef EOS_TDERIVATIVE
288
289
290
291
292
293 dden1ds(i,k)=c(1)+1.5_r8*c(2)*sqrtts+2.0_r8*
w00*ts
294 dden1dt(i,k)=dcdt(0)+ts*(dcdt(1)+sqrtts*dcdt(2))
295# endif
296
297
298
299
300
308# ifdef EOS_TDERIVATIVE
309
310 dcdt(3)=
a01+tt*(2.0_r8*
a02+tt*(3.0_r8*
a03+tt*4.0_r8*
a04))
311 dcdt(4)=
b01+tt*(2.0_r8*
b02+tt*3.0_r8*
b03)
313 dcdt(6)=
e01+tt*(2.0_r8*
e02+tt*3.0_r8*
e03)
317# endif
318
319 bulk0(i,k)=c(3)+ts*(c(4)+sqrtts*c(5))
320 bulk1(i,k)=c(6)+ts*(c(7)+sqrtts*
g00)
321 bulk2(i,k)=c(8)+ts*c(9)
322 bulk(i,k)=bulk0(i,k)-tp*(bulk1(i,k)-tp*bulk2(i,k))
323
324# if defined LMD_SKPP || defined LMD_BKPP || \
325 defined bulk_fluxes || defined balance_operator
326
327
328
329
330
331 dbulkds(i,k)=c(4)+sqrtts*1.5_r8*c(5)- &
332 & tp*(c(7)+sqrtts*1.5_r8*
g00-tp*c(9))
333 dbulkdt(i,k)=dcdt(3)+ts*(dcdt(4)+sqrtts*dcdt(5))- &
334 & tp*(dcdt(6)+ts*dcdt(7)- &
335 & tp*(dcdt(8)+ts*dcdt(9)))
336# endif
337
338
339
340
341
342 cff=1.0_r8/(bulk(i,k)+tpr10)
343 den(i,k)=den1(i,k)*bulk(i,k)*cff
344# if defined SEDIMENT && defined SED_DENS
345 sedden=0.0_r8
348 cff1=1.0_r8/
srho(ised,ng)
349 sedden=sedden+ &
350 & t(i,j,k,nrhs,itrc)* &
351 & (
srho(ised,ng)-den(i,k))*cff1
352 END DO
353 den(i,k)=den(i,k)+sedden
354# endif
355 den(i,k)=den(i,k)-1000.0_r8
356# ifdef MASKING
357 den(i,k)=den(i,k)*rmask(i,j)
358# endif
359 END DO
360 END DO
361
362# ifdef VAR_RHO_2D
363
364
365
366
367
368
369
370 DO i=istrt,iendt
371 cff1=den(i,
n(ng))*hz(i,j,
n(ng))
372 rhos(i,j)=0.5_r8*cff1*hz(i,j,
n(ng))
373 rhoa(i,j)=cff1
374 END DO
376 DO i=istrt,iendt
377 cff1=den(i,k)*hz(i,j,k)
378 rhos(i,j)=rhos(i,j)+hz(i,j,k)*(rhoa(i,j)+0.5_r8*cff1)
379 rhoa(i,j)=rhoa(i,j)+cff1
380 END DO
381 END DO
383 DO i=istrt,iendt
384 cff1=1.0_r8/(z_w(i,j,
n(ng))-z_w(i,j,0))
385 rhoa(i,j)=cff2*cff1*rhoa(i,j)
386 rhos(i,j)=2.0_r8*cff1*cff1*cff2*rhos(i,j)
387 END DO
388# endif
389
390# if defined BV_FREQUENCY
391
392
393
394
395
396
397
398
399
400
401
403 DO i=istrt,iendt
404 bulk_up=bulk0(i,k+1)- &
405 & z_w(i,j,k)*(bulk1(i,k+1)- &
406 & bulk2(i,k+1)*z_w(i,j,k))
407 bulk_dn=bulk0(i,k )- &
408 & z_w(i,j,k)*(bulk1(i,k )- &
409 & bulk2(i,k )*z_w(i,j,k))
410 cff1=1.0_r8/(bulk_up+0.1_r8*z_w(i,j,k))
411 cff2=1.0_r8/(bulk_dn+0.1_r8*z_w(i,j,k))
412 den_up=cff1*(den1(i,k+1)*bulk_up)
413 den_dn=cff2*(den1(i,k )*bulk_dn)
414 bvf(i,j,k)=-
g*(den_up-den_dn)/ &
415 & (0.5_r8*(den_up+den_dn)* &
416 & (z_r(i,j,k+1)-z_r(i,j,k)))
417 END DO
418 END DO
419 DO i=istrt,iendt
420
421
422 bvf(i,j,0)=0.0_r8
423 bvf(i,j,
n(ng))=0.0_r8
424 END DO
425# endif
426
427# if defined LMD_SKPP || defined LMD_BKPP || \
428 defined bulk_fluxes || defined balance_operator
429
430
431
432
433
434
435# ifdef LMD_DDMIX
437# else
439# endif
440 DO i=istrt,iendt
441 tpr10=0.1_r8*z_r(i,j,k)
442
443
444
445 cff=bulk(i,k)+tpr10
446 cff1=tpr10*den1(i,k)
447 cff2=bulk(i,k)*cff
448 wrk(i,k)=(den(i,k)+1000.0_r8)*cff*cff
449 tcof(i,k)=-(dbulkdt(i,k)*cff1+ &
450 & dden1dt(i,k)*cff2)
451 scof(i,k)= (dbulkds(i,k)*cff1+ &
452 & dden1ds(i,k)*cff2)
453# ifdef LMD_DDMIX
454 alfaobeta(i,j,k)=tcof(i,k)/scof(i,k)
455# endif
456 END DO
458 DO i=istrt,iendt
459 cff=1.0_r8/wrk(i,
n(ng))
460 alpha(i,j)=cff*tcof(i,
n(ng))
461 beta(i,j)=cff*scof(i,
n(ng))
462 END DO
463 END IF
464 END DO
465# endif
466
467
468
469
470
471
472
473
475 DO i=istrt,iendt
476 rho(i,j,k)=den(i,k)
477 pden(i,j,k)=(den1(i,k)-1000.0_r8)
478# ifdef MASKING
479 pden(i,j,k)=pden(i,j,k)*rmask(i,j)
480# endif
481 END DO
482 END DO
483 END DO
484
485
486
487
488
491 & lbi, ubi, lbj, ubj, 1,
n(ng), &
492 & rho)
494 & lbi, ubi, lbj, ubj, 1,
n(ng), &
495 & pden)
496
497# if defined LMD_SKPP || defined LMD_BKPP || \
498 defined bulk_fluxes || defined balance_operator
499# ifdef LMD_DDMIX
501 & lbi, ubi, lbj, ubj, 0,
n(ng), &
502 & alfaobeta)
503# endif
505 & lbi, ubi, lbj, ubj, &
506 & alpha)
508 & lbi, ubi, lbj, ubj, &
509 & beta)
510# endif
511
512# ifdef VAR_RHO_2D
514 & lbi, ubi, lbj, ubj, &
515 & rhoa)
517 & lbi, ubi, lbj, ubj, &
518 & rhos)
519# endif
520
521# ifdef BV_FREQUENCY
523 & lbi, ubi, lbj, ubj, 0,
n(ng), &
524 & bvf)
525# endif
526 END IF
527
528# ifdef DISTRIBUTE
529
531 & lbi, ubi, lbj, ubj, 1,
n(ng), &
534 & rho, pden)
535
536# if defined LMD_SKPP || defined LMD_BKPP || \
537 defined bulk_fluxes || defined balance_operator
538# ifdef LMD_DDMIX
540 & lbi, ubi, lbj, ubj, 0,
n(ng), &
543 & alfaobeta)
544# endif
546 & lbi, ubi, lbj, ubj, &
549 & alpha, beta)
550# endif
551
552# ifdef VAR_RHO_2D
554 & lbi, ubi, lbj, ubj, &
557 & rhoa, rhos)
558# endif
559
560# ifdef BV_FREQUENCY
562 & lbi, ubi, lbj, ubj, 0,
n(ng), &
565 & bvf)
566# endif
567# endif
568
569 RETURN
subroutine exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
subroutine exchange_r3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
subroutine exchange_w3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
integer, dimension(:), allocatable n
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
real(r8), dimension(:,:), allocatable srho
integer, dimension(:), allocatable idsed
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)