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 501 – NEMO

Changeset 501


Ignore:
Timestamp:
2006-09-12T13:10:14+02:00 (18 years ago)
Author:
opalod
Message:

nemo_v1_update_068:CE:re-organization of coordinate definition and scale factors

Location:
trunk/NEMO/TOP_SRC/TRP
Files:
14 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/TOP_SRC/TRP/trcadv_cen2.F90

    r433 r501  
    5252      !!        Part I : horizontal advection 
    5353      !!      * centered flux: 
    54       !!         * s-coordinate (lk_sco=T) or 
    55       !!         * z-coordinate with partial steps (lk_zps=T), 
     54      !!         * s-coordinate (ln_sco=T) or 
     55      !!         * z-coordinate with partial steps (ln_zps=T), 
    5656      !!        the vertical scale factors e3. are inside the derivatives: 
    5757      !!               zcenu = e2u*e3u  un  mi(tn) 
    … …  
    6161      !!               zcenv = e1v  vn  mj(tn) 
    6262      !!      * horizontal advective trend (divergence of the fluxes) 
    63       !!         * s-coordinate (lk_sco=T) or 
    64       !!         * z-coordinate with partial steps (lk_zps=T) 
     63      !!         * s-coordinate (ln_sco=T) or 
     64      !!         * z-coordinate with partial steps (ln_zps=T) 
    6565      !!               ztra = 1/(e1t*e2t*e3t) { di-1[zwx] + dj-1[zwy] } 
    6666      !!         * z-coordinate (default key), e3t=e3u=e3v: 
    … …  
    190190                  zcofj = MAX( zind(ji,jj+1,jk), zind(ji,jj,jk) ) 
    191191                  ! volume fluxes * 1/2 
    192 #if defined key_s_coord || defined key_partial_steps 
     192#if ! defined key_zco 
    193193                  zfui = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * zun(ji,jj,jk) 
    194194                  zfvj = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk) 
    … …  
    219219            DO jj = 2, jpjm1 
    220220               DO ji = fs_2, fs_jpim1   ! vector opt. 
    221 #if defined key_s_coord || defined key_partial_steps 
     221#if ! defined key_zco 
    222222                  zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk) 
    223223#else 
    … …  
    233233#if defined key_trc_diatrd  
    234234                  ! recompute the trends in i- and j-direction as Uh gradh(T) 
    235 # if defined key_s_coord || defined key_partial_steps 
     235#if ! defined key_zco 
    236236                  zfui = 0.5 * e2u(ji  ,jj) * fse3u(ji,  jj,jk) * zun(ji,  jj,jk) 
    237237                  zfui1= 0.5 * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zun(ji-1,jj,jk) 

  • trunk/NEMO/TOP_SRC/TRP/trcadv_muscl.F90

    r433 r501  
    166166               DO ji = fs_2, fs_jpim1   ! vector opt. 
    167167                  ! volume fluxes 
    168 #if defined key_s_coord || defined key_partial_steps 
     168#if ! defined key_zco 
    169169                  zeu = e2u(ji,jj) * fse3u(ji,jj,jk) * zun(ji,jj,jk) 
    170170                  zev = e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk) 
    … …  
    200200            DO jj = 2, jpjm1       
    201201               DO ji = fs_2, fs_jpim1   ! vector opt. 
    202 #if defined key_s_coord || defined key_partial_steps 
     202#if ! defined key_zco 
    203203                  zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) ) 
    204204#else 
    … …  
    212212#if defined key_trc_diatrd 
    213213                  ! recompute the trends in i- and j-direction as Uh gradh(T) 
    214 #   if defined key_s_coord || defined key_partial_steps 
     214#if ! defined key_zco 
    215215                  zfui =  e2u(ji  ,jj) * fse3u(ji,  jj,jk) * un(ji,  jj,jk)   & 
    216216                     & -  e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * un(ji-1,jj,jk) 

  • trunk/NEMO/TOP_SRC/TRP/trcadv_muscl2.F90

    r433 r501  
    164164               DO ji = fs_2, fs_jpim1   ! vector opt. 
    165165                  ! volume fluxes 
    166 #if defined key_s_coord || defined key_partial_steps 
     166#if ! defined key_zco 
    167167                  zeu = e2u(ji,jj) * fse3u(ji,jj,jk) * zun(ji,jj,jk) 
    168168                  zev = e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk) 
    … …  
    194194            DO jj = 2, jpjm1 
    195195               DO ji = fs_2, fs_jpim1   ! vector opt. 
    196 #if defined key_s_coord || defined key_partial_steps 
     196#if ! defined key_zco 
    197197                  zev = e1v(ji,jj) * fse3v(ji,jj,jk) 
    198198                  IF( umask(ji,jj,jk) == 0. ) THEN 
    … …  
    248248            DO jj = 2, jpjm1       
    249249               DO ji = fs_2, fs_jpim1   ! vector opt. 
    250 #if defined key_s_coord || defined key_partial_steps 
     250#if ! defined key_zco 
    251251                  zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) ) 
    252252#else 
    … …  
    260260#if defined key_trc_diatrd 
    261261                  ! recompute the trends in i- and j-direction as Uh gradh(T) 
    262 #   if defined key_s_coord || defined key_partial_steps 
     262#if ! defined key_zco 
    263263                  zfui =  e2u(ji  ,jj) * fse3u(ji,  jj,jk) * un(ji,  jj,jk)   & 
    264264                     & -  e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * un(ji-1,jj,jk) 

  • trunk/NEMO/TOP_SRC/TRP/trcbbc.F90

    r494 r501  
    7878 
    7979      !! * Local declarations 
    80 #if defined key_vectopt_loop   &&   ! defined key_autotasking 
     80#if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    8181      INTEGER ::   ji, jn                  ! dummy loop indices 
    8282#else 
    … …  
    9797 
    9898         DO jn = 1, jptra 
    99 #if defined key_vectopt_loop   &&   ! defined key_autotasking 
     99#if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    100100            DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    101101               tra(ji,1,nbotlevt(ji,1),jn) = tra(ji,1,nbotlevt(ji,1),jn) + qgh_trd(ji,1) 
    … …  
    206206      CASE ( 1:2 )                !  geothermal heat flux 
    207207 
    208 #if defined key_vectopt_loop   &&   ! defined key_autotasking 
     208#if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    209209         DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    210210            qgh_trd(ji,1) = ro0cpr * qgh_trd(ji,1) / fse3t(ji,1,nbotlevt(ji,1) ) 

  • trunk/NEMO/TOP_SRC/TRP/trcbbl.F90

    r439 r501  
    1818   USE oce_trc             ! ocean dynamics and active tracers variables 
    1919   USE trc                 ! ocean passive tracers variables 
     20   USE trctrp_lec      ! passive tracers transport 
    2021   USE prtctl_trc          ! Print control for debbuging 
    2122   USE eosbn2 
     23   USE lbclnk 
     24 
    2225   IMPLICIT NONE 
    2326   PRIVATE 
    … …  
    5356      mbkt, mbku, mbkv                 ! ??? 
    5457 
    55    REAL(wp) ::        &  !!! * trcbbl namelist * 
    56       atrcbbl = 1.e+3      ! lateral coeff. for bottom boundary layer scheme (m2/s) 
    5758 
    5859   !! * Substitutions 
    … …  
    115116      INTEGER ::   ik 
    116117      INTEGER ::   ii0, ii1, ij0, ij1       ! temporary integers 
    117 #  if defined key_partial_steps 
    118118      INTEGER  ::   iku1, iku2, ikv1,ikv2   ! temporary intergers 
    119119      REAL(wp) ::   ze3u, ze3v              ! temporary scalars 
    120 #  else 
    121120      INTEGER ::   iku, ikv 
    122 #  endif 
    123121      REAL(wp) ::   & 
    124122         zsign, zt, zs, zh, zalbet,      &  ! temporary scalars 
    … …  
    161159      ! mbathy= number of w-level, minimum value=1 (cf dommsk.F) 
    162160 
    163 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     161#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    164162      jj = 1 
    165163      DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    … …  
    172170            zsnb(ji,jj) = sn(ji,jj,ik) * tmask(ji,jj,1) 
    173171            zdep(ji,jj) = fsdept(ji,jj,ik)                ! depth of the ocean bottom T-level 
    174 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
    175          END DO 
    176 #  endif 
    177       END DO 
    178  
    179 #  if defined key_partial_steps 
    180       ! partial steps correction  
    181 #   if defined key_vectopt_loop   &&   ! defined key_autotasking 
    182       jj = 1 
    183       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     172#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     173         END DO 
     174#  endif 
     175      END DO 
     176 
     177      IF( ln_zps ) THEN      ! partial steps correction 
     178 
     179#   if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
     180         jj = 1 
     181         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    184182#   else 
    185       DO jj = 1, jpjm1 
    186          DO ji = 1, jpim1 
     183         DO jj = 1, jpjm1 
     184            DO ji = 1, jpim1 
    187185#   endif 
    188             iku1 = MAX( mbathy(ji+1,jj  )-1, 1 ) 
    189             iku2 = MAX( mbathy(ji  ,jj  )-1, 1 ) 
    190             ikv1 = MAX( mbathy(ji  ,jj+1)-1, 1 ) 
    191             ikv2 = MAX( mbathy(ji  ,jj  )-1, 1 ) 
    192             ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) )  
    193             ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) )  
    194             zahu(ji,jj) = atrcbbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1) 
    195             zahv(ji,jj) = atrcbbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1) 
    196 #   if ! defined key_vectopt_loop   ||   defined key_autotasking 
    197          END DO 
     186               iku1 = MAX( mbathy(ji+1,jj  )-1, 1 ) 
     187               iku2 = MAX( mbathy(ji  ,jj  )-1, 1 ) 
     188               ikv1 = MAX( mbathy(ji  ,jj+1)-1, 1 ) 
     189               ikv2 = MAX( mbathy(ji  ,jj  )-1, 1 ) 
     190               ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) )  
     191               ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) )  
     192               zahu(ji,jj) = atrcbbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1) 
     193               zahv(ji,jj) = atrcbbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1) 
     194#   if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     195            END DO 
    198196#   endif 
    199       END DO 
    200 #  else 
    201 #   if defined key_vectopt_loop   &&   ! defined key_autotasking 
    202       jj = 1 
    203       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     197         END DO 
     198      ELSE                  ! z-coordinate - full steps or s-coordinate 
     199#   if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
     200         jj = 1 
     201         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    204202#   else 
    205       DO jj = 1, jpjm1 
    206          DO ji = 1, jpim1 
     203         DO jj = 1, jpjm1 
     204            DO ji = 1, jpim1 
    207205#   endif 
    208             iku = mbku(ji,jj) 
    209             ikv = mbkv(ji,jj) 
    210             zahu(ji,jj) = atrcbbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1) 
    211             zahv(ji,jj) = atrcbbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1) 
    212 #   if ! defined key_vectopt_loop   ||   defined key_autotasking 
    213          END DO 
     206               iku = mbku(ji,jj) 
     207               ikv = mbkv(ji,jj) 
     208               zahu(ji,jj) = atrcbbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1) 
     209               zahv(ji,jj) = atrcbbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1) 
     210#   if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     211            END DO 
    214212#   endif 
    215       END DO 
    216 #  endif 
     213         END DO 
     214     ENDIF 
    217215 
    218216!! 
    … …  
    227225         ! first derivative (gradient) 
    228226          
    229 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     227#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    230228         jj = 1 
    231229         DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    … …  
    236234               ik = mbkt(ji,jj)  
    237235               ztrb(ji,jj) = trb(ji,jj,ik,jn) * tmask(ji,jj,1) 
    238 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
    239             END DO 
    240 #  endif 
    241          END DO 
    242  
    243 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     236#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     237            END DO 
     238#  endif 
     239         END DO 
     240 
     241#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    244242         jj = 1 
    245243         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    … …  
    250248               zkx(ji,jj) = bblx(ji,jj) * zahu(ji,jj) * ( ztrb(ji+1,jj) - ztrb(ji,jj) ) 
    251249               zky(ji,jj) = bbly(ji,jj) * zahv(ji,jj) * ( ztrb(ji,jj+1) - ztrb(ji,jj) ) 
    252 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
     250#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    253251            END DO 
    254252#  endif 
    … …  
    266264         CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    267265 
    268 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     266#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    269267      jj = 1 
    270268      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    … …  
    285283            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    286284            zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
    287 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
    288          END DO 
    289 #  endif 
    290       END DO 
    291  
    292 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     285#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     286         END DO 
     287#  endif 
     288      END DO 
     289 
     290#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    293291      jj = 1 
    294292      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    … …  
    307305                   -          ( zsnb(ji,jj+1) - zsnb(ji,jj) ) 
    308306            ! sign of local j-gradient of density multiplied by the j-slope 
    309             zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     307            zsign = SIGN( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    310308            zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
    311 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
     309#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    312310         END DO 
    313311#  endif 
    … …  
    316314   CASE ( 1 )               ! Linear formulation function of temperature only 
    317315 
    318 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     316#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    319317      jj = 1 
    320318      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    … …  
    328326            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    329327            zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
    330 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
    331          END DO 
    332 #  endif 
    333       END DO 
    334  
    335 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     328#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     329         END DO 
     330#  endif 
     331      END DO 
     332 
     333#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    336334      jj = 1 
    337335      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    … …  
    343341            zgdrho =  ( ztnb(ji,jj+1) - ztnb(ji,jj) ) 
    344342            ! sign of local j-gradient of density multiplied by the j-slope 
    345             zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     343            zsign = SIGN( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    346344            zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
    347345 
    348 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
     346#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    349347         END DO 
    350348#  endif 
    … …  
    378376      CASE DEFAULT 
    379377 
    380          IF(lwp) WRITE(numout,cform_err) 
    381          IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos 
    382          nstop = nstop + 1 
     378         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
     379         CALL ctl_stop( ctmp1 ) 
    383380 
    384381      END SELECT 
    … …  
    390387         ! first derivative (gradient) 
    391388 
    392 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     389#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    393390         jj = 1 
    394391         DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    … …  
    399396               ik = mbkt(ji,jj) 
    400397               ztrb(ji,jj) = trb(ji,jj,ik,jn) * tmask(ji,jj,1) 
    401 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
    402             END DO 
    403 #  endif 
    404          END DO 
    405 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     398#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     399            END DO 
     400#  endif 
     401         END DO 
     402#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    406403         jj = 1 
    407404         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    … …  
    412409               zkx(ji,jj) = zki(ji,jj) * ( ztrb(ji+1,jj) - ztrb(ji,jj) ) 
    413410               zky(ji,jj) = zkj(ji,jj) * ( ztrb(ji,jj+1) - ztrb(ji,jj) ) 
    414 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
     411#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    415412            END DO 
    416413#  endif 
    … …  
    450447          
    451448         ! second derivative (divergence) and add to the general tracer trend 
    452 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
     449#  if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    453450         jj = 1 
    454451         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    … …  
    462459                  &    + zky(ji,jj) - zky(ji  ,jj-1)  ) * zbtr 
    463460               tra(ji,jj,ik,jn) = tra(ji,jj,ik,jn) + ztra 
    464 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
     461#  if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    465462            END DO 
    466463#  endif 
    … …  
    498495      !! ** Purpose :   Initialization for the bottom boundary layer scheme. 
    499496      !! 
    500       !! ** Method  :   Read the namtrcbbl namelist and check the parameters 
    501       !!      called by tra_bbl at the first timestep (nittrc000) 
    502497      !! 
    503498      !! History : 
    … …  
    506501      !! * Local declarations 
    507502      INTEGER ::   ji, jj      ! dummy loop indices 
    508       INTEGER :: numnat=80 
    509       NAMELIST/namtrcbbl/ atrcbbl 
    510  
    511       !!---------------------------------------------------------------------- 
    512       ! Read Namelist namtrcbbl : bottom boundary layer scheme 
    513       ! -------------------- 
    514  
    515       OPEN(numnat,FILE='namelist.trp.cfc') 
    516       REWIND ( numnat ) 
    517       READ   ( numnat, namtrcbbl ) 
    518       CLOSE(numnat) 
    519  
    520  
    521       ! Parameter control and print 
    522       ! --------------------------- 
    523       IF(lwp) THEN 
    524          WRITE(numout,*) 
    525          WRITE(numout,*) 'trc_bbl_init : * Diffusive Bottom Boundary Layer' 
    526          WRITE(numout,*) '~~~~~~~~~~~~' 
    527          WRITE(numout,*) ' bottom boundary layer coef.    atrcbbl = ', atrcbbl 
    528 # if defined key_trcbbl_adv 
    529             WRITE(numout,*) '               * Advective Bottom Boundary Layer' 
    530 # endif 
    531          WRITE(numout,*) 
    532       ENDIF 
    533   
     503 
     504      REAL(wp),  DIMENSION(jpi,jpj) :: zmbk   
     505 
     506      !!---------------------------------------------------------------------- 
     507 
    534508      DO jj = 1, jpj 
    535509         DO ji = 1, jpi 
    … …  
    537511         END DO 
    538512      END DO 
     513       
    539514      DO jj = 1, jpjm1 
    540515         DO ji = 1, jpim1 
    … …  
    543518         END DO 
    544519      END DO 
    545 !!bug ??? 
    546 !!bug Caution : define the vakue of mbku & mbkv everywhere!!! but lbc mpp lnk : pb when closed (0) 
     520 
     521      zmbk(:,:) = FLOAT( mbku (:,:) )    
     522      CALL lbc_lnk(zmbk,'U',1.) 
     523      mbku (:,:) = MAX( INT( zmbk(:,:) ), 1 )  
     524    
     525      zmbk(:,:) = FLOAT( mbkv (:,:) )    
     526      CALL lbc_lnk(zmbk,'V',1.) 
     527      mbkv (:,:) = MAX( INT( zmbk(:,:) ), 1 )  
    547528 
    548529# if defined key_trcbbl_adv 

  • trunk/NEMO/TOP_SRC/TRP/trcbbl_adv.h90

    r403 r501  
    5252      !!   9.0  !  04-03  (C. Ethe) Adaptation for Passive tracers  
    5353      !!----------------------------------------------------------------------      
    54       !! * Modules used 
    55       USE lbclnk           ! ocean lateral boundary conditions (or mpp link) 
    56       USE eosbn2 
    57  
     54      !gh 
     55       
    5856      !! * Arguments 
    5957      INTEGER, INTENT( in ) ::   kt        ! ocean time-step  
    … …  
    6664         zsign, zt, zs, zh, zalbet,     &  ! temporary scalars 
    6765         zgdrho, zbtr, ztra                !    "         "  
    68       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    69          zki, zkj, zkw, zkx, zky, zkz,  &  ! temporary workspace arrays 
    70          ztnb, zsnb, zdep, ztrb,        &  !    "                  " 
    71          zahu, zahv                        !    "                  " 
     66      REAL(wp), DIMENSION(jpi,jpj) ::   &   
     67          ztnb, zsnb, zdep, ztrb       ! temporary workspace arrays  
    7268      REAL(wp), DIMENSION(jpi,jpj) ::   &  ! temporary workspace arrays 
    7369         zalphax, zwu, zunb,            &  !    "                  " 
    7470         zalphay, zwv, zvnb,            &  !    "                  " 
    75          zwx, zwy                          !    "                  " 
     71         zwx, zwy, zww, zwz,            &  !    "                  " 
     72         zti, zsi ,ztmin,ztmax, zsmin,zsmax!    "                  " 
     73                              !    "                  " 
    7674      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    7775         zhdivn                            ! temporary workspace arrays 
    7876      REAL(wp) ::   & 
    79          zfui, zfvj, zbt, zsigna           ! temporary scalars 
     77         zfui, zfvj, zbt,  zsigna,     &  ! temporary scalars 
     78    iku1,iku2,ikv1,ikv2,      &  ! temporary scalars 
     79    ze3u,ze3v,          &  ! temporary scalars 
     80    z2,z2dtt                  ! temporary scalars 
    8081      REAL(wp) ::   & 
    8182         fsalbt, pft, pfs, pfh             ! statement function 
    … …  
    103104      !!---------------------------------------------------------------------- 
    104105 
    105       IF( kt == nittrc000 )   CALL trc_bbl_init    ! initialization at first time-step 
    106  
     106   IF( kt == nit000 )   CALL trc_bbl_init    ! initialization at first time-step 
     107    
    107108      ! 1. 2D fields of bottom temperature and salinity, and bottom slope 
    108109      ! ----------------------------------------------------------------- 
    109110      ! mbathy= number of w-level, minimum value=1 (cf dommsk.F) 
    110111 
    111 #if defined key_vectopt_loop   &&   ! defined key_autotasking 
     112#if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    112113      jj = 1 
    113114      DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    … …  
    116117         DO ji = 1, jpi 
    117118#endif 
    118             ik = mbkt(ji,jj)                               ! index of the bottom ocean T-level 
    119             ztnb(ji,jj) = tn(ji,jj,ik) * tmask(ji,jj,1)    ! masked now T at the ocean bottom  
    120             zsnb(ji,jj) = sn(ji,jj,ik) * tmask(ji,jj,1)    ! masked now S at the ocean bottom 
     119            ik = mbkt(ji,jj)                    ! index of the bottom ocean T-level 
     120            ztnb(ji,jj) = tn(ji,jj,ik)    ! masked now T at the ocean bottom  
     121            zsnb(ji,jj) = sn(ji,jj,ik)    ! masked now S at the ocean bottom 
    121122            zdep(ji,jj) = fsdept(ji,jj,ik)                 ! depth of the ocean bottom T-level 
    122 #if ! defined key_vectopt_loop   ||   defined key_autotasking 
     123!gh 
     124            zunb(ji,jj) = un(ji,jj,mbku(ji,jj))  
     125            zvnb(ji,jj) = vn(ji,jj,mbkv(ji,jj))  
     126#if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    123127         END DO 
    124128#endif 
    125129      END DO 
    126 #if defined key_vectopt_loop   &&   ! defined key_autotasking  
    127       jj = 1 
    128       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    129             zunb(ji,jj) = un(ji,jj,mbku(ji,jj)) * umask(ji,jj,1) 
    130             zvnb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) * vmask(ji,jj,1)   ! retirer le mask en u, v et t ! 
    131       END DO 
    132 #else 
    133       DO jj = 1, jpjm1 
    134          DO ji = 1, jpim1 
    135             zunb(ji,jj) = un(ji,jj,mbku(ji,jj)) * umask(ji,jj,1) 
    136             zvnb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) * vmask(ji,jj,1) 
    137          END DO 
    138       END DO 
    139 #endif 
    140  
    141       ! boundary conditions on zunb and zvnb   (changed sign) 
    142        CALL lbc_lnk( zunb, 'U', -1. )   ;   CALL lbc_lnk( zvnb, 'V', -1. ) 
    143  
    144  
    145130 
    146131      ! 2. Criteria of additional bottom diffusivity: grad(rho).grad(h)<0 
    … …  
    166151          zgdrho = zgdrho * umask(ji,jj,1) 
    167152      !   ... sign of local i-gradient of density multiplied by the i-slope 
    168           zsign = sign( 0.5, -zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    169           zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
    170  
    171           zsigna= sign(0.5, zunb(ji,jj)*(  zdep(ji+1,jj) - zdep(ji,jj) )) 
    172           zalphax(ji,jj)=(0.5+zsigna)*(0.5-zsign)*umask(ji,jj,1) 
     153          zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     154     zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     155          zalphax(ji,jj) = ( 0.5 + zsigna ) * ( 0.5-zsign ) * umask(ji,jj,1) 
    173156        END DO 
    174157      END DO 
    … …  
    185168          zgdrho = zalbet*( ztnb(ji,jj+1) - ztnb(ji,jj) )   & 
    186169                     -    ( zsnb(ji,jj+1) - zsnb(ji,jj) ) 
    187           zgdrho = zgdrho*vmask(ji,jj,1) 
     170          zgdrho = zgdrho * vmask(ji,jj,1) 
    188171      !   ... sign of local j-gradient of density multiplied by the j-slope 
    189           zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    190           zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
    191  
    192           zsigna= sign(0.5, zvnb(ji,jj)*(zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    193           zalphay(ji,jj)=(0.5+zsigna)*(0.5-zsign)*vmask(ji,jj,1) 
     172          zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     173     zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     174          zalphay(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 
    194175        END DO 
    195176      END DO 
    … …  
    198179      CASE ( 1 )               ! Linear formulation function of temperature only 
    199180 
    200  
    201 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
    202       jj = 1 
    203       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    204 #  else 
    205181      DO jj = 1, jpjm1 
    206          DO ji = 1, jpim1 
    207 #  endif 
     182        DO ji = 1, fs_jpim1   ! vector opt. 
    208183            ! temperature, salinity anomalie and depth 
    209184            zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) ) 
    210185            zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0 
    211186            zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 
    212             ! masked ratio alpha/beta 
     187!gh            ! masked ratio alpha/beta 
    213188            ! local density gradient along i-bathymetric slope 
    214             zgdrho =  ( ztnb(ji+1,jj) - ztnb(ji,jj) ) 
     189            zgdrho =  ( ztnb(ji+1,jj) - ztnb(ji,jj) )    
    215190            ! sign of local i-gradient of density multiplied by the i-slope 
    216             zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    217             zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
    218  
    219             zsigna= sign(0.5, zunb(ji,jj)*(  zdep(ji+1,jj) - zdep(ji,jj) )) 
    220             zalphax(ji,jj)=(0.5-zsigna)*(0.5-zsign)*umask(ji,jj,1) 
    221 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
     191            zsign = SIGN( 0.5, - zgdrho    * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     192       zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     193            zalphax(ji,jj) = ( 0.5 - zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1) 
    222194         END DO 
    223 #  endif 
    224       END DO 
    225  
    226 #  if defined key_vectopt_loop   &&   ! defined key_autotasking 
    227       jj = 1 
    228       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    229 #  else 
     195      END DO 
     196 
    230197      DO jj = 1, jpjm1 
    231          DO ji = 1, jpim1 
    232 #  endif 
     198        DO ji = 1, fs_jpim1   ! vector opt. 
    233199            ! temperature, salinity anomalie and depth 
    234200            zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) ) 
    235201            zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0 
    236202            zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 
    237             ! masked ratio alpha/beta 
     203!gh             ! masked ratio alpha/beta 
    238204            ! local density gradient along j-bathymetric slope 
    239             zgdrho =  ( ztnb(ji,jj+1) - ztnb(ji,jj) ) 
     205            zgdrho =  ( ztnb(ji,jj+1) - ztnb(ji,jj) )    
    240206            ! sign of local j-gradient of density multiplied by the j-slope 
    241             zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    242             zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
    243  
    244             zsigna= sign(0.5, zvnb(ji,jj)*(zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    245             zalphay(ji,jj)=(0.5-zsigna)*(0.5-zsign)*vmask(ji,jj,1) 
    246 #  if ! defined key_vectopt_loop   ||   defined key_autotasking 
     207            zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     208       zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     209            zalphay(ji,jj) = ( 0.5 - zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 
    247210         END DO 
    248 #  endif 
    249       END DO 
    250  
     211      END DO 
     212        
    251213      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    252  
    253       DO jj = 1, jpjm1 
    254          DO ji = 1, fs_jpim1   ! vector opt. 
    255             ! local density gradient along i-bathymetric slope 
     214 DO jj = 1, jpjm1 
     215        DO ji = 1, fs_jpim1   ! vector opt. 
     216       ! local density gradient along i-bathymetric slope 
    256217            zgdrho = - ( rbeta*( zsnb(ji+1,jj) - zsnb(ji,jj) )   & 
    257218                     -  ralpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 
    258219            ! sign of local i-gradient of density multiplied by the i-slope 
    259220            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    260  
    261             zsigna= sign(0.5, zunb(ji,jj)*(  zdep(ji+1,jj) - zdep(ji,jj) )) 
     221       zsigna= SIGN( 0.5, zunb(ji,jj)*(  zdep(ji+1,jj) - zdep(ji,jj) )) 
    262222            zalphax(ji,jj)=(0.5-zsigna)*(0.5-zsign)*umask(ji,jj,1) 
     223        END DO 
     224      END DO 
     225 
     226      DO jj = 1, jpjm1 
     227        DO ji = 1, fs_jpim1   ! vector opt. 
     228      ! local density gradient along j-bathymetric slope 
     229            zgdrho = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) )   & 
     230                   -    ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) )    
     231            ! sign of local j-gradient of density multiplied by the j-slope 
     232            zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji,jj+1) - zdep(ji,jj) ) )   
     233       zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     234            zalphay(ji,jj) = ( 0.5 - zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 
    263235         END DO 
    264236      END DO 
    265237 
    266       DO jj = 1, jpjm1 
    267          DO ji = 1, fs_jpim1   ! vector opt. 
    268              ! local density gradient along j-bathymetric slope 
    269              zgdrho = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) )   & 
    270                     -    ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) ) 
    271              ! sign of local j-gradient of density multiplied by the j-slope 
    272              zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    273  
    274              zsigna= sign(0.5, zvnb(ji,jj)*(zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    275              zalphay(ji,jj)=(0.5-zsigna)*(0.5-zsign)*vmask(ji,jj,1) 
    276          END DO 
    277       END DO 
    278  
    279  
     238        
    280239      CASE DEFAULT 
    281240 
    … …  
    295254       u_trc_bbl(:,:,:) = 0.e0 
    296255       v_trc_bbl(:,:,:) = 0.e0 
    297 # if defined key_vectopt_loop   &&   ! defined key_autotasking 
     256        
     257        
     258!gh      
     259       IF( ln_zps ) THEN 
     260      ! partial steps correction    
     261       
     262#if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    298263       jj = 1 
    299264       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    300 # else 
     265#else 
    301266       DO jj = 1, jpjm1 
    302267          DO ji = 1, jpim1 
    303 # endif 
    304              iku = mbku(ji,jj) 
    305              ikv = mbkv(ji,jj) 
     268#endif 
     269             iku  = mbku(ji  ,jj  ) 
     270             ikv  = mbkv(ji  ,jj  )   
     271             iku1 = mbkt(ji+1,jj  ) 
     272             iku2 = mbkt(ji  ,jj  ) 
     273             ikv1 = mbkt(ji  ,jj+1) 
     274             ikv2 = mbkt(ji  ,jj  ) 
     275             ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) )  
     276             ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) )  
     277              
    306278             IF( MAX(iku,ikv) >  1 ) THEN 
    307                 u_trc_bbl(ji,jj,iku) = zalphax(ji,jj) * un(ji,jj,iku) * umask(ji,jj,1) 
    308                 v_trc_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv) * vmask(ji,jj,1) 
     279                u_trc_bbl(ji,jj,iku) = zalphax(ji,jj) * un(ji,jj,iku) * ze3u / fse3u(ji,jj,iku) 
     280                v_trc_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv) * ze3v / fse3v(ji,jj,ikv)        
    309281             ENDIF 
    310 # if ! defined key_vectopt_loop   ||   defined key_autotasking 
    311           END DO 
    312 # endif 
     282#if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     283          END DO 
     284#endif 
    313285       END DO 
    314286 
    315        ! lateral boundary conditions on u_trc_bbl and v_trc_bbl   (changed sign) 
     287      ! lateral boundary conditions on u_trc_bbl and v_trc_bbl   (changed sign) 
    316288       CALL lbc_lnk( u_trc_bbl, 'U', -1. )   ;   CALL lbc_lnk( v_trc_bbl, 'V', -1. ) 
    317  
    318  
     289        
     290    ELSE    ! z-coordinate - full steps or s-coordinate    
     291       ! if not partial step loop over the whole domain no lbc call 
     292 
     293#if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
     294      jj = 1 
     295      DO ji = 1, jpij   ! vector opt. (forced unrolling) 
     296#else 
     297      DO jj = 1, jpj 
     298         DO ji = 1, jpi 
     299#endif 
     300            iku = mbku(ji,jj) 
     301            ikv = mbkv(ji,jj) 
     302            IF( MAX(iku,ikv) >  1 ) THEN 
     303               u_trc_bbl(ji,jj,iku) = zalphax(ji,jj) * un(ji,jj,iku)  
     304               v_trc_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv)        
     305            ENDIF 
     306#if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     307         END DO 
     308#endif 
     309          END DO 
     310        
     311       ENDIF 
    319312        
    320313       DO jn = 1, jptra 
    321314 
    322 #if defined key_vectopt_loop   &&   ! defined key_autotasking 
     315#if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    323316          jj = 1 
    324317          DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    … …  
    329322                ik = mbkt(ji,jj)                               ! index of the bottom ocean T-level 
    330323                ztrb(ji,jj) = trb(ji,jj,ik,jn) * tmask(ji,jj,1)    ! masked now T at the ocean bottom  
    331 #if ! defined key_vectopt_loop   ||   defined key_autotasking 
    332              END DO 
    333 #endif 
    334           END DO 
     324#if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     325             END DO 
     326#endif 
     327          END DO 
     328 
    335329 
    336330 
    … …  
    339333          ! ... Second order centered tracer flux at u and v-points 
    340334        
    341 # if defined key_vectopt_loop   &&   ! defined key_autotasking 
     335# if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    342336          jj = 1 
    343337          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    … …  
    348342                iku = mbku(ji,jj) 
    349343                ikv = mbkv(ji,jj) 
    350                 zfui = zalphax(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,iku) * zunb(ji,jj) 
    351                 zfvj = zalphay(ji,jj) *e1v(ji,jj) * fse3v(ji,jj,ikv) * zvnb(ji,jj) 
     344                zfui = e2u(ji,jj) * fse3u(ji,jj,iku) * u_trc_bbl(ji,jj,iku) 
     345                zfvj = e1v(ji,jj) * fse3v(ji,jj,ikv) * v_trc_bbl(ji,jj,ikv) 
    352346                ! upstream scheme 
    353347                zwx(ji,jj) = ( ( zfui + ABS( zfui ) ) * ztrb(ji  ,jj  )   & 
    … …  
    355349                zwy(ji,jj) = ( ( zfvj + ABS( zfvj ) ) * ztrb(ji  ,jj  )   & 
    356350                   &          +( zfvj - ABS( zfvj ) ) * ztrb(ji  ,jj+1) ) * 0.5 
    357 #if ! defined key_vectopt_loop   ||   defined key_autotasking 
    358              END DO 
    359 #endif 
    360           END DO 
    361 # if defined key_vectopt_loop   &&   ! defined key_autotasking 
     351#if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     352             END DO 
     353#endif 
     354          END DO 
     355      
     356# if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    362357          jj = 1 
    363358          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    … …  
    371366                ztra = - zbtr * (  zwx(ji,jj) - zwx(ji-1,jj  )   & 
    372367                   &             + zwy(ji,jj) - zwy(ji  ,jj-1)  ) 
    373  
     368  
    374369                ! add it to the general tracer trends 
    375370                tra(ji,jj,ik,jn) = tra(ji,jj,ik,jn) + ztra 
    376 #if ! defined key_vectopt_loop   ||   defined key_autotasking 
    377              END DO 
    378 #endif 
    379           END DO 
    380  
    381        END DO 
    382  
    383       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     371#if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     372             END DO 
     373#endif 
     374          END DO 
     375      
     376        END DO 
     377    
     378        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    384379         WRITE(charout, FMT="('bbl - adv')") 
    385380         CALL prt_ctl_trc_info(charout) 
    386381         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    387382      ENDIF          
     383        
    388384       ! 6. Vertical advection velocities 
    389385       ! -------------------------------- 
    … …  
    393389          DO jj=1, jpjm1 
    394390             DO ji = 1, fs_jpim1   ! vertor opt. 
    395                 zwu(ji,jj) = -e2u(ji,jj) * u_trc_bbl(ji,jj,jk) 
    396                 zwv(ji,jj) = -e1v(ji,jj) * v_trc_bbl(ji,jj,jk) 
     391                zwu(ji,jj) = -e2u(ji,jj) * u_trc_bbl(ji,jj,jk) * fse3u(ji,jj,jk) 
     392                zwv(ji,jj) = -e1v(ji,jj) * v_trc_bbl(ji,jj,jk) * fse3v(ji,jj,jk) 
    397393             END DO 
    398394          END DO 
    … …  
    401397          DO jj = 2, jpjm1 
    402398             DO ji = fs_2, fs_jpim1   ! vector opt. 
    403                 zbt = e1t(ji,jj) * e2t(ji,jj) 
     399                zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    404400                zhdivn(ji,jj,jk) = (  zwu(ji,jj) - zwu(ji-1,jj  )   & 
    405401                   &                + zwv(ji,jj) - zwv(ji  ,jj-1)  ) / zbt 
    … …  
    410406 
    411407       ! ... horizontal bottom divergence 
    412 # if defined key_vectopt_loop   &&   ! defined key_autotasking 
    413        jj = 1 
    414        DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     408!gh 
     409       IF( ln_zps ) THEN  
     410      
     411# if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
     412          jj = 1 
     413          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    415414# else 
    416        DO jj = 1, jpjm1 
    417           DO ji = 1, jpim1 
    418 # endif 
    419              iku = mbku(ji,jj) 
    420              ikv = mbkv(ji,jj) 
    421              zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,iku)  
    422              zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * fse3v(ji,jj,ikv)  
    423 #if ! defined key_vectopt_loop   ||   defined key_autotasking 
    424           END DO 
    425 #endif 
    426        END DO 
    427  
    428 # if defined key_vectopt_loop   &&   ! defined key_autotasking 
     415          DO jj = 1, jpjm1 
     416             DO ji = 1, jpim1 
     417# endif 
     418                iku  = mbku(ji  ,jj  ) 
     419                ikv  = mbkv(ji  ,jj  )   
     420                iku1 = mbkt(ji+1,jj  ) 
     421                iku2 = mbkt(ji  ,jj  ) 
     422                ikv1 = mbkt(ji  ,jj+1) 
     423                ikv2 = mbkt(ji  ,jj  ) 
     424                ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) )  
     425                ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) )  
     426                 
     427                zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * ze3u   
     428                zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * ze3v 
     429#if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     430             END DO 
     431#endif 
     432          END DO 
     433    
     434       ELSE 
     435 
     436# if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
     437          jj = 1 
     438          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     439# else 
     440          DO jj = 1, jpjm1 
     441             DO ji = 1, jpim1 
     442# endif 
     443                iku = mbku(ji,jj) 
     444                ikv = mbkv(ji,jj) 
     445                zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,iku)  
     446                zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * fse3v(ji,jj,ikv)  
     447#if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     448             END DO 
     449#endif 
     450          END DO 
     451       ENDIF 
     452 
     453# if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    429454       jj = 1 
    430455       DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    … …  
    436461             zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,ik) 
    437462             zhdivn(ji,jj,ik) =   & 
    438                 &   (  zwu(ji  ,jj  ) * ( zunb(ji  ,jj  ) - un(ji  ,jj  ,ik) *umask(ji  ,jj  ,1) )   & 
    439                 &    - zwu(ji-1,jj  ) * ( zunb(ji-1,jj  ) - un(ji-1,jj  ,ik) *umask(ji-1,jj  ,1) )   & 
    440                 &    + zwv(ji  ,jj  ) * ( zvnb(ji  ,jj  ) - vn(ji  ,jj  ,ik) *vmask(ji  ,jj  ,1) )   & 
    441                 &    - zwv(ji  ,jj-1) * ( zvnb(ji  ,jj-1) - vn(ji  ,jj-1,ik) *vmask(ji  ,jj-1,1) )   & 
     463                &   (  zwu(ji  ,jj  ) * ( zunb(ji  ,jj  ) - un(ji  ,jj  ,ik) )   & 
     464                &    - zwu(ji-1,jj  ) * ( zunb(ji-1,jj  ) - un(ji-1,jj  ,ik) )   & 
     465                &    + zwv(ji  ,jj  ) * ( zvnb(ji  ,jj  ) - vn(ji  ,jj  ,ik) )   & 
     466                &    - zwv(ji  ,jj-1) * ( zvnb(ji  ,jj-1) - vn(ji  ,jj-1,ik) )   & 
    442467                &   ) / zbt 
    443468 
    444 # if ! defined key_vectopt_loop   ||   defined key_autotasking 
     469# if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    445470          END DO 
    446471# endif 

  • trunk/NEMO/TOP_SRC/TRP/trcldf_bilap.F90

    r433 r501  
    4141      !!      evaluated using before fields (forward time scheme). The hor. 
    4242      !!      diffusive trends of passive tracer is given by: 
    43       !!       * s-coordinate ('key_s_coord' defined), the vertical scale  
     43      !!       * s-coordinate, the vertical scale  
    4444      !!      factors e3. are inside the derivatives: 
    4545      !!      Laplacian of trb: 
    … …  
    8787      !! * Local declarations 
    8888      INTEGER ::   ji, jj, jk, jn             ! dummy loop indices 
    89 #if defined key_partial_steps 
    9089      INTEGER ::   iku, ikv                   ! temporary integers 
    91 #endif 
     90 
    9291      REAL(wp) ::   ztra     ! temporary scalars 
    9392 
    … …  
    116115            DO jj = 1, jpjm1 
    117116               DO ji = 1, fs_jpim1   ! vector opt. 
    118 #if defined key_s_coord || defined key_partial_steps 
     117#if ! defined key_zco  
    119118                  ! s-coordinates, vertical scale factor are used 
    120119                  zbtr(ji,jj) = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) ) 
    … …  
    141140               END DO 
    142141            END DO 
    143 #if defined key_partial_steps 
    144  
    145             DO jj = 1, jpj-1 
    146                DO ji = 1, jpi-1 
    147                   ! last level 
    148                   iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1 
    149                   ikv = MIN ( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1 
    150                   IF( iku == jk ) THEN 
    151                      ztu(ji,jj,jk) = zeeu(ji,jj) * gtu(ji,jj) 
    152                   ENDIF 
    153                   IF( ikv == jk ) THEN 
    154                      ztv(ji,jj,jk) = zeev(ji,jj) * gtv(ji,jj) 
    155                   ENDIF 
    156                END DO 
    157             END DO 
    158 #endif 
     142 
     143            IF( ln_zps ) THEN 
     144               DO jj = 1, jpj-1 
     145                  DO ji = 1, jpi-1 
     146                     ! last level 
     147                     iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1 
     148                     ikv = MIN ( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1 
     149                     IF( iku == jk ) THEN 
     150                        ztu(ji,jj,jk) = zeeu(ji,jj) * gtu(ji,jj) 
     151                     ENDIF 
     152                     IF( ikv == jk ) THEN 
     153                        ztv(ji,jj,jk) = zeev(ji,jj) * gtv(ji,jj) 
     154                     ENDIF 
     155                  END DO 
     156               END DO 
     157            ENDIF 
    159158 
    160159            ! Second derivative (divergence) 

  • trunk/NEMO/TOP_SRC/TRP/trcldf_iso_zps.F90

    r433 r501  
    44   !! Ocean passive tracers:  horizontal component of the lateral tracer mixing trend 
    55   !!============================================================================== 
    6 #if key_passivetrc && ( defined key_ldfslp   &&   defined key_partial_steps ) 
     6#if key_passivetrc &&  defined key_ldfslp  
    77   !!---------------------------------------------------------------------- 
    88   !!   'key_ldfslp'               slope of the lateral diffusive direction 

  • trunk/NEMO/TOP_SRC/TRP/trcldf_lap.F90

    r433 r501  
    4040      !!      fields (forward time scheme). The horizontal diffusive trends of  
    4141      !!      the passive tracer is given by: 
    42       !!       * s-coordinate ('key_s_coord' defined), the vertical scale  
     42      !!       * s-coordinate, the vertical scale  
    4343      !!      factors e3. are inside the derivatives: 
    4444      !!          difft = 1/(e1t*e2t*e3t) {  di-1[ aht e2u*e3u/e1u di(trb) ] 
    … …  
    101101            DO jj = 1, jpjm1 
    102102               DO ji = 1, fs_jpim1   ! vector opt. 
    103 #if defined key_s_coord 
    104                   zabe1 = fsahtru(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj) * fse3u(ji,jj,jk) 
    105                   zabe2 = fsahtrv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj) * fse3v(ji,jj,jk) 
    106 #else 
    107                   zabe1 = fsahtru(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj) 
    108                   zabe2 = fsahtrv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj) 
    109 #endif 
     103                  IF ( ln_sco ) THEN 
     104                     zabe1 = fsahtru(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj) * fse3u(ji,jj,jk) 
     105                     zabe2 = fsahtrv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj) * fse3v(ji,jj,jk) 
     106                  ELSE 
     107                     zabe1 = fsahtru(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj) 
     108                     zabe2 = fsahtrv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj) 
     109                  ENDIF 
    110110                  ztu(ji,jj,jk) = zabe1 * ( trb(ji+1,jj  ,jk,jn) - trb(ji,jj,jk,jn) ) 
    111111                  ztv(ji,jj,jk) = zabe2 * ( trb(ji  ,jj+1,jk,jn) - trb(ji,jj,jk,jn) ) 
    … …  
    118118            DO jj = 2, jpjm1 
    119119               DO ji = fs_2, fs_jpim1   ! vector opt. 
    120 #if defined key_s_coord 
    121                   zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk) 
    122 #else 
    123                   zbtr = zbtr2(ji,jj) 
    124 #endif 
     120                  IF ( ln_sco ) THEN 
     121                     zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk) 
     122                  ELSE 
     123                     zbtr = zbtr2(ji,jj) 
     124                  ENDIF 
    125125                  ! horizontal diffusive trends 
    126126                  ztrax = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) 

  • trunk/NEMO/TOP_SRC/TRP/trcnxt.F90

    r349 r501  
    9797 
    9898#if defined key_obc 
    99         IF(lwp) WRITE(numout,cform_err) 
    100         IF(lwp) WRITE(numout,*) '          Passive tracers and Open Boundary condition can not be used together ' 
    101         IF(lwp) WRITE(numout,*) '          Check in trc_nxt routine' 
    102         nstop = nstop + 1 
     99        CALL ctl_stop( '          Passive tracers and Open Boundary condition can not be used together ' & 
     100           &           '          Check in trc_nxt routine' ) 
    103101#endif 
    104102 

  • trunk/NEMO/TOP_SRC/TRP/trcsbc.F90

    r349 r501  
    7373      ! 0. initialization 
    7474      zsrau = 1. / rauw 
    75 #if ! defined key_s_coord 
    76       zse3t = 1. / fse3t(1,1,1) 
    77 #endif 
     75      IF( .NOT. ln_sco )  zse3t = 1. / fse3t(1,1,1) 
    7876 
    7977      DO jn = 1, jptra 
    … …  
    8179         DO jj = 2, jpj 
    8280            DO ji = fs_2, fs_jpim1   ! vector opt. 
    83 #if defined key_s_coord 
    84                zse3t = 1. / fse3t(ji,jj,1) 
    85 #endif 
     81               IF( ln_sco ) zse3t = 1. / fse3t(ji,jj,1) 
    8682               ! concent./dilut. effect 
    8783               ztra = emps(ji,jj) * zsrau * trn(ji,jj,1,jn) * zse3t * tmask(ji,jj,1) 

  • trunk/NEMO/TOP_SRC/TRP/trctrp.F90

    r439 r501  
    8282                               CALL trc_sbc( kt )            ! surface boundary condition 
    8383# if defined key_trcbbc 
    84       IF(lwp) WRITE(numout,cform_err) 
    85       IF(lwp) WRITE(numout,*) ' Bottom heat flux not yet implemented' 
    86       IF(lwp) WRITE(numout,*) ' With passive tracers. ' 
    87       IF(lwp) WRITE(numout,*) ' Check trc_trp routine' 
    88       nstop = nstop + 1 
     84       CALL ctl_stop( '  Bottom heat flux not yet implemented with passive tracer         ' & 
     85           &          '  Check in trc_trp routine ' ) 
    8986# endif  
    9087      !                                                      ! bottom boundary condition 
    … …  
    10299 
    103100  
    104       IF( n_cla == 1   )   THEN  
    105          IF(lwp) WRITE(numout,cform_err) 
    106          IF(lwp) WRITE(numout,*) '          Cross Land Advection not yet implemented' 
    107          IF(lwp) WRITE(numout,*) '          With Passive tracers. n_cla = ', n_cla 
    108          IF(lwp) WRITE(numout,*) '          Check trc_trp routine' 
    109          nstop = nstop + 1 
     101      IF( n_cla == 1   ) THEN 
     102         WRITE(ctmp1,*) ' Cross Land Advection not yet implemented with passive tracer n_cla = ',n_cla 
     103         CALL ctl_stop(ctmp1) 
    110104      ENDIF 
    111105 
    … …  
    128122      !                                                       
    129123 
    130       IF( lk_zps .AND. .NOT. lk_trccfg_1d ) & 
     124      IF( ln_zps .AND. .NOT. lk_trccfg_1d ) & 
    131125         &                     CALL zps_hde_trc( kt, trb, gtru, gtrv )  ! Partial steps: now horizontal gradient 
    132126      !                                                                 ! of passive tracers at the bottom ocean level 

  • trunk/NEMO/TOP_SRC/TRP/trctrp_lec.F90

    r349 r501  
    2727      ln_trcadv_muscl2 = .FALSE. ,  &  !: MUSCL2 scheme flag 
    2828      ln_trcadv_smolar = .TRUE.        !: Smolarkiewicz scheme flag 
     29 
     30   !! Bottom boundary layer 
     31   REAL(wp), PUBLIC ::        &   
     32      atrcbbl = 1.e+3      ! lateral coeff. for bottom boundary layer scheme (m2/s) 
    2933 
    3034   !! Lateral diffusion 
    … …  
    9195         &                 ln_trcadv_muscl, ln_trcadv_muscl2, ln_trcadv_smolar 
    9296 
     97#if  defined key_trcbbl_dif   ||   defined key_trcbbl_adv  
     98      NAMELIST/namtrcbbl/ atrcbbl 
     99#endif 
     100 
    93101      NAMELIST/namtrcldf/  ln_trcldf_diff  , ln_trcldf_lap  , ln_trcldf_bilap, & 
    94102         &                 ln_trcldf_level, ln_trcldf_hor, ln_trcldf_iso,   & 
    … …  
    122130         WRITE(numout,*) '             SMOLARKIEWICZ advection scheme ln_trcadv_smolar = ', ln_trcadv_smolar 
    123131      ENDIF 
     132 
     133#if  defined key_trcbbl_dif 
     134      ! Read Namelist namtrcbbl : Bottom boundary layer coef 
     135      ! -------------------------------------------------- 
     136      REWIND ( numnat ) 
     137      READ   ( numnat, namtrcbbl ) 
     138 
     139      ! Parameter control and print 
     140      ! --------------------------- 
     141      IF(lwp) THEN 
     142         WRITE(numout,*) ' Diffusive Bottom Boundary Layer' 
     143         WRITE(numout,*) '~~~~~~~~' 
     144         WRITE(numout,*) ' bottom boundary layer coef.    atrcbbl = ', atrcbbl 
     145# if defined key_trcbbl_adv 
     146            WRITE(numout,*) ' * Advective Bottom Boundary Layer' 
     147# endif 
     148         WRITE(numout,*) 
     149      ENDIF 
     150#endif 
    124151 
    125152      !  Define the lateral tracer physics parameters 

  • trunk/NEMO/TOP_SRC/TRP/zpshde_trc.F90

    r349 r501  
    44   !! Ocean passive tracers:  
    55   !!============================================================================== 
    6 #if defined key_passivetrc && ( defined key_partial_steps || defined key_esopa ) 
     6#if defined key_passivetrc  
    77   !!---------------------------------------------------------------------- 
    8    !!   'key_partial_steps' :               z-coordinate with partial steps 
     8   !!                  z-coordinate with partial steps 
    99   !!---------------------------------------------------------------------- 
    1010   !!   zps_hde_trc  :  Horizontal DErivative of passive tracers at the last 
    … …  
    123123      DO jn = 1, jptra 
    124124         ! Interpolation of passive tracers at the last ocean level 
    125 # if defined key_vectopt_loop   &&   ! defined key_autotasking 
     125# if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    126126         jj = 1 
    127127         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled) 
    … …  
    168168                  pgtrv(ji,jj,jn) = vmask(ji,jj,1) * ( ptra(ji,jj+1,ikv,jn) - ztraj(ji,jj,jn) ) 
    169169               ENDIF 
    170 # if ! defined key_vectopt_loop   ||   defined key_autotasking 
     170# if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    171171            END DO 
    172172# endif 
Note: See TracChangeset for help on using the changeset viewer.