194
195
196
197
198 integer, intent(in) :: ng, tile
199 integer, intent(in) :: LBi, UBi, LBj, UBj
200 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
201 integer, intent(in) :: knew, nrhs, nstp, nnew
202
203# ifdef ASSUMED_SHAPE
204# ifdef MASKING
205 real(r8), intent(in) :: umask(LBi:,LBj:)
206 real(r8), intent(in) :: vmask(LBi:,LBj:)
207# endif
208# ifdef WET_DRY_NOT_YET
209 real(r8), intent(in) :: umask_wet(LBi:,LBj:)
210 real(r8), intent(in) :: vmask_wet(LBi:,LBj:)
211# endif
212 real(r8), intent(in) :: om_v(LBi:,LBj:)
213 real(r8), intent(in) :: on_u(LBi:,LBj:)
214 real(r8), intent(in) :: pm(LBi:,LBj:)
215 real(r8), intent(in) :: pn(LBi:,LBj:)
216 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
217 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
218 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
219 real(r8), intent(in) :: Akv(LBi:,LBj:,0:)
220 real(r8), intent(in) :: DU_avg1(LBi:,LBj:)
221 real(r8), intent(in) :: DV_avg1(LBi:,LBj:)
222 real(r8), intent(in) :: DU_avg2(LBi:,LBj:)
223 real(r8), intent(in) :: DV_avg2(LBi:,LBj:)
224 real(r8), intent(in) :: u(LBi:,LBj:,:,:)
225 real(r8), intent(in) :: v(LBi:,LBj:,:,:)
226# ifdef NEARSHORE_MELLOR
227 real(r8), intent(in) :: ubar_stokes(LBi:,LBj:)
228 real(r8), intent(in) :: vbar_stokes(LBi:,LBj:)
229 real(r8), intent(in) :: u_stokes(LBi:,LBj:,:)
230 real(r8), intent(in) :: v_stokes(LBi:,LBj:,:)
231# endif
232# ifdef DIAGNOSTICS_UV
233
234
235
236
237
238
239
240
241# endif
242 real(r8), intent(inout) :: Huon(LBi:,LBj:,:)
243 real(r8), intent(inout) :: Hvom(LBi:,LBj:,:)
244 real(r8), intent(inout) :: ad_Hz(LBi:,LBj:,:)
245 real(r8), intent(inout) :: ad_z_r(LBi:,LBj:,:)
246 real(r8), intent(inout) :: ad_z_w(LBi:,LBj:,0:)
247 real(r8), intent(inout) :: ad_Akv(LBi:,LBj:,0:)
248 real(r8), intent(inout) :: ad_DU_avg1(LBi:,LBj:)
249 real(r8), intent(inout) :: ad_DV_avg1(LBi:,LBj:)
250 real(r8), intent(inout) :: ad_DU_avg2(LBi:,LBj:)
251 real(r8), intent(inout) :: ad_DV_avg2(LBi:,LBj:)
252 real(r8), intent(inout) :: ad_ru(LBi:,LBj:,0:,:)
253 real(r8), intent(inout) :: ad_rv(LBi:,LBj:,0:,:)
254 real(r8), intent(inout) :: ad_u(LBi:,LBj:,:,:)
255 real(r8), intent(inout) :: ad_v(LBi:,LBj:,:,:)
256# ifdef AD_OUTPUT_STATE
257 real(r8), intent(inout) :: ad_u_sol(LBi:,LBj:,:)
258 real(r8), intent(inout) :: ad_v_sol(LBi:,LBj:,:)
259# endif
260# ifdef NEARSHORE_MELLOR
261 real(r8), intent(inout) :: ad_ubar_stokes(LBi:,LBj:)
262 real(r8), intent(inout) :: ad_vbar_stokes(LBi:,LBj:)
263 real(r8), intent(inout) :: ad_u_stokes(LBi:,LBj:,:)
264 real(r8), intent(inout) :: ad_v_stokes(LBi:,LBj:,:)
265# endif
266 real(r8), intent(inout) :: ad_ubar(LBi:,LBj:,:)
267 real(r8), intent(inout) :: ad_vbar(LBi:,LBj:,:)
268 real(r8), intent(inout) :: ad_Huon(LBi:,LBj:,:)
269 real(r8), intent(inout) :: ad_Hvom(LBi:,LBj:,:)
270
271 real(r8), intent(out) :: ad_ubar_sol(LBi:,LBj:)
272 real(r8), intent(out) :: ad_vbar_sol(LBi:,LBj:)
273
274# else
275
276# ifdef MASKING
277 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
278 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
279# endif
280# ifdef WET_DRY_NOT_YET
281 real(r8), intent(in) :: umask_wet(LBi:UBi,LBj:UBj)
282 real(r8), intent(in) :: vmask_wet(LBi:UBi,LBj:UBj)
283# endif
284 real(r8), intent(in) :: om_v(LBi:UBi,LBj:UBj)
285 real(r8), intent(in) :: on_u(LBi:UBi,LBj:UBj)
286 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
287 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
288 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
289 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
290 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
291 real(r8), intent(in) :: Akv(LBi:UBi,LBj:UBj,0:N(ng))
292 real(r8), intent(in) :: DU_avg1(LBi:UBi,LBj:UBj)
293 real(r8), intent(in) :: DV_avg1(LBi:UBi,LBj:UBj)
294 real(r8), intent(in) :: DU_avg2(LBi:UBi,LBj:UBj)
295 real(r8), intent(in) :: DV_avg2(LBi:UBi,LBj:UBj)
296 real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
297 real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
298# ifdef NEARSHORE_MELLOR
299 real(r8), intent(in) :: ubar_stokes(LBi:UBi,LBj:UBj)
300 real(r8), intent(in) :: vbar_stokes(LBi:UBi,LBj:UBj)
301 real(r8), intent(in) :: u_stokes(LBi:UBi,LBj:UBj,N(ng))
302 real(r8), intent(in) :: v_stokes(LBi:UBi,LBj:UBj,N(ng))
303# endif
304# ifdef DIAGNOSTICS_UV
305
306
307
308
309
310
311
312
313# endif
314 real(r8), intent(inout) :: Huon(LBi:UBi,LBj:UBj,N(ng))
315 real(r8), intent(inout) :: Hvom(LBi:UBi,LBj:UBj,N(ng))
316 real(r8), intent(inout) :: ad_Hz(LBi:UBi,LBj:UBj,N(ng))
317 real(r8), intent(inout) :: ad_z_r(LBi:UBi,LBj:UBj,N(ng))
318 real(r8), intent(inout) :: ad_z_w(LBi:UBi,LBj:UBj,0:N(ng))
319 real(r8), intent(inout) :: ad_Akv(LBi:UBi,LBj:UBj,0:N(ng))
320 real(r8), intent(inout) :: ad_DU_avg1(LBi:UBi,LBj:UBj)
321 real(r8), intent(inout) :: ad_DV_avg1(LBi:UBi,LBj:UBj)
322 real(r8), intent(inout) :: ad_DU_avg2(LBi:UBi,LBj:UBj)
323 real(r8), intent(inout) :: ad_DV_avg2(LBi:UBi,LBj:UBj)
324 real(r8), intent(inout) :: ad_ru(LBi:UBi,LBj:UBj,0:N(ng),2)
325 real(r8), intent(inout) :: ad_rv(LBi:UBi,LBj:UBj,0:N(ng),2)
326 real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2)
327 real(r8), intent(inout) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2)
328# ifdef AD_OUTPUT_STATE
329 real(r8), intent(inout) :: ad_u_sol(LBi:UBi,LBj:UBj,N(ng))
330 real(r8), intent(inout) :: ad_v_sol(LBi:UBi,LBj:UBj,N(ng))
331# endif
332# ifdef NEARSHORE_MELLOR
333 real(r8), intent(in) :: ad_ubar_stokes(LBi:UBi,LBj:UBj)
334 real(r8), intent(in) :: ad_vbar_stokes(LBi:UBi,LBj:UBj)
335 real(r8), intent(inout) :: ad_u_stokes(LBi:UBi,LBj:UBj,N(ng))
336 real(r8), intent(inout) :: ad_v_stokes(LBi:UBi,LBj:UBj,N(ng))
337# endif
338 real(r8), intent(inout) :: ad_ubar(LBi:UBi,LBj:UBj,3)
339 real(r8), intent(inout) :: ad_vbar(LBi:UBi,LBj:UBj,3)
340 real(r8), intent(inout) :: ad_Huon(LBi:UBi,LBj:UBj,N(ng))
341 real(r8), intent(inout) :: ad_Hvom(LBi:UBi,LBj:UBj,N(ng))
342
343 real(r8), intent(out) :: ad_ubar_sol(LBi:UBi,LBj:UBj)
344 real(r8), intent(out) :: ad_vbar_sol(LBi:UBi,LBj:UBj)
345# endif
346
347
348
349 integer :: i, idiag, is, j, k
350
351 real(r8) :: cff, cff1, cff2
352 real(r8) :: ad_cff, ad_cff1, ad_cff2
353 real(r8) :: adfac, adfac1, adfac2
354
355 real(r8), dimension(IminS:ImaxS) :: CF1
356 real(r8), dimension(IminS:ImaxS) :: FC1
357# ifdef NEARSHORE_MELLOR
358 real(r8), dimension(IminS:ImaxS) :: CFs1
359 real(r8), dimension(IminS:ImaxS) :: DCs1
360# endif
361 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: AK
362 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: BC
363 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: CF
364 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: DC
365 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: DC1
366 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: FC
367# ifdef NEARSHORE_MELLOR
368 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: CFs
369 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: DCs
370# endif
371 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hzk
372 real(r8), dimension(IminS:ImaxS,N(ng)) :: oHz
373# ifdef DIAGNOSTICS_UV
374
375
376# endif
377 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: ad_AK
378 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: ad_BC
379 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: ad_CF
380 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: ad_DC
381 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: ad_FC
382# ifdef NEARSHORE_MELLOR
383 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: ad_CFs
384 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: ad_DCs
385# endif
386 real(r8), dimension(IminS:ImaxS,N(ng)) :: ad_Hzk
387 real(r8), dimension(IminS:ImaxS,N(ng)) :: ad_oHz
388
389# include "set_bounds.h"
390
391
392
393
394
395 ad_cff=0.0_r8
396 ad_cff1=0.0_r8
397 DO k=0,n(ng)
398 DO i=imins,imaxs
399 ad_ak(i,k)=0.0_r8
400 ad_bc(i,k)=0.0_r8
401 ad_cf(i,k)=0.0_r8
402 ad_dc(i,k)=0.0_r8
403# ifdef NEARSHORE_MELLOR
404 ad_cfs(i,k)=0.0_r8
405 ad_dcs(i,k)=0.0_r8
406# endif
407 ad_fc(i,k)=0.0_r8
408 END DO
409 END DO
410 DO k=1,n(ng)
411 DO i=imins,imaxs
412 ad_hzk(i,k)=0.0_r8
413 ad_ohz(i,k)=0.0_r8
414 END DO
415 END DO
416
417# ifdef UV_DESTAGGERED
418
419
420
421
422
423
424
425
426
427 CALL ad_uv_c2a_grid (ng, tile, itlm, nnew)
428# endif
429
430
431
432
433
434# ifdef DISTRIBUTE
435
436
437
438
439
440
441
442 CALL ad_mp_exchange2d (ng, tile, iadm, 4, &
443 & lbi, ubi, lbj, ubj, &
444 & nghostpoints, &
445 & ewperiodic(ng), nsperiodic(ng), &
446 & ad_ubar(:,:,1), ad_vbar(:,:,1), &
447 & ad_ubar(:,:,2), ad_vbar(:,:,2))
448
449
450
451
452
453
454
455
456 CALL ad_mp_exchange3d (ng, tile, iadm, 4, &
457 & lbi, ubi, lbj, ubj, 1, n(ng), &
458 & nghostpoints, &
459 & ewperiodic(ng), nsperiodic(ng), &
460 & ad_u(:,:,:,nnew), ad_v(:,:,:,nnew), &
461 & ad_huon, ad_hvom)
462
463# endif
464
465 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
466 DO k=1,2
467
468
469
470
471 CALL ad_exchange_v2d_tile (ng, tile, &
472 & lbi, ubi, lbj, ubj, &
473 & ad_vbar(:,:,k))
474
475
476
477
478 CALL ad_exchange_u2d_tile (ng, tile, &
479 & lbi, ubi, lbj, ubj, &
480 & ad_ubar(:,:,k))
481 END DO
482
483 CALL exchange_v3d_tile (ng, tile, &
484 & lbi, ubi, lbj, ubj, 1, n(ng), &
485 & hvom)
486
487
488
489
490 CALL ad_exchange_v3d_tile (ng, tile, &
491 & lbi, ubi, lbj, ubj, 1, n(ng), &
492 & ad_hvom)
493
494 CALL exchange_u3d_tile (ng, tile, &
495 & lbi, ubi, lbj, ubj, 1, n(ng), &
496 & huon)
497
498
499
500
501 CALL ad_exchange_u3d_tile (ng, tile, &
502 & lbi, ubi, lbj, ubj, 1, n(ng), &
503 & ad_huon)
504
505
506
507
508
509 CALL ad_exchange_v3d_tile (ng, tile, &
510 & lbi, ubi, lbj, ubj, 1, n(ng), &
511 & ad_v(:,:,:,nnew))
512
513
514
515
516 CALL ad_exchange_u3d_tile (ng, tile, &
517 & lbi, ubi, lbj, ubj, 1, n(ng), &
518 & ad_u(:,:,:,nnew))
519 END IF
520
521
522
523
524
525
526
527 j_loop1 : DO j=jstrt,jendt
528 IF (j.ge.jstr) THEN
529
530
531
532
533
534 DO i=istrt,iendt
535 dc(i,0)=0.0_r8
536 cf(i,0)=0.0_r8
537# ifdef NEARSHORE_MELLOR
538 cfs(i,0)=0.0_r8
539# endif
540 fc(i,0)=0.0_r8
541 END DO
542 DO k=1,n(ng)
543 DO i=istrt,iendt
544 cff=0.5_r8*om_v(i,j)
545 dc(i,k)=cff*(hz(i,j,k)+hz(i,j-1,k))
546 dc(i,0)=dc(i,0)+dc(i,k)
547 cf(i,0)=cf(i,0)+ &
548 & dc(i,k)*v(i,j,k,nnew)
549# ifdef NEARSHORE_MELLOR
550 cfs(i,0)=cfs(i,0)+ &
551 & dc(i,k)*v_stokes(i,j,k)
552# endif
553 END DO
554 END DO
555 DO i=istrt,iendt
556 dc1(i,0)=dc(i,0)
557# ifdef NEARSHORE_MELLOR
558 cff2=dc(i,0)*vbar_stokes(i,j)
559# endif
560 dc(i,0)=1.0_r8/dc(i,0)
561 cf1(i)=cf(i,0)
562 cf(i,0)=dc(i,0)*(cf(i,0)-dv_avg1(i,j))
563# ifdef NEARSHORE_MELLOR
564 cfs1(i)=cfs(i,0)
565 cfs(i,0)=dc(i,0)*(cfs(i,0)-cff2)
566# endif
567 END DO
568 DO k=n(ng),1,-1
569 DO i=istrt,iendt
570
571# ifdef NEARSHORE_MELLOR
572
573# endif
574
575
576 fc(i,0)=fc(i,0)+ &
577 & 0.5_r8*(hvom(i,j,k)+v(i,j,k,nnew)*dc(i,k))
578# ifdef NEARSHORE_MELLOR
579 fc(i,0)=fc(i,0)+ &
580 & 0.5_r8*v_stokes(i,j,k)*dc(i,k)
581# endif
582 END DO
583 END DO
584 DO i=istrt,iendt
585 fc1(i)=fc(i,0)
586 fc(i,0)=dc(i,0)*(fc(i,0)-dv_avg2(i,j))
587 END DO
588
589
590
591 DO k=1,n(ng)
592 DO i=istrt,iendt
593
594
595
596
597 ad_dc(i,k)=ad_dc(i,k)-ad_hvom(i,j,k)*fc(i,0)
598 ad_fc(i,0)=ad_fc(i,0)-ad_hvom(i,j,k)*dc(i,k)
599 END DO
600 END DO
601 DO i=istrt,iendt
602
603
604
605 adfac=dc(i,0)*ad_fc(i,0)
606 ad_dc(i,0)=ad_dc(i,0)+ad_fc(i,0)*(fc1(i)-dv_avg2(i,j))
607 ad_dv_avg2(i,j)=ad_dv_avg2(i,j)-adfac
608 ad_fc(i,0)=adfac
609 END DO
610
611
612 DO k=1,n(ng)
613 DO i=istrt,iendt
614# ifdef DIAGNOSTICS_UV
615
616
617# endif
618
619
620 ad_hvom(i,j,k)=ad_hvom(i,j,k)+ad_fc(i,0)
621# ifdef NEARSHORE_MELLOR
622
623
624
625
626 adfac=0.5_r8*ad_hvom(i,j,k)
627 ad_dc(i,k)=ad_dc(i,k)+v_stokes(i,j,k)*adfac
628 ad_v_stokes(i,j,k)=ad_v_stokes(i,j,k)+dc(i,k)*adfac
629# endif
630
631
632
633
634 adfac=0.5_r8*ad_hvom(i,j,k)
635 ad_dc(i,k)=ad_dc(i,k)+v(i,j,k,nnew)*adfac
636 ad_v(i,j,k,nnew)=ad_v(i,j,k,nnew)+dc(i,k)*adfac
637 ad_hvom(i,j,k)=adfac
638 END DO
639 END DO
640
641
642
643
644
645
646
647 IF (.not.(compositegrid(inorth,ng).or.nsperiodic(ng))) THEN
648 IF (j.eq.mm(ng)+1) THEN
649 DO k=1,n(ng)
650 DO i=istr,iend
651# ifdef NEARSHORE_MELLOR
652# ifdef WET_DRY_NOT_YET
653
654
655
656 ad_v_stokes(i,j,k)=ad_v_stokes(i,j,k)* &
657 & vmask_wet(i,j)
658# endif
659# ifdef MASKING
660
661
662
663 ad_v_stokes(i,j,k)=ad_v_stokes(i,j,k)* &
664 & vmask(i,j)
665# endif
666
667
668
669 ad_cfs(i,0)=ad_cfs(i,0)-ad_v_stokes(i,j,k)
670# endif
671# ifdef WET_DRY_NOT_YET
672
673
674
675 ad_v(i,j,k,nnew)=ad_v(i,j,k,nnew)* &
676 & vmask_wet(i,j)
677# endif
678# ifdef MASKING
679
680
681
682 ad_v(i,j,k,nnew)=ad_v(i,j,k,nnew)* &
683 & vmask(i,j)
684# endif
685
686
687
688 ad_cf(i,0)=ad_cf(i,0)-ad_v(i,j,k,nnew)
689 END DO
690 END DO
691 END IF
692 END IF
693
694 IF (.not.(compositegrid(isouth,ng).or.nsperiodic(ng))) THEN
695 IF (j.eq.1) THEN
696 DO k=1,n(ng)
697 DO i=istr,iend
698# ifdef NEARSHORE_MELLOR
699# ifdef WET_DRY_NOT_YET
700
701
702
703 ad_v_stokes(i,j,k)=ad_v_stokes(i,j,k)* &
704 & vmask_wet(i,j)
705# endif
706# ifdef MASKING
707
708
709
710 ad_v_stokes(i,j,k)=ad_v_stokes(i,j,k)* &
711 & vmask(i,j)
712# endif
713
714
715
716 ad_cfs(i,0)=ad_cfs(i,0)-ad_v_stokes(i,j,k)
717# endif
718# ifdef WET_DRY_NOT_YET
719
720
721
722 ad_v(i,j,k,nnew)=ad_v(i,j,k,nnew)* &
723 & vmask_wet(i,j)
724# endif
725# ifdef MASKING
726
727
728
729 ad_v(i,j,k,nnew)=ad_v(i,j,k,nnew)* &
730 & vmask(i,j)
731# endif
732
733
734
735 ad_cf(i,0)=ad_cf(i,0)-ad_v(i,j,k,nnew)
736 END DO
737 END DO
738 END IF
739 END IF
740
741 IF (.not.(compositegrid(ieast,ng).or.ewperiodic(ng))) THEN
742 IF (domain(ng)%Eastern_Edge(tile)) THEN
743 DO k=1,n(ng)
744# ifdef NEARSHORE_MELLOR
745# ifdef WET_DRY_NOT_YET
746
747
748
749 ad_v_stokes(iend+1,j,k)=ad_v_stokes(iend+1,j,k)* &
750 & vmask_wet(iend+1,j)
751# endif
752# ifdef MASKING
753
754
755
756 ad_v_stokes(iend+1,j,k)=ad_v_stokes(iend+1,j,k)* &
757 & vmask(iend+1,j)
758# endif
759
760
761
762 ad_cfs(iend+1,0)=ad_cfs(iend+1,0)- &
763 & ad_v_stokes(iend+1,j,k)
764# endif
765# ifdef WET_DRY_NOT_YET
766
767
768
769 ad_v(iend+1,j,k,nnew)=ad_v(iend+1,j,k,nnew)* &
770 & vmask_wet(iend+1,j)
771# endif
772# ifdef MASKING
773
774
775
776 ad_v(iend+1,j,k,nnew)=ad_v(iend+1,j,k,nnew)* &
777 & vmask(iend+1,j)
778# endif
779
780
781
782 ad_cf(iend+1,0)=ad_cf(iend+1,0)- &
783 & ad_v(iend+1,j,k,nnew)
784 END DO
785 END IF
786 END IF
787
788 IF (.not.(compositegrid(iwest,ng).or.ewperiodic(ng))) THEN
789 IF (domain(ng)%Western_Edge(tile)) THEN
790 DO k=1,n(ng)
791# ifdef NEARSHORE_MELLOR
792# ifdef WET_DRY_NOT_YET
793
794
795
796 ad_v_stokes(istr-1,j,k)=ad_v_stokes(istr-1,j,k)* &
797 & vmask_wet(istr-1,j)
798# endif
799# ifdef MASKING
800
801
802
803 ad_v_stokes(istr-1,j,k)=ad_v_stokes(istr-1,j,k)* &
804 & vmask(istr-1,j)
805# endif
806
807
808
809 ad_cfs(istr-1,0)=ad_cfs(istr-1,0)- &
810 & ad_v_stokes(istr-1,j,k)
811# endif
812# ifdef WET_DRY_NOT_YET
813
814
815
816 ad_v(istr-1,j,k,nnew)=ad_v(istr-1,j,k,nnew)* &
817 & vmask_wet(istr-1,j)
818# endif
819# ifdef MASKING
820
821
822
823 ad_v(istr-1,j,k,nnew)=ad_v(istr-1,j,k,nnew)* &
824 & vmask(istr-1,j)
825# endif
826
827
828
829 ad_cf(istr-1,0)=ad_cf(istr-1,0)- &
830 & ad_v(istr-1,j,k,nnew)
831 END DO
832 END IF
833 END IF
834
835# ifdef DIAGNOSTICS_UV
836
837
838
839
840
841
842# ifdef MASKING
843
844# endif
845
846
847
848# endif
849
850
851
852
853 DO i=istrt,iendt
854 ad_vbar_sol(i,j)=ad_vbar(i,j,1)+ad_vbar(i,j,2)
855 END DO
856
857
858
859
860
861
862 DO i=istrt,iendt
863# ifdef DIAGNOSTICS_UV
864
865
866
867
868
869# endif
870
871
872 ad_vbar(i,j,1)=ad_vbar(i,j,1)+ad_vbar(i,j,2)
873 ad_vbar(i,j,2)=0.0_r8
874
875
876
877 ad_dc(i,0)=ad_dc(i,0)+ad_vbar(i,j,1)*dv_avg1(i,j)
878 ad_dv_avg1(i,j)=ad_dv_avg1(i,j)+ad_vbar(i,j,1)*dc(i,0)
879 ad_vbar(i,j,1)=0.0_r8
880# ifdef NEARSHORE_MELLOR
881
882
883
884 adfac=dc(i,0)*ad_cfs(i,0)
885 ad_dc(i,0)=ad_dc(i,0)+(cfs1(i)-cff2)*ad_cfs(i,0)
886 ad_cff2=ad_cff2-adfac
887 ad_cfs(i,0)=ad_cfs(i,0)+adfac
888 ad_cfs(i,0)=0.0_r8
889# endif
890
891
892
893 adfac=dc(i,0)*ad_cf(i,0)
894 ad_dc(i,0)=ad_dc(i,0)+ad_cf(i,0)*(cf1(i)-dv_avg1(i,j))
895 ad_dv_avg1(i,j)=ad_dv_avg1(i,j)-adfac
896 ad_cf(i,0)=adfac
897
898
899 ad_dc(i,0)=-ad_dc(i,0)/(dc1(i,0)*dc1(i,0))
900# ifdef NEARSHORE_MELLOR
901
902
903
904 ad_vbar_stokes(i,j)=ad_vbar_stokes(i,j)+dc(i,0)*ad_cff2
905 ad_dc(i,0)=ad_dc(i,0)+vbar_stokes(i,j)*ad_cff2
906 ad_cff2=0.0_r8
907# endif
908 END DO
909 DO i=istrt,iendt
910 dc(i,0)=0.0_r8
911 cf(i,0)=0.0_r8
912# ifdef NEARSHORE_MELLOR
913 cfs(i,0)=0.0_r8
914# endif
915 fc(i,0)=0.0_r8
916 END DO
917 DO k=1,n(ng)
918 DO i=istrt,iendt
919 cff=0.5_r8*om_v(i,j)
920 dc(i,k)=cff*(hz(i,j,k)+hz(i,j-1,k))
921 dc(i,0)=dc(i,0)+dc(i,k)
922 cf(i,0)=cf(i,0)+ &
923 & dc(i,k)*v(i,j,k,nnew)
924# ifdef NEARSHORE_MELLOR
925 cfs(i,0)=cfs(i,0)+dc(i,k)*v_stokes(i,j,k)
926
927
928
929
930 ad_dc(i,k)=ad_dc(i,k)+v_stokes(i,j,k)*ad_cfs(i,0)
931 ad_v_stokes(i,j,k)=ad_v_stokes(i,j,k)+dc(i,k)*ad_cfs(i,0)
932# endif
933
934
935
936
937 ad_dc(i,k)=ad_dc(i,k)+ad_cf(i,0)*v(i,j,k,nnew)
938 ad_v(i,j,k,nnew)=ad_v(i,j,k,nnew)+ad_cf(i,0)*dc(i,k)
939
940
941 ad_dc(i,k)=ad_dc(i,k)+ad_dc(i,0)
942
943
944 adfac=cff*ad_dc(i,k)
945 ad_hz(i,j-1,k)=ad_hz(i,j-1,k)+adfac
946 ad_hz(i,j ,k)=ad_hz(i,j ,k)+adfac
947 ad_dc(i,k)=0.0_r8
948 END DO
949 END DO
950 DO i=istrt,iendt
951
952
953 ad_fc(i,0)=0.0_r8
954# ifdef NEARSHORE_MELLOR
955
956
957 ad_cfs(i,0)=0.0_r8
958# endif
959
960
961 ad_cf(i,0)=0.0_r8
962
963
964 ad_dc(i,0)=0.0_r8
965 END DO
966 END IF
967
968
969
970
971
972
973 DO i=istrp,iendt
974 dc(i,0)=0.0_r8
975 cf(i,0)=0.0_r8
976# ifdef NEARSHORE_MELLOR
977 cfs(i,0)=0.0_r8
978# endif
979 fc(i,0)=0.0_r8
980 END DO
981 DO k=1,n(ng)
982 DO i=istrp,iendt
983 cff=0.5_r8*on_u(i,j)
984 dc(i,k)=cff*(hz(i,j,k)+hz(i-1,j,k))
985 dc(i,0)=dc(i,0)+dc(i,k)
986 cf(i,0)=cf(i,0)+ &
987 & dc(i,k)*u(i,j,k,nnew)
988# ifdef NEARSHORE_MELLOR
989 cfs(i,0)=cfs(i,0)+ &
990 & dc(i,k)*u_stokes(i,j,k)
991# endif
992 END DO
993 END DO
994 DO i=istrp,iendt
995 dc1(i,0)=dc(i,0)
996# ifdef NEARSHORE_MELLOR
997 cff2=dc(i,0)*ubar_stokes(i,j)
998# endif
999 dc(i,0)=1.0_r8/dc(i,0)
1000 cf1(i)=cf(i,0)
1001 cf(i,0)=dc(i,0)*(cf(i,0)-du_avg1(i,j))
1002# ifdef NEARSHORE_MELLOR
1003 cfs1(i)=cfs(i,0)
1004 cfs(i,0)=dc(i,0)*(cfs(i,0)-cff2)
1005# endif
1006 END DO
1007 DO k=n(ng),1,-1
1008 DO i=istrp,iendt
1009
1010# ifdef NEARSHORE_MELLOR
1011
1012# endif
1013
1014
1015 fc(i,0)=fc(i,0)+ &
1016 & 0.5_r8*(huon(i,j,k)+u(i,j,k,nnew)*dc(i,k))
1017# ifdef NEARSHORE_MELLOR
1018 fc(i,0)=fc(i,0)+ &
1019 & 0.5_r8*u_stokes(i,j,k)*dc(i,k)
1020# endif
1021 END DO
1022 END DO
1023 DO i=istrp,iendt
1024 fc1(i)=fc(i,0)
1025 fc(i,0)=dc(i,0)*(fc(i,0)-du_avg2(i,j))
1026 END DO
1027
1028
1029
1030 DO k=1,n(ng)
1031 DO i=istrp,iendt
1032
1033
1034
1035
1036 ad_dc(i,k)=ad_dc(i,k)-ad_huon(i,j,k)*fc(i,0)
1037 ad_fc(i,0)=ad_fc(i,0)-ad_huon(i,j,k)*dc(i,k)
1038 END DO
1039 END DO
1040 DO i=istrp,iendt
1041
1042
1043
1044 adfac=dc(i,0)*ad_fc(i,0)
1045 ad_dc(i,0)=ad_dc(i,0)+ad_fc(i,0)*(fc1(i)-du_avg2(i,j))
1046 ad_du_avg2(i,j)=ad_du_avg2(i,j)-adfac
1047 ad_fc(i,0)=adfac
1048 END DO
1049
1050
1051 DO k=1,n(ng)
1052 DO i=istrp,iendt
1053# ifdef DIAGNOSTICS_UV
1054
1055# endif
1056
1057
1058 ad_huon(i,j,k)=ad_huon(i,j,k)+ad_fc(i,0)
1059# ifdef NEARSHORE_MELLOR
1060
1061
1062
1063
1064 adfac=0.5_r8*ad_huon(i,j,k)
1065 ad_u_stokes(i,j,k)=ad_u_stokes(i,j,k)+dc(i,k)*adfac
1066 ad_dc(i,k)=ad_dc(i,k)+u_stokes(i,j,k)*adfac
1067# endif
1068
1069
1070
1071
1072 adfac=0.5_r8*ad_huon(i,j,k)
1073 ad_dc(i,k)=ad_dc(i,k)+u(i,j,k,nnew)*adfac
1074 ad_u(i,j,k,nnew)=ad_u(i,j,k,nnew)+dc(i,k)*adfac
1075 ad_huon(i,j,k)=adfac
1076 END DO
1077 END DO
1078
1079
1080
1081
1082
1083
1084
1085 IF (.not.(compositegrid(inorth,ng).or.nsperiodic(ng))) THEN
1086 IF (j.eq.mm(ng)+1) THEN
1087 DO k=1,n(ng)
1088 DO i=istru,iend
1089# ifdef NEARSHORE_MELLOR
1090# ifdef WET_DRY_NOT_YET
1091
1092
1093
1094 ad_u_stokes(i,j,k)=ad_u_stokes(i,j,k)* &
1095 & umask_wet(i,j)
1096# endif
1097# ifdef MASKING
1098
1099
1100
1101 ad_u_stokes(i,j,k)=ad_u_stokes(i,j,k)* &
1102 & umask(i,j)
1103# endif
1104
1105
1106
1107 ad_cfs(i,0)=ad_cfs(i,0)-ad_u_stokes(i,j,k)
1108# endif
1109# ifdef WET_DRY_NOT_YET
1110
1111
1112
1113 ad_u(i,j,k,nnew)=ad_u(i,j,k,nnew)* &
1114 & umask_wet(i,j)
1115# endif
1116# ifdef MASKING
1117
1118
1119
1120 ad_u(i,j,k,nnew)=ad_u(i,j,k,nnew)* &
1121 & umask(i,j)
1122# endif
1123
1124
1125 ad_cf(i,0)=ad_cf(i,0)-ad_u(i,j,k,nnew)
1126 END DO
1127 END DO
1128 END IF
1129 END IF
1130
1131 IF (.not.(compositegrid(isouth,ng).or.nsperiodic(ng))) THEN
1132 IF (j.eq.0) THEN
1133 DO k=1,n(ng)
1134 DO i=istru,iend
1135# ifdef NEARSHORE_MELLOR
1136# ifdef WET_DRY_NOT_YET
1137
1138
1139
1140 ad_u_stokes(i,j,k)=ad_u_stokes(i,j,k)* &
1141 & umask_wet(i,j)
1142# endif
1143# ifdef MASKING
1144
1145
1146
1147 ad_u_stokes(i,j,k)=ad_u_stokes(i,j,k)* &
1148 & umask(i,j)
1149# endif
1150
1151
1152
1153 ad_cfs(i,0)=ad_cfs(i,0)-ad_u_stokes(i,j,k)
1154# endif
1155# ifdef WET_DRY_NOT_YET
1156
1157
1158
1159 ad_u(i,j,k,nnew)=ad_u(i,j,k,nnew)* &
1160 & umask_wet(i,j)
1161# endif
1162# ifdef MASKING
1163
1164
1165
1166 ad_u(i,j,k,nnew)=ad_u(i,j,k,nnew)* &
1167 & umask(i,j)
1168# endif
1169
1170
1171 ad_cf(i,0)=ad_cf(i,0)-ad_u(i,j,k,nnew)
1172 END DO
1173 END DO
1174 END IF
1175 END IF
1176
1177 IF (.not.(compositegrid(ieast,ng).or.ewperiodic(ng))) THEN
1178 IF (domain(ng)%Eastern_Edge(tile)) THEN
1179 DO k=1,n(ng)
1180# ifdef NEARSHORE_MELLOR
1181# ifdef WET_DRY_NOT_YET
1182
1183
1184
1185 ad_u_stokes(iend+1,j,k)=ad_u_stokes(iend+1,j,k)* &
1186 & umask_wet(iend+1,j)
1187# endif
1188# ifdef MASKING
1189
1190
1191
1192 ad_u_stokes(iend+1,j,k)=ad_u_stokes(iend+1,j,k)* &
1193 & umask(iend+1,j)
1194# endif
1195
1196
1197
1198 ad_cfs(iend+1,0)=ad_cfs(iend+1,0)- &
1199 & ad_u_stokes(iend+1,j,k)
1200# endif
1201# ifdef WET_DRY_NOT_YET
1202
1203
1204
1205 ad_u(iend+1,j,k,nnew)=ad_u(iend+1,j,k,nnew)* &
1206 & umask_wet(iend+1,j)
1207# endif
1208# ifdef MASKING
1209
1210
1211
1212 ad_u(iend+1,j,k,nnew)=ad_u(iend+1,j,k,nnew)* &
1213 & umask(iend+1,j)
1214# endif
1215
1216
1217
1218 ad_cf(iend+1,0)=ad_cf(iend+1,0)- &
1219 & ad_u(iend+1,j,k,nnew)
1220 END DO
1221 END IF
1222 END IF
1223
1224 IF (.not.(compositegrid(iwest,ng).or.ewperiodic(ng))) THEN
1225 IF (domain(ng)%Western_Edge(tile)) THEN
1226 DO k=1,n(ng)
1227# ifdef NEARSHORE_MELLOR
1228# ifdef WET_DRY_NOT_YET
1229
1230
1231
1232 ad_u_stokes(istr,j,k)=ad_u_stokes(istr,j,k)* &
1233 & umask_wet(istr,j)
1234# endif
1235# ifdef MASKING
1236
1237
1238
1239 ad_u_stokes(istr,j,k)=ad_u_stokes(istr,j,k)* &
1240 & umask(istr,j)
1241# endif
1242
1243
1244
1245 ad_cfs(istr,0)=ad_cfs(istr,0)- &
1246 & ad_u_stokes(istr,j,k)
1247# endif
1248# ifdef WET_DRY_NOT_YET
1249
1250
1251
1252 ad_u(istr,j,k,nnew)=ad_u(istr,j,k,nnew)* &
1253 & umask_wet(istr,j)
1254# endif
1255# ifdef MASKING
1256
1257
1258
1259 ad_u(istr,j,k,nnew)=ad_u(istr,j,k,nnew)* &
1260 & umask(istr,j)
1261# endif
1262
1263
1264
1265 ad_cf(istr,0)=ad_cf(istr,0)- &
1266 & ad_u(istr,j,k,nnew)
1267 END DO
1268 END IF
1269 END IF
1270
1271# ifdef DIAGNOSTICS_UV
1272
1273
1274
1275
1276
1277
1278# ifdef MASKING
1279
1280# endif
1281
1282
1283
1284# endif
1285
1286
1287
1288
1289 DO i=istrp,iendt
1290 ad_ubar_sol(i,j)=ad_ubar(i,j,1)+ad_ubar(i,j,2)
1291 END DO
1292
1293
1294
1295
1296
1297
1298 DO i=istrp,iendt
1299# ifdef DIAGNOSTICS_UV
1300
1301
1302# endif
1303
1304
1305 ad_ubar(i,j,1)=ad_ubar(i,j,1)+ad_ubar(i,j,2)
1306 ad_ubar(i,j,2)=0.0_r8
1307
1308
1309
1310 ad_dc(i,0)=ad_dc(i,0)+ad_ubar(i,j,1)*du_avg1(i,j)
1311 ad_du_avg1(i,j)=ad_du_avg1(i,j)+ad_ubar(i,j,1)*dc(i,0)
1312 ad_ubar(i,j,1)=0.0_r8
1313# ifdef NEARSHORE_MELLOR
1314
1315
1316
1317 adfac=dc(i,0)*ad_cfs(i,0)
1318 ad_dc(i,0)=ad_dc(i,0)+(cfs1(i)-cff2)*ad_cfs(i,0)
1319 ad_cfs(i,0)=ad_cfs(i,0)+adfac
1320 ad_cff2=tl_cff2-adfac
1321 ad_cfs(i,0)=0.0_r8
1322# endif
1323
1324
1325
1326 adfac=dc(i,0)*ad_cf(i,0)
1327 ad_dc(i,0)=ad_dc(i,0)+ad_cf(i,0)*(cf1(i)-du_avg1(i,j))
1328 ad_du_avg1(i,j)=ad_du_avg1(i,j)-adfac
1329 ad_cf(i,0)=adfac
1330
1331
1332 ad_dc(i,0)=-ad_dc(i,0)/(dc1(i,0)*dc1(i,0))
1333# ifdef NEARSHORE_MELLOR
1334
1335
1336
1337 ad_dc(i,0)=ad_dc(i,0)+ubar_stokes(i,j)*ad_cff2
1338 ad_ubar_stokes(i,j)=ad_ubar_stokes(i,j)+dc(i,0)*ad_cff2
1339 ad_cff2=0.0_r8
1340# endif
1341 END DO
1342 DO i=istrp,iendt
1343 dc(i,0)=0.0_r8
1344 cf(i,0)=0.0_r8
1345# ifdef NEARSHORE_MELLOR
1346 cfs(i,0)=0.0_r8
1347# endif
1348 fc(i,0)=0.0_r8
1349 END DO
1350 DO k=1,n(ng)
1351 DO i=istrp,iendt
1352 cff=0.5_r8*on_u(i,j)
1353 dc(i,k)=0.5_r8*(hz(i,j,k)+hz(i-1,j,k))*on_u(i,j)
1354 dc(i,0)=dc(i,0)+dc(i,k)
1355 cf(i,0)=cf(i,0)+ &
1356 & dc(i,k)*u(i,j,k,nnew)
1357# ifdef NEARSHORE_MELLOR
1358 cfs(i,0)=cfs(i,0)+ &
1359 & dc(i,k)*u_stokes(i,j,k)
1360
1361
1362
1363
1364 ad_dc(i,k)=ad_dc(i,k)+u_stokes(i,j,k)*ad_cfs(i,0)
1365 ad_u_stokes(i,j,k)=ad_u_stokes(i,j,k)+dc(i,k)*ad_cfs(i,0)
1366# endif
1367
1368
1369
1370
1371 ad_dc(i,k)=ad_dc(i,k)+ad_cf(i,0)*u(i,j,k,nnew)
1372 ad_u(i,j,k,nnew)=ad_u(i,j,k,nnew)+ad_cf(i,0)*dc(i,k)
1373
1374
1375 ad_dc(i,k)=ad_dc(i,k)+ad_dc(i,0)
1376
1377
1378 adfac=cff*ad_dc(i,k)
1379 ad_hz(i-1,j,k)=ad_hz(i-1,j,k)+adfac
1380 ad_hz(i ,j,k)=ad_hz(i ,j,k)+adfac
1381 ad_dc(i,k)=0.0_r8
1382 END DO
1383 END DO
1384 DO i=istrp,iendt
1385
1386
1387 ad_fc(i,0)=0.0_r8
1388# ifdef NEARSHORE_MELLOR
1389
1390
1391 ad_cfs(i,0)=0.0_r8
1392# endif
1393
1394
1395 ad_cf(i,0)=0.0_r8
1396
1397
1398 ad_dc(i,0)=0.0_r8
1399 END DO
1400 END DO j_loop1
1401
1402
1403
1404
1405
1406
1407 IF (luvsrc(ng)) THEN
1408 DO is=1,nsrc(ng)
1409 i=sources(ng)%Isrc(is)
1410 j=sources(ng)%Jsrc(is)
1411 IF (((istrr.le.i).and.(i.le.iendr)).and. &
1412 & ((jstrr.le.j).and.(j.le.jendr))) THEN
1413 IF (int(sources(ng)%Dsrc(is)).eq.0) THEN
1414 DO k=1,n(ng)
1415 cff1=1.0_r8/(on_u(i,j)* &
1416 & 0.5_r8*(z_w(i-1,j,k)-z_w(i-1,j,k-1)+ &
1417 & z_w(i ,j,k)-z_w(i ,j,k-1)))
1418
1419
1420
1421 sources(ng)%ad_Qsrc(is,k)=sources(ng)%ad_Qsrc(is,k)+ &
1422 & cff1*ad_u(i,j,k,nnew)
1423 ad_cff1=ad_cff1+ &
1424 & sources(ng)%Qsrc(is,k)*ad_u(i,j,k,nnew)
1425 ad_u(i,j,k,nnew)=0.0_r8
1426
1427
1428
1429
1430 adfac=-0.5_r8*cff1*cff1*on_u(i,j)*ad_cff1
1431 ad_z_w(i-1,j,k-1)=ad_z_w(i-1,j,k-1)-adfac
1432 ad_z_w(i ,j,k-1)=ad_z_w(i ,j,k-1)-adfac
1433 ad_z_w(i-1,j,k )=ad_z_w(i-1,j,k )+adfac
1434 ad_z_w(i ,j,k )=ad_z_w(i ,j,k )+adfac
1435 ad_cff1=0.0_r8
1436 END DO
1437 ELSE IF (int(sources(ng)%Dsrc(is)).eq.1) THEN
1438 DO k=1,n(ng)
1439 cff1=1.0_r8/(om_v(i,j)* &
1440 & 0.5_r8*(z_w(i,j-1,k)-z_w(i,j-1,k-1)+ &
1441 & z_w(i,j ,k)-z_w(i,j ,k-1)))
1442
1443
1444
1445 sources(ng)%ad_Qsrc(is,k)=sources(ng)%ad_Qsrc(is,k)+ &
1446 & cff1*ad_v(i,j,k,nnew)
1447 ad_cff1=ad_cff1+ &
1448 & sources(ng)%Qsrc(is,k)*ad_v(i,j,k,nnew)
1449 ad_v(i,j,k,nnew)=0.0_r8
1450
1451
1452
1453
1454 adfac=-0.5_r8*cff1*cff1*om_v(i,j)*ad_cff1
1455 ad_z_w(i,j-1,k-1)=ad_z_w(i,j-1,k-1)-adfac
1456 ad_z_w(i,j ,k-1)=ad_z_w(i,j ,k-1)-adfac
1457 ad_z_w(i,j-1,k )=ad_z_w(i,j-1,k )+adfac
1458 ad_z_w(i,j ,k )=ad_z_w(i,j ,k )+adfac
1459 ad_cff1=0.0_r8
1460 END DO
1461 END IF
1462 END IF
1463 END DO
1464 END IF
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476 CALL ad_v3dbc_tile (ng, tile, &
1477 & lbi, ubi, lbj, ubj, n(ng), &
1478 & imins, imaxs, jmins, jmaxs, &
1479 & nstp, nnew, &
1480 & ad_v)
1481
1482
1483
1484
1485
1486
1487 CALL ad_u3dbc_tile (ng, tile, &
1488 & lbi, ubi, lbj, ubj, n(ng), &
1489 & imins, imaxs, jmins, jmaxs, &
1490 & nstp, nnew, &
1491 & ad_u)
1492
1493
1494
1495
1496
1497 j_loop2 : DO j=jstr,jend
1498 IF (j.ge.jstrv) THEN
1499
1500
1501
1502 DO i=istr,iend
1503 ak(i,0)=0.5_r8*(akv(i,j-1,0)+ &
1504 & akv(i,j ,0))
1505 DO k=1,n(ng)
1506 ak(i,k)=0.5_r8*(akv(i,j-1,k)+ &
1507 & akv(i,j ,k))
1508 hzk(i,k)=0.5_r8*(hz(i,j-1,k)+ &
1509 & hz(i,j ,k))
1510# if defined SPLINES_VVISC || defined DIAGNOSTICS_UV
1511 ohz(i,k)=1.0_r8/hzk(i,k)
1512# endif
1513 END DO
1514 END DO
1515
1516
1517
1518# if defined DIAGNOSTICS_UV && defined MASKING
1519
1520
1521
1522
1523
1524
1525
1526# endif
1527
1528 DO k=1,n(ng)
1529 DO i=istr,iend
1530# ifdef DIAGNOSTICS_UV
1531# ifdef NEARSHORE_MELLOR
1532
1533
1534# endif
1535# ifdef UV_ADV
1536
1537
1538
1539
1540
1541
1542# endif
1543# if defined UV_VIS2 || defined UV_VIS4
1544
1545
1546
1547
1548
1549
1550# endif
1551# ifdef UV_COR
1552
1553
1554# endif
1555
1556
1557
1558
1559# endif
1560# ifdef NEARSHORE_MELLOR
1561# ifdef WET_DRY_NOT_YET
1562
1563
1564 ad_v_stokes(i,j,k)=ad_v_stokes(i,j,k)*vmask_wet(i,j)
1565# endif
1566# ifdef MASKING
1567
1568
1569 ad_v_stokes(i,j,k)=ad_v_stokes(i,j,k)*vmask(i,j)
1570# endif
1571
1572
1573 ad_dcs(i,0)=ad_dcs(i,0)-ad_v_stokes(i,j,k)
1574# endif
1575# ifdef WET_DRY_NOT_YET
1576
1577
1578 ad_v(i,j,k,nnew)=ad_v(i,j,k,nnew)*vmask_wet(i,j)
1579# endif
1580# ifdef MASKING
1581
1582
1583 ad_v(i,j,k,nnew)=ad_v(i,j,k,nnew)*vmask(i,j)
1584# endif
1585
1586
1587 ad_dc(i,0)=ad_dc(i,0)-ad_v(i,j,k,nnew)
1588 END DO
1589 END DO
1590
1591
1592
1593
1594 DO i=istr,iend
1595 cf(i,0)=hzk(i,1)
1596 dc(i,0)=v(i,j,1,nnew)*hzk(i,1)
1597 END DO
1598 DO k=2,n(ng)
1599 DO i=istr,iend
1600 cf(i,0)=cf(i,0)+hzk(i,k)
1601 dc(i,0)=dc(i,0)+v(i,j,k,nnew)*hzk(i,k)
1602 END DO
1603 END DO
1604 DO i=istr,iend
1605 dc1(i,0)=dc(i,0)
1606 cff1=1.0_r8/(cf(i,0)*om_v(i,j))
1607 dc(i,0)=(dc(i,0)*om_v(i,j)-dv_avg1(i,j))*cff1
1608# ifdef NEARSHORE_MELLOR
1609 dcs1(i)=dcs(i,0)
1610 cff2=1.0_r8/cf(i,0)
1611 dcs(i,0)=dcs(i,0)*cff2-vbar_stokes(i,j)
1612# endif
1613# ifdef DIAGNOSTICS_UV
1614
1615
1616
1617
1618
1619
1620
1621# endif
1622# ifdef NEARSHORE_MELLOR
1623
1624
1625
1626 ad_vbar_stokes(i,j)=ad_vbar_stokes(i,j)-ad_dcs(i,0)
1627 ad_cff2=ad_cff2+dcs1(i,0)*ad_dcs(i,0)
1628 ad_dcs(i,0)=cff2*ad_dcs(i,0)
1629
1630
1631 ad_cf(i,0)=ad_cf(i,0)-cff2*cff2*tl_cff2
1632 ad_cff2=0.0_r8
1633# endif
1634
1635
1636
1637 adfac=cff1*ad_dc(i,0)
1638 ad_dv_avg1(i,j)=ad_dv_avg1(i,j)-adfac
1639 ad_cff1=ad_cff1+ &
1640 & (dc1(i,0)*om_v(i,j)-dv_avg1(i,j))*ad_dc(i,0)
1641 ad_dc(i,0)=om_v(i,j)*adfac
1642
1643
1644 ad_cf(i,0)=ad_cf(i,0)-cff1*cff1*om_v(i,j)*ad_cff1
1645 ad_cff1=0.0_r8
1646 END DO
1647 DO i=istr,iend
1648 cf(i,0)=hzk(i,1)
1649 dc(i,0)=v(i,j,1,nnew)*hzk(i,1)
1650 END DO
1651 DO k=2,n(ng)
1652 DO i=istr,iend
1653 cf(i,0)=cf(i,0)+hzk(i,k)
1654 dc(i,0)=dc(i,0)+v(i,j,k,nnew)*hzk(i,k)
1655# ifdef DIAGNOSTICS_UV
1656# ifdef NEARSHORE_MELLOR
1657
1658
1659# endif
1660# ifdef UV_ADV
1661
1662
1663
1664
1665
1666
1667# endif
1668# if defined UV_VIS2 || defined UV_VIS4
1669
1670
1671
1672
1673
1674
1675# endif
1676# ifdef UV_COR
1677
1678
1679# endif
1680
1681
1682
1683
1684# endif
1685# ifdef NEARSHORE_MELLOR
1686
1687
1688
1689
1690 ad_v_stokes(i,j,k)=ad_v_stokes(i,j,k)+hzk(i,k)*ad_dcs(i,0)
1691 ad_hzk(i,k)=ad_hzk(i,k)+v_stokes(i,j,k)*ad_dcs(i,0)
1692# endif
1693
1694
1695
1696
1697 ad_v(i,j,k,nnew)=ad_v(i,j,k,nnew)+ad_dc(i,0)*hzk(i,k)
1698 ad_hzk(i,k)=ad_hzk(i,k)+v(i,j,k,nnew)*ad_dc(i,0)
1699
1700
1701 ad_hzk(i,k)=ad_hzk(i,k)+ad_cf(i,0)
1702 END DO
1703 END DO
1704 DO i=istr,iend
1705 cf(i,0)=hzk(i,1)
1706 dc(i,0)=v(i,j,1,nnew)*hzk(i,1)
1707# ifdef DIAGNOSTICS_UV
1708# ifdef NEARSHORE_MELLOR
1709
1710# endif
1711# ifdef UV_ADV
1712
1713
1714
1715# endif
1716# if defined UV_VIS2 || defined UV_VIS4
1717
1718
1719
1720# endif
1721# ifdef UV_COR
1722
1723# endif
1724
1725
1726# endif
1727# ifdef NEARSHORE_MELLOR
1728
1729
1730
1731 ad_v_stokes(i,j,1)=ad_v_stokes(i,j,1)+hzk(i,1)*ad_dcs(i,0)
1732 ad_hzk(i,1)=ad_hzk(i,1)+v_stokes(i,j,1)*ad_dcs(i,0)
1733 ad_dcs(i,0)=0.0_r8
1734# endif
1735
1736
1737
1738 ad_v(i,j,1,nnew)=ad_v(i,j,1,nnew)+ad_dc(i,0)*hzk(i,1)
1739 ad_hzk(i,1)=ad_hzk(i,1)+v(i,j,1,nnew)*ad_dc(i,0)
1740 ad_dc(i,0)=0.0_r8
1741
1742
1743 ad_hzk(i,1)=ad_hzk(i,1)+ad_cf(i,0)
1744 ad_cf(i,0)=0.0_r8
1745 END DO
1746
1747# if defined SPLINES_VVISC
1748
1749
1750
1751
1752
1753
1754 cff1=1.0_r8/6.0_r8
1755 DO k=1,n(ng)-1
1756 DO i=istr,iend
1757 fc(i,k)=cff1*hzk(i,k )-dt(ng)*ak(i,k-1)*ohz(i,k )
1758 cf(i,k)=cff1*hzk(i,k+1)-dt(ng)*ak(i,k+1)*ohz(i,k+1)
1759 END DO
1760 END DO
1761 DO i=istr,iend
1762 cf(i,0)=0.0_r8
1763 dc(i,0)=0.0_r8
1764 END DO
1765
1766
1767
1768 cff1=1.0_r8/3.0_r8
1769 DO k=1,n(ng)-1
1770 DO i=istr,iend
1771 bc(i,k)=cff1*(hzk(i,k)+hzk(i,k+1))+ &
1772 & dt(ng)*ak(i,k)*(ohz(i,k)+ohz(i,k+1))
1773 cff=1.0_r8/(bc(i,k)-fc(i,k)*cf(i,k-1))
1774 cf(i,k)=cff*cf(i,k)
1775 dc(i,k)=cff*(v(i,j,k+1,nnew)-v(i,j,k,nnew)- &
1776 & fc(i,k)*dc(i,k-1))
1777 END DO
1778 END DO
1779
1780
1781
1782
1783 DO i=istr,iend
1784 dc(i,n(ng))=0.0_r8
1785 END DO
1786 DO k=n(ng)-1,1,-1
1787 DO i=istr,iend
1788 dc(i,k)=dc(i,k)-cf(i,k)*dc(i,k+1)
1789 END DO
1790 END DO
1791
1792
1793
1794 DO k=0,n(ng)
1795 DO i=istr,iend
1796 dc1(i,k)=dc(i,k)*ak(i,k)
1797 END DO
1798 END DO
1799
1800
1801 DO k=n(ng),1,-1
1802 DO i=istr,iend
1803# ifdef DIAGNOSTICS_UV
1804
1805# endif
1806
1807
1808 ad_cff=ad_cff+ad_v(i,j,k,nnew)
1809
1810
1811
1812 adfac=dt(ng)*ad_cff
1813 adfac1=adfac*ohz(i,k)
1814 ad_dc(i,k-1)=ad_dc(i,k-1)-adfac1
1815 ad_dc(i,k )=ad_dc(i,k )+adfac1
1816 ad_ohz(i,k)=ad_ohz(i,k)+(dc1(i,k)-dc1(i,k-1))*adfac
1817 ad_cff=0.0_r8
1818
1819
1820 ad_ak(i,k)=ad_ak(i,k)+dc(i,k)*ad_dc(i,k)
1821 ad_dc(i,k)=ak(i,k)*ad_dc(i,k)
1822 END DO
1823 END DO
1824
1825
1826
1827 DO k=1,n(ng)-1
1828 DO i=istr,iend
1829
1830
1831 ad_dc(i,k+1)=ad_dc(i,k+1)-cf(i,k)*ad_dc(i,k)
1832 END DO
1833 END DO
1834 DO i=istr,iend
1835
1836
1837 ad_dc(i,n(ng))=0.0_r8
1838 END DO
1839
1840
1841
1842 cff1=1.0_r8/3.0_r8
1843 DO k=n(ng)-1,1,-1
1844 DO i=istr,iend
1845 bc(i,k)=cff1*(hzk(i,k)+hzk(i,k+1))+ &
1846 & dt(ng)*ak(i,k)*(ohz(i,k)+ohz(i,k+1))
1847 cff=1.0_r8/(bc(i,k)-fc(i,k)*cf(i,k-1))
1848
1849
1850
1851
1852
1853
1854
1855 adfac=cff*ad_dc(i,k)
1856 ad_dc(i,k-1)=ad_dc(i,k-1)-fc(i,k)*adfac
1857 ad_cf(i,k)=ad_cf(i,k)-dc(i,k+1)*adfac
1858 ad_bc(i,k)=ad_bc(i,k)-dc(i,k )*adfac
1859 ad_fc(i,k)=ad_fc(i,k)-dc(i,k-1)*adfac
1860 ad_v(i,j,k, nnew)=ad_v(i,j,k ,nnew)-adfac
1861 ad_v(i,j,k+1,nnew)=ad_v(i,j,k+1,nnew)+adfac
1862 ad_dc(i,k)=0.0_r8
1863
1864
1865
1866
1867 adfac=dt(ng)*ad_bc(i,k)
1868 adfac1=adfac*ak(i,k)
1869 adfac2=cff1*ad_bc(i,k)
1870 ad_ohz(i,k )=ad_ohz(i,k )+adfac1
1871 ad_ohz(i,k+1)=ad_ohz(i,k+1)+adfac1
1872 ad_ak(i,k)=ad_ak(i,k)+(ohz(i,k)+ohz(i,k+1))*adfac
1873 ad_hzk(i,k )=ad_hzk(i,k )+adfac2
1874 ad_hzk(i,k+1)=ad_hzk(i,k+1)+adfac2
1875 ad_bc(i,k)=0.0_r8
1876 END DO
1877 END DO
1878
1879
1880
1881
1882
1883 DO i=istr,iend
1884
1885
1886 ad_dc(i,0)=0.0_r8
1887
1888
1889 ad_cf(i,0)=0.0_r8
1890 END DO
1891 cff1=1.0_r8/6.0_r8
1892 DO k=1,n(ng)-1
1893 DO i=istr,iend
1894
1895
1896
1897
1898 adfac=dt(ng)*ad_cf(i,k)
1899 ad_ohz(i,k+1)=ad_ohz(i,k+1)-ak(i,k+1)*adfac
1900 ad_ak(i,k+1)=ad_ak(i,k+1)-ohz(i,k+1)*adfac
1901 ad_hzk(i,k+1)=ad_hzk(i,k+1)+cff1*ad_cf(i,k)
1902 ad_cf(i,k)=0.0_r8
1903
1904
1905
1906
1907 adfac=dt(ng)*ad_fc(i,k)
1908 ad_ohz(i,k)=ad_ohz(i,k)-ak(i,k-1)*adfac
1909 ad_ak(i,k-1)=ad_ak(i,k-1)-ohz(i,k)*adfac
1910 ad_hzk(i,k)=ad_hzk(i,k)+cff1*ad_fc(i,k)
1911 ad_fc(i,k)=0.0_r8
1912 END DO
1913 END DO
1914# else
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926 cff=-lambda*dt(ng)/0.5_r8
1927 DO k=1,n(ng)-1
1928 DO i=istr,iend
1929 cff1=1.0_r8/(z_r(i,j,k+1)+z_r(i,j-1,k+1)- &
1930 & z_r(i,j,k )-z_r(i,j-1,k ))
1931 fc(i,k)=cff*cff1*ak(i,k)
1932 END DO
1933 END DO
1934 DO i=istr,iend
1935 fc(i,0)=0.0_r8
1936 fc(i,n(ng))=0.0_r8
1937 END DO
1938 DO k=1,n(ng)
1939 DO i=istr,iend
1940 bc(i,k)=hzk(i,k)-fc(i,k)-fc(i,k-1)
1941 END DO
1942 END DO
1943 DO i=istr,iend
1944 cff=1.0_r8/bc(i,1)
1945 cf(i,1)=cff*fc(i,1)
1946 END DO
1947 DO k=2,n(ng)-1
1948 DO i=istr,iend
1949 cff=1.0_r8/(bc(i,k)-fc(i,k-1)*cf(i,k-1))
1950 cf(i,k)=cff*fc(i,k)
1951 END DO
1952 END DO
1953
1954
1955
1956
1957
1958
1959 DO k=1,n(ng)-1
1960 DO i=istr,iend
1961# ifdef DIAGNOSTICS_UV
1962
1963
1964# endif
1965
1966
1967 ad_dc(i,k)=ad_dc(i,k)+ad_v(i,j,k,nnew)
1968 ad_v(i,j,k,nnew)=0.0_r8
1969
1970
1971 ad_dc(i,k+1)=-cf(i,k)*ad_dc(i,k)
1972# ifdef DIAGNOSTICS_UV
1973
1974# endif
1975 END DO
1976 END DO
1977 DO i=istr,iend
1978# ifdef DIAGNOSTICS_UV
1979
1980
1981# endif
1982
1983
1984 ad_dc(i,n(ng))=ad_dc(i,n(ng))+ad_v(i,j,n(ng),nnew)
1985 ad_v(i,j,n(ng),nnew)=0.0_r8
1986
1987
1988
1989 adfac=ad_dc(i,n(ng))/ &
1990 & (bc(i,n(ng))-fc(i,n(ng)-1)*cf(i,n(ng)-1))
1991 ad_dc(i,n(ng)-1)=ad_dc(i,n(ng)-1)-fc(i,n(ng)-1)*adfac
1992 ad_dc(i,n(ng) )=adfac
1993 END DO
1994
1995
1996
1997
1998
1999
2000 DO k=n(ng)-1,2,-1
2001 DO i=istr,iend
2002 cff=1.0_r8/(bc(i,k)-fc(i,k-1)*cf(i,k-1))
2003
2004
2005 adfac=cff*ad_dc(i,k)
2006 ad_dc(i,k-1)=ad_dc(i,k-1)-fc(i,k-1)*adfac
2007 ad_dc(i,k )=adfac
2008 END DO
2009 END DO
2010 DO i=istr,iend
2011 cff=1.0_r8/bc(i,1)
2012
2013
2014 ad_dc(i,1)=cff*ad_dc(i,1)
2015 END DO
2016 DO i=istr,iend
2017
2018
2019
2020
2021 ad_bc(i,n(ng) )=-v(i,j,n(ng) ,nnew)*ad_dc(i,n(ng))
2022 ad_fc(i,n(ng)-1)=-v(i,j,n(ng)-1,nnew)*ad_dc(i,n(ng))
2023 ad_v(i,j,n(ng),nnew)=ad_dc(i,n(ng))
2024 ad_dc(i,n(ng))=0.0_r8
2025
2026
2027
2028
2029 ad_fc(i,1)=-v(i,j,2,nnew)*ad_dc(i,1)
2030 ad_bc(i,1)=-v(i,j,1,nnew)*ad_dc(i,1)
2031 ad_v(i,j,1,nnew)=ad_dc(i,1)
2032 ad_dc(i,1)=0.0_r8
2033 END DO
2034 DO k=2,n(ng)-1
2035 DO i=istr,iend
2036
2037
2038
2039
2040
2041 ad_fc(i,k-1)=ad_fc(i,k-1)-v(i,j,k-1,nnew)*ad_dc(i,k)
2042 ad_fc(i,k )=ad_fc(i,k )-v(i,j,k+1,nnew)*ad_dc(i,k)
2043 ad_bc(i,k )=ad_bc(i,k )-v(i,j,k ,nnew)*ad_dc(i,k)
2044 ad_v(i,j,k,nnew)=ad_v(i,j,k,nnew)+ad_dc(i,k)
2045 ad_dc(i,k)=0.0_r8
2046 END DO
2047 END DO
2048 DO k=1,n(ng)
2049 DO i=istr,iend
2050
2051
2052 ad_hzk(i,k)=ad_hzk(i,k)+ad_bc(i,k)
2053 ad_fc(i,k-1)=ad_fc(i,k-1)-ad_bc(i,k)
2054 ad_fc(i,k )=ad_fc(i,k )-ad_bc(i,k)
2055 ad_bc(i,k)=0.0_r8
2056 END DO
2057 END DO
2058
2059
2060
2061
2062
2063 DO i=istr,iend
2064
2065
2066 ad_fc(i,n(ng))=0.0_r8
2067
2068
2069 ad_fc(i,0)=0.0_r8
2070 END DO
2071 cff=-lambda*dt(ng)/0.5_r8
2072 DO k=1,n(ng)-1
2073 DO i=istr,iend
2074 cff1=1.0_r8/(z_r(i,j,k+1)+z_r(i,j-1,k+1)- &
2075 & z_r(i,j,k )-z_r(i,j-1,k ))
2076
2077
2078 adfac=cff*ad_fc(i,k)
2079 ad_ak(i,k)=ad_ak(i,k)+cff1*adfac
2080 ad_cff1=ad_cff1+ak(i,k)*adfac
2081 ad_fc(i,k)=0.0_r8
2082
2083
2084
2085 adfac=-cff1*cff1*ad_cff1
2086 ad_z_r(i,j-1,k )=ad_z_r(i,j-1,k )-adfac
2087 ad_z_r(i,j ,k )=ad_z_r(i,j ,k )-adfac
2088 ad_z_r(i,j-1,k+1)=ad_z_r(i,j-1,k+1)+adfac
2089 ad_z_r(i,j ,k+1)=ad_z_r(i,j ,k+1)+adfac
2090 ad_cff1=0.0_r8
2091 END DO
2092 END DO
2093# endif
2094
2095
2096
2097 IF (iic(ng).eq.ntfirst(ng)) THEN
2098 cff=0.25_r8*dt(ng)
2099 ELSE IF (iic(ng).eq.(ntfirst(ng)+1)) THEN
2100 cff=0.25_r8*dt(ng)*3.0_r8/2.0_r8
2101 ELSE
2102 cff=0.25_r8*dt(ng)*23.0_r8/12.0_r8
2103 END IF
2104 DO i=istr,iend
2105 dc(i,0)=cff*(pm(i,j)+pm(i,j-1))*(pn(i,j)+pn(i,j-1))
2106 END DO
2107
2108
2109
2110
2111 DO k=1,n(ng)
2112 DO i=istr,iend
2113# ifdef DIAGNOSTICS_UV
2114
2115# ifdef BODYFORCE
2116
2117
2118
2119# endif
2120
2121# if defined UV_VIS2 || defined UV_VIS4
2122
2123
2124
2125# endif
2126
2127
2128
2129
2130
2131
2132# endif
2133# ifdef SPLINES_VVISC
2134
2135
2136
2137 ad_ohz(i,k)=ad_ohz(i,k)+ &
2138 & (v(i,j,k,nnew)*hzk(i,k))*ad_v(i,j,k,nnew)
2139 ad_v(i,j,k,nnew)=ad_v(i,j,k,nnew)*ohz(i,k)
2140# endif
2141
2142
2143
2144 ad_rv(i,j,k,nrhs)=ad_rv(i,j,k,nrhs)+ &
2145 & dc(i,0)*ad_v(i,j,k,nnew)
2146 END DO
2147 END DO
2148 DO i=istr,iend
2149 DO k=1,n(ng)
2150# ifdef SPLINES_VVISC
2151 ohz(i,k)=1.0_r8/hzk(i,k)
2152
2153
2154 ad_hzk(i,k)=ad_hzk(i,k)-ohz(i,k)*ohz(i,k)*ad_ohz(i,k)
2155 ad_ohz(i,k)=0.0_r8
2156# endif
2157
2158
2159
2160 adfac=0.5_r8*ad_hzk(i,k)
2161 ad_hz(i,j-1,k)=ad_hz(i,j-1,k)+adfac
2162 ad_hz(i,j ,k)=ad_hz(i,j ,k)+adfac
2163 ad_hzk(i,k)=0.0_r8
2164
2165
2166
2167 adfac=0.5_r8*ad_ak(i,k)
2168 ad_akv(i,j-1,k)=ad_akv(i,j-1,k)+adfac
2169 ad_akv(i,j ,k)=ad_akv(i,j ,k)+adfac
2170 ad_ak(i,k)=0.0_r8
2171 END DO
2172
2173
2174
2175 adfac=0.5_r8*ad_ak(i,0)
2176 ad_akv(i,j-1,0)=ad_akv(i,j-1,0)+adfac
2177 ad_akv(i,j ,0)=ad_akv(i,j ,0)+adfac
2178 ad_ak(i,0)=0.0_r8
2179 END DO
2180 END IF
2181
2182
2183
2184
2185
2186
2187
2188 DO i=istru,iend
2189 ak(i,0)=0.5_r8*(akv(i-1,j,0)+ &
2190 & akv(i ,j,0))
2191 DO k=1,n(ng)
2192 ak(i,k)=0.5_r8*(akv(i-1,j,k)+ &
2193 & akv(i ,j,k))
2194 hzk(i,k)=0.5_r8*(hz(i-1,j,k)+ &
2195 & hz(i ,j,k))
2196# ifdef SPLINES_VVISC
2197 ohz(i,k)=1.0_r8/hzk(i,k)
2198# endif
2199 END DO
2200 END DO
2201
2202
2203
2204# if defined DIAGNOSTICS_UV && defined MASKING
2205
2206
2207
2208
2209
2210
2211
2212# endif
2213
2214 DO k=1,n(ng)
2215 DO i=istru,iend
2216# ifdef DIAGNOSTICS_UV
2217# ifdef NEARSHORE_MELLOR
2218
2219
2220# endif
2221# ifdef UV_ADV
2222
2223
2224
2225
2226
2227
2228# endif
2229# if defined UV_VIS2 || defined UV_VIS4
2230
2231
2232
2233
2234
2235
2236# endif
2237# ifdef UV_COR
2238
2239
2240# endif
2241
2242
2243
2244
2245# endif
2246# ifdef NEARSHORE_MELLOR
2247# ifdef WET_DRY_NOT_YET
2248
2249
2250 ad_u_stokes(i,j,k)=ad_u_stokes(i,j,k)*umask_wet(i,j)
2251# endif
2252# ifdef MASKING
2253
2254
2255 ad_u_stokes(i,j,k)=ad_u_stokes(i,j,k)*umask(i,j)
2256# endif
2257
2258
2259 ad_dcs(i,0)=ad_dcs(i,0)-ad_u_stokes(i,j,k)
2260# endif
2261# ifdef WET_DRY_NOT_YET
2262
2263
2264 ad_u(i,j,k,nnew)=ad_u(i,j,k,nnew)*umask_wet(i,j)
2265# endif
2266# ifdef MASKING
2267
2268
2269 ad_u(i,j,k,nnew)=ad_u(i,j,k,nnew)*umask(i,j)
2270# endif
2271
2272
2273 ad_dc(i,0)=ad_dc(i,0)-ad_u(i,j,k,nnew)
2274 END DO
2275 END DO
2276
2277
2278
2279
2280 DO i=istru,iend
2281 cf(i,0)=hzk(i,1)
2282 dc(i,0)=u(i,j,1,nnew)*hzk(i,1)
2283 END DO
2284 DO k=2,n(ng)
2285 DO i=istru,iend
2286 cf(i,0)=cf(i,0)+hzk(i,k)
2287 dc(i,0)=dc(i,0)+u(i,j,k,nnew)*hzk(i,k)
2288 END DO
2289 END DO
2290 DO i=istru,iend
2291 dc1(i,0)=dc(i,0)
2292 cff1=1.0/(cf(i,0)*on_u(i,j))
2293 dc(i,0)=(dc(i,0)*on_u(i,j)-du_avg1(i,j))*cff1
2294# ifdef NEARSHORE_MELLOR
2295 dcs1(i)=dcs(i,0)
2296 cff2=1.0_r8/cf(i,0)
2297 dcs(i,0)=dcs(i,0)*cff2-ubar_stokes(i,j)
2298# endif
2299# ifdef DIAGNOSTICS_UV
2300
2301
2302
2303
2304
2305
2306
2307# endif
2308# ifdef NEARSHORE_MELLOR
2309
2310
2311
2312 ad_cff2=ad_cff2+dcs1(i)*ad_dcs(i,0)
2313 ad_ubar_stokes(i,j)=ad_ubar_stokes(i,j)-ad_dcs(i,0)
2314 ad_dcs(i,0)=cff2*ad_dcs(i,0)
2315
2316
2317 ad_cf(i,0)=ad_cf(i,0)-cff2*cff2*ad_cff2
2318 ad_cff2=0.0_r8
2319# endif
2320
2321
2322
2323 adfac=cff1*ad_dc(i,0)
2324 ad_du_avg1(i,j)=ad_du_avg1(i,j)-adfac
2325 ad_cff1=ad_cff1+ &
2326 & (dc1(i,0)*on_u(i,j)-du_avg1(i,j))*ad_dc(i,0)
2327 ad_dc(i,0)=on_u(i,j)*adfac
2328
2329
2330 ad_cf(i,0)=ad_cf(i,0)-cff1*cff1*on_u(i,j)*ad_cff1
2331 ad_cff1=0.0_r8
2332 END DO
2333 DO i=istru,iend
2334 cf(i,0)=hzk(i,1)
2335 dc(i,0)=u(i,j,1,nnew)*hzk(i,1)
2336 END DO
2337 DO k=2,n(ng)
2338 DO i=istru,iend
2339 cf(i,0)=cf(i,0)+hzk(i,k)
2340 dc(i,0)=dc(i,0)+u(i,j,k,nnew)*hzk(i,k)
2341# ifdef NEARSHORE_MELLOR
2342 dcs(i,0)=dcs(i,0)+u_stokes(i,j,k)*hzk(i,k)
2343# endif
2344# ifdef DIAGNOSTICS_UV
2345# ifdef NEARSHORE_MELLOR
2346
2347
2348# endif
2349# ifdef UV_ADV
2350
2351
2352
2353
2354
2355
2356# endif
2357# if defined UV_VIS2 || defined UV_VIS4
2358
2359
2360
2361
2362
2363
2364# endif
2365# ifdef UV_COR
2366
2367
2368# endif
2369
2370
2371
2372
2373# endif
2374# ifdef NEARSHORE_MELLOR
2375
2376
2377
2378
2379 ad_u_stokes(i,j,k)=ad_u_stokes(i,j,k)+hzk(i,k)*ad_dcs(i,0)
2380 ad_hzk(i,k)=ad_hzk(i,k)+u_stokes(i,j,k)*ad_dcs(i,0)
2381# endif
2382
2383
2384
2385
2386 ad_u(i,j,k,nnew)=ad_u(i,j,k,nnew)+ad_dc(i,0)*hzk(i,k)
2387 ad_hzk(i,k)=ad_hzk(i,k)+u(i,j,k,nnew)*ad_dc(i,0)
2388
2389
2390 ad_hzk(i,k)=ad_hzk(i,k)+ad_cf(i,0)
2391 END DO
2392 END DO
2393 DO i=istru,iend
2394 cf(i,0)=hzk(i,1)
2395 dc(i,0)=u(i,j,1,nnew)*hzk(i,1)
2396# ifdef NEARSHORE_MELLOR
2397 dcs(i,0)=u_stokes(i,j,1)*hzk(i,1)
2398# endif
2399# ifdef DIAGNOSTICS_UV
2400# ifdef NEARSHORE_MELLOR
2401
2402# endif
2403# ifdef UV_ADV
2404
2405
2406
2407# endif
2408# if defined UV_VIS2 || defined UV_VIS4
2409
2410
2411
2412# endif
2413# ifdef UV_COR
2414
2415# endif
2416
2417
2418# endif
2419# ifdef NEARSHORE_MELLOR
2420
2421
2422
2423 ad_u_stokes(i,j,1)=ad_u_stokes(i,j,1)+hzk(i,1)*ad_dcs(i,0)
2424 ad_hzk(i,1)=ad_hzk(i,1)+u_stokes(i,j,1)*ad_dcs(i,0)
2425 ad_dcs(i,0)=0.0_r8
2426# endif
2427
2428
2429
2430 ad_u(i,j,1,nnew)=ad_u(i,j,1,nnew)+ad_dc(i,0)*hzk(i,1)
2431 ad_hzk(i,1)=ad_hzk(i,1)+u(i,j,1,nnew)*ad_dc(i,0)
2432 ad_dc(i,0)=0.0_r8
2433
2434
2435 ad_hzk(i,1)=ad_hzk(i,1)+ad_cf(i,0)
2436 ad_cf(i,0)=0.0_r8
2437 END DO
2438
2439# if defined SPLINES_VVISC
2440
2441
2442
2443
2444
2445
2446 cff1=1.0_r8/6.0_r8
2447 DO k=1,n(ng)-1
2448 DO i=istru,iend
2449 fc(i,k)=cff1*hzk(i,k )-dt(ng)*ak(i,k-1)*ohz(i,k )
2450 cf(i,k)=cff1*hzk(i,k+1)-dt(ng)*ak(i,k+1)*ohz(i,k+1)
2451 END DO
2452 END DO
2453 DO i=istru,iend
2454 cf(i,0)=0.0_r8
2455 dc(i,0)=0.0_r8
2456 END DO
2457
2458
2459
2460 cff1=1.0_r8/3.0_r8
2461 DO k=1,n(ng)-1
2462 DO i=istru,iend
2463 bc(i,k)=cff1*(hzk(i,k)+hzk(i,k+1))+ &
2464 & dt(ng)*ak(i,k)*(ohz(i,k)+ohz(i,k+1))
2465 cff=1.0_r8/(bc(i,k)-fc(i,k)*cf(i,k-1))
2466 cf(i,k)=cff*cf(i,k)
2467 dc(i,k)=cff*(u(i,j,k+1,nnew)-u(i,j,k,nnew)- &
2468 & fc(i,k)*dc(i,k-1))
2469 END DO
2470 END DO
2471
2472
2473
2474
2475 DO i=istru,iend
2476 dc(i,n(ng))=0.0_r8
2477 END DO
2478 DO k=n(ng)-1,1,-1
2479 DO i=istru,iend
2480 dc(i,k)=dc(i,k)-cf(i,k)*dc(i,k+1)
2481 END DO
2482 END DO
2483
2484
2485
2486 DO k=0,n(ng)
2487 DO i=istru,iend
2488 dc1(i,k)=dc(i,k)*ak(i,k)
2489 END DO
2490 END DO
2491
2492
2493 DO k=n(ng),1,-1
2494 DO i=istru,iend
2495# ifdef DIAGNOSTICS_UV
2496
2497# endif
2498
2499
2500 ad_cff=ad_cff+ad_u(i,j,k,nnew)
2501
2502
2503
2504 adfac=dt(ng)*ad_cff
2505 adfac1=adfac*ohz(i,k)
2506 ad_dc(i,k-1)=ad_dc(i,k-1)-adfac1
2507 ad_dc(i,k )=ad_dc(i,k )+adfac1
2508 ad_ohz(i,k)=ad_ohz(i,k)+(dc1(i,k)-dc1(i,k-1))*adfac
2509 ad_cff=0.0_r8
2510
2511
2512 ad_ak(i,k)=ad_ak(i,k)+dc(i,k)*ad_dc(i,k)
2513 ad_dc(i,k)=ak(i,k)*ad_dc(i,k)
2514 END DO
2515 END DO
2516
2517
2518
2519 DO k=1,n(ng)-1
2520 DO i=istru,iend
2521
2522
2523 ad_dc(i,k+1)=ad_dc(i,k+1)-cf(i,k)*ad_dc(i,k)
2524 END DO
2525 END DO
2526 DO i=istru,iend
2527
2528
2529 ad_dc(i,n(ng))=0.0_r8
2530 END DO
2531
2532
2533
2534 cff1=1.0_r8/3.0_r8
2535 DO k=n(ng)-1,1,-1
2536 DO i=istru,iend
2537 bc(i,k)=cff1*(hzk(i,k)+hzk(i,k+1))+ &
2538 & dt(ng)*ak(i,k)*(ohz(i,k)+ohz(i,k+1))
2539 cff=1.0_r8/(bc(i,k)-fc(i,k)*cf(i,k-1))
2540
2541
2542
2543
2544
2545
2546
2547 adfac=cff*ad_dc(i,k)
2548 ad_dc(i,k-1)=ad_dc(i,k-1)-fc(i,k)*adfac
2549 ad_cf(i,k)=ad_cf(i,k)-dc(i,k+1)*adfac
2550 ad_bc(i,k)=ad_bc(i,k)-dc(i,k )*adfac
2551 ad_fc(i,k)=ad_fc(i,k)-dc(i,k-1)*adfac
2552 ad_u(i,j,k ,nnew)=ad_u(i,j,k ,nnew)-adfac
2553 ad_u(i,j,k+1,nnew)=ad_u(i,j,k+1,nnew)+adfac
2554 ad_dc(i,k)=0.0_r8
2555
2556
2557
2558
2559 adfac=dt(ng)*ad_bc(i,k)
2560 adfac1=adfac*ak(i,k)
2561 adfac2=cff1*ad_bc(i,k)
2562 ad_ohz(i,k )=ad_ohz(i,k )+adfac1
2563 ad_ohz(i,k+1)=ad_ohz(i,k+1)+adfac1
2564 ad_ak(i,k)=ad_ak(i,k)+(ohz(i,k)+ohz(i,k+1))*adfac
2565 ad_hzk(i,k )=ad_hzk(i,k )+adfac2
2566 ad_hzk(i,k+1)=ad_hzk(i,k+1)+adfac2
2567 ad_bc(i,k)=0.0_r8
2568 END DO
2569 END DO
2570
2571
2572
2573
2574
2575 DO i=istru,iend
2576
2577
2578 ad_dc(i,0)=0.0_r8
2579
2580
2581 ad_cf(i,0)=0.0_r8
2582 END DO
2583 cff1=1.0_r8/6.0_r8
2584 DO k=1,n(ng)-1
2585 DO i=istru,iend
2586
2587
2588
2589
2590 adfac=dt(ng)*ad_cf(i,k)
2591 ad_ohz(i,k+1)=ad_ohz(i,k+1)-ak(i,k+1)*adfac
2592 ad_ak(i,k+1)=ad_ak(i,k+1)-ohz(i,k+1)*adfac
2593 ad_hzk(i,k+1)=ad_hzk(i,k+1)+cff1*ad_cf(i,k)
2594 ad_cf(i,k)=0.0_r8
2595
2596
2597
2598
2599 adfac=dt(ng)*ad_fc(i,k)
2600 ad_ohz(i,k)=ad_ohz(i,k)-ak(i,k-1)*adfac
2601 ad_ak(i,k-1)=ad_ak(i,k-1)-ohz(i,k)*adfac
2602 ad_hzk(i,k)=ad_hzk(i,k)+cff1*ad_fc(i,k)
2603 ad_fc(i,k)=0.0_r8
2604 END DO
2605 END DO
2606# else
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618 cff=-lambda*dt(ng)/0.5_r8
2619 DO k=1,n(ng)-1
2620 DO i=istru,iend
2621 cff1=1.0_r8/(z_r(i,j,k+1)+z_r(i-1,j,k+1)- &
2622 & z_r(i,j,k )-z_r(i-1,j,k ))
2623 fc(i,k)=cff*cff1*ak(i,k)
2624 END DO
2625 END DO
2626 DO i=istru,iend
2627 fc(i,0)=0.0_r8
2628 fc(i,n(ng))=0.0_r8
2629 END DO
2630 DO k=1,n(ng)
2631 DO i=istru,iend
2632 bc(i,k)=hzk(i,k)-fc(i,k)-fc(i,k-1)
2633 END DO
2634 END DO
2635 DO i=istru,iend
2636 cff=1.0_r8/bc(i,1)
2637 cf(i,1)=cff*fc(i,1)
2638 END DO
2639 DO k=2,n(ng)-1
2640 DO i=istru,iend
2641 cff=1.0_r8/(bc(i,k)-fc(i,k-1)*cf(i,k-1))
2642 cf(i,k)=cff*fc(i,k)
2643 END DO
2644 END DO
2645
2646
2647
2648
2649
2650
2651 DO k=1,n(ng)-1
2652 DO i=istru,iend
2653# ifdef DIAGNOSTICS_UV
2654
2655
2656# endif
2657
2658
2659 ad_dc(i,k)=ad_dc(i,k)+ad_u(i,j,k,nnew)
2660 ad_u(i,j,k,nnew)=0.0_r8
2661
2662
2663 ad_dc(i,k+1)=-cf(i,k)*ad_dc(i,k)
2664# ifdef DIAGNOSTICS_UV
2665
2666# endif
2667 END DO
2668 END DO
2669 DO i=istru,iend
2670# ifdef DIAGNOSTICS_UV
2671
2672
2673# endif
2674
2675
2676 ad_dc(i,n(ng))=ad_dc(i,n(ng))+ad_u(i,j,n(ng),nnew)
2677 ad_u(i,j,n(ng),nnew)=0.0_r8
2678
2679
2680
2681 adfac=ad_dc(i,n(ng))/ &
2682 & (bc(i,n(ng))-fc(i,n(ng)-1)*cf(i,n(ng)-1))
2683 ad_dc(i,n(ng)-1)=ad_dc(i,n(ng)-1)-fc(i,n(ng)-1)*adfac
2684 ad_dc(i,n(ng) )=adfac
2685 END DO
2686
2687
2688
2689
2690
2691
2692 DO k=n(ng)-1,2,-1
2693 DO i=istru,iend
2694 cff=1.0_r8/(bc(i,k)-fc(i,k-1)*cf(i,k-1))
2695
2696
2697 adfac=cff*ad_dc(i,k)
2698 ad_dc(i,k-1)=ad_dc(i,k-1)-fc(i,k-1)*adfac
2699 ad_dc(i,k )=adfac
2700 END DO
2701 END DO
2702 DO i=istru,iend
2703 cff=1.0_r8/bc(i,1)
2704
2705
2706 ad_dc(i,1)=cff*ad_dc(i,1)
2707 END DO
2708 DO i=istru,iend
2709
2710
2711
2712
2713 ad_bc(i,n(ng) )=-u(i,j,n(ng) ,nnew)*ad_dc(i,n(ng))
2714 ad_fc(i,n(ng)-1)=-u(i,j,n(ng)-1,nnew)*ad_dc(i,n(ng))
2715 ad_u(i,j,n(ng),nnew)=ad_dc(i,n(ng))
2716 ad_dc(i,n(ng))=0.0_r8
2717
2718
2719
2720
2721 ad_fc(i,1)=-u(i,j,2,nnew)*ad_dc(i,1)
2722 ad_bc(i,1)=-u(i,j,1,nnew)*ad_dc(i,1)
2723 ad_u(i,j,1,nnew)=ad_dc(i,1)
2724 ad_dc(i,1)=0.0_r8
2725 END DO
2726 DO k=2,n(ng)-1
2727 DO i=istru,iend
2728
2729
2730
2731
2732
2733 ad_fc(i,k-1)=ad_fc(i,k-1)-u(i,j,k-1,nnew)*ad_dc(i,k)
2734 ad_fc(i,k )=ad_fc(i,k )-u(i,j,k+1,nnew)*ad_dc(i,k)
2735 ad_bc(i,k )=ad_bc(i,k )-u(i,j,k ,nnew)*ad_dc(i,k)
2736 ad_u(i,j,k,nnew)=ad_u(i,j,k,nnew)+ad_dc(i,k)
2737 ad_dc(i,k)=0.0_r8
2738 END DO
2739 END DO
2740 DO k=1,n(ng)
2741 DO i=istru,iend
2742
2743
2744 ad_hzk(i,k)=ad_hzk(i,k)+ad_bc(i,k)
2745 ad_fc(i,k-1)=ad_fc(i,k-1)-ad_bc(i,k)
2746 ad_fc(i,k )=ad_fc(i,k )-ad_bc(i,k)
2747 ad_bc(i,k)=0.0_r8
2748 END DO
2749 END DO
2750
2751
2752
2753
2754
2755 DO i=istru,iend
2756
2757
2758 ad_fc(i,n)=0.0_r8
2759
2760
2761 ad_fc(i,0)=0.0_r8
2762 END DO
2763 cff=-lambda*dt(ng)/0.5_r8
2764 DO k=1,n(ng)-1
2765 DO i=istru,iend
2766 cff1=1.0_r8/(z_r(i,j,k+1)+z_r(i-1,j,k+1)- &
2767 & z_r(i,j,k )-z_r(i-1,j,k ))
2768
2769
2770 adfac=cff*ad_fc(i,k)
2771 ad_ak(i,k)=ad_ak(i,k)+cff1*adfac
2772 ad_cff1=ad_cff1+ak(i,k)*adfac
2773 ad_fc(i,k)=0.0_r8
2774
2775
2776
2777 adfac=-cff1*cff1*ad_cff1
2778 ad_z_r(i-1,j,k )=ad_z_r(i-1,j,k )-adfac
2779 ad_z_r(i ,j,k )=ad_z_r(i ,j,k )-adfac
2780 ad_z_r(i-1,j,k+1)=ad_z_r(i-1,j,k+1)+adfac
2781 ad_z_r(i ,j,k+1)=ad_z_r(i ,j,k+1)+adfac
2782 ad_cff1=0.0_r8
2783 END DO
2784 END DO
2785# endif
2786
2787
2788
2789 IF (iic(ng).eq.ntfirst(ng)) THEN
2790 cff=0.25_r8*dt(ng)
2791 ELSE IF (iic(ng).eq.(ntfirst(ng)+1)) THEN
2792 cff=0.25_r8*dt(ng)*3.0_r8/2.0_r8
2793 ELSE
2794 cff=0.25_r8*dt(ng)*23.0_r8/12.0_r8
2795 END IF
2796 DO i=istru,iend
2797 dc(i,0)=cff*(pm(i,j)+pm(i-1,j))*(pn(i,j)+pn(i-1,j))
2798 END DO
2799
2800
2801
2802
2803 DO k=1,n(ng)
2804 DO i=istru,iend
2805# ifdef DIAGNOSTICS_UV
2806
2807# ifdef BODYFORCE
2808
2809
2810
2811# endif
2812
2813# if defined UV_VIS2 || defined UV_VIS4
2814
2815
2816
2817# endif
2818
2819
2820
2821
2822
2823# endif
2824# ifdef SPLINES_VVISC
2825
2826
2827
2828 ad_ohz(i,k)=ad_ohz(i,k)+ &
2829 & (u(i,j,k,nnew)*hzk(i,k))*ad_u(i,j,k,nnew)
2830 ad_u(i,j,k,nnew)=ad_u(i,j,k,nnew)*ohz(i,k)
2831# endif
2832
2833
2834
2835 ad_ru(i,j,k,nrhs)=ad_ru(i,j,k,nrhs)+ &
2836 & dc(i,0)*ad_u(i,j,k,nnew)
2837 END DO
2838 END DO
2839 DO i=istru,iend
2840 DO k=1,n(ng)
2841# if defined SPLINES_VVISC || defined DIAGNOSTICS_UV
2842 ohz(i,k)=1.0_r8/hzk(i,k)
2843
2844
2845 ad_hzk(i,k)=ad_hzk(i,k)-ohz(i,k)*ohz(i,k)*ad_ohz(i,k)
2846 ad_ohz(i,k)=0.0_r8
2847# endif
2848
2849
2850
2851 adfac=0.5_r8*ad_hzk(i,k)
2852 ad_hz(i-1,j,k)=ad_hz(i-1,j,k)+adfac
2853 ad_hz(i ,j,k)=ad_hz(i ,j,k)+adfac
2854 ad_hzk(i,k)=0.0_r8
2855
2856
2857
2858 adfac=0.5_r8*ad_ak(i,k)
2859 ad_akv(i-1,j,k)=ad_akv(i-1,j,k)+adfac
2860 ad_akv(i ,j,k)=ad_akv(i ,j,k)+adfac
2861 ad_ak(i,k)=0.0_r8
2862 END DO
2863
2864
2865
2866 adfac=0.5_r8*ad_ak(i,0)
2867 ad_akv(i-1,j,0)=ad_akv(i-1,j,0)+adfac
2868 ad_akv(i ,j,0)=ad_akv(i ,j,0)+adfac
2869 ad_ak(i,0)=0.0_r8
2870 END DO
2871 END DO j_loop2
2872
2873# ifdef AD_OUTPUT_STATE
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883 DO j=jstrb,jendb
2884 IF (j.ge.jstrm) THEN
2885 DO k=1,n(ng)
2886 DO i=istrb,iendb
2887 ad_v_sol(i,j,k)=ad_v(i,j,k,nnew)
2888 END DO
2889 END DO
2890 END IF
2891 DO k=1,n(ng)
2892 DO i=istrm,iendb
2893 ad_u_sol(i,j,k)=ad_u(i,j,k,nnew)
2894 END DO
2895 END DO
2896 END DO
2897# endif
2898
2899 RETURN