154
155
159# ifdef SEDIMENT_NOT_YET
161# endif
162
165# ifdef DISTRIBUTE
167# endif
168
169
170
171 integer, intent(in) :: ng, tile, model
172 integer, intent(in) :: LBi, UBi, LBj, UBj
173 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
174 integer, intent(in) :: nrhs
175
176# ifdef ASSUMED_SHAPE
177# ifdef MASKING
178 real(r8), intent(in) :: rmask(LBi:,LBj:)
179# endif
180# ifdef VAR_RHO_2D_NOT_YET
181 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
182# endif
183 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
184 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
185 real(r8), intent(in) :: t(LBi:,LBj:,:,:,:)
186# ifdef VAR_RHO_2D_NOT_YET
187 real(r8), intent(in) :: tl_Hz(LBi:,LBj:,:)
188# endif
189 real(r8), intent(in) :: tl_z_r(LBi:,LBj:,:)
190 real(r8), intent(in) :: tl_z_w(LBi:,LBj:,0:)
191 real(r8), intent(in) :: tl_t(LBi:,LBj:,:,:,:)
192# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET || \
193 defined bulk_fluxes
194 real(r8), intent(inout) :: alpha(LBi:,LBj:)
195 real(r8), intent(inout) :: beta(LBi:,LBj:)
196# endif
197# ifdef VAR_RHO_2D_NOT_YET
198 real(r8), intent(out) :: rhoA(LBi:,LBj:)
199 real(r8), intent(out) :: rhoS(LBi:,LBj:)
200 real(r8), intent(out) :: tl_rhoA(LBi:,LBj:)
201 real(r8), intent(out) :: tl_rhoS(LBi:,LBj:)
202# endif
203# ifdef BV_FREQUENCY_NOT_YET
204 real(r8), intent(out) :: tl_bvf(LBi:,LBj:,0:)
205# endif
206# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET || \
207 defined bulk_fluxes
208 real(r8), intent(out) :: tl_alpha(LBi:,LBj:)
209 real(r8), intent(out) :: tl_beta(LBi:,LBj:)
210# ifdef LMD_DDMIX_NOT_YET
211 real(r8), intent(out) :: tl_alfaobeta(LBi:,LBj:,0:)
212# endif
213# endif
214# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET
215 real(r8), intent(out) :: tl_pden(LBi:,LBj:,:)
216# endif
217 real(r8), intent(out) :: rho(LBi:,LBj:,:)
218 real(r8), intent(out) :: tl_rho(LBi:,LBj:,:)
219# else
220# ifdef MASKING
221 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
222# endif
223# ifdef VAR_RHO_2D_NOT_YET
224 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
225# endif
226 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
227 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
228 real(r8), intent(in) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
229# ifdef VAR_RHO_2D_NOT_YET
230 real(r8), intent(in) :: tl_Hz(LBi:UBi,LBj:UBj,N(ng))
231# endif
232 real(r8), intent(in) :: tl_z_r(LBi:UBi,LBj:UBj,N(ng))
233 real(r8), intent(in) :: tl_z_w(LBi:UBi,LBj:UBj,0:N(ng))
234 real(r8), intent(in) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
235# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET || \
236 defined bulk_fluxes
237 real(r8), intent(inout) :: alpha(LBi:UBi,LBj:UBj)
238 real(r8), intent(inout) :: beta(LBi:UBi,LBj:UBj)
239# endif
240# ifdef VAR_RHO_2D_NOT_YET
241 real(r8), intent(out) :: rhoA(LBi:UBi,LBj:UBj)
242 real(r8), intent(out) :: rhoS(LBi:UBi,LBj:UBj)
243 real(r8), intent(out) :: tl_rhoA(LBi:UBi,LBj:UBj)
244 real(r8), intent(out) :: tl_rhoS(LBi:UBi,LBj:UBj)
245# endif
246# ifdef BV_FREQUENCY_NOT_YET
247 real(r8), intent(out) :: tl_bvf(LBi:UBi,LBj:UBj,0:N(ng))
248# endif
249# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET || \
250 defined bulk_fluxes
251 real(r8), intent(out) :: tl_alpha(LBi:UBi,LBj:UBj)
252 real(r8), intent(out) :: tl_beta(LBi:UBi,LBj:UBj)
253# ifdef LMD_DDMIX_NOT_YET
254 real(r8), intent(out) :: tl_alfaobeta(LBi:UBi,LBj:UBj,0:N(ng))
255# endif
256# endif
257# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET
258 real(r8), intent(out) :: tl_pden(LBi:UBi,LBj:UBj,N(ng))
259# endif
260 real(r8), intent(out) :: rho(LBi:UBi,LBj:UBj,N(ng))
261 real(r8), intent(out) :: tl_rho(LBi:UBi,LBj:UBj,N(ng))
262# endif
263
264
265
266 integer :: i, ised, itrc, j, k
267
268 real(r8) :: SedDen, Tp, Tpr10, Ts, Tt, sqrtTs
269 real(r8) :: tl_SedDen, tl_Tp, tl_Tpr10, tl_Ts, tl_Tt, tl_sqrtTs
270# ifdef BV_FREQUENCY_NOT_YET
271 real(r8) :: bulk_dn, bulk_up, den_dn, den_up
272 real(r8) :: tl_bulk_dn, tl_bulk_up, tl_den_dn, tl_den_up
273# endif
274 real(r8) :: cff, cff1, cff2, cff3
275 real(r8) :: tl_cff, tl_cff1, tl_cff2, tl_cff3
276
277 real(r8), dimension(0:9) :: C
278 real(r8), dimension(0:9) :: tl_C
279# ifdef EOS_TDERIVATIVE
280 real(r8), dimension(0:9) :: dCdT(0:9)
281 real(r8), dimension(0:9) :: tl_dCdT(0:9)
282 real(r8), dimension(0:9) :: d2Cd2T(0:9)
283
284 real(r8), dimension(IminS:ImaxS,N(ng)) :: DbulkDS
285 real(r8), dimension(IminS:ImaxS,N(ng)) :: DbulkDT
286 real(r8), dimension(IminS:ImaxS,N(ng)) :: Dden1DS
287 real(r8), dimension(IminS:ImaxS,N(ng)) :: Dden1DT
288 real(r8), dimension(IminS:ImaxS,N(ng)) :: Scof
289 real(r8), dimension(IminS:ImaxS,N(ng)) :: Tcof
290 real(r8), dimension(IminS:ImaxS,N(ng)) :: wrk
291
292 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_DbulkDS
293 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_DbulkDT
294 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_Dden1DS
295 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_Dden1DT
296 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_Scof
297 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_Tcof
298 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_wrk
299# endif
300 real(r8), dimension(IminS:ImaxS,N(ng)) :: bulk
301 real(r8), dimension(IminS:ImaxS,N(ng)) :: bulk0
302 real(r8), dimension(IminS:ImaxS,N(ng)) :: bulk1
303 real(r8), dimension(IminS:ImaxS,N(ng)) :: bulk2
304 real(r8), dimension(IminS:ImaxS,N(ng)) :: den
305 real(r8), dimension(IminS:ImaxS,N(ng)) :: den1
306
307 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_bulk
308 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_bulk0
309 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_bulk1
310 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_bulk2
311 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_den
312 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_den1
313
314# include "set_bounds.h"
315
316
317
318
319
320
321
322 DO j=jstrt,jendt
324 DO i=istrt,iendt
325
326
327
328
329 tt=max(-2.0_r8,t(i,j,k,nrhs,
itemp))
330 tl_tt=(0.5_r8-sign(0.5_r8,-2.0_r8- &
331 & t(i,j,k,nrhs,
itemp)))* &
332 & tl_t(i,j,k,nrhs,
itemp)
333# ifdef SALINITY
334 ts=max(0.0_r8,t(i,j,k,nrhs,
isalt))
335 tl_ts=(0.5_r8-sign(0.5_r8,-t(i,j,k,nrhs,
isalt)))* &
336 & tl_t(i,j,k,nrhs,
isalt)
337 sqrtts=sqrt(ts)
338 IF (ts.ne.0.0_r8) THEN
339 tl_sqrtts=0.5_r8*tl_ts/sqrt(ts)
340 ELSE
341 tl_sqrtts=0.0_r8
342 END IF
343# else
344 ts=0.0_r8
345 tl_ts=0.0_r8
346 sqrtts=0.0_r8
347 tl_sqrtts=0.0_r8
348# endif
349 tp=z_r(i,j,k)
350 tl_tp=tl_z_r(i,j,k)
351 tpr10=0.1_r8*tp
352 tl_tpr10=0.1_r8*tl_tp
353
354
355
356
357
358
362# ifdef EOS_TDERIVATIVE
363
364 dcdt(0)=
q01+tt*(2.0_r8*
q02+tt*(3.0_r8*
q03+tt*(4.0_r8*
q04+ &
366 dcdt(1)=
u01+tt*(2.0_r8*
u02+tt*(3.0_r8*
u03+tt*4.0_r8*
u04))
368# endif
369 tl_c(0)=tl_tt*dcdt(0)
370 tl_c(1)=tl_tt*dcdt(1)
371 tl_c(2)=tl_tt*dcdt(2)
372
373 den1(i,k)=c(0)+ts*(c(1)+sqrtts*c(2)+ts*
w00)
374 tl_den1(i,k)=tl_c(0)+ &
375 & tl_ts*(c(1)+sqrtts*c(2)+ts*
w00)+ &
376 & ts*(tl_c(1)+tl_sqrtts*c(2)+ &
377 & sqrtts*tl_c(2)+tl_ts*
w00)
378
379# ifdef EOS_TDERIVATIVE
380
381
382
383
384
385 d2cd2t(0)=2.0_r8*
q02+tt*(6.0_r8*
q03+tt*(12.0_r8*
q04+ &
387 d2cd2t(1)=2.0_r8*
u02+tt*(6.0_r8*
u03+tt*12.0_r8*
u04)
389
390 tl_dcdt(0)=tl_tt*d2cd2t(0)
391 tl_dcdt(1)=tl_tt*d2cd2t(1)
392 tl_dcdt(2)=tl_tt*d2cd2t(2)
393
394 dden1ds(i,k)=c(1)+1.5_r8*c(2)*sqrtts+2.0_r8*
w00*ts
395 dden1dt(i,k)=dcdt(0)+ts*(dcdt(1)+sqrtts*dcdt(2))
396
397 tl_dden1ds(i,k)=tl_c(1)+ &
398 & 1.5_r8*(tl_c(2)*sqrtts+ &
399 & c(2)*tl_sqrtts)+ &
401 tl_dden1dt(i,k)=tl_dcdt(0)+ &
402 & tl_ts*(dcdt(1)+sqrtts*dcdt(2))+ &
403 & ts*(tl_dcdt(1)+tl_sqrtts*dcdt(2)+ &
404 & sqrtts*tl_dcdt(2))
405# endif
406
407
408
409
410
418# ifdef EOS_TDERIVATIVE
419
420 dcdt(3)=
a01+tt*(2.0_r8*
a02+tt*(3.0_r8*
a03+tt*4.0_r8*
a04))
421 dcdt(4)=
b01+tt*(2.0_r8*
b02+tt*3.0_r8*
b03)
423 dcdt(6)=
e01+tt*(2.0_r8*
e02+tt*3.0_r8*
e03)
427# endif
428
429 tl_c(3)=tl_tt*dcdt(3)
430 tl_c(4)=tl_tt*dcdt(4)
431 tl_c(5)=tl_tt*dcdt(5)
432 tl_c(6)=tl_tt*dcdt(6)
433 tl_c(7)=tl_tt*dcdt(7)
434 tl_c(8)=tl_tt*dcdt(8)
435 tl_c(9)=tl_tt*dcdt(9)
436
437 bulk0(i,k)=c(3)+ts*(c(4)+sqrtts*c(5))
438 bulk1(i,k)=c(6)+ts*(c(7)+sqrtts*
g00)
439 bulk2(i,k)=c(8)+ts*c(9)
440 bulk(i,k)=bulk0(i,k)-tp*(bulk1(i,k)-tp*bulk2(i,k))
441
442 tl_bulk0(i,k)=tl_c(3)+ &
443 & tl_ts*(c(4)+sqrtts*c(5))+ &
444 & ts*(tl_c(4)+tl_sqrtts*c(5)+ &
445 & sqrtts*tl_c(5))
446 tl_bulk1(i,k)=tl_c(6)+ &
447 & tl_ts*(c(7)+sqrtts*
g00)+ &
448 & ts*(tl_c(7)+tl_sqrtts*
g00)
449 tl_bulk2(i,k)=tl_c(8)+tl_ts*c(9)+ts*tl_c(9)
450 tl_bulk(i,k)=tl_bulk0(i,k)- &
451 & tl_tp*(bulk1(i,k)-tp*bulk2(i,k))- &
452 & tp*(tl_bulk1(i,k)- &
453 & tl_tp*bulk2(i,k)- &
454 & tp*tl_bulk2(i,k))
455
456# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET || \
457 defined bulk_fluxes
458
459
460
461
462
463 d2cd2t(3)=2.0_r8*
a02+tt*(6.0_r8*
a03+tt*12.0_r8*
a04)
464 d2cd2t(4)=2.0_r8*
b02+tt*6.0_r8*
b03
466 d2cd2t(6)=2.0_r8*
e02+tt*6.0_r8*
e03
470
471 tl_dcdt(3)=tl_tt*d2cd2t(3)
472 tl_dcdt(4)=tl_tt*d2cd2t(4)
473 tl_dcdt(5)=tl_tt*d2cd2t(5)
474 tl_dcdt(6)=tl_tt*d2cd2t(6)
475 tl_dcdt(7)=tl_tt*d2cd2t(7)
476 tl_dcdt(8)=tl_tt*d2cd2t(8)
477 tl_dcdt(9)=tl_tt*d2cd2t(9)
478
479 dbulkds(i,k)=c(4)+sqrtts*1.5_r8*c(5)- &
480 & tp*(c(7)+sqrtts*1.5_r8*
g00-tp*c(9))
481 dbulkdt(i,k)=dcdt(3)+ts*(dcdt(4)+sqrtts*dcdt(5))- &
482 & tp*(dcdt(6)+ts*dcdt(7)- &
483 & tp*(dcdt(8)+ts*dcdt(9)))
484
485 tl_dbulkds(i,k)=tl_c(4)+ &
486 & 1.5_r8*(tl_sqrtts*c(5)+ &
487 & sqrtts*tl_c(5))- &
488 & tl_tp*(c(7)+sqrtts*1.5_r8*
g00- &
489 & tp*c(9))- &
490 & tp*(tl_c(7)+tl_sqrtts*1.5_r8*
g00- &
491 & tl_tp*c(9)-tp*tl_c(9))
492 tl_dbulkdt(i,k)=tl_dcdt(3)+ &
493 & tl_ts*(dcdt(4)+sqrtts*dcdt(5))+ &
494 & ts*(tl_dcdt(4)+tl_sqrtts*dcdt(5)+ &
495 & sqrtts*tl_dcdt(5))- &
496 & tl_tp*(dcdt(6)+ts*dcdt(7)- &
497 & tp*(dcdt(8)+ts*dcdt(9)))- &
498 & tp*(tl_dcdt(6)+tl_ts*dcdt(7)+ts*tl_dcdt(7)- &
499 & tl_tp*(dcdt(8)+ts*dcdt(9))- &
500 & tp*(tl_dcdt(8)+tl_ts*dcdt(9)+ &
501 & ts*tl_dcdt(9)))
502# endif
503
504
505
506
507
508 cff=1.0_r8/(bulk(i,k)+tpr10)
509 tl_cff=-cff*cff*(tl_bulk(i,k)+tl_tpr10)
510 den(i,k)=den1(i,k)*bulk(i,k)*cff
511 tl_den(i,k)=tl_den1(i,k)*bulk(i,k)*cff+ &
512 & den1(i,k)*(tl_bulk(i,k)*cff+ &
513 & bulk(i,k)*tl_cff)
514# if defined SEDIMENT_NOT_YET && defined SED_DENS_NOT_YET
515 sedden=0.0_r8
516 tl_sedden=0.0_r8
519 cff1=1.0_r8/
srho(ised,ng)
520 sedden=sedden+ &
521 & t(i,j,k,nrhs,itrc)* &
522 & (
srho(ised,ng)-den(i,k))*cff1
523 tl_sedden=tl_sedden+ &
524 & (tl_t(i,j,k,nrhs,itrc)* &
525 & (
srho(ised,ng)-den(i,k))- &
526 & t(i,j,k,nrhs,itrc)* &
527 & tl_den(i,k))*cff1
528 END DO
529 den(i,k)=den(i,k)+sedden
530 tl_den(i,k)=tl_den(i,k)+tl_sedden
531# endif
532 den(i,k)=den(i,k)-1000.0_r8
533# ifdef MASKING
534 den(i,k)=den(i,k)*rmask(i,j)
535 tl_den(i,k)=tl_den(i,k)*rmask(i,j)
536# endif
537 END DO
538 END DO
539
540# ifdef VAR_RHO_2D_NOT_YET
541
542
543
544
545
546
547 DO i=istrt,iendt
548 cff1=den(i,
n(ng))*hz(i,j,
n(ng))
549 tl_cff1=tl_den(i,
n(ng))*hz(i,j,
n(ng))+ &
550 & den(i,
n(ng))*tl_hz(i,j,
n(ng))
551 rhos(i,j)=0.5_r8*cff1*hz(i,j,
n(ng))
552 tl_rhos(i,j)=0.5_r8*(tl_cff1*hz(i,j,
n(ng))+ &
553 & cff1*tl_hz(i,j,
n(ng)))
554 rhoa(i,j)=cff1
555 tl_rhoa(i,j)=tl_cff1
556 END DO
558 DO i=istrt,iendt
559 cff1=den(i,k)*hz(i,j,k)
560 tl_cff1=tl_den(i,k)*hz(i,j,k)+ &
561 & den(i,k)*tl_hz(i,j,k)
562 rhos(i,j)=rhos(i,j)+hz(i,j,k)*(rhoa(i,j)+0.5_r8*cff1)
563 tl_rhos(i,j)=tl_rhos(i,j)+ &
564 & tl_hz(i,j,k)*(rhoa(i,j)+0.5_r8*cff1)+ &
565 & hz(i,j,k)*(tl_rhoa(i,j)+0.5_r8*tl_cff1)
566 rhoa(i,j)=rhoa(i,j)+cff1
567 tl_rhoa(i,j)=tl_rhoa(i,j)+tl_cff1
568 END DO
569 END DO
571 DO i=istrt,iendt
572 cff1=1.0_r8/(z_w(i,j,
n(ng))-z_w(i,j,0))
573 tl_cff1=-cff1*cff1*(tl_z_w(i,j,
n(ng))-tl_z_w(i,j,0))
574
575
576
577
578
579 tl_rhoa(i,j)=cff2*(tl_cff1*rhoa(i,j)+cff1*tl_rhoa(i,j))
580 rhoa(i,j)=cff2*cff1*rhoa(i,j)
581 tl_rhos(i,j)=2.0_r8*cff2* &
582 & cff1*(2.0_r8*tl_cff1*rhos(i,j)+ &
583 & cff1*tl_rhos(i,j))
584 rhos(i,j)=2.0_r8*cff1*cff1*cff2*rhos(i,j)
585 END DO
586# endif
587
588# if defined BV_FREQUENCY_NOT_YET
589
590
591
592
593
594
595
596
597
598
599
601 DO i=istrt,iendt
602 bulk_up=bulk0(i,k+1)- &
603 & z_w(i,j,k)*(bulk1(i,k+1)- &
604 & bulk2(i,k+1)*z_w(i,j,k))
605 tl_bulk_up=tl_bulk0(i,k+1)- &
606 & tl_z_w(i,j,k)*(bulk1(i,k+1)- &
607 & bulk2(i,k+1)*z_w(i,j,k))- &
608 & z_w(i,j,k)*(tl_bulk1(i,k+1)- &
609 & tl_bulk2(i,k+1)*z_w(i,j,k)- &
610 & bulk2(i,k+1)*tl_z_w(i,j,k))
611 bulk_dn=bulk0(i,k )- &
612 & z_w(i,j,k)*(bulk1(i,k )- &
613 & bulk2(i,k )*z_w(i,j,k))
614 tl_bulk_dn=tl_bulk0(i,k )- &
615 & tl_z_w(i,j,k)*(bulk1(i,k )- &
616 & bulk2(i,k )*z_w(i,j,k))- &
617 & z_w(i,j,k)*(tl_bulk1(i,k )- &
618 & tl_bulk2(i,k )*z_w(i,j,k)- &
619 & bulk2(i,k )*tl_z_w(i,j,k))
620 cff1=1.0_r8/(bulk_up+0.1_r8*z_w(i,j,k))
621 cff2=1.0_r8/(bulk_dn+0.1_r8*z_w(i,j,k))
622 tl_cff1=-cff1*cff1*(tl_bulk_up+0.1_r8*tl_z_w(i,j,k))
623 tl_cff2=-cff2*cff2*(tl_bulk_dn+0.1_r8*tl_z_w(i,j,k))
624 den_up=cff1*(den1(i,k+1)*bulk_up)
625 den_dn=cff2*(den1(i,k )*bulk_dn)
626 tl_den_up=tl_cff1*(den1(i,k+1)*bulk_up)+ &
627 & cff1*(tl_den1(i,k+1)*bulk_up+ &
628 & den1(i,k+1)*tl_bulk_up)
629 tl_den_dn=tl_cff2*(den1(i,k )*bulk_dn)+ &
630 & cff2*(tl_den1(i,k )*bulk_dn+ &
631 & den1(i,k )*tl_bulk_dn)
632
633
634
635
636 cff3=1.0_r8/(0.5_r8*(den_up+den_dn)* &
637 & (z_r(i,j,k+1)-z_r(i,j,k)))
638 tl_cff3=-cff3*cff3* &
639 & 0.5_r8*((tl_den_up+tl_den_dn)* &
640 & (z_r(i,j,k+1)-z_r(i,j,k))+ &
641 & (den_up+den_dn)* &
642 & (tl_z_r(i,j,k+1)-tl_z_r(i,j,k)))
643 tl_bvf(i,j,k)=-
g*((tl_den_up-tl_den_dn)*cff3+ &
644 & (den_up-den_dn)*tl_cff3)
645 END DO
646 END DO
647 DO i=istrt,iendt
648
649
650 tl_bvf(i,j,0)=0.0_r8
651
652
653 tl_bvf(i,j,
n(ng))=0.0_r8
654 END DO
655# endif
656
657# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET || \
658 defined bulk_fluxes
659
660
661
662
663
664
665# ifdef LMD_DDMIX_NOT_YET
667# else
669# endif
670 DO i=istrt,iendt
671 tpr10=0.1_r8*z_r(i,j,k)
672 tl_tpr10=0.1_r8*tl_z_r(i,j,k)
673
674
675
676 cff=bulk(i,k)+tpr10
677 tl_cff=tl_bulk(i,k)+tl_tpr10
678 cff1=tpr10*den1(i,k)
679 tl_cff1=tl_tpr10*den1(i,k)+tpr10*tl_den1(i,k)
680 cff2=bulk(i,k)*cff
681 tl_cff2=tl_bulk(i,k)*cff+bulk(i,k)*tl_cff
682 wrk(i,k)=(den(i,k)+1000.0_r8)*cff*cff
683 tl_wrk(i,k)=cff*(cff*tl_den(i,k)+ &
684 & 2.0_r8*tl_cff*(den(i,k)+1000.0_r8))
685 tcof(i,k)=-(dbulkdt(i,k)*cff1+ &
686 & dden1dt(i,k)*cff2)
687 tl_tcof(i,k)=-(tl_dbulkdt(i,k)*cff1+ &
688 & dbulkdt(i,k)*tl_cff1+ &
689 & tl_dden1dt(i,k)*cff2+ &
690 & dden1dt(i,k)*tl_cff2)
691 scof(i,k)= (dbulkds(i,k)*cff1+ &
692 & dden1ds(i,k)*cff2)
693 tl_scof(i,k)= (tl_dbulkds(i,k)*cff1+ &
694 & dbulkds(i,k)*tl_cff1+ &
695 & tl_dden1ds(i,k)*cff2+ &
696 & dden1ds(i,k)*tl_cff2)
697# ifdef LMD_DDMIX_NOT_YET
698
699
700 tl_alfaobeta(i,j,k)=(tl_tcof(i,k)*scof(i,k)- &
701 & tcof(i,k)*tl_scof(i,k))/ &
702 & (scof(i,k)*scof(i,k))
703# endif
704 END DO
706 DO i=istrt,iendt
707 cff=1.0_r8/wrk(i,
n(ng))
708 tl_cff=-cff*cff*tl_wrk(i,
n(ng))
709 alpha(i,j)=cff*tcof(i,
n(ng))
710 tl_alpha(i,j)=tl_cff*tcof(i,
n(ng))+cff*tl_tcof(i,
n(ng))
711 beta(i,j)=cff*scof(i,
n(ng))
712 tl_beta(i,j)=tl_cff*scof(i,
n(ng))+cff*tl_scof(i,
n(ng))
713 END DO
714 END IF
715 END DO
716# endif
717
718
719
720
721
722
723
724
726 DO i=istrt,iendt
727 rho(i,j,k)=den(i,k)
728 tl_rho(i,j,k)=tl_den(i,k)
729# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET
730
731
732 tl_pden(i,j,k)=tl_den1(i,k)
733# ifdef MASKING
734
735
736 tl_pden(i,j,k)=tl_pden(i,k)*rmask(i,j)
737# endif
738# endif
739 END DO
740 END DO
741 END DO
742
743
744
745
746
749 & lbi, ubi, lbj, ubj, 1,
n(ng), &
750 & rho)
752 & lbi, ubi, lbj, ubj, 1,
n(ng), &
753 & tl_rho)
754
755# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET
756
757
758
759
761 & lbi, ubi, lbj, ubj, 1,
n(ng), &
762 & tl_pden)
763# endif
764
765# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET || \
766 defined bulk_fluxes_not_yet
767# ifdef LMD_DDMIX_NOT_YET
768
769
770
771
773 & lbi, ubi, lbj, ubj, 0,
n(ng), &
774 & tl_alfaobeta)
775# endif
777 & lbi, ubi, lbj, ubj, &
778 & alpha)
780 & lbi, ubi, lbj, ubj, &
781 & tl_alpha)
783 & lbi, ubi, lbj, ubj, &
784 & beta)
786 & lbi, ubi, lbj, ubj, &
787 & tl_beta)
788# endif
789
790# ifdef VAR_RHO_2D_NOT_YET
792 & lbi, ubi, lbj, ubj, &
793 & rhoa)
795 & lbi, ubi, lbj, ubj, &
796 & tl_rhoa)
798 & lbi, ubi, lbj, ubj, &
799 & rhos)
801 & lbi, ubi, lbj, ubj, &
802 & tl_rhos)
803# endif
804
805# ifdef BV_FREQUENCY_NOT_YET
806
807
808
809
811 & lbi, ubi, lbj, ubj, 0,
n(ng), &
812 & tl_bvf)
813# endif
814 END IF
815
816# ifdef DISTRIBUTE
817
819 & lbi, ubi, lbj, ubj, 1,
n(ng), &
822 & rho)
824 & lbi, ubi, lbj, ubj, 1,
n(ng), &
827 & tl_rho)
828
829# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET
830
831
832
833
834
835
837 & lbi, ubi, lbj, ubj, 1,
n(ng), &
840 & tl_pden)
841# endif
842
843# if defined LMD_SKPP_NOT_YET || defined LMD_BKPP_NOT_YET || \
844 defined bulk_fluxes
845# ifdef LMD_DDMIX_NOT_YET
846
847
848
849
850
851
853 & lbi, ubi, lbj, ubj, 0,
n(ng), &
856 & tl_alfaobeta)
857# endif
859 & lbi, ubi, lbj, ubj, &
862 & alpha, beta)
864 & lbi, ubi, lbj, ubj, &
867 & tl_alpha, tl_beta)
868# endif
869
870# ifdef VAR_RHO_2D_NOT_YET
872 & lbi, ubi, lbj, ubj, &
875 & rhoa, rhos)
877 & lbi, ubi, lbj, ubj, &
880 & tl_rhoa, tl_rhos)
881# endif
882
883# ifdef BV_FREQUENCY_NOT_YET
884
885
886
887
888
889
891 & lbi, ubi, lbj, ubj, 0,
n(ng), &
894 & tl_bvf)
895# endif
896# endif
897
898 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)