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 888 for trunk/NEMO/OPA_SRC/TRA/traadv_cen2.F90 – NEMO

Ignore:
Timestamp:
2008-04-11T19:05:03+02:00 (16 years ago)
Author:
ctlod
Message:

merge dev_001_SBC branche with the trunk to include the New Surface Module package, see ticket: #113

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r833 r888  
    11MODULE traadv_cen2 
    2    !!============================================================================== 
    3    !!                       ***  MODULE  traadv_cen2  *** 
     2   !!====================================================================== 
     3   !!                     ***  MODULE  traadv_cen2  *** 
    44   !! Ocean active tracers:  horizontal & vertical advective trend 
    5    !!============================================================================== 
    6    !! History :  8.2  !  01-08  (G. Madec, E. Durand)  trahad+trazad = traadv  
    7    !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
    8    !!            9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
    9    !!            " "  !  06-04  (R. Benshila, G. Madec) Step reorganization 
     5   !!====================================================================== 
     6   !! History :   8.2  !  01-08  (G. Madec, E. Durand)  trahad+trazad=traadv  
     7   !!             8.5  !  02-06  (G. Madec)  F90: Free form and module 
     8   !!             9.0  !  04-08  (C. Talandier) New trends organization 
     9   !!             " "  !  05-11  (V. Garnier) Surface pressure gradient organization 
     10   !!             " "  !  06-04  (R. Benshila, G. Madec) Step reorganization 
     11   !!             " "  !  06-07  (G. madec)  add ups_orca_set routine 
    1012   !!---------------------------------------------------------------------- 
    1113 
     
    1315   !!   tra_adv_cen2 : update the tracer trend with the horizontal and 
    1416   !!                  vertical advection trends using a seconder order 
     17   !!   ups_orca_set : allow mixed upstream/centered scheme in specific 
     18   !!                  area (set for orca 2 and 4 only) 
    1519   !!---------------------------------------------------------------------- 
    1620   USE oce             ! ocean dynamics and active tracers 
    1721   USE dom_oce         ! ocean space and time domain 
     22   USE sbc_oce         ! surface boundary condition: ocean 
     23   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
     24   USE trdmod_oce      ! ocean variables trends 
    1825   USE trdmod          ! ocean active tracers trends  
    19    USE trdmod_oce      ! ocean variables trends 
    20    USE flxrnf          ! 
     26   USE closea          ! closed sea 
    2127   USE trabbl          ! advective term in the BBL 
    2228   USE ocfzpt          ! 
     29   USE sbcrnf          ! river runoffs 
     30   USE in_out_manager  ! I/O manager 
    2331   USE lib_mpp 
    2432   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    25    USE in_out_manager  ! I/O manager 
    2633   USE diaptr          ! poleward transport diagnostics 
    27    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
    2834   USE prtctl          ! Print control 
    2935 
     
    3137   PRIVATE 
    3238 
    33    PUBLIC   tra_adv_cen2   ! routine called by step.F90 
     39   PUBLIC   tra_adv_cen2    ! routine called by step.F90 
     40   PUBLIC   ups_orca_set    ! routine used by traadv_cen2_jki.F90 
     41 
     42   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   upsmsk    !: mixed upstream/centered scheme near some straits  
     43   !                                                   !  and in closed seas (orca 2 and 4 configurations) 
    3444 
    3545   REAL(wp), DIMENSION(jpi,jpj) ::   btr2   ! inverse of T-point surface [1/(e1t*e2t)] 
     
    3949#  include "vectopt_loop_substitute.h90" 
    4050   !!---------------------------------------------------------------------- 
    41    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    42    !! $Header$  
     51   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
     52   !! $Id$ 
    4353   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4454   !!---------------------------------------------------------------------- 
     
    118128      !! 
    119129      INTEGER  ::   ji, jj, jk                           ! dummy loop indices 
    120       REAL(wp) ::                           & 
    121          zbtr, zta, zsa, zfui, zfvj,        &  ! temporary scalars 
    122          zhw, ze3tr, zcofi, zcofj,          &  !    "         " 
    123          zupsut, zupsvt, zupsus, zupsvs,    &  !    "         " 
    124          zfp_ui, zfp_vj, zfm_ui, zfm_vj,    &  !    "         " 
    125          zcofk, zupst, zupss, zcent,        &  !    "         " 
    126          zcens, zfp_w, zfm_w,               &  !    "         " 
    127          zcenut, zcenvt, zcenus, zcenvs,    &  !    "         " 
    128          z_hdivn_x, z_hdivn_y, z_hdivn 
    129       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz, ztrdt, zind   ! 3D workspace  
     130      REAL(wp) ::   zta, zsa, zbtr, zhw, ze3tr,       &  ! temporary scalars 
     131         &          zfp_ui, zfp_vj, zfp_w , zfui  ,   &  !    "         " 
     132         &          zfm_ui, zfm_vj, zfm_w , zfvj  ,   &  !    "         " 
     133         &          zcofi , zcofj , zcofk ,           &  !    "         " 
     134         &          zupsut, zupsus, zcenut, zcenus,   &  !    "         " 
     135         &          zupsvt, zupsvs, zcenvt, zcenvs,   &  !    "         " 
     136         &          zupst , zupss , zcent , zcens ,   &  !    "         " 
     137         &          z_hdivn_x, z_hdivn_y, z_hdivn  
     138      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz, ztrdt, zind   ! 3D workspace 
    130139      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zww, ztrds         !  "      " 
    131140      !!---------------------------------------------------------------------- 
     
    136145         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~   Vector optimization case' 
    137146         IF(lwp) WRITE(numout,*) 
    138          !  
    139          btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 
     147         ! 
     148         upsmsk(:,:) = 0.e0                              ! not upstream by default 
     149         IF( cp_cfg == "orca" )   CALL ups_orca_set      ! set mixed Upstream/centered scheme near some straits 
     150         !                                               ! and in closed seas (orca2 and orca4 only) 
     151         !    
     152         btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )        ! inverse of T-point surface 
    140153      ENDIF 
    141154 
     
    145158         DO jj = 1, jpj 
    146159            DO ji = 1, jpi 
    147                zind(ji,jj,jk) =  MAX ( upsrnfh(ji,jj) * upsrnfz(jk),     &  ! changing advection scheme near runoff 
    148                   &                    upsadv(ji,jj)                     &  ! in the vicinity of some straits 
     160               zind(ji,jj,jk) = MAX (   & 
     161                  rnfmsk(ji,jj) * rnfmsk_z(jk),      &  ! near runoff mouths (& closed sea outflows) 
     162                  upsmsk(ji,jj)                      &  ! some of some straits 
    149163#if defined key_lim3 || defined key_lim2 
    150                   &                  , tmask(ji,jj,jk)                   &  ! half upstream tracer fluxes 
    151                   &                  * MAX( 0., SIGN( 1., fzptn(ji,jj)   &  ! if tn < ("freezing"+0.1 ) 
    152                   &                                +0.1-tn(ji,jj,jk) ) ) & 
     164                  !                                     ! below ice covered area (if tn < "freezing"+0.1 ) 
     165                  , MAX(  0., SIGN( 1., fzptn(ji,jj) + 0.1 - tn(ji,jj,jk) )  ) * tmask(ji,jj,jk)   & 
    153166#endif 
    154167                  &                  ) 
     
    157170      END DO 
    158171 
    159  
    160       !  Horizontal advective fluxes 
    161       ! ----------------------------- 
     172      ! I. Horizontal advective fluxes 
     173      ! ------------------------------ 
     174      !  Second order centered tracer flux at u and v-points 
     175      ! ----------------------------------------------------- 
    162176      !                                                ! =============== 
    163177      DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    278292         &                       tab3d_2=sa, clinfo2=            ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    279293 
    280       ! 4. "zonal" mean advective heat and salt transport  
    281       ! ------------------------------------------------- 
     294      ! "zonal" mean advective heat and salt transport  
     295      ! ---------------------------------------------- 
    282296 
    283297      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
     
    312326      ENDIF 
    313327 
    314       ! 1. Vertical advective fluxes 
     328      ! 1. Vertical advective fluxes  
    315329      ! ---------------------------- 
    316330      ! Second order centered tracer flux at w-point 
     
    386400      ! 
    387401   END SUBROUTINE tra_adv_cen2 
     402    
     403    
     404   SUBROUTINE ups_orca_set 
     405      !!---------------------------------------------------------------------- 
     406      !!                  ***  ROUTINE ups_orca_set  *** 
     407      !!        
     408      !! ** Purpose :   add a portion of upstream scheme in area where the 
     409      !!                centered scheme generates too strong overshoot 
     410      !! 
     411      !! ** Method  :   orca (R4 and R2) confiiguration setting. Set upsmsk 
     412      !!                array to nozero value in some straith.  
     413      !! 
     414      !! ** Action : - upsmsk set to 1 at some strait, 0 elsewhere for orca 
     415      !!---------------------------------------------------------------------- 
     416      INTEGER  ::   ii0, ii1, ij0, ij1      ! temporary integers 
     417      !!---------------------------------------------------------------------- 
     418       
     419      ! mixed upstream/centered scheme near river mouths 
     420      ! ------------------------------------------------ 
     421      SELECT CASE ( jp_cfg ) 
     422      !                                        ! ======================= 
     423      CASE ( 4 )                               !  ORCA_R4 configuration  
     424         !                                     ! ======================= 
     425         !                                          ! Gibraltar Strait 
     426         ii0 =  70   ;   ii1 =  71 
     427         ij0 =  52   ;   ij1 =  53   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50 
     428         ! 
     429         !                                     ! ======================= 
     430      CASE ( 2 )                               !  ORCA_R2 configuration  
     431         !                                     ! ======================= 
     432         !                                          ! Gibraltar Strait 
     433         ij0 = 102   ;   ij1 = 102 
     434         ii0 = 138   ;   ii1 = 138   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.20 
     435         ii0 = 139   ;   ii1 = 139   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40 
     436         ii0 = 140   ;   ii1 = 140   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50 
     437         ij0 = 101   ;   ij1 = 102 
     438         ii0 = 141   ;   ii1 = 141   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50 
     439         !                                          ! Bab el Mandeb Strait 
     440         ij0 =  87   ;   ij1 =  88 
     441         ii0 = 164   ;   ii1 = 164   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.10 
     442         ij0 =  88   ;   ij1 =  88 
     443         ii0 = 163   ;   ii1 = 163   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25 
     444         ii0 = 162   ;   ii1 = 162   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40 
     445         ii0 = 160   ;   ii1 = 161   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50 
     446         ij0 =  89   ;   ij1 =  89 
     447         ii0 = 158   ;   ii1 = 160   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25 
     448         ij0 =  90   ;   ij1 =  90 
     449         ii0 = 160   ;   ii1 = 160   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25 
     450         !                                          ! Sound Strait 
     451         ij0 = 116   ;   ij1 = 116 
     452         ii0 = 144   ;   ii1 = 144   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25 
     453         ii0 = 145   ;   ii1 = 147   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50 
     454         ii0 = 148   ;   ii1 = 148   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25 
     455         ! 
     456      END SELECT  
     457       
     458      ! mixed upstream/centered scheme over closed seas 
     459      ! ----------------------------------------------- 
     460      CALL clo_ups( upsmsk(:,:) ) 
     461      ! 
     462   END SUBROUTINE ups_orca_set 
    388463 
    389464   !!====================================================================== 
Note: See TracChangeset for help on using the changeset viewer.