- Timestamp:
- 2017-12-13T15:58:53+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
r7753 r9019 30 30 USE lib_mpp ! distribued memory computing library 31 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 32 USE wrk_nemo ! work arrays33 32 USE timing ! timing 34 33 … … 45 44 ! !!* Namelist namtra_ldf : lateral mixing on tracers * 46 45 ! != Operator type =! 46 LOGICAL , PUBLIC :: ln_traldf_NONE !: no operator: No explicit diffusion 47 47 LOGICAL , PUBLIC :: ln_traldf_lap !: laplacian operator 48 48 LOGICAL , PUBLIC :: ln_traldf_blp !: bilaplacian operator … … 119 119 INTEGER :: ierr, inum, ios ! local integer 120 120 REAL(wp) :: zah0 ! local scalar 121 ! 122 NAMELIST/namtra_ldf/ ln_traldf_ lap, ln_traldf_blp ,& ! type of operator123 & ln_traldf_lev , ln_traldf_hor , ln_traldf_triad, & ! acting direction of the operator124 & ln_traldf_iso , ln_traldf_msc , rn_slpmax , & ! option for iso-neutral operator125 & ln_triad_iso , ln_botmix_triad, rn_sw_triad , & ! option for triad operator126 & rn_aht_0 , rn_bht_0 , nn_aht_ijk_t ! lateral eddy coefficient121 !! 122 NAMELIST/namtra_ldf/ ln_traldf_NONE, ln_traldf_lap , ln_traldf_blp , & ! type of operator 123 & ln_traldf_lev , ln_traldf_hor , ln_traldf_triad, & ! acting direction of the operator 124 & ln_traldf_iso , ln_traldf_msc , rn_slpmax , & ! option for iso-neutral operator 125 & ln_triad_iso , ln_botmix_triad, rn_sw_triad , & ! option for triad operator 126 & rn_aht_0 , rn_bht_0 , nn_aht_ijk_t ! lateral eddy coefficient 127 127 !!---------------------------------------------------------------------- 128 128 ! … … 144 144 WRITE(numout,*) '~~~~~~~~~~~~ ' 145 145 WRITE(numout,*) ' Namelist namtra_ldf : lateral mixing parameters (type, direction, coefficients)' 146 !147 146 WRITE(numout,*) ' type :' 147 WRITE(numout,*) ' no explicit diffusion ln_traldf_NONE = ', ln_traldf_NONE 148 148 WRITE(numout,*) ' laplacian operator ln_traldf_lap = ', ln_traldf_lap 149 149 WRITE(numout,*) ' bilaplacian operator ln_traldf_blp = ', ln_traldf_blp 150 !151 150 WRITE(numout,*) ' direction of action :' 152 151 WRITE(numout,*) ' iso-level ln_traldf_lev = ', ln_traldf_lev … … 159 158 WRITE(numout,*) ' switching triad or not rn_sw_triad = ', rn_sw_triad 160 159 WRITE(numout,*) ' lateral mixing on bottom ln_botmix_triad = ', ln_botmix_triad 161 !162 160 WRITE(numout,*) ' coefficients :' 163 161 WRITE(numout,*) ' lateral eddy diffusivity (lap case) rn_aht_0 = ', rn_aht_0 … … 168 166 ! ! Parameter control 169 167 ! 170 IF( .NOT.ln_traldf_lap .AND. .NOT.ln_traldf_blp) THEN168 IF( ln_traldf_NONE ) THEN 171 169 IF(lwp) WRITE(numout,*) ' No diffusive operator selected. ahtu and ahtv are not allocated' 172 170 l_ldftra_time = .FALSE. … … 490 488 ! 491 489 INTEGER :: ji, jj, jk ! dummy loop indices 492 REAL(wp) :: zfw, ze3w, zn2, z1_f20, zaht, zaht_min, zzaei ! local scalars 493 REAL(wp), DIMENSION(:,:), POINTER :: zn, zah, zhw, zross, zaeiw ! 2D workspace 494 !!---------------------------------------------------------------------- 495 ! 496 IF( nn_timing == 1 ) CALL timing_start('ldf_eiv') 497 ! 498 CALL wrk_alloc( jpi,jpj, zn, zah, zhw, zross, zaeiw ) 499 ! 490 REAL(wp) :: zfw, ze3w, zn2, z1_f20, zaht, zaht_min, zzaei ! local scalars 491 REAL(wp), DIMENSION(jpi,jpj) :: zn, zah, zhw, zross, zaeiw ! 2D workspace 492 !!---------------------------------------------------------------------- 493 ! 494 IF( ln_timing ) CALL timing_start('ldf_eiv') 495 ! 500 496 zn (:,:) = 0._wp ! Local initialization 501 497 zhw (:,:) = 5._wp … … 575 571 END DO 576 572 ! 577 CALL wrk_dealloc( jpi,jpj, zn, zah, zhw, zross, zaeiw ) 578 ! 579 IF( nn_timing == 1 ) CALL timing_stop('ldf_eiv') 573 IF( ln_timing ) CALL timing_stop('ldf_eiv') 580 574 ! 581 575 END SUBROUTINE ldf_eiv … … 610 604 REAL(wp) :: zuwk, zuwk1, zuwi, zuwi1 ! local scalars 611 605 REAL(wp) :: zvwk, zvwk1, zvwj, zvwj1 ! - - 612 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpsi_uw, zpsi_vw 613 !!---------------------------------------------------------------------- 614 ! 615 IF( nn_timing == 1 ) CALL timing_start( 'ldf_eiv_trp') 616 ! 617 CALL wrk_alloc( jpi,jpj,jpk, zpsi_uw, zpsi_vw ) 618 606 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpsi_uw, zpsi_vw 607 !!---------------------------------------------------------------------- 608 ! 609 IF( ln_timing ) CALL timing_start( 'ldf_eiv_trp') 610 ! 619 611 IF( kt == kit000 ) THEN 620 612 IF(lwp) WRITE(numout,*) … … 658 650 IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) CALL ldf_eiv_dia( zpsi_uw, zpsi_vw ) 659 651 ! 660 CALL wrk_dealloc( jpi,jpj,jpk, zpsi_uw, zpsi_vw ) 661 ! 662 IF( nn_timing == 1 ) CALL timing_stop( 'ldf_eiv_trp') 652 IF( ln_timing ) CALL timing_stop( 'ldf_eiv_trp') 663 653 ! 664 654 END SUBROUTINE ldf_eiv_trp … … 679 669 INTEGER :: ji, jj, jk ! dummy loop indices 680 670 REAL(wp) :: zztmp ! local scalar 681 REAL(wp), DIMENSION(:,:) , POINTER :: zw2d ! 2D workspace 682 REAL(wp), DIMENSION(:,:,:), POINTER :: zw3d ! 3D workspace 683 !!---------------------------------------------------------------------- 684 ! 685 IF( nn_timing == 1 ) CALL timing_start( 'ldf_eiv_dia') 671 REAL(wp), DIMENSION(jpi,jpj) :: zw2d ! 2D workspace 672 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d ! 3D workspace 673 !!---------------------------------------------------------------------- 674 ! 675 !!gm I don't like this routine.... Crazy way of doing things, not optimal at all... 676 !!gm to be redesigned.... 677 IF( ln_timing ) CALL timing_start( 'ldf_eiv_dia') 686 678 ! 687 679 ! !== eiv stream function: output ==! … … 693 685 ! 694 686 ! !== eiv velocities: calculate and output ==! 695 CALL wrk_alloc( jpi,jpj,jpk, zw3d )696 687 ! 697 688 zw3d(:,:,jpk) = 0._wp ! bottom value always 0 … … 718 709 CALL iom_put( "woce_eiv", zw3d ) 719 710 ! 720 !721 !722 CALL wrk_alloc( jpi,jpj, zw2d )723 711 ! 724 712 zztmp = 0.5_wp * rau0 * rcp … … 792 780 IF( ln_diaptr ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d ) 793 781 ! 794 CALL wrk_dealloc( jpi,jpj, zw2d ) 795 CALL wrk_dealloc( jpi,jpj,jpk, zw3d ) 796 ! 797 IF( nn_timing == 1 ) CALL timing_stop( 'ldf_eiv_dia') 782 ! 783 IF( ln_timing ) CALL timing_stop( 'ldf_eiv_dia') 798 784 ! 799 785 END SUBROUTINE ldf_eiv_dia
Note: See TracChangeset
for help on using the changeset viewer.