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

Ignore:
Timestamp:
2006-05-10T19:01:19+02:00 (18 years ago)
Author:
opalod
Message:

nemo_v1_update_049:RB: reorganization of tracers part, remove traadv_cen2_atsk.h90 traldf_iso_zps.F90 trazdf_iso.F90 trazdf_iso_vopt.F90, change atsk routines to jki

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/OPA_SRC/TRA/trabbl.F90

    r428 r457  
    3131   !! * Shared module variables 
    3232   REAL(wp), PUBLIC ::            &  !!: * bbl namelist * 
    33       atrbbl = 1.e+3                  !: lateral coeff. for BBL scheme (m2/s) 
    34 #if defined key_trabbl_dif 
     33      atrbbl = 1.e+3                  !: lateral coeff. for bottom boundary  
     34      !                               !  layer scheme (m2/s)  
     35# if defined key_trabbl_dif 
    3536   LOGICAL, PUBLIC, PARAMETER ::   &  !: 
    3637      lk_trabbl_dif = .TRUE.          !: diffusive bottom boundary layer flag 
    37 #else 
     38# else 
    3839   LOGICAL, PUBLIC, PARAMETER ::   &  !: 
    3940      lk_trabbl_dif = .FALSE.         !: diffusive bottom boundary layer flag 
    40 #endif 
     41# endif 
    4142 
    4243# if defined key_trabbl_adv 
    … …  
    114115      USE oce, ONLY :    ztdta => ua,     & ! use ua as 3D workspace    
    115116                         ztdsa => va        ! use va as 3D workspace    
    116       USE eosbn2, ONLY : neos ! type of equation of state 
     117      USE eosbn2 , ONLY : neos              ! type of equation of state 
    117118 
    118119      !! * Arguments  
    … …  
    123124      INTEGER ::   ik 
    124125      INTEGER ::   ii0, ii1, ij0, ij1       ! temporary integers 
    125 #  if defined key_partial_steps 
    126126      INTEGER  ::   iku1, iku2, ikv1,ikv2   ! temporary intergers 
    127127      REAL(wp) ::   ze3u, ze3v              ! temporary scalars 
    128 #  else 
    129128      INTEGER ::   iku, ikv 
    130 #  endif 
    131129      REAL(wp) ::   & 
    132130         zsign, zt, zs, zh, zalbet,      &  ! temporary scalars 
    … …  
    172170      ! mbathy= number of w-level, minimum value=1 (cf dommsk.F) 
    173171 
    174 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     172#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    175173      jj = 1 
    176174      DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    … …  
    185183            zsbb(ji,jj) = sb(ji,jj,ik) * tmask(ji,jj,1) 
    186184            zdep(ji,jj) = fsdept(ji,jj,ik)                ! depth of the ocean bottom T-level 
    187 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
    188          END DO 
    189 #  endif 
    190       END DO 
    191  
    192 #  if defined key_partial_steps 
    193       ! partial steps correction  
    194 #   if defined key_vectopt_loop   &&   ! defined key_autotasking 
    195       jj = 1 
    196       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     185#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     186         END DO 
     187#  endif 
     188      END DO 
     189 
     190      IF( ln_zps ) THEN      ! partial steps correction  
     191# if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
     192         jj = 1 
     193         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     194# else 
     195         DO jj = 1, jpjm1 
     196            DO ji = 1, jpim1 
     197# endif 
     198               iku1 = MAX( mbathy(ji+1,jj  )-1, 1 ) 
     199               iku2 = MAX( mbathy(ji  ,jj  )-1, 1 ) 
     200               ikv1 = MAX( mbathy(ji  ,jj+1)-1, 1 ) 
     201               ikv2 = MAX( mbathy(ji  ,jj  )-1, 1 ) 
     202               ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) )  
     203               ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) )  
     204               zahu(ji,jj) = atrbbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1) 
     205               zahv(ji,jj) = atrbbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1) 
     206# if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     207            END DO 
     208# endif 
     209         END DO 
     210      ELSE                    ! z-coordinate - full steps or s-coordinate 
     211#   if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
     212         jj = 1 
     213         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    197214#   else 
    198       DO jj = 1, jpjm1 
    199          DO ji = 1, jpim1 
     215         DO jj = 1, jpjm1 
     216            DO ji = 1, jpim1 
    200217#   endif 
    201             iku1 = MAX( mbathy(ji+1,jj  )-1, 1 ) 
    202             iku2 = MAX( mbathy(ji  ,jj  )-1, 1 ) 
    203             ikv1 = MAX( mbathy(ji  ,jj+1)-1, 1 ) 
    204             ikv2 = MAX( mbathy(ji  ,jj  )-1, 1 ) 
    205             ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) )  
    206             ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) )  
    207             zahu(ji,jj) = atrbbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1) 
    208             zahv(ji,jj) = atrbbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1) 
    209 #   if ! defined key_vectopt_loop   ||   defined key_autotasking 
    210          END DO 
     218               iku = mbku(ji,jj) 
     219               ikv = mbkv(ji,jj) 
     220               zahu(ji,jj) = atrbbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1) 
     221               zahv(ji,jj) = atrbbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1) 
     222#   if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     223            END DO 
    211224#   endif 
    212       END DO 
    213 #  else 
    214 #   if defined key_vectopt_loop   &&   ! defined key_autotasking 
    215       jj = 1 
    216       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    217 #   else 
    218       DO jj = 1, jpjm1 
    219          DO ji = 1, jpim1 
    220 #   endif 
    221             iku = mbku(ji,jj) 
    222             ikv = mbkv(ji,jj) 
    223             zahu(ji,jj) = atrbbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1) 
    224             zahv(ji,jj) = atrbbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1) 
    225 #   if ! defined key_vectopt_loop   ||   defined key_autotasking 
    226          END DO 
    227 #   endif 
    228       END DO 
    229 #  endif 
     225         END DO 
     226      ENDIF 
    230227 
    231228      ! 1. Criteria of additional bottom diffusivity: grad(rho).grad(h)<0 
    … …  
    238235      CASE ( 0   )               ! 0 :Jackett and McDougall (1994) formulation 
    239236 
    240 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     237#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    241238      jj = 1 
    242239      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    … …  
    257254            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    258255            zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
    259 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
    260          END DO 
    261 #  endif 
    262       END DO 
    263  
    264 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     256#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     257         END DO 
     258#  endif 
     259      END DO 
     260 
     261#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    265262      jj = 1 
    266263      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    … …  
    281278            zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    282279            zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
    283 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
     280#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    284281         END DO 
    285282#  endif 
    … …  
    288285      CASE ( 1 )               ! Linear formulation function of temperature only 
    289286                               !  
    290 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     287#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    291288      jj = 1 
    292289      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    … …  
    300297            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    301298            zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
    302 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
    303          END DO 
    304 #  endif 
    305       END DO 
    306  
    307 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     299#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     300         END DO 
     301#  endif 
     302      END DO 
     303 
     304#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    308305      jj = 1 
    309306      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    … …  
    317314            zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    318315            zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
    319 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
     316#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    320317         END DO 
    321318#  endif 
    … …  
    341338 
    342339      ! first derivative (gradient) 
    343 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     340#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    344341      jj = 1 
    345342      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    … …  
    353350            zky(ji,jj) = zkj(ji,jj) * ( ztbb(ji,jj+1) - ztbb(ji,jj) ) 
    354351            zkw(ji,jj) = zkj(ji,jj) * ( zsbb(ji,jj+1) - zsbb(ji,jj) ) 
    355 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
     352#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    356353         END DO 
    357354#  endif 
    … …  
    391388 
    392389      ! second derivative (divergence) and add to the general tracer trend 
    393 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     390#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    394391      jj = 1 
    395392      DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    … …  
    406403            ta(ji,jj,ik) = ta(ji,jj,ik) + zta 
    407404            sa(ji,jj,ik) = sa(ji,jj,ik) + zsa 
    408 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
     405#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    409406         END DO 
    410407#  endif 
    … …  
    414411      ! BBL lateral diffusion tracers trends 
    415412      IF( l_trdtra )   THEN 
    416 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     413#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    417414         jj = 1 
    418415         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    … …  
    424421            tldfbbl(ji,jj) = ta(ji,jj,ik) - ztdta(ji,jj,ik) 
    425422            sldfbbl(ji,jj) = sa(ji,jj,ik) - ztdsa(ji,jj,ik) 
    426 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
     423#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    427424            END DO 
    428425#  endif 
Note: See TracChangeset for help on using the changeset viewer.