New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 9019 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90 – NEMO

Ignore:
Timestamp:
2017-12-13T15:58:53+01:00 (6 years ago)
Author:
timgraham
Message:

Merge of dev_CNRS_2017 into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

    r7753 r9019  
    3030   USE lib_mpp         ! distribued memory computing library 
    3131   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    32    USE wrk_nemo        ! work arrays 
    3332   USE timing          ! timing 
    3433 
     
    4544   !                                   !!* Namelist namtra_ldf : lateral mixing on tracers *  
    4645   !                                    != Operator type =! 
     46   LOGICAL , PUBLIC ::   ln_traldf_NONE      !: no operator: No explicit diffusion 
    4747   LOGICAL , PUBLIC ::   ln_traldf_lap       !: laplacian operator 
    4848   LOGICAL , PUBLIC ::   ln_traldf_blp       !: bilaplacian operator 
     
    119119      INTEGER  ::   ierr, inum, ios   ! local integer 
    120120      REAL(wp) ::   zah0              ! local scalar 
    121       ! 
    122       NAMELIST/namtra_ldf/ 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 
     121      !! 
     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 
    127127      !!---------------------------------------------------------------------- 
    128128      ! 
     
    144144         WRITE(numout,*) '~~~~~~~~~~~~ ' 
    145145         WRITE(numout,*) '   Namelist namtra_ldf : lateral mixing parameters (type, direction, coefficients)' 
    146          ! 
    147146         WRITE(numout,*) '      type :' 
     147         WRITE(numout,*) '         no explicit diffusion                   ln_traldf_NONE  = ', ln_traldf_NONE 
    148148         WRITE(numout,*) '         laplacian operator                      ln_traldf_lap   = ', ln_traldf_lap 
    149149         WRITE(numout,*) '         bilaplacian operator                    ln_traldf_blp   = ', ln_traldf_blp 
    150          ! 
    151150         WRITE(numout,*) '      direction of action :' 
    152151         WRITE(numout,*) '         iso-level                               ln_traldf_lev   = ', ln_traldf_lev 
     
    159158         WRITE(numout,*) '            switching triad or not               rn_sw_triad     = ', rn_sw_triad 
    160159         WRITE(numout,*) '            lateral mixing on bottom             ln_botmix_triad = ', ln_botmix_triad 
    161          ! 
    162160         WRITE(numout,*) '      coefficients :' 
    163161         WRITE(numout,*) '         lateral eddy diffusivity   (lap case)   rn_aht_0        = ', rn_aht_0 
     
    168166      !                                ! Parameter control 
    169167      ! 
    170       IF( .NOT.ln_traldf_lap .AND. .NOT.ln_traldf_blp ) THEN 
     168      IF( ln_traldf_NONE ) THEN 
    171169         IF(lwp) WRITE(numout,*) '   No diffusive operator selected. ahtu and ahtv are not allocated' 
    172170         l_ldftra_time = .FALSE. 
     
    490488      ! 
    491489      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      ! 
    500496      zn   (:,:) = 0._wp      ! Local initialization 
    501497      zhw  (:,:) = 5._wp 
     
    575571      END DO 
    576572      !   
    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') 
    580574      ! 
    581575   END SUBROUTINE ldf_eiv 
     
    610604      REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! local scalars 
    611605      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      ! 
    619611      IF( kt == kit000 )  THEN 
    620612         IF(lwp) WRITE(numout,*) 
     
    658650      IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw ) 
    659651      ! 
    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') 
    663653      ! 
    664654    END SUBROUTINE ldf_eiv_trp 
     
    679669      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
    680670      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') 
    686678      ! 
    687679      !                                                  !==  eiv stream function: output  ==! 
     
    693685      ! 
    694686      !                                                  !==  eiv velocities: calculate and output  ==! 
    695       CALL wrk_alloc( jpi,jpj,jpk,   zw3d ) 
    696687      ! 
    697688      zw3d(:,:,jpk) = 0._wp                                    ! bottom value always 0 
     
    718709      CALL iom_put( "woce_eiv", zw3d ) 
    719710      ! 
    720       !       
    721       ! 
    722       CALL wrk_alloc( jpi,jpj,   zw2d ) 
    723711      ! 
    724712      zztmp = 0.5_wp * rau0 * rcp  
     
    792780      IF( ln_diaptr ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d ) 
    793781      ! 
    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')       
    798784      ! 
    799785   END SUBROUTINE ldf_eiv_dia 
Note: See TracChangeset for help on using the changeset viewer.