165
166
169
171# ifdef DISTRIBUTE
173# endif
174
175
176
177 integer, intent(in) :: ng, tile
178 integer, intent(in) :: LBi, UBi, LBj, UBj
179 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
180 integer, intent(in) :: nrhs
181
182# ifdef ASSUMED_SHAPE
183 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
184 real(r8), intent(in) :: tl_Hz(LBi:,LBj:,:)
185# if defined UV_LOGDRAG
186 real(r8), intent(in) :: ZoBot(LBi:,LBj:)
187# elif defined UV_LDRAG
188 real(r8), intent(in) :: rdrag(LBi:,LBj:)
189# elif defined UV_QDRAG
190 real(r8), intent(in) :: rdrag2(LBi:,LBj:)
191# endif
192# if !defined BBL_MODEL_NOT_YET || defined ICESHELF
193 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
194 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
195 real(r8), intent(in) :: tl_z_r(LBi:,LBj:,:)
196 real(r8), intent(in) :: tl_z_w(LBi:,LBj:,0:)
197# endif
198# if defined ICESHELF
199 real(r8), intent(in) :: zice(LBi:,LBj:)
200# endif
201 real(r8), intent(in) :: t(LBi:,LBj:,:,:,:)
202 real(r8), intent(in) :: tl_t(LBi:,LBj:,:,:,:)
203# if !defined BBL_MODEL_NOT_YET || defined ICESHELF
204 real(r8), intent(in) :: u(LBi:,LBj:,:,:)
205 real(r8), intent(in) :: v(LBi:,LBj:,:,:)
206 real(r8), intent(in) :: tl_u(LBi:,LBj:,:,:)
207 real(r8), intent(in) :: tl_v(LBi:,LBj:,:,:)
208# endif
209# ifdef QCORRECTION
210 real(r8), intent(in) :: dqdt(LBi:,LBj:)
211 real(r8), intent(in) :: sst(LBi:,LBj:)
212# endif
213# if defined SCORRECTION || defined SRELAXATION
214 real(r8), intent(in) :: sss(LBi:,LBj:)
215# endif
216 real(r8), intent(in) :: stflux(LBi:,LBj:,:)
217 real(r8), intent(in) :: btflux(LBi:,LBj:,:)
218# if defined ICESHELF
219# ifdef SHORTWAVE
220 real(r8), intent(inout) :: srflx(LBi:,LBj:)
221# endif
222 real(r8), intent(inout) :: sustr(LBi:,LBj:)
223 real(r8), intent(inout) :: svstr(LBi:,LBj:)
224 real(r8), intent(inout) :: tl_sustr(LBi:,LBj:)
225 real(r8), intent(inout) :: tl_svstr(LBi:,LBj:)
226# endif
227# ifndef BBL_MODEL_NOT_YET
228 real(r8), intent(inout) :: bustr(LBi:,LBj:)
229 real(r8), intent(inout) :: bvstr(LBi:,LBj:)
230 real(r8), intent(inout) :: tl_bustr(LBi:,LBj:)
231 real(r8), intent(inout) :: tl_bvstr(LBi:,LBj:)
232# endif
233 real(r8), intent(inout) :: stflx(LBi:,LBj:,:)
234 real(r8), intent(inout) :: btflx(LBi:,LBj:,:)
235 real(r8), intent(inout) :: tl_stflx(LBi:,LBj:,:)
236 real(r8), intent(inout) :: tl_btflx(LBi:,LBj:,:)
237# else
238 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
239 real(r8), intent(in) :: tl_Hz(LBi:UBi,LBj:UBj,N(ng))
240# if defined UV_LOGDRAG
241 real(r8), intent(in) :: ZoBot(LBi:UBi,LBj:UBj)
242# elif defined UV_LDRAG
243 real(r8), intent(in) :: rdrag(LBi:UBi,LBj:UBj)
244# elif defined UV_QDRAG
245 real(r8), intent(in) :: rdrag2(LBi:UBi,LBj:UBj)
246# endif
247# if !defined BBL_MODEL_NOT_YET || defined ICESHELF
248 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
249 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
250 real(r8), intent(in) :: tl_z_r(LBi:UBi,LBj:UBj,N(ng))
251 real(r8), intent(in) :: tl_z_w(LBi:UBi,LBj:UBj,0:N(ng))
252# endif
253# if defined ICESHELF
254 real(r8), intent(in) :: zice(LBi:UBi,LBj:UBj)
255# endif
256 real(r8), intent(in) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
257 real(r8), intent(in) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
258# if !defined BBL_MODEL_NOT_YET || defined ICESHELF
259 real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
260 real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
261 real(r8), intent(in) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
262 real(r8), intent(in) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
263# endif
264# ifdef QCORRECTION
265 real(r8), intent(in) :: dqdt(LBi:UBi,LBj:UBj)
266 real(r8), intent(in) :: sst(LBi:UBi,LBj:UBj)
267# endif
268# if defined SCORRECTION || defined SRELAXATION
269 real(r8), intent(in) :: sss(LBi:UBi,LBj:UBj)
270# endif
271 real(r8), intent(in) :: stflux(LBi:UBi,LBj:UBj,NT(ng))
272 real(r8), intent(in) :: btflux(LBi:UBi,LBj:UBj,NT(ng))
273# if defined ICESHELF
274# ifdef SHORTWAVE
275 real(r8), intent(inout) :: srflx(LBi:UBi,LBj:UBj)
276# endif
277 real(r8), intent(inout) :: sustr(LBi:UBi,LBj:UBj)
278 real(r8), intent(inout) :: svstr(LBi:UBi,LBj:UBj)
279 real(r8), intent(inout) :: tl_sustr(LBi:UBi,LBj:UBj)
280 real(r8), intent(inout) :: tl_svstr(LBi:UBi,LBj:UBj)
281# endif
282# ifndef BBL_MODEL_NOT_YET
283 real(r8), intent(inout) :: bustr(LBi:UBi,LBj:UBj)
284 real(r8), intent(inout) :: bvstr(LBi:UBi,LBj:UBj)
285 real(r8), intent(inout) :: tl_bustr(LBi:UBi,LBj:UBj)
286 real(r8), intent(inout) :: tl_bvstr(LBi:UBi,LBj:UBj)
287# endif
288 real(r8), intent(inout) :: stflx(LBi:UBi,LBj:UBj,NT(ng))
289 real(r8), intent(inout) :: btflx(LBi:UBi,LBj:UBj,NT(ng))
290 real(r8), intent(inout) :: tl_stflx(LBi:UBi,LBj:UBj,NT(ng))
291 real(r8), intent(inout) :: tl_btflx(LBi:UBi,LBj:UBj,NT(ng))
292# endif
293
294
295
296 integer :: i, j, itrc
297
298 real(r8) :: EmP, tl_EmP
299# if !defined BBL_MODEL_NOT_YET || defined ICESHELF
300 real(r8) :: cff1, cff2, cff3
301 real(r8) :: tl_cff1, tl_cff2, tl_cff3
302# endif
303
304# if (!defined BBL_MODEL_NOT_YET || defined ICESHELF) && defined UV_LOGDRAG
305 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: wrk
306 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_wrk
307# endif
308
309# include "set_bounds.h"
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325 DO j=jstrr,jendr
326 DO i=istrr,iendr
327
328
329 tl_stflx(i,j,
itemp)=0.0_r8
330
331
332 tl_btflx(i,j,
itemp)=0.0_r8
333 END DO
334 END DO
335
336# ifdef QCORRECTION
337
338
339
340
341
342
343
344 DO j=jstrr,jendr
345 DO i=istrr,iendr
346
347
348
349# ifdef TL_IOMS
351 & dqdt(i,j)*(tl_t(i,j,
n(ng),nrhs,
itemp)- &
352 & sst(i,j))
353# else
355 & dqdt(i,j)*tl_t(i,j,
n(ng),nrhs,
itemp)
356# endif
357 END DO
358 END DO
359# endif
360
361# ifdef LIMIT_STFLX_COOLING
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379 cff1=-2.0_r8
380 DO j=jstrr,jendr
381 DO i=istrr,iendr
382 cff2=stflx(i,j,
itemp)
383 tl_cff2=tl_stflx(i,j,
itemp)
384 cff3=0.5_r8*(1.0_r8+sign(1.0_r8,cff1-t(i,j,
n(ng),nrhs,
itemp)))
385
386
387
388
389
390 tl_stflx(i,j,
itemp)=(1.0_r8- &
391 & cff3*0.5_r8*(1.0_r8-sign(1.0_r8,cff2)))* &
392 & tl_cff2+ &
393# ifdef TL_IOMS
394 & cff3*0.5_r8*(cff2-abs(cff2))
395# endif
396 END DO
397 END DO
398# endif
399
400# ifdef SALINITY
401
402
403
404
405
406
407 DO j=jstrr,jendr
408 DO i=istrr,iendr
409 emp=stflux(i,j,
isalt)
410 tl_emp=0.0_r8
411# if defined SCORRECTION
412
413
414
415
416# ifdef TL_IOMS
417 tl_stflx(i,j,
isalt)=emp*tl_t(i,j,
n(ng),nrhs,
isalt)+ &
418 & tl_emp*t(i,j,
n(ng),nrhs,
isalt)- &
420 & (tl_hz(i,j,
n(ng))* &
421 & (t(i,j,
n(ng),nrhs,
isalt)-sss(i,j))+ &
423 & (tl_t(i,j,
n(ng),nrhs,
isalt)+ &
424 & t(i,j,
n(ng),nrhs,
isalt)))- &
425 & emp*t(i,j,
n(ng),nrhs,
isalt)
426# else
427 tl_stflx(i,j,
isalt)=emp*tl_t(i,j,
n(ng),nrhs,
isalt)+ &
428 & tl_emp*t(i,j,
n(ng),nrhs,
isalt)- &
430 & (tl_hz(i,j,
n(ng))* &
431 & (t(i,j,
n(ng),nrhs,
isalt)-sss(i,j))+ &
433 & tl_t(i,j,
n(ng),nrhs,
isalt))
434# endif
435# elif defined SRELAXATION
436
437
438
439# ifdef TL_IOMS
441 & (tl_hz(i,j,
n(ng))* &
442 & (t(i,j,
n(ng),nrhs,
isalt)-sss(i,j))+ &
444 & (tl_t(i,j,
n(ng),nrhs,
isalt)- &
445 & t(i,j,
n(ng),nrhs,
isalt)))
446# else
448 & (tl_hz(i,j,
n(ng))* &
449 & (t(i,j,
n(ng),nrhs,
isalt)-sss(i,j))+ &
451 & tl_t(i,j,
n(ng),nrhs,
isalt))
452# endif
453# else
454
455
456# ifdef TL_IOMS
457 tl_stflx(i,j,
isalt)=emp*tl_t(i,j,
n(ng),nrhs,
isalt)+ &
458 & (tl_emp-emp)* &
460# else
461 tl_stflx(i,j,
isalt)=emp*tl_t(i,j,
n(ng),nrhs,
isalt)+ &
462 & tl_emp*t(i,j,
n(ng),nrhs,
isalt)
463# endif
464# endif
465
466
468 & tl_t(i,j,1,nrhs,
isalt)+ &
469 & tl_btflx(i,j,
isalt)* &
470 & t(i,j,1,nrhs,
isalt)- &
471# ifdef TL_IOMS
473# endif
474 END DO
475 END DO
476# endif
477
478# if defined BIOLOGY || defined SEDIMENT || defined T_PASSIVE
479
480
481
482
483
485 DO j=jstrr,jendr
486 DO i=istrr,iendr
487
488
489 rp_stflx(i,j,itrc)=0.0_r8
490
491
492 rp_btflx(i,j,itrc)=0.0_r8
493 END DO
494 END DO
495 END DO
496# endif
497
498# ifdef ICESHELF
499
500
501
502
503
504
506 DO j=jstrr,jendr
507 DO i=istrr,iendr
508 IF (zice(i,j).ne.0.0_r8) THEN
509
510
511 tl_stflx(i,j,itrc)=0.0_r8
512 END IF
513 END DO
514 END DO
515 END DO
516# ifdef SHORTWAVE
517 DO j=jstrr,jendr
518 DO i=istrr,iendr
519 IF (zice(i,j).ne.0.0_r8) THEN
520
521
522 srflx(i,j)=0.0_r8
523 END IF
524 END DO
525 END DO
526# endif
527
528
529
530
531
532
533# if defined UV_LOGDRAG
534
535
536
537 DO j=jstrv-1,jend
538 DO i=istru-1,iend
539 cff1=1.0_r8/log((z_w(i,j,
n(ng))-z_r(i,j,
n(ng)))/zobot(i,j))
540 tl_cff1=-cff1*cff1*(tl_z_w(i,j,
n(ng))-tl_z_r(i,j,
n(ng)))/ &
541 & (z_w(i,j,
n(ng))-z_r(i,j,
n(ng)))+ &
542# ifdef TL_IOMS
543 & cff1*(1.0_r8+cff1)
544# endif
547# ifdef TL_IOMS
548 & cff2
549# endif
551 tl_cff3=(0.5_r8-sign(0.5_r8,
cdb_min-cff2))*tl_cff2+ &
552# ifdef TL_IOMS
554# endif
556 tl_wrk(i,j)=(0.5_r8-sign(0.5_r8,cff3-
cdb_max))*tl_cff3+ &
557# ifdef TL_IOMS
559# endif
560 END DO
561 END DO
562 DO j=jstr,jend
563 DO i=istru,iend
564 IF (zice(i,j)*zice(i-1,j).ne.0.0_r8) THEN
565 cff1=0.25_r8*(v(i ,j ,
n(ng),nrhs)+ &
566 & v(i ,j+1,
n(ng),nrhs)+ &
567 & v(i-1,j ,
n(ng),nrhs)+ &
568 & v(i-1,j+1,
n(ng),nrhs))
569 tl_cff1=0.25_r8*(tl_v(i ,j ,
n(ng),nrhs)+ &
570 & tl_v(i ,j+1,
n(ng),nrhs)+ &
571 & tl_v(i-1,j ,
n(ng),nrhs)+ &
572 & tl_v(i-1,j+1,
n(ng),nrhs))
573 cff2=sqrt(u(i,j,
n(ng),nrhs)*u(i,j,
n(ng),nrhs)+cff1*cff1)
574 IF (cff2.ne.0.0_r8) THEN
575 tl_cff2=(u(i,j,
n(ng),nrhs)*tl_u(i,j,
n(ng),nrhs)+ &
576 & cff1*tl_cff1)/cff2
577 ELSE
578 tl_cff2=0.0_r8
579 END IF
580 sustr(i,j)=-0.5_r8*(wrk(i-1,j)+wrk(i,j))* &
581 & u(i,j,
n(ng),nrhs)*cff2
582# ifdef TL_IOMS
583 tl_sustr(i,j)=-0.5_r8* &
584 & ((tl_wrk(i-1,j)+tl_wrk(i,j))* &
585 & u(i,j,
n(ng),nrhs)*cff2+ &
586 & (wrk(i-1,j)+wrk(i,j))* &
587 & (tl_u(i,j,
n(ng),nrhs)*cff2+ &
588 & u(i,j,
n(ng),nrhs)*tl_cff2))+ &
589 & 2.0_r8*sustr(i,j)
590# else
591 tl_sustr(i,j)=-0.5_r8* &
592 & ((tl_wrk(i-1,j)+tl_wrk(i,j))* &
593 & u(i,j,
n(ng),nrhs)*cff2+ &
594 & (wrk(i-1,j)+wrk(i,j))* &
595 & (tl_u(i,j,
n(ng),nrhs)*cff2+ &
596 & u(i,j,
n(ng),nrhs)*tl_cff2))
597# endif
598 END IF
599 END DO
600 END DO
601 DO j=jstrv,jend
602 DO i=istr,iend
603 IF (zice(i,j)*zice(i,j-1).ne.0.0_r8) THEN
604 cff1=0.25_r8*(u(i ,j ,
n(ng),nrhs)+ &
605 & u(i+1,j ,
n(ng),nrhs)+ &
606 & u(i ,j-1,
n(ng),nrhs)+ &
607 & u(i+1,j-1,
n(ng),nrhs))
608 tl_cff1=0.25_r8*(tl_u(i ,j ,
n(ng),nrhs)+ &
609 & tl_u(i+1,j ,
n(ng),nrhs)+ &
610 & tl_u(i ,j-1,
n(ng),nrhs)+ &
611 & tl_u(i+1,j-1,
n(ng),nrhs))
612 cff2=sqrt(cff1*cff1+v(i,j,
n(ng),nrhs)*v(i,j,
n(ng),nrhs))
613 IF (cff2.ne.0.0_r8) THEN
614 tl_cff2=(cff1*tl_cff1+ &
615 & v(i,j,
n(ng),nrhs)*tl_v(i,j,
n(ng),nrhs))/cff2
616 ELSE
617 tl_cff2=0.0_r8
618 END IF
619 svstr(i,j)=-0.5_r8*(wrk(i,j-1)+wrk(i,j))* &
620 & v(i,j,
n(ng),nrhs)*cff2
621# ifdef TL_IOMS
622 tl_svstr(i,j)=-0.5_r8* &
623 & ((tl_wrk(i,j-1)+tl_wrk(i,j))* &
624 & v(i,j,
n(ng),nrhs)*cff2+ &
625 & (wrk(i,j-1)+wrk(i,j))* &
626 & (tl_v(i,j,
n(ng),nrhs)*cff2+ &
627 & v(i,j,
n(ng),nrhs)*tl_cff2))+ &
628 & 2.0_r8*svstr(i,j)
629# else
630 tl_svstr(i,j)=-0.5_r8* &
631 & ((tl_wrk(i,j-1)+tl_wrk(i,j))* &
632 & v(i,j,
n(ng),nrhs)*cff2+ &
633 & (wrk(i,j-1)+wrk(i,j))* &
634 & (tl_v(i,j,
n(ng),nrhs)*cff2+ &
635 & v(i,j,
n(ng),nrhs)*tl_cff2))
636# endif
637 END IF
638 END DO
639 END DO
640# elif defined UV_QDRAG
641
642
643
644 DO j=jstr,jend
645 DO i=istru,iend
646 IF (zice(i,j)*zice(i-1,j).ne.0.0_r8) THEN
647 cff1=0.25_r8*(v(i ,j ,
n(ng),nrhs)+ &
648 & v(i ,j+1,
n(ng),nrhs)+ &
649 & v(i-1,j ,
n(ng),nrhs)+ &
650 & v(i-1,j+1,
n(ng),nrhs))
651 tl_cff1=0.25_r8*(tl_v(i ,j ,
n(ng),nrhs)+ &
652 & tl_v(i ,j+1,
n(ng),nrhs)+ &
653 & tl_v(i-1,j ,
n(ng),nrhs)+ &
654 & tl_v(i-1,j+1,
n(ng),nrhs))
655 & cff2=sqrt(u(i,j,
n(ng),nrhs)*u(i,j,
n(ng),nrhs)+cff1*cff1)
656 IF (cff2.ne.0.0_r8) THEN
657 tl_cff2=(u(i,j,
n(ng),nrhs)*tl_u(i,j,
n(ng),nrhs)+ &
658 & cff1*tl_cff1)/cff2
659 ELSE
660 tl_cff2=0.0_r8
661 END IF
662 sustr(i,j)=-0.5_r8*(rdrag2(i-1,j)+rdrag2(i,j))* &
663 & u(i,j,
n(ng),nrhs)*cff2
664# ifdef TL_IOMS
665 tl_sustr(i,j)=-0.5_r8*(rdrag2(i-1,j)+rdrag2(i,j))* &
666 & (tl_u(i,j,
n(ng),nrhs)*cff2+ &
667 & u(i,j,
n(ng),nrhs)*tl_cff2)+ &
668 & sustr(i,j)
669# else
670 tl_sustr(i,j)=-0.5_r8*(rdrag2(i-1,j)+rdrag2(i,j))* &
671 & (tl_u(i,j,
n(ng),nrhs)*cff2+ &
672 & u(i,j,
n(ng),nrhs)*tl_cff2)
673# endif
674 END IF
675 END DO
676 END DO
677 DO j=jstrv,jend
678 DO i=istr,iend
679 IF (zice(i,j)*zice(i,j-1).ne.0.0_r8) THEN
680 cff1=0.25_r8*(u(i ,j ,
n(ng),nrhs)+ &
681 & u(i+1,j ,
n(ng),nrhs)+ &
682 & u(i ,j-1,
n(ng),nrhs)+ &
683 & u(i+1,j-1,
n(ng),nrhs))
684 tl_cff1=0.25_r8*(tl_u(i ,j ,
n(ng),nrhs)+ &
685 & tl_u(i+1,j ,
n(ng),nrhs)+ &
686 & tl_u(i ,j-1,
n(ng),nrhs)+ &
687 & tl_u(i+1,j-1,
n(ng),nrhs))
688 cff2=sqrt(cff1*cff1+v(i,j,
n(ng),nrhs)*v(i,j,
n(ng),nrhs))
689 IF (cff2.ne.0.0_r8) THEN
690 tl_cff2=(cff1*tl_cff1+ &
691 & v(i,j,
n(ng),nrhs)*tl_v(i,j,
n(ng),nrhs))/cff2
692 ELSE
693 tl_cff2=0.0_r8
694 END IF
695 svstr(i,j)=-0.5_r8*(rdrag2(i,j-1)+rdrag2(i,j))* &
696 & v(i,j,
n(ng),nrhs)*cff2
697# ifdef TL_IOMS
698 tl_svstr(i,j)=-0.5_r8*(rdrag2(i,j-1)+rdrag2(i,j))* &
699 & (tl_v(i,j,
n(ng),nrhs)*cff2+ &
700 & v(i,j,
n(ng),nrhs)*tl_cff2)+ &
701 & svstr(i,j)
702# else
703 tl_svstr(i,j)=-0.5_r8*(rdrag2(i,j-1)+rdrag2(i,j))* &
704 & (tl_v(i,j,
n(ng),nrhs)*cff2+ &
705 & v(i,j,
n(ng),nrhs)*tl_cff2)
706# endif
707 END IF
708 END DO
709 END DO
710# elif defined UV_LDRAG
711
712
713
714 DO j=jstr,jend
715 DO i=istru,iend
716 IF (zice(i,j)*zice(i-1,j).ne.0.0_r8) THEN
717 sustr(i,j)=-0.5_r8*(rdrag(i-1,j)+rdrag(i,j))* &
719 tl_sustr(i,j)=-0.5_r8*(rdrag(i-1,j)+rdrag(i,j))* &
720 & tl_u(i,j,
n(ng),nrhs)
721 END IF
722 END DO
723 END DO
724 DO j=jstrv,jend
725 DO i=istr,iend
726 IF (zice(i,j)*zice(i,j-1).ne.0.0_r8) THEN
727 svstr(i,j)=-0.5_r8*(rdrag(i,j-1)+rdrag(i,j))* &
729 tl_svstr(i,j)=-0.5_r8*(rdrag(i,j-1)+rdrag(i,j))* &
730 & tl_v(i,j,
n(ng),nrhs)
731 END IF
732 END DO
733 END DO
734# else
735 DO j=jstr,jend
736 DO i=istru,iend
737 IF (zice(i,j)*zice(i-1,j).ne.0.0_r8) THEN
738 sustr(i,j)=0.0_r8
739 tl_sustr(i,j)=0.0_r8
740 END IF
741 END DO
742 END DO
743 DO j=jstrv,jend
744 DO i=istr,iend
745 IF (zice(i,j)*zice(i,j-1).ne.0.0_r8) THEN
746 svstr(i,j)=0.0_r8
747 tl_svstr(i,j)=0.0_r8
748 END IF
749 END DO
750 END DO
751# endif
752
753
754
755
757 & lbi, ubi, lbj, ubj, &
758 & sustr)
760 & lbi, ubi, lbj, ubj, &
761 & tl_sustr)
763 & lbi, ubi, lbj, ubj, &
764 & svstr)
766 & lbi, ubi, lbj, ubj, &
767 & tl_svstr)
768
769# ifdef DISTRIBUTE
770
771
772
773
774
775
777 & lbi, ubi, lbj, ubj, &
780 & sustr, svstr, &
781 & tl_sustr, tl_svstr)
782# endif
783# endif
784# ifndef BBL_MODEL_NOT_YET
785
786
787
788
789
790# if defined UV_LOGDRAG
791
792
793
794 DO j=jstrv-1,jend
795 DO i=istru-1,iend
796 cff1=1.0_r8/log((z_r(i,j,1)-z_w(i,j,0))/zobot(i,j))
797 tl_cff1=-cff1*cff1*(tl_z_r(i,j,1)-tl_z_w(i,j,0))/ &
798 & (z_r(i,j,1)-z_w(i,j,0))+ &
799# ifdef TL_IOMS
800 & cff1*(1.0_r8+cff1)
801# endif
804# ifdef TL_IOMS
805 & cff2
806# endif
808 tl_cff3=(0.5_r8-sign(0.5_r8,
cdb_min-cff2))*tl_cff2+ &
809# ifdef TL_IOMS
811# endif
813 tl_wrk(i,j)=(0.5_r8-sign(0.5_r8,cff3-
cdb_max))*tl_cff3+ &
814# ifdef TL_IOMS
816# endif
817 END DO
818 END DO
819 DO j=jstr,jend
820 DO i=istru,iend
821 cff1=0.25_r8*(v(i ,j ,1,nrhs)+ &
822 & v(i ,j+1,1,nrhs)+ &
823 & v(i-1,j ,1,nrhs)+ &
824 & v(i-1,j+1,1,nrhs))
825 tl_cff1=0.25_r8*(tl_v(i ,j ,1,nrhs)+ &
826 & tl_v(i ,j+1,1,nrhs)+ &
827 & tl_v(i-1,j ,1,nrhs)+ &
828 & tl_v(i-1,j+1,1,nrhs))
829 cff2=sqrt(u(i,j,1,nrhs)*u(i,j,1,nrhs)+cff1*cff1)
830 IF (cff2.ne.0.0_r8) THEN
831 tl_cff2=(u(i,j,1,nrhs)*tl_u(i,j,1,nrhs)+cff1*tl_cff1)/cff2
832 ELSE
833 tl_cff2=0.0_r8
834 END IF
835 bustr(i,j)=0.5_r8*(wrk(i-1,j)+wrk(i,j))* &
836 & u(i,j,1,nrhs)*cff2
837# ifdef TL_IOMS
838 tl_bustr(i,j)=0.5_r8* &
839 & ((tl_wrk(i-1,j)+tl_wrk(i,j))* &
840 & u(i,j,1,nrhs)*cff2+ &
841 & (wrk(i-1,j)+wrk(i,j))* &
842 & (tl_u(i,j,1,nrhs)*cff2+ &
843 & u(i,j,1,nrhs)*tl_cff2))- &
844 & 2.0_r8*bustr(i,j)
845# else
846 tl_bustr(i,j)=0.5_r8* &
847 & ((tl_wrk(i-1,j)+tl_wrk(i,j))* &
848 & u(i,j,1,nrhs)*cff2+ &
849 & (wrk(i-1,j)+wrk(i,j))* &
850 & (tl_u(i,j,1,nrhs)*cff2+ &
851 & u(i,j,1,nrhs)*tl_cff2))
852# endif
853 END DO
854 END DO
855 DO j=jstrv,jend
856 DO i=istr,iend
857 cff1=0.25_r8*(u(i ,j ,1,nrhs)+ &
858 & u(i+1,j ,1,nrhs)+ &
859 & u(i ,j-1,1,nrhs)+ &
860 & u(i+1,j-1,1,nrhs))
861 tl_cff1=0.25_r8*(tl_u(i ,j ,1,nrhs)+ &
862 & tl_u(i+1,j ,1,nrhs)+ &
863 & tl_u(i ,j-1,1,nrhs)+ &
864 & tl_u(i+1,j-1,1,nrhs))
865 cff2=sqrt(cff1*cff1+v(i,j,1,nrhs)*v(i,j,1,nrhs))
866 IF (cff2.ne.0.0_r8) THEN
867 tl_cff2=(cff1*tl_cff1+v(i,j,1,nrhs)*tl_v(i,j,1,nrhs))/cff2
868 ELSE
869 tl_cff2=0.0_r8
870 END IF
871 bvstr(i,j)=0.5_r8*(wrk(i,j-1)+wrk(i,j))* &
872 & v(i,j,1,nrhs)*cff2
873# ifdef TL_IOMS
874 tl_bvstr(i,j)=0.5_r8* &
875 & ((tl_wrk(i,j-1)+tl_wrk(i,j))* &
876 & v(i,j,1,nrhs)*cff2+ &
877 & (wrk(i,j-1)+wrk(i,j))* &
878 & (tl_v(i,j,1,nrhs)*cff2+ &
879 & v(i,j,1,nrhs)*tl_cff2))- &
880 & 2.0_r8*bvstr(i,j)
881# else
882 tl_bvstr(i,j)=0.5_r8* &
883 & ((tl_wrk(i,j-1)+tl_wrk(i,j))* &
884 & v(i,j,1,nrhs)*cff2+ &
885 & (wrk(i,j-1)+wrk(i,j))* &
886 & (tl_v(i,j,1,nrhs)*cff2+ &
887 & v(i,j,1,nrhs)*tl_cff2))
888# endif
889 END DO
890 END DO
891# elif defined UV_QDRAG
892
893
894
895 DO j=jstr,jend
896 DO i=istru,iend
897 cff1=0.25_r8*(v(i ,j ,1,nrhs)+ &
898 & v(i ,j+1,1,nrhs)+ &
899 & v(i-1,j ,1,nrhs)+ &
900 & v(i-1,j+1,1,nrhs))
901 tl_cff1=0.25_r8*(tl_v(i ,j ,1,nrhs)+ &
902 & tl_v(i ,j+1,1,nrhs)+ &
903 & tl_v(i-1,j ,1,nrhs)+ &
904 & tl_v(i-1,j+1,1,nrhs))
905 cff2=sqrt(u(i,j,1,nrhs)*u(i,j,1,nrhs)+cff1*cff1)
906 IF (cff2.ne.0.0_r8) THEN
907 tl_cff2=(u(i,j,1,nrhs)*tl_u(i,j,1,nrhs)+cff1*tl_cff1)/cff2
908 ELSE
909 tl_cff2=0.0_r8
910 END IF
911 bustr(i,j)=0.5_r8*(rdrag2(i-1,j)+rdrag2(i,j))* &
912 & u(i,j,1,nrhs)*cff2
913# ifdef TL_IOMS
914 tl_bustr(i,j)=0.5_r8*(rdrag2(i-1,j)+rdrag2(i,j))* &
915 & (tl_u(i,j,1,nrhs)*cff2+ &
916 & u(i,j,1,nrhs)*tl_cff2)- &
917 & bustr(i,j)
918# else
919 tl_bustr(i,j)=0.5_r8*(rdrag2(i-1,j)+rdrag2(i,j))* &
920 & (tl_u(i,j,1,nrhs)*cff2+ &
921 & u(i,j,1,nrhs)*tl_cff2)
922# endif
923 END DO
924 END DO
925 DO j=jstrv,jend
926 DO i=istr,iend
927 cff1=0.25_r8*(u(i ,j ,1,nrhs)+ &
928 & u(i+1,j ,1,nrhs)+ &
929 & u(i ,j-1,1,nrhs)+ &
930 & u(i+1,j-1,1,nrhs))
931 tl_cff1=0.25_r8*(tl_u(i ,j ,1,nrhs)+ &
932 & tl_u(i+1,j ,1,nrhs)+ &
933 & tl_u(i ,j-1,1,nrhs)+ &
934 & tl_u(i+1,j-1,1,nrhs))
935 cff2=sqrt(cff1*cff1+v(i,j,1,nrhs)*v(i,j,1,nrhs))
936 IF (cff2.ne.0.0_r8) THEN
937 tl_cff2=(cff1*tl_cff1+v(i,j,1,nrhs)*tl_v(i,j,1,nrhs))/cff2
938 ELSE
939 tl_cff2=0.0_r8
940 END IF
941 bvstr(i,j)=0.5_r8*(rdrag2(i,j-1)+rdrag2(i,j))* &
942 & v(i,j,1,nrhs)*cff2
943# ifdef TL_IOMS
944 tl_bvstr(i,j)=0.5_r8*(rdrag2(i,j-1)+rdrag2(i,j))* &
945 & (tl_v(i,j,1,nrhs)*cff2+ &
946 & v(i,j,1,nrhs)*tl_cff2)- &
947 & bvstr(i,j)
948# else
949 tl_bvstr(i,j)=0.5_r8*(rdrag2(i,j-1)+rdrag2(i,j))* &
950 & (tl_v(i,j,1,nrhs)*cff2+ &
951 & v(i,j,1,nrhs)*tl_cff2)
952# endif
953 END DO
954 END DO
955# elif defined UV_LDRAG
956
957
958
959 DO j=jstr,jend
960 DO i=istru,iend
961 bustr(i,j)=0.5_r8*(rdrag(i-1,j)+rdrag(i,j))* &
962 & u(i,j,1,nrhs)
963 tl_bustr(i,j)=0.5_r8*(rdrag(i-1,j)+rdrag(i,j))* &
964 & tl_u(i,j,1,nrhs)
965 END DO
966 END DO
967 DO j=jstrv,jend
968 DO i=istr,iend
969 bvstr(i,j)=0.5_r8*(rdrag(i,j-1)+rdrag(i,j))* &
970 & v(i,j,1,nrhs)
971 tl_bvstr(i,j)=0.5_r8*(rdrag(i,j-1)+rdrag(i,j))* &
972 & tl_v(i,j,1,nrhs)
973 END DO
974 END DO
975# endif
976
977
978
980 & lbi, ubi, lbj, ubj, &
981 & bustr)
983 & lbi, ubi, lbj, ubj, &
984 & tl_bustr)
986 & lbi, ubi, lbj, ubj, &
987 & bvstr)
989 & lbi, ubi, lbj, ubj, &
990 & tl_bvstr)
991
992# ifdef DISTRIBUTE
993
994
995
996
997
998
1000 & lbi, ubi, lbj, ubj, &
1003 & bustr, bvstr, &
1004 & tl_bustr, tl_bvstr)
1005# endif
1006# endif
1007
1008 RETURN
subroutine bc_v2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
subroutine bc_u2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
integer, dimension(:), allocatable n
integer, dimension(:), allocatable nt
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
real(dp), dimension(:,:), allocatable tnudg
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)