Changeset 8882 for branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/LDF
- Timestamp:
- 2017-12-01T18:44:09+01:00 (6 years ago)
- Location:
- branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/LDF
- Files:
-
- 3 edited
-
ldfdyn.F90 (modified) (8 diffs)
-
ldfslp.F90 (modified) (10 diffs)
-
ldftra.F90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90
r7753 r8882 24 24 USE lib_mpp ! distribued memory computing library 25 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 26 USE wrk_nemo ! Memory Allocation27 26 28 27 IMPLICIT NONE … … 33 32 34 33 ! !!* Namelist namdyn_ldf : lateral mixing on momentum * 34 LOGICAL , PUBLIC :: ln_dynldf_NONE !: No operator (i.e. no explicit diffusion) 35 35 LOGICAL , PUBLIC :: ln_dynldf_lap !: laplacian operator 36 36 LOGICAL , PUBLIC :: ln_dynldf_blp !: bilaplacian operator … … 96 96 REAL(wp) :: zah0 ! local scalar 97 97 ! 98 NAMELIST/namdyn_ldf/ ln_dynldf_ lap, ln_dynldf_blp, &99 & ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso , &100 & nn_ahm_ijk_t , rn_ahm_0, rn_ahm_b, rn_bhm_0 , &101 & rn_csmc , rn_minfac, rn_maxfac 98 NAMELIST/namdyn_ldf/ ln_dynldf_NONE, ln_dynldf_lap, ln_dynldf_blp, & ! type of operator 99 & ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso , & ! acting direction of the operator 100 & nn_ahm_ijk_t , rn_ahm_0, rn_ahm_b, rn_bhm_0 , & ! lateral eddy coefficient 101 & rn_csmc , rn_minfac, rn_maxfac ! Smagorinsky settings 102 102 !!---------------------------------------------------------------------- 103 103 ! … … 118 118 ! 119 119 WRITE(numout,*) ' type :' 120 WRITE(numout,*) ' no explicit diffusion ln_dynldf_NONE= ', ln_dynldf_NONE 120 121 WRITE(numout,*) ' laplacian operator ln_dynldf_lap = ', ln_dynldf_lap 121 122 WRITE(numout,*) ' bilaplacian operator ln_dynldf_blp = ', ln_dynldf_blp … … 131 132 WRITE(numout,*) ' background viscosity (iso case) rn_ahm_b = ', rn_ahm_b, ' m2/s' 132 133 WRITE(numout,*) ' lateral bilaplacian eddy viscosity rn_bhm_0 = ', rn_bhm_0, ' m4/s' 133 WRITE(numout,*) ' smagorinsky settings (nn_ahm_ijk_t = 32) :'134 WRITE(numout,*) ' Smagorinsky settings (nn_ahm_ijk_t = 32) :' 134 135 WRITE(numout,*) ' Smagorinsky coefficient rn_csmc = ', rn_csmc 135 136 WRITE(numout,*) ' factor multiplier for theorectical lower limit for ' … … 140 141 141 142 ! ! Parameter control 142 IF( .NOT.ln_dynldf_lap .AND. .NOT.ln_dynldf_blp) THEN143 IF( ln_dynldf_NONE ) THEN 143 144 IF(lwp) WRITE(numout,*) ' No viscous operator selected. ahmt and ahmf are not allocated' 144 145 l_ldfdyn_time = .FALSE. … … 284 285 !!---------------------------------------------------------------------- 285 286 ! 286 IF( nn_timing == 1 )CALL timing_start('ldf_dyn')287 IF( ln_timing ) CALL timing_start('ldf_dyn') 287 288 ! 288 289 SELECT CASE( nn_ahm_ijk_t ) !== Eddy vicosity coefficients ==! … … 411 412 CALL iom_put( "ahmf_3d", ahmf(:,:,:) ) ! 3D v-eddy diffusivity coeff. 412 413 ! 413 IF( nn_timing == 1 )CALL timing_stop('ldf_dyn')414 IF( ln_timing ) CALL timing_stop('ldf_dyn') 414 415 ! 415 416 END SUBROUTINE ldf_dyn -
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r7753 r8882 32 32 USE lib_mpp ! distribued memory computing library 33 33 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 34 USE wrk_nemo ! work arrays35 34 USE timing ! Timing 36 35 … … 118 117 REAL(wp) :: zck, zfk, zbw ! - - 119 118 REAL(wp) :: zdepu, zdepv ! - - 120 REAL(wp), POINTER, DIMENSION(:,: ) :: zslpml_hmlpu, zslpml_hmlpv 121 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zww 122 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdzr 123 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgru, zgrv 124 !!---------------------------------------------------------------------- 125 ! 126 IF( nn_timing == 1 ) CALL timing_start('ldf_slp') 127 ! 128 CALL wrk_alloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 129 CALL wrk_alloc( jpi,jpj, zslpml_hmlpu, zslpml_hmlpv ) 130 119 REAL(wp), DIMENSION(jpi,jpj) :: zslpml_hmlpu, zslpml_hmlpv 120 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgru, zwz, zdzr 121 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrv, zww 122 !!---------------------------------------------------------------------- 123 ! 124 IF( ln_timing ) CALL timing_start('ldf_slp') 125 ! 131 126 zeps = 1.e-20_wp !== Local constant initialization ==! 132 127 z1_16 = 1.0_wp / 16._wp … … 157 152 DO jj = 1, jpjm1 158 153 DO ji = 1, jpim1 159 IF ( miku(ji,jj) > 1 )zgru(ji,jj,miku(ji,jj)) = grui(ji,jj)160 IF ( mikv(ji,jj) > 1 )zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj)154 IF( miku(ji,jj) > 1 ) zgru(ji,jj,miku(ji,jj)) = grui(ji,jj) 155 IF( mikv(ji,jj) > 1 ) zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj) 161 156 END DO 162 157 END DO … … 375 370 ENDIF 376 371 ! 377 CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 378 CALL wrk_dealloc( jpi,jpj, zslpml_hmlpu, zslpml_hmlpv ) 379 ! 380 IF( nn_timing == 1 ) CALL timing_stop('ldf_slp') 372 IF( ln_timing ) CALL timing_stop('ldf_slp') 381 373 ! 382 374 END SUBROUTINE ldf_slp … … 409 401 REAL(wp) :: zdzrho_raw 410 402 REAL(wp) :: zbeta0, ze3_e1, ze3_e2 411 REAL(wp), POINTER, DIMENSION(:,:) :: z1_mlbw 412 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalbet 413 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zdxrho , zdyrho, zdzrho ! Horizontal and vertical density gradients 414 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zti_mlb, ztj_mlb ! for Griffies operator only 415 !!---------------------------------------------------------------------- 416 ! 417 IF( nn_timing == 1 ) CALL timing_start('ldf_slp_triad') 418 ! 419 CALL wrk_alloc( jpi,jpj, z1_mlbw ) 420 CALL wrk_alloc( jpi,jpj,jpk, zalbet ) 421 CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho, klstart = 0 ) 422 CALL wrk_alloc( jpi,jpj, 2,2, zti_mlb, ztj_mlb, kkstart = 0, klstart = 0 ) 403 REAL(wp), DIMENSION(jpi,jpj) :: z1_mlbw 404 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zalbet 405 REAL(wp), DIMENSION(jpi,jpj,jpk,0:1) :: zdxrho , zdyrho, zdzrho ! Horizontal and vertical density gradients 406 REAL(wp), DIMENSION(jpi,jpj,0:1,0:1) :: zti_mlb, ztj_mlb ! for Griffies operator only 407 !!---------------------------------------------------------------------- 408 ! 409 IF( ln_timing ) CALL timing_start('ldf_slp_triad') 410 ! 423 411 ! 424 412 !--------------------------------! … … 624 612 CALL lbc_lnk( wslp2, 'W', 1. ) ! lateral boundary confition on wslp2 only ==>>> gm : necessary ? to be checked 625 613 ! 626 CALL wrk_dealloc( jpi,jpj, z1_mlbw ) 627 CALL wrk_dealloc( jpi,jpj,jpk, zalbet ) 628 CALL wrk_dealloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho, klstart = 0 ) 629 CALL wrk_dealloc( jpi,jpj, 2,2, zti_mlb, ztj_mlb, kkstart = 0, klstart = 0 ) 630 ! 631 IF( nn_timing == 1 ) CALL timing_stop('ldf_slp_triad') 614 IF( ln_timing ) CALL timing_stop('ldf_slp_triad') 632 615 ! 633 616 END SUBROUTINE ldf_slp_triad … … 663 646 !!---------------------------------------------------------------------- 664 647 ! 665 IF( nn_timing == 1 )CALL timing_start('ldf_slp_mxl')648 IF( ln_timing ) CALL timing_start('ldf_slp_mxl') 666 649 ! 667 650 zeps = 1.e-20_wp !== Local constant initialization ==! … … 746 729 CALL lbc_lnk( wslpiml, 'W', -1. ) ; CALL lbc_lnk( wslpjml, 'W', -1. ) ! lateral boundary conditions 747 730 ! 748 IF( nn_timing == 1 )CALL timing_stop('ldf_slp_mxl')731 IF( ln_timing ) CALL timing_stop('ldf_slp_mxl') 749 732 ! 750 733 END SUBROUTINE ldf_slp_mxl … … 763 746 !!---------------------------------------------------------------------- 764 747 ! 765 IF( nn_timing == 1 )CALL timing_start('ldf_slp_init')748 IF( ln_timing ) CALL timing_start('ldf_slp_init') 766 749 ! 767 750 IF(lwp) THEN … … 821 804 ENDIF 822 805 ! 823 IF( nn_timing == 1 )CALL timing_stop('ldf_slp_init')806 IF( ln_timing ) CALL timing_stop('ldf_slp_init') 824 807 ! 825 808 END SUBROUTINE ldf_slp_init -
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
r7753 r8882 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.
