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 5883 for branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90 – NEMO

Ignore:
Timestamp:
2015-11-13T08:01:08+01:00 (8 years ago)
Author:
gm
Message:

#1613: vvl by default: TRA/TRC remove optimization associated with linear free surface

File:
1 moved

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90

    r5861 r5883  
    1 MODULE traldf_lap 
     1MODULE traldf_lap_blp 
    22   !!============================================================================== 
    3    !!                       ***  MODULE  traldf_lap  *** 
     3   !!                       ***  MODULE  traldf_lap_blp  *** 
    44   !! Ocean tracers:  lateral diffusivity trend  (laplacian and bilaplacian) 
    55   !!============================================================================== 
    6    !! History :  OPA  ! 1987-06  (P. Andrich, D. L Hostis)  Original code 
    7    !!                 ! 1991-11  (G. Madec) 
    8    !!                 ! 1995-11  (G. Madec)  suppress volumetric scale factors 
    9    !!                 ! 1996-01  (G. Madec)  statement function for e3 
    10    !!            NEMO ! 2002-06  (G. Madec)  F90: Free form and module 
    11    !!            1.0  ! 2004-08  (C. Talandier) New trends organization 
    12    !!                 ! 2005-11  (G. Madec)  add zps case 
    13    !!            3.0  ! 2010-06  (C. Ethe, G. Madec) Merge TRA-TRC 
    14    !!            3.7  ! 2014-01  (G. Madec, S. Masson) re-entrant laplacian  
    15    !!---------------------------------------------------------------------- 
    16  
    17    !!---------------------------------------------------------------------- 
    18    !!   tra_ldf_lap : update the tracer trend with the lateral diffusion : iso-level laplacian operator 
    19    !!   tra_ldf_blp : update the tracer trend with the lateral diffusion : iso-level bilaplacian operator 
    20    !!---------------------------------------------------------------------- 
    21    USE oce             ! ocean dynamics and active tracers 
    22    USE dom_oce         ! ocean space and time domain 
    23    USE ldftra          ! lateral physics: eddy diffusivity 
    24    USE diaptr          ! poleward transport diagnostics 
    25    USE trc_oce         ! share passive tracers/Ocean variables 
    26    USE zpshde          ! partial step: hor. derivative     (zps_hde routine) 
     6   !! History :  3.7  ! 2014-01  (G. Madec, S. Masson)  Original code, re-entrant laplacian  
     7   !!---------------------------------------------------------------------- 
     8 
     9   !!---------------------------------------------------------------------- 
     10   !!   tra_ldf_lap   : tracer trend update with iso-level laplacian diffusive operator 
     11   !!   tra_ldf_blp   : tracer trend update with iso-level or iso-neutral bilaplacian operator 
     12   !!---------------------------------------------------------------------- 
     13   USE oce            ! ocean dynamics and active tracers 
     14   USE dom_oce        ! ocean space and time domain 
     15   USE ldftra         ! lateral physics: eddy diffusivity 
     16   USE traldf_iso     ! iso-neutral lateral diffusion (standard operator)     (tra_ldf_iso   routine) 
     17   USE traldf_triad   ! iso-neutral lateral diffusion (triad    operator)     (tra_ldf_triad routine) 
     18   USE diaptr         ! poleward transport diagnostics 
     19   USE trc_oce        ! share passive tracers/Ocean variables 
     20   USE zpshde         ! partial step: hor. derivative     (zps_hde routine) 
    2721   ! 
    28    USE in_out_manager  ! I/O manager 
    29    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    30    USE lib_mpp         ! distribued memory computing library 
    31    USE timing          ! Timing 
    32    USE wrk_nemo        ! Memory allocation 
     22   USE in_out_manager ! I/O manager 
     23   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     24   USE lib_mpp        ! distribued memory computing library 
     25   USE timing         ! Timing 
     26   USE wrk_nemo       ! Memory allocation 
    3327 
    3428   IMPLICIT NONE 
    3529   PRIVATE 
    3630 
    37    PUBLIC   tra_ldf_lap   ! routine called by traldf.F90 
     31   PUBLIC   tra_ldf_lap   ! called by traldf.F90 
     32   PUBLIC   tra_ldf_blp   ! called by traldf.F90 
     33 
     34   !                      ! Flag to control the type of lateral diffusive operator 
     35   INTEGER, PARAMETER, PUBLIC ::   np_ERROR  =-10   ! error in specification of lateral diffusion 
     36   INTEGER, PARAMETER, PUBLIC ::   np_no_ldf = 00   ! without operator (i.e. no lateral diffusive trend) 
     37   !                          !!      laplacian     !    bilaplacian    ! 
     38   INTEGER, PARAMETER, PUBLIC ::   np_lap    = 10   ,   np_blp    = 20  ! iso-level operator 
     39   INTEGER, PARAMETER, PUBLIC ::   np_lap_i  = 11   ,   np_blp_i  = 21  ! standard iso-neutral or geopotential operator 
     40   INTEGER, PARAMETER, PUBLIC ::   np_lap_it = 12   ,   np_blp_it = 22  ! triad    iso-neutral or geopotential operator 
    3841 
    3942   !! * Substitutions 
     
    162165   END SUBROUTINE tra_ldf_lap 
    163166    
     167 
     168   SUBROUTINE tra_ldf_blp( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   & 
     169      &                                                    pgui, pgvi,   & 
     170      &                                                    ptb , pta , kjpt, kldf ) 
     171      !!---------------------------------------------------------------------- 
     172      !!                 ***  ROUTINE tra_ldf_blp  *** 
     173      !!                     
     174      !! ** Purpose :   Compute the before lateral tracer diffusive  
     175      !!      trend and add it to the general trend of tracer equation. 
     176      !! 
     177      !! ** Method  :   The lateral diffusive trends is provided by a bilaplacian 
     178      !!      operator applied to before field (forward in time). 
     179      !!      It is computed by two successive calls to laplacian routine 
     180      !! 
     181      !! ** Action :   pta   updated with the before rotated bilaplacian diffusion 
     182      !!---------------------------------------------------------------------- 
     183      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
     184      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index 
     185      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
     186      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
     187      INTEGER                              , INTENT(in   ) ::   kldf       ! type of operator used 
     188      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s] 
     189      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
     190      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top levels 
     191      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields 
     192      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
     193      ! 
     194      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
     195      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zlap         ! laplacian at t-point 
     196      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zglu, zglv   ! bottom GRADh of the laplacian (u- and v-points) 
     197      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zgui, zgvi   ! top    GRADh of the laplacian (u- and v-points) 
     198      !!--------------------------------------------------------------------- 
     199      ! 
     200      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_blp') 
     201      ! 
     202      CALL wrk_alloc( jpi,jpj,jpk,kjpt,   zlap )  
     203      CALL wrk_alloc( jpi,jpj,    kjpt,   zglu, zglv, zgui, zgvi )  
     204      ! 
     205      IF( kt == kit000 .AND. lwp )  THEN 
     206         WRITE(numout,*) 
     207         SELECT CASE ( kldf ) 
     208         CASE ( np_blp    )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-level   bilaplacian operator on ', cdtype 
     209         CASE ( np_blp_i  )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (Standard)' 
     210         CASE ( np_blp_it )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (triad)' 
     211         END SELECT 
     212         WRITE(numout,*) '~~~~~~~~~~~' 
     213      ENDIF 
     214 
     215      zlap(:,:,:,:) = 0._wp 
     216      ! 
     217      SELECT CASE ( kldf )       !==  1st laplacian applied to ptb (output in zlap)  ==! 
     218      ! 
     219      CASE ( np_blp    )               ! iso-level bilaplacian 
     220         CALL tra_ldf_lap  ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb,      zlap, kjpt, 1 ) 
     221      CASE ( np_blp_i  )               ! rotated   bilaplacian : standard operator (Madec) 
     222         CALL tra_ldf_iso  ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 ) 
     223      CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies) 
     224         CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 ) 
     225      END SELECT 
     226      ! 
     227      DO jn = 1, kjpt 
     228         CALL lbc_lnk( zlap(:,:,:,jn) , 'T', 1. )     ! Lateral boundary conditions (unchanged sign) 
     229      END DO 
     230      !                                               ! Partial top/bottom cell: GRADh( zlap )   
     231      IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom 
     232      ELSEIF(             ln_zps ) THEN   ;   CALL zps_hde    ( kt, kjpt, zlap, zglu, zglv )              ! only bottom  
     233      ENDIF 
     234      ! 
     235      SELECT CASE ( kldf )       !==  2nd laplacian applied to zlap (output in pta)  ==! 
     236      ! 
     237      CASE ( np_blp    )               ! iso-level bilaplacian 
     238         CALL tra_ldf_lap  ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pta,      kjpt, 2 ) 
     239      CASE ( np_blp_i  )               ! rotated   bilaplacian : standard operator (Madec) 
     240         CALL tra_ldf_iso  ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 ) 
     241      CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies) 
     242         CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 ) 
     243      END SELECT 
     244      ! 
     245      CALL wrk_dealloc( jpi,jpj,jpk,kjpt,   zlap )  
     246      CALL wrk_dealloc( jpi,jpj    ,kjpt,   zglu, zglv, zgui, zgvi )  
     247      ! 
     248      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_blp') 
     249      ! 
     250   END SUBROUTINE tra_ldf_blp 
     251 
    164252   !!============================================================================== 
    165 END MODULE traldf_lap 
     253END MODULE traldf_lap_blp 
Note: See TracChangeset for help on using the changeset viewer.