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 3294 for trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90 – NEMO

Ignore:
Timestamp:
2012-01-28T17:44:18+01:00 (12 years ago)
Author:
rblod
Message:

Merge of 3.4beta into the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r2715 r3294  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  trcldf  *** 
    4    !! Ocean Passive tracers : lateral diffusive trends  
     4   !! Ocean Passive tracers : lateral diffusive trends 
    55   !!===================================================================== 
    66   !! History :  9.0  ! 2005-11 (G. Madec)  Original code 
    7    !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA  
     7   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
    88   !!---------------------------------------------------------------------- 
    99#if defined key_top 
     
    2323   USE traldf_bilap    ! lateral mixing            (tra_ldf_bilap routine) 
    2424   USE traldf_iso      ! lateral mixing            (tra_ldf_iso routine) 
     25   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine) 
    2526   USE traldf_lap      ! lateral mixing            (tra_ldf_lap routine) 
    2627   USE trdmod_oce 
     
    3132   PRIVATE 
    3233 
    33    PUBLIC   trc_ldf    ! called by step.F90  
     34   PUBLIC   trc_ldf    ! called by step.F90 
    3435   !                                                 !!: ** lateral mixing namelist (nam_trcldf) ** 
    35    INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals) 
     36   REAL(wp) ::  rldf_rat    ! ratio between active and passive tracers diffusive coefficient 
     37   INTEGER  ::  nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals) 
    3638   !! * Substitutions 
    3739#  include "domzgr_substitute.h90" 
     
    3941   !!---------------------------------------------------------------------- 
    4042   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    41    !! $Id$  
     43   !! $Id$ 
    4244   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4345   !!---------------------------------------------------------------------- 
     
    4850      !!---------------------------------------------------------------------- 
    4951      !!                  ***  ROUTINE tra_ldf  *** 
    50       !!  
     52      !! 
    5153      !! ** Purpose :   compute the lateral ocean tracer physics. 
    5254      !! 
     
    5658      INTEGER            :: jn 
    5759      CHARACTER (len=22) :: charout 
    58       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrtrd 
    59       !!---------------------------------------------------------------------- 
    60  
    61       IF( kt == nit000 )   CALL ldf_ctl          ! initialisation & control of options 
    62  
    63       IF( l_trdtrc )  THEN  
    64          ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) )  ! temporary save of trends 
     60      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd 
     61      !!---------------------------------------------------------------------- 
     62      ! 
     63      IF( nn_timing == 1 )   CALL timing_start('trc_ldf') 
     64      ! 
     65      IF( kt == nittrc000 )   CALL ldf_ctl          ! initialisation & control of options 
     66 
     67      rldf = rldf_rat 
     68 
     69      IF( l_trdtrc )  THEN 
     70         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) 
    6571         ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
    6672      ENDIF 
    6773 
    6874      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend 
    69       CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level laplacian 
    70       CASE ( 1 )   ;   CALL tra_ldf_iso   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )  ! rotated laplacian  
    71       CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level bilaplacian 
    72       CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, 'TRC',             trb, tra, jptra            )  ! s-coord. horizontal bilaplacian 
     75      CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level laplacian 
     76      CASE ( 1 )                                                                                            ! rotated laplacian 
     77                       IF( ln_traldf_grif ) THEN 
     78                          CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
     79                       ELSE 
     80                          CALL tra_ldf_iso     ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
     81                       ENDIF 
     82      CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level bilaplacian 
     83      CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            )  ! s-coord. horizontal bilaplacian 
    7384         ! 
    7485      CASE ( -1 )                                     ! esopa: test all possibility with control print 
    75          CALL tra_ldf_lap   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra            ) 
     86         CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            ) 
    7687         WRITE(charout, FMT="('ldf0 ')") ;  CALL prt_ctl_trc_info(charout) 
    7788                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    78          CALL tra_ldf_iso   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
     89         IF( ln_traldf_grif ) THEN 
     90            CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
     91         ELSE 
     92            CALL tra_ldf_iso     ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
     93         ENDIF 
    7994         WRITE(charout, FMT="('ldf1 ')") ;  CALL prt_ctl_trc_info(charout) 
    8095                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    81          CALL tra_ldf_bilap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra            ) 
     96         CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            ) 
    8297         WRITE(charout, FMT="('ldf2 ')") ;  CALL prt_ctl_trc_info(charout) 
    8398                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    84          CALL tra_ldf_bilapg( kt, 'TRC',             trb, tra, jptra            ) 
     99         CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            ) 
    85100         WRITE(charout, FMT="('ldf3 ')") ;  CALL prt_ctl_trc_info(charout) 
    86101                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     
    92107           CALL trd_tra( kt, 'TRC', jn, jptra_trd_ldf, ztrtrd(:,:,:,jn) ) 
    93108        END DO 
    94         DEALLOCATE( ztrtrd )  
     109        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 
    95110      ENDIF 
    96111      !                                          ! print mean trends (used for debugging) 
     
    100115      ENDIF 
    101116      ! 
     117      IF( nn_timing == 1 )   CALL timing_stop('trc_ldf') 
     118      ! 
    102119   END SUBROUTINE trc_ldf 
    103120 
     
    106123      !!---------------------------------------------------------------------- 
    107124      !!                  ***  ROUTINE ldf_ctl  *** 
    108       !!  
     125      !! 
    109126      !! ** Purpose :   Choice of the operator for the lateral tracer diffusion 
    110127      !! 
    111128      !! ** Method  :   set nldf from the namtra_ldf logicals 
    112       !!      nldf == -2   No lateral diffusion   
     129      !!      nldf == -2   No lateral diffusion 
    113130      !!      nldf == -1   ESOPA test: ALL operators are used 
    114131      !!      nldf ==  0   laplacian operator 
     
    117134      !!      nldf ==  3   Rotated bilaplacian 
    118135      !!---------------------------------------------------------------------- 
    119       INTEGER ::   ioptio, ierr         ! temporary integers  
    120       !!---------------------------------------------------------------------- 
    121  
     136      INTEGER ::   ioptio, ierr         ! temporary integers 
     137      !!---------------------------------------------------------------------- 
     138 
     139      IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN 
     140         IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN 
     141            rldf_rat = 1.0_wp 
     142         ELSE 
     143            CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
     144         END IF 
     145      ELSE 
     146         rldf_rat = rn_ahtrc_0 / rn_aht_0 
     147      END IF 
    122148      !  Define the lateral mixing oparator for tracers 
    123149      ! =============================================== 
    124      
     150 
    125151      !                               ! control the input 
    126152      ioptio = 0 
     
    163189         ENDIF 
    164190         IF ( ln_zps ) THEN             ! z-coordinate 
    165             IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed  
     191            IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed 
    166192            IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation) 
    167193            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
     
    206232      ENDIF 
    207233 
     234      IF( ln_trcldf_bilap ) THEN 
     235         IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion' 
     236         IF( rn_ahtrc_0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal diffusivity coef. rn_ahtrc_0 must be negative' ) 
     237      ELSE 
     238         IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)' 
     239         IF( rn_ahtrc_0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop('The horizontal diffusivity coef. rn_ahtrc_0 must be positive' ) 
     240      ENDIF 
     241 
     242      ! ratio between active and passive tracers diffusive coef. 
     243      IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN 
     244         IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN 
     245            rldf_rat = 1.0_wp 
     246         ELSE 
     247            CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
     248         END IF 
     249      ELSE 
     250         rldf_rat = rn_ahtrc_0 / rn_aht_0 
     251      END IF 
     252      IF( rldf_rat < 0 ) THEN 
     253         IF( .NOT.lk_offline ) THEN  
     254            CALL ctl_stop( 'Choose the same type of diffusive scheme both for active & passive tracers' ) 
     255         ELSE 
     256            CALL ctl_stop( 'Change the sign of rn_aht_0 in namelist to -/+1' ) 
     257         ENDIF  
     258      ENDIF 
    208259      ! 
    209260   END SUBROUTINE ldf_ctl 
Note: See TracChangeset for help on using the changeset viewer.