 Timestamp:
 20181003T15:52:45+02:00 (2 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

NEMO/branches/2018/dev_r10057_ENHANCE03_ZTILDE/src/OCE/DOM/domvvl.F90
r10164 r10167 230 230 frq_rst_e3t(:,:) = 0.0_wp 231 231 frq_rst_hdv(:,:) = 1.0_wp / rdt 232 rn_lf_cutoff = 2.0_wp * rpi * rdt / 86400._wp 232 233 tildemask(:,:) = 0._wp 233 234 ENDIF … … 289 290 IF( ln_vvl_layer ) THEN 290 291 IF ( ln_vvl_zstar_on_shelf ) THEN 291 zhmin = 100._wp292 zhmax = 1 50._wp292 zhmin = 50._wp 293 zhmax = 100._wp 293 294 DO jj = 1, jpj 294 295 DO ji = 1, jpi … … 1000 1001 ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 1001 1002 END DO 1003 1004 ! Output some diagnostics: 1005 !  1006 IF (ln_vvl_ztilde .OR. ln_vvl_layer) CALL dom_vvl_dia( kt ) 1002 1007 1003 1008 ! write restart file … … 2513 2518 END SUBROUTINE nonosc_2d 2514 2519 2520 SUBROUTINE dom_vvl_dia( kt ) 2521 !! 2522 !! *** ROUTINE dom_vvl_dia *** 2523 !! 2524 !! ** Purpose : Output some diagnostics in ztilde/zlayer cases 2525 !! 2526 !! 2527 !! * Arguments 2528 INTEGER, INTENT( in ) :: kt ! time step 2529 !! * Local declarations 2530 INTEGER :: ji,jj,jk,jkbot ! dummy loop indices 2531 REAL(wp) :: ztmp1 2532 REAL(wp), DIMENSION(4) :: zr1 2533 REAL(wp), DIMENSION(jpi,jpj ) :: zout2d 2534 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwdw, zout 2535 !! 2536 IF( ln_timing ) CALL timing_start('dom_vvl_dia') 2537 ! 2538 ! Compute internal interfaces depths: 2539 ! 2540 IF ( iom_use("dh_tilde").OR.iom_use("depw_tilde").OR.iom_use("stiff_tilde")) THEN 2541 zwdw(:,:,1) = 0.e0 2542 DO jj = 1, jpj 2543 DO ji = 1, jpi 2544 DO jk = 2, jpkm1 2545 zwdw(ji,jj,jk) = zwdw(ji,jj,jk1) + & 2546 & (tilde_e3t_n(ji,jj,jk1)+e3t_0(ji,jj,jk1)) * tmask(ji,jj,jk1) 2547 END DO 2548 END DO 2549 END DO 2550 ENDIF 2551 ! 2552 ! Output interface depth anomaly: 2553 !  2554 IF ( iom_use("depw_tilde") ) CALL iom_put( "depw_tilde", (zwdw(:,:,:)gdepw_0(:,:,:))*tmask(:,:,:) ) 2555 ! 2556 ! Output grid stiffness (Tpoints): 2557 !  2558 IF ( iom_use("stiff_tilde" ) ) THEN 2559 zr1(:) = 0.e0 2560 zout(:,:,:) = 0.e0 2561 zout2d(:,:) = 0.e0 2562 DO ji = 2, jpim1 2563 DO jj = 2, jpjm1 2564 ! Exclude last level because of partial bottom cells 2565 jkbot = MIN(mbkt(ji,jj)1,mbkt(ji1,jj)1,mbkt(ji+1,jj)1,mbkt(ji,jj1)1,mbkt(ji,jj+1)1) 2566 DO jk = 1, jkbot 2567 zr1(1) = umask(ji1,jj ,jk) *abs( (zwdw(ji ,jj ,jk )zwdw(ji1,jj ,jk ) & 2568 & +zwdw(ji ,jj ,jk+1)zwdw(ji1,jj ,jk+1)) & 2569 & /(zwdw(ji ,jj ,jk )+zwdw(ji1,jj ,jk ) & 2570 & zwdw(ji ,jj ,jk+1)zwdw(ji1,jj ,jk+1) + rsmall) ) 2571 zr1(2) = umask(ji ,jj ,jk) *abs( (zwdw(ji+1,jj ,jk )zwdw(ji ,jj ,jk ) & 2572 & +zwdw(ji+1,jj ,jk+1)zwdw(ji ,jj ,jk+1)) & 2573 & /(zwdw(ji+1,jj ,jk )+zwdw(ji ,jj ,jk ) & 2574 & zwdw(ji+1,jj ,jk+1)zwdw(ji ,jj ,jk+1) + rsmall) ) 2575 zr1(3) = vmask(ji ,jj ,jk) *abs( (zwdw(ji ,jj+1,jk )zwdw(ji ,jj ,jk ) & 2576 & +zwdw(ji ,jj+1,jk+1)zwdw(ji ,jj ,jk+1)) & 2577 & /(zwdw(ji ,jj+1,jk )+zwdw(ji ,jj ,jk ) & 2578 & zwdw(ji ,jj+1,jk+1)zwdw(ji ,jj ,jk+1) + rsmall) ) 2579 zr1(4) = vmask(ji ,jj1,jk) *abs( (zwdw(ji ,jj ,jk )zwdw(ji ,jj1,jk ) & 2580 & +zwdw(ji ,jj ,jk+1)zwdw(ji ,jj1,jk+1)) & 2581 & /(zwdw(ji ,jj ,jk )+zwdw(ji ,jj1,jk ) & 2582 & zwdw(ji, jj ,jk+1)zwdw(ji ,jj1,jk+1) + rsmall) ) 2583 ztmp1 = MAXVAL( zr1(1:4) ) 2584 zout(ji,jj,jk) = ztmp1 2585 zout2d(ji,jj) = MAX( zout2d(ji,jj), ztmp1 ) 2586 END DO 2587 END DO 2588 END DO 2589 CALL lbc_lnk( zout2d(:,:), 'T', 1. ) 2590 CALL iom_put( "stiff_tilde", zout2d(:,:) ) 2591 END IF 2592 ! Output Horizontal Laplacian of interfaces depths (Wpoints): 2593 !  2594 IF ( iom_use("dh_tilde") ) THEN 2595 ! 2596 zout(:,:,1 )=0._wp 2597 zout(:,:,:)=0._wp 2598 DO jk = 2, jpkm1 2599 DO jj = 1, jpjm1 2600 DO ji = 1, fs_jpim1 ! vector opt. 2601 ua(ji,jj,jk) = umask(ji,jj,jk) * e2_e1u(ji,jj) & 2602 & * ( zwdw(ji,jj,jk)  zwdw(ji+1,jj ,jk) ) 2603 va(ji,jj,jk) = vmask(ji,jj,jk) * e1_e2v(ji,jj) & 2604 & * ( zwdw(ji,jj,jk)  zwdw(ji ,jj+1,jk) ) 2605 END DO 2606 END DO 2607 END DO 2608 2609 DO jk = 2, jpkm1 2610 DO jj = 2, jpjm1 2611 DO ji = fs_2, fs_jpim1 ! vector opt. 2612 ztmp1 = ( (ua(ji1,jj ,jk)  ua(ji,jj,jk)) & 2613 & + (va(ji ,jj1,jk)  va(ji,jj,jk)) ) * SQRT(r1_e1e2t(ji,jj)) 2614 zout(ji,jj,jk) = ABS(ztmp1)*tmask(ji,jj,jk) 2615 END DO 2616 END DO 2617 END DO 2618 ! Mask open boundaries: 2619 #if defined key_bdy 2620 IF (lk_bdy) THEN 2621 DO jk = 1, jpkm1 2622 zout(:,:,jk) = zout(:,:,jk) * bdytmask(:,:) 2623 END DO 2624 ENDIF 2625 #endif 2626 zout2d(:,:) = 0.e0 2627 DO jk=1,jpkm1 2628 zout2d(:,:) = max( zout2d(:,:), zout(:,:,jk)) 2629 END DO 2630 CALL lbc_lnk( zout2d(:,:), 'T', 1. ) 2631 ! 2632 CALL iom_put( "dh_tilde", zout2d(:,:) ) 2633 ENDIF 2634 ! 2635 ! Output vertical Laplacian of interfaces depths (Wpoints): 2636 !  2637 IF ( iom_use("dz_tilde" ) ) THEN 2638 zout(:,:,1 ) = 0._wp 2639 zout(:,:,:) = 0._wp 2640 DO ji = 2, jpim1 2641 DO jj = 2, jpjm1 2642 DO jk=2,mbkt(ji,jj)1 2643 zout(ji,jj,jk) = 2._wp*ABS(tilde_e3t_n(ji,jj,jk)+e3t_0(ji,jj,jk)tilde_e3t_n(ji,jj,jk1)e3t_0(ji,jj,jk1)) & 2644 & /(tilde_e3t_n(ji,jj,jk)+e3t_0(ji,jj,jk)+tilde_e3t_n(ji,jj,jk1)+e3t_0(ji,jj,jk1)) & 2645 & * tmask(ji,jj,jk) 2646 END DO 2647 END DO 2648 END DO 2649 zout2d(:,:) = 0.e0 2650 DO jk=1,jpkm1 2651 zout2d(:,:) = max( zout2d(:,:), zout(:,:,jk)) 2652 END DO 2653 CALL lbc_lnk( zout2d(:,:), 'T', 1. ) 2654 CALL iom_put( "dz_tilde", zout2d(:,:) ) 2655 2656 END IF 2657 ! 2658 ! 2659 ! Output low pass Uvelocity: 2660 !  2661 IF ( iom_use("un_lf_tilde" ).AND.ln_vvl_ztilde ) THEN 2662 zout(:,:,jpk) = 0.e0 2663 DO jk=1,jpkm1 2664 zout(:,:,jk) = un_lf(:,:,jk,1)/e3u_n(:,:,jk)*r1_e2u(:,:) 2665 END DO 2666 CALL iom_put( "un_lf_tilde", zout(:,:,:) ) 2667 END IF 2668 ! 2669 ! Output low pass Vvelocity: 2670 !  2671 IF ( iom_use("vn_lf_tilde" ).AND.ln_vvl_ztilde ) THEN 2672 zout(:,:,jpk) = 0.e0 2673 DO jk=1,jpkm1 2674 zout(:,:,jk) = vn_lf(:,:,jk,1)/e3v_n(:,:,jk)*r1_e1v(:,:) 2675 END DO 2676 CALL iom_put( "vn_lf_tilde", zout(:,:,:) ) 2677 END IF 2678 ! 2679 ! Barotropic cell thickness anomaly: 2680 !  2681 IF( iom_use("e3t_star") ) THEN 2682 zout(:,:,:) = (e3t_n(:,:,:)tilde_e3t_n(:,:,:)e3t_0(:,:,:))*tmask(:,:,:) 2683 CALL iom_put( "e3t_star" , zout(:,:,:) ) 2684 ENDIF 2685 ! 2686 ! Baroclinic cell thickness anomaly: 2687 !  2688 IF( iom_use("e3t_tilde") ) THEN 2689 CALL iom_put( "e3t_tilde" , tilde_e3t_n(:,:,:) ) 2690 ENDIF 2691 ! 2692 IF( ln_timing ) CALL timing_stop('dom_vvl_dia') 2693 ! 2694 END SUBROUTINE dom_vvl_dia 2695 2515 2696 !!====================================================================== 2516 2697 END MODULE domvvl
Note: See TracChangeset
for help on using the changeset viewer.