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 497 for trunk/NEMO/OFF_SRC – NEMO

Changeset 497 for trunk/NEMO/OFF_SRC


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

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

Location:
trunk/NEMO/OFF_SRC
Files:
9 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/OFF_SRC/DOM/dom_oce.F90

    r361 r497  
    8383      ff                  !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 
    8484 
     85 
    8586   !!---------------------------------------------------------------------- 
    8687   !! vertical coordinate and scale factors 
    8788   !! -------------------------------------- 
    8889 
    89    REAL(wp), PUBLIC ::   & !!: * namelist namdom * 
    90       e3zps_min = 5.0,   &  !: miminum thickness for partial steps (meters) 
    91       e3zps_rat = 0.1       !: minimum thickness ration for partial steps 
     90   LOGICAL, PUBLIC ::           & !!: namzgr : vertical coordinate 
     91      ln_zco     =  .TRUE.  ,   &  !: z-coordinate - full step 
     92      ln_zps     =  .FALSE. ,   &  !: z-coordinate - partial step 
     93      ln_sco     =  .FALSE.        !: s-coordinate or hybrid z-s coordinate 
    9294 
    93    !! z-coordinate (default option) (also used in the other cases 
    94    !! -----------------------------  as reference z-coordinate) 
     95#if defined key_zco 
     96   LOGICAL, PUBLIC, PARAMETER ::   lk_zco = .TRUE.    !: z-coordinate flag (1D arrays) 
     97#else 
     98   LOGICAL, PUBLIC, PARAMETER ::   lk_zco = .FALSE.   !: z-coordinate flag (3D arrays) 
     99 
     100   !! All coordinates 
     101   !! --------------- 
     102   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: 
     103      gdep3w        ,    &  !: depth of T-points (sum of e3w) (m) 
     104      gdept , gdepw ,    &  !: analytical depth at T-W  points (m) 
     105      e3v   , e3f   ,    &  !: analytical vertical scale factors at  V--F 
     106      e3t   , e3u   ,    &  !:                                       T--U  points (m) 
     107      e3vw          ,    &  !: analytical vertical scale factors at  VW-- 
     108      e3w   , e3uw          !:                                        W--UW  points (m) 
     109#endif 
     110   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
     111      hur, hvr,          &  !: inverse of u and v-points ocean depth (1/m) 
     112      hu , hv               !: depth at u- and v-points (meters) 
     113 
     114   !! z-coordinate with full steps (also used in the other cases as reference z-coordinate) 
     115   !! =-----------------====------ 
    95116   REAL(wp), PUBLIC, DIMENSION(jpk) ::   &  !: 
    96       gdept, gdepw,    &  !: reference depth of t- and w-points (m) 
    97       e3t, e3w            !: reference vertical scale factors at T- and W-pts (m) 
     117      gdept_0, gdepw_0,       &  !: reference depth of t- and w-points (m) 
     118      e3t_0  , e3w_0             !: reference vertical scale factors at T- and W-pts (m) 
    98119 
    99 #if defined key_partial_steps 
    100    !! Partial steps ('key_partial_steps') 
    101    !! ----------------------------------- 
    102    LOGICAL, PUBLIC, PARAMETER ::   lk_zps = .TRUE.   !: partial steps flag 
    103    LOGICAL, PUBLIC, PARAMETER ::   lk_sco = .FALSE.  !: s-coordinate flag 
    104    LOGICAL, PUBLIC, PARAMETER ::   lk_zco = .FALSE.  !: z-coordinate flag 
    105    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: 
    106       gdep3w,                 &  !: ??? 
    107       gdept_ps, gdepw_ps,     &  !: depth of t- and w-points (m) 
    108       e3t_ps, e3u_ps, e3v_ps, &  !: vertical scale factors at t-, u-, w-, 
    109       e3w_ps, e3f_ps,         &  !: w- and f- points (m) 
    110       e3uw_ps, e3vw_ps           !: uw- and vw- points (m) 
     120   !! z-coordinate with partial steps 
     121   !! =-----------------=======------ 
     122   REAL(wp), PUBLIC ::      & !!: * namelist namdom * 
     123      e3zps_min = 5.0_wp,   &  !: miminum thickness for partial steps (meters) 
     124      e3zps_rat = 0.1_wp       !: minimum thickness ration for partial steps 
    111125 
    112126   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
    113127      hdept, hdepw, e3tp, e3wp   !: ??? 
    114128 
    115 #elif defined key_s_coord 
    116    !! s-coordinate ('key_s_coord') 
    117    !! ---------------------------- 
    118    LOGICAL, PUBLIC, PARAMETER ::   lk_zps = .FALSE.   !: partial steps flag 
    119    LOGICAL, PUBLIC, PARAMETER ::   lk_sco = .TRUE.    !: s-coordinate flag 
    120    LOGICAL, PUBLIC, PARAMETER ::   lk_zco = .FALSE.   !: z-coordinate flag 
    121    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
    122       hbatt, hbatu,    &  !: ocean depth at the vertical of  t-, u-, v- 
    123       hbatv               !: and f-point (m) 
    124  
     129   !! s-coordinate and hybrid z-s-coordinate 
     130   !! =----------------======--------------- 
    125131   REAL(wp), PUBLIC, DIMENSION(jpk) ::   &   !: 
    126       gsigt, gsigw ,   &  !: model level depth coefficient at t-, w-levels 
    127       gsi3w,           &  !: model level depth coefficient at w-level 
    128                           !  defined as the sum of e3w scale factors 
     132      gsigt, gsigw ,   &  !: model level depth coefficient at t-, w-levels (analytic) 
     133      gsi3w        ,   &  !: model level depth coefficient at w-level (sum of gsigw) 
    129134      esigt, esigw        !: vertical scale factor coef. at t-, w-levels 
    130135 
    131 #else 
    132    !! z-coordinate (Default option) 
    133    !! ----------------------------- 
    134    LOGICAL, PUBLIC, PARAMETER ::   lk_zps = .FALSE.   !: partial steps flag 
    135    LOGICAL, PUBLIC, PARAMETER ::   lk_sco = .FALSE.   !: s-coordinate flag 
    136    LOGICAL, PUBLIC, PARAMETER ::   lk_zco = .TRUE.    !: s-coordinate flag 
    137 #endif 
     136   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
     137      hbatv , hbatf ,   &  !: ocean depth at the vertical of  V--F 
     138      hbatt , hbatu ,   &  !:                                 T--U  points (m) 
     139      scosrf, scobot,   &  !:  ocean surface and bottom topographies (if deviating from coordinate surfaces in HYBRID) 
     140      hifv  , hiff  ,   &  !: interface depth between stretching    at  V--F 
     141      hift  , hifu         !: and quasi-uniform spacing                 T--U  points (m) 
     142 
     143 
    138144   !!---------------------------------------------------------------------- 
    139145   !! masks, bathymetry 
     
    180186      !                        ! parameterize exchanges through straits 
    181187 
     188#if defined key_off_degrad 
     189   !! ------------------------------------------------ 
     190   !! Degradation method 
     191   !! -------------------------------------------------- 
     192   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: & 
     193      facvol  !! volume for degraded regions 
     194#endif 
     195 
    182196   !!---------------------------------------------------------------------- 
    183197END MODULE dom_oce 
  • trunk/NEMO/OFF_SRC/DOM/domain.F90

    r343 r497  
    2929   PUBLIC dom_init       ! called by opa.F90 
    3030 
     31   !! * Module variables 
     32      REAL(wp) ::          & !!: Namelist nam_zgr_sco 
     33      sbot_min =  300.  ,  &  !: minimum depth of s-bottom surface (>0) (m) 
     34      sbot_max = 5250.  ,  &  !: maximum depth of s-bottom surface (= ocean depth) (>0) (m) 
     35      theta    =    6.0 ,  &  !: surface control parameter (0<=theta<=20) 
     36      thetb    =    0.75,  &  !: bottom control parameter  (0<=thetb<= 1) 
     37      r_max    =    0.15      !: maximum cut-off r-value allowed (0<r_max<1) 
     38 
     39 
    3140   !! * Substitutions 
    3241#  include "domzgr_substitute.h90" 
     
    98107      !! * Modules used 
    99108      USE ioipsl 
    100       NAMELIST/namrun/ no    , cexper   , ln_rstart , nrstdt , nit000,          & 
     109      INTEGER ::   ioptio = 0      ! temporary integer 
     110 
     111      NAMELIST/nam_run/ no    , cexper   , ln_rstart , nrstdt , nit000,          & 
    101112         &             nitend, ndate0   , nleapy   , ninist , nstock,           & 
    102113         &             nprint, nwrite   , nrunoff  , ln_ctl , nictls, nictle,   & 
    103114         &             njctls, njctle   , nbench   , isplt  , jsplt 
    104115 
    105       NAMELIST/namdom/ e3zps_min, e3zps_rat, nmsh  ,   & 
     116      NAMELIST/nam_zgr/ ln_zco, ln_zps, ln_sco 
     117 
     118      NAMELIST/nam_dom/ e3zps_min, e3zps_rat, nmsh  ,   & 
    106119         &             nacc  , atfp     , rdt      , rdtmin , rdtmax,   & 
    107120         &             rdth  
    108121 
    109       NAMELIST/namcla/ n_cla 
     122      NAMELIST/nam_cla/ n_cla 
    110123      !!---------------------------------------------------------------------- 
    111124 
     
    118131      ! Namelist namrun : parameters of the run 
    119132      REWIND( numnam ) 
    120       READ  ( numnam, namrun ) 
     133      READ  ( numnam, nam_run ) 
    121134 
    122135      IF(lwp) THEN 
     
    256269      ENDIF 
    257270 
     271      ! Read Namelist nam_zgr : vertical coordinate' 
     272      ! --------------------- 
     273      REWIND ( numnam ) 
     274      READ   ( numnam, nam_zgr ) 
     275 
     276      ! Parameter control and print 
     277      ! --------------------------- 
     278      ! Control print 
     279      IF(lwp) THEN 
     280         WRITE(numout,*) 
     281         WRITE(numout,*) 'Namelist namzgr : vertical coordinate' 
     282         WRITE(numout,*) '~~~~~~~' 
     283         WRITE(numout,*) '          Namelist nam_zgr : set vertical coordinate' 
     284         WRITE(numout,*) '             z-coordinate - full steps      ln_zco = ', ln_zco 
     285         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps = ', ln_zps 
     286         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco = ', ln_sco 
     287      ENDIF 
     288 
     289      ! Check Vertical coordinate options 
     290      ioptio = 0 
     291      IF( ln_zco ) ioptio = ioptio + 1 
     292      IF( ln_zps ) ioptio = ioptio + 1 
     293      IF( ln_sco ) ioptio = ioptio + 1 
     294      IF ( ioptio /= 1 ) CALL ctl_stop( ' none or several vertical coordinate options used' ) 
     295 
     296      IF( ln_zco ) THEN 
     297          IF(lwp) WRITE(numout,*) '          z-coordinate with reduced incore memory requirement' 
     298          IF( ln_zps .OR. ln_sco ) CALL ctl_stop( ' reduced memory with zps or sco option is impossible' ) 
     299      ENDIF 
     300 
     301 
    258302      ! Namelist namdom : space/time domain (bathymetry, mesh, timestep) 
    259303      REWIND( numnam ) 
    260       READ  ( numnam, namdom ) 
     304      READ  ( numnam, nam_dom ) 
    261305 
    262306      IF(lwp) THEN 
     
    285329      ! Namelist cross land advection 
    286330      REWIND( numnam ) 
    287       READ  ( numnam, namcla ) 
     331      READ  ( numnam, nam_cla ) 
    288332      IF(lwp) THEN 
    289333         WRITE(numout,*) 
  • trunk/NEMO/OFF_SRC/DOM/domcfg.F90

    r343 r497  
    1414   USE lib_mpp         ! distributed memory computing library 
    1515 
     16 
    1617   IMPLICIT NONE 
    1718   PRIVATE 
     
    2021   PUBLIC dom_cfg        ! called by opa.F90 
    2122   !!---------------------------------------------------------------------- 
    22    !!   OPA 9.0 , LOCEAN-IPSL  (2005) 
    23    !!   $Header$ 
    24    !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     23   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     24   !! $Header$  
     25   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    2526   !!---------------------------------------------------------------------- 
    2627 
     
    6465                                                                  ' north fold with F-point pivot' 
    6566      ENDIF 
    66       IF( jperio <  0 .OR. jperio > 6 ) THEN 
    67           IF(lwp) WRITE(numout,cform_err) 
    68           IF(lwp) WRITE(numout,*) 'jperio is out of range' 
    69           nstop = nstop + 1 
    70       ENDIF 
    71  
     67      IF( jperio <  0 .OR. jperio > 6 ) CALL ctl_stop( 'jperio is out of range' ) 
    7268 
    7369      ! global domain versus zoom and/or local domain 
     
    144140         WRITE(numout,25)              (mi1(ji),ji = 1,jpidta) 
    145141         WRITE(numout,*) 
    146          WRITE(numout,*) '          conversion local  ==> data i-index domain' 
     142         WRITE(numout,*) '          conversion local  ==> data j-index domain' 
    147143         WRITE(numout,25)              (mjg(jj),jj = 1,jpj) 
    148144         WRITE(numout,*) 
    149          WRITE(numout,*) '          conversion data  ==> local i-index domain' 
     145         WRITE(numout,*) '          conversion data  ==> local j-index domain' 
    150146         WRITE(numout,*) '             starting index' 
    151147         WRITE(numout,25)              (mj0(jj),jj = 1,jpjdta) 
     
    160156      ! zoom control 
    161157      IF( jpiglo + jpizoom - 1  >  jpidta .OR.   & 
    162           jpjglo + jpjzoom - 1  >  jpjdta      ) THEN 
    163          IF(lwp)WRITE(numout,cform_err) 
    164          IF(lwp)WRITE(numout,*)' global or zoom domain exceed the data domain ! ' 
    165          nstop = nstop + 1 
    166       ENDIF 
     158          jpjglo + jpjzoom - 1  >  jpjdta      ) & 
     159          &   CALL ctl_stop( ' global or zoom domain exceed the data domain ! ' ) 
    167160 
    168161      ! set zoom flag 
     
    184177         WRITE(numout,*) '             lzoom_n = ', lzoom_n, ' (T = forced closed North boundary)' 
    185178      ENDIF 
    186       IF(  ( lzoom_e .OR. lzoom_w )  .AND.  ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 )  ) THEN 
    187          IF(lwp)WRITE(numout,cform_err) 
    188          IF(lwp)WRITE(numout,*)' Your zoom choice is inconsistent with east-west cyclic boundary condition' 
    189          nstop = nstop + 1 
    190       ENDIF 
    191       IF(  lzoom_n  .AND.  ( 3 <= jperio .AND. jperio <= 6 )  ) THEN 
    192          IF(lwp)WRITE(numout,cform_err) 
    193          IF(lwp)WRITE(numout,*)' Your zoom choice is inconsistent with North fold boundary condition' 
    194          nstop = nstop + 1 
    195       ENDIF 
     179      IF(  ( lzoom_e .OR. lzoom_w )  .AND.  ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 )  )   & 
     180           &   CALL ctl_stop( ' Your zoom choice is inconsistent with east-west cyclic boundary condition' ) 
     181      IF(  lzoom_n  .AND.  ( 3 <= jperio .AND. jperio <= 6 )  )   & 
     182           &   CALL ctl_stop( ' Your zoom choice is inconsistent with North fold boundary condition' ) 
     183 
    196184 
    197185      ! Pre-defined arctic/antarctic zoom of ORCA configuration flag 
  • trunk/NEMO/OFF_SRC/DOM/domrea_dimg.h90

    r343 r497  
    7171       irecl8 = jpi*jpj*wp 
    7272       ios1 = 0 ; ios2 = 0 
    73        IF (lk_zps ) ios1= 1  
    74        IF (lk_sco ) ios2= 1 
     73       IF (ln_zps ) ios1= 1  
     74       IF (ln_sco ) ios2= 1 
    7575    
    7676       SELECT CASE (nmsh ) 
     
    262262          mbathy=zprt*tmask(:,:,1)+1 
    263263 
    264 #if defined key_s_coord 
    265          ! 
    266          ! hbat 
    267          irec = irecv(inum4) + (narea - 1 ) 
    268          READ(inum4,REC=irec) hbatt(:,:) 
    269          irecv(inum4) = irecv(inum4) + jpnij  
    270         
    271          irec = irecv(inum4) + (narea - 1 ) 
    272          READ(inum4,REC=irec) hbatu(:,:) 
    273          irecv(inum4) = irecv(inum4) + jpnij  
    274  
    275          irec = irecv(inum4) + (narea - 1 ) 
    276          READ(inum4,REC=irec) hbatv(:,:) 
    277          irecv(inum4) = irecv(inum4) + jpnij  
    278  
    279          irec = irecv(inum4) + (narea - 1 ) 
    280          READ(inum4,REC=irec) hbatf(:,:) 
    281          irecv(inum4) = irecv(inum4) + jpnij  
    282          ! 
    283          ! gsig and esig ( as vectors of jpk per record ) 
    284          irec =  irecv(inum4) + (narea - 1 ) 
    285          READ(inum4,REC=irec) gsigt(:) 
    286          irecv(inum4) = irecv(inum4) + jpnij  
    287  
    288          irec =  irecv(inum4) + (narea - 1 ) 
    289          READ(inum4,REC=irec) gsigw(:) 
    290          irecv(inum4) = irecv(inum4) + jpnij  
    291  
    292          irec =  irecv(inum4) + (narea - 1 ) 
    293          READ(inum4,REC=irec) gsi3w(:) 
    294          irecv(inum4) = irecv(inum4) + jpnij  
    295  
    296          irec =  irecv(inum4) + (narea - 1 ) 
    297          READ(inum4,REC=irec) esigt(:) 
    298          irecv(inum4) = irecv(inum4) + jpnij  
    299  
    300          irec =  irecv(inum4) + (narea - 1 ) 
    301          READ(inum4,REC=irec) esigw(:) 
    302          irecv(inum4) = irecv(inum4) + jpnij  
    303  
    304 # elif defined key_partial_steps 
    305          ! 
    306          ! hdep 
    307          irec = irecv(inum4) + (narea - 1 ) 
    308          READ(inum4,REC=irec) hdept(:,:) 
    309          irecv(inum4) = irecv(inum4) + jpnij  
    310         
    311          irec = irecv(inum4) + (narea - 1 ) 
    312          READ(inum4,REC=irec) hdepw(:,:) 
    313          irecv(inum4) = irecv(inum4) + jpnij  
    314          ! 
    315          ! e3t_ps (3D) 
    316          DO jk=1,jpk 
    317              irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 
    318              READ(inum4,REC=irec) e3t_ps(:,:,jk) 
    319          END DO 
    320          irecv(inum4) = irecv(inum4) + jpk * jpnij  
    321  
    322          ! e3u_ps e3v_ps e3w_ps (3D) 
    323          DO jk=1,jpk 
    324              irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 
    325              READ(inum4,REC=irec) e3u_ps(:,:,jk) 
    326          END DO 
    327          irecv(inum4) = irecv(inum4) + jpk * jpnij  
    328           
    329          DO jk=1,jpk 
    330              irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 
    331              READ(inum4,REC=irec) e3v_ps(:,:,jk) 
    332          END DO 
    333          irecv(inum4) = irecv(inum4) + jpk * jpnij  
    334  
    335          DO jk=1,jpk 
    336              irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 
    337              READ(inum4,REC=irec) e3w_ps(:,:,jk) 
    338          END DO 
    339          irecv(inum4) = irecv(inum4) + jpk * jpnij  
    340          !  
    341          !  
    342          ! gdep 
    343          irec =  irecv(inum4) + (narea - 1 ) 
    344          READ(inum4,REC=irec) gdept(:) 
    345          irecv(inum4) = irecv(inum4) + jpnij  
    346  
    347          irec =  irecv(inum4) + (narea - 1 ) 
    348          READ(inum4,REC=irec) gdepw(:) 
    349          irecv(inum4) = irecv(inum4) + jpnij  
    350          ! 
    351          ! e3 
    352          irec =  irecv(inum4) + (narea - 1 ) 
    353          READ(inum4,REC=irec) e3t(:) 
    354          irecv(inum4) = irecv(inum4) + jpnij  
    355  
    356          irec =  irecv(inum4) + (narea - 1 ) 
    357          READ(inum4,REC=irec) e3w(:) 
     264#if ! defined key_zco 
     265          IF( ln_sco ) THEN                                         ! s-coordinate 
     266             ! 
     267             ! hbat 
     268             irec = irecv(inum4) + (narea - 1 ) 
     269             READ(inum4,REC=irec) hbatt(:,:) 
     270             irecv(inum4) = irecv(inum4) + jpnij  
     271              
     272             irec = irecv(inum4) + (narea - 1 ) 
     273             READ(inum4,REC=irec) hbatu(:,:) 
     274             irecv(inum4) = irecv(inum4) + jpnij  
     275              
     276             irec = irecv(inum4) + (narea - 1 ) 
     277             READ(inum4,REC=irec) hbatv(:,:) 
     278             irecv(inum4) = irecv(inum4) + jpnij  
     279              
     280             irec = irecv(inum4) + (narea - 1 ) 
     281             READ(inum4,REC=irec) hbatf(:,:) 
     282             irecv(inum4) = irecv(inum4) + jpnij  
     283             ! 
     284             ! gsig and esig ( as vectors of jpk per record ) 
     285             irec =  irecv(inum4) + (narea - 1 ) 
     286             READ(inum4,REC=irec) gsigt(:) 
     287             irecv(inum4) = irecv(inum4) + jpnij  
     288              
     289             irec =  irecv(inum4) + (narea - 1 ) 
     290             READ(inum4,REC=irec) gsigw(:) 
     291             irecv(inum4) = irecv(inum4) + jpnij  
     292              
     293             irec =  irecv(inum4) + (narea - 1 ) 
     294             READ(inum4,REC=irec) gsi3w(:) 
     295             irecv(inum4) = irecv(inum4) + jpnij  
     296              
     297             irec =  irecv(inum4) + (narea - 1 ) 
     298             READ(inum4,REC=irec) esigt(:) 
     299             irecv(inum4) = irecv(inum4) + jpnij  
     300              
     301             irec =  irecv(inum4) + (narea - 1 ) 
     302             READ(inum4,REC=irec) esigw(:) 
     303             irecv(inum4) = irecv(inum4) + jpnij  
     304 
     305             ! e3 (3D) 
     306             DO jk=1,jpk 
     307                irec =  irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 
     308                READ(inum4,REC=irec) e3t(:,:,jk) 
     309             ENDIF 
     310             irecv(inum4) = irecv(inum4) + jpk * jpnij  
     311              
     312             DO jk=1,jpk 
     313                irec =  irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 
     314                READ(inum4,REC=irec) e3u(:,:,jk) 
     315             ENDIF 
     316             irecv(inum4) = irecv(inum4) + jpk * jpnij  
     317              
     318             DO jk=1,jpk 
     319                irec =  irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 
     320                READ(inum4,REC=irec) e3v(:,:,jk) 
     321             ENDIF 
     322             irecv(inum4) = irecv(inum4) + jpk * jpnij  
     323              
     324             DO jk=1,jpk 
     325                irec =  irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 
     326                READ(inum4,REC=irec) e3w(:,:,jk) 
     327             ENDIF 
     328             irecv(inum4) = irecv(inum4) + jpk * jpnij  
     329 
     330             ! gdep 
     331             irec =  irecv(inum4) + (narea - 1 ) 
     332             READ(inum4,REC=irec) gdept_0(:) 
     333             irecv(inum4) = irecv(inum4) + jpnij  
     334              
     335             irec =  irecv(inum4) + (narea - 1 ) 
     336             READ(inum4,REC=irec) gdepw_0(:) 
     337             irecv(inum4) = irecv(inum4) + jpnij  
     338             ! 
     339          ENDIF 
     340              
     341          IF( ln_zps ) THEN 
     342             ! 
     343             ! hdep 
     344             irec = irecv(inum4) + (narea - 1 ) 
     345             READ(inum4,REC=irec) hdept(:,:) 
     346             irecv(inum4) = irecv(inum4) + jpnij  
     347              
     348             irec = irecv(inum4) + (narea - 1 ) 
     349             READ(inum4,REC=irec) hdepw(:,:) 
     350             irecv(inum4) = irecv(inum4) + jpnij  
     351             ! 
     352             ! e3t_ps (3D) 
     353             DO jk=1,jpk 
     354                irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 
     355                READ(inum4,REC=irec) e3t(:,:,jk) 
     356             END DO 
     357             irecv(inum4) = irecv(inum4) + jpk * jpnij  
     358              
     359             ! e3u_ps e3v_ps e3w_ps (3D) 
     360             DO jk=1,jpk 
     361                irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 
     362                READ(inum4,REC=irec) e3u(:,:,jk) 
     363             END DO 
     364             irecv(inum4) = irecv(inum4) + jpk * jpnij  
     365              
     366             DO jk=1,jpk 
     367                irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 
     368                READ(inum4,REC=irec) e3v(:,:,jk) 
     369             END DO 
     370             irecv(inum4) = irecv(inum4) + jpk * jpnij  
     371              
     372             DO jk=1,jpk 
     373                irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 
     374                READ(inum4,REC=irec) e3w(:,:,jk) 
     375             END DO 
     376             irecv(inum4) = irecv(inum4) + jpk * jpnij  
     377             !  
     378             !  
     379             ! gdep 
     380             irec =  irecv(inum4) + (narea - 1 ) 
     381             READ(inum4,REC=irec) gdept_0(:) 
     382             irecv(inum4) = irecv(inum4) + jpnij  
     383              
     384             irec =  irecv(inum4) + (narea - 1 ) 
     385             READ(inum4,REC=irec) gdepw_0(:) 
     386             irecv(inum4) = irecv(inum4) + jpnij  
     387             ! 
     388             ! e3 
     389             irec =  irecv(inum4) + (narea - 1 ) 
     390             READ(inum4,REC=irec) e3t_0(:) 
     391             irecv(inum4) = irecv(inum4) + jpnij  
     392              
     393             irec =  irecv(inum4) + (narea - 1 ) 
     394             READ(inum4,REC=irec) e3w_0(:) 
     395          ENDIF 
    358396#else 
    359          ! 
    360          ! gdep 
    361          irec =  irecv(inum4) + (narea - 1 ) 
    362          READ(inum4,REC=irec) gdept(:) 
    363          irecv(inum4) = irecv(inum4) + jpnij  
    364  
    365          irec =  irecv(inum4) + (narea - 1 ) 
    366          READ(inum4,REC=irec) gdepw(:) 
    367          irecv(inum4) = irecv(inum4) + jpnij  
    368          ! 
    369          ! e3 
    370          irec =  irecv(inum4) + (narea - 1 ) 
    371          READ(inum4,REC=irec) e3t(:) 
    372          irecv(inum4) = irecv(inum4) + jpnij  
    373  
    374          irec =  irecv(inum4) + (narea - 1 ) 
    375          READ(inum4,REC=irec) e3w(:) 
    376          irecv(inum4) = irecv(inum4) + jpnij  
     397          ! 
     398          ! gdep 
     399          irec =  irecv(inum4) + (narea - 1 ) 
     400          READ(inum4,REC=irec) gdept_0(:) 
     401          irecv(inum4) = irecv(inum4) + jpnij  
     402           
     403          irec =  irecv(inum4) + (narea - 1 ) 
     404          READ(inum4,REC=irec) gdepw_0(:) 
     405          irecv(inum4) = irecv(inum4) + jpnij  
     406          ! 
     407          ! e3 
     408          irec =  irecv(inum4) + (narea - 1 ) 
     409          READ(inum4,REC=irec) e3t_0(:) 
     410          irecv(inum4) = irecv(inum4) + jpnij  
     411           
     412          irec =  irecv(inum4) + (narea - 1 ) 
     413          READ(inum4,REC=irec) e3w_0(:) 
     414          irecv(inum4) = irecv(inum4) + jpnij  
    377415         ! 
    378416#endif 
  • trunk/NEMO/OFF_SRC/DOM/domrea_fdir.h90

    r343 r497  
    7777      ! 4. depth and vertical scale factors 
    7878      ! ----------------------------------- 
    79 #if defined key_s_coord 
    80       clfield='HBATT'   ;    READ(inum) clfield, hbatt 
    81       clfield='HBATU'   ;    READ(inum) clfield, hbatu 
    82       clfield='HBATV'   ;    READ(inum) clfield, hbatv 
    83       clfield='HBATF'   ;    READ(inum) clfield, hbatf 
    84       clfield='GSIGT'   ;    READ(inum) clfield, gsigt 
    85       clfield='GSIGW'   ;    READ(inum) clfield, gsigw 
    86       clfield='GSI3W'   ;    READ(inum) clfield, gsi3w 
    87       clfield='ESIGT'   ;    READ(inum) clfield, esigt 
    88       clfield='ESIGW'   ;    READ(inum) clfield, esigw 
     79#if ! defined key_zco 
     80      IF( ln_sco ) THEN 
     81         clfield='HBATT'   ;    READ(inum) clfield, hbatt 
     82         clfield='HBATU'   ;    READ(inum) clfield, hbatu 
     83         clfield='HBATV'   ;    READ(inum) clfield, hbatv 
     84         clfield='HBATF'   ;    READ(inum) clfield, hbatf 
     85         clfield='GSIGT'   ;    READ(inum) clfield, gsigt 
     86         clfield='GSIGW'   ;    READ(inum) clfield, gsigw 
     87         clfield='GSI3W'   ;    READ(inum) clfield, gsi3w 
     88         clfield='ESIGT'   ;    READ(inum) clfield, esigt 
     89         clfield='ESIGW'   ;    READ(inum) clfield, esigw 
     90      ENDIF 
    8991#else 
    9092      clfield='GDEPT'   ;    READ(inum) clfield, gdept 
  • trunk/NEMO/OFF_SRC/DOM/domstp.F90

    r343 r497  
    77   !!---------------------------------------------------------------------- 
    88   !!   dom_stp        : ocean time domain initialization 
     9   !!---------------------------------------------------------------------- 
     10   !! History : 
     11   !!        !  90-10  (O. Marti)  Original code 
     12   !!        !  96-01  (G. Madec)  terrain following coordinates 
     13   !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    914   !!---------------------------------------------------------------------- 
    1015   !! * Modules used 
     
    2227#  include "domzgr_substitute.h90" 
    2328   !!---------------------------------------------------------------------- 
    24    !!   OPA 9.0 , LOCEAN-IPSL  (2005) 
    25    !!   $Header$ 
    26    !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     29   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     30   !! $Header$  
     31   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    2732   !!---------------------------------------------------------------------- 
    2833 
     
    5661      !! References : 
    5762      !!      Bryan, K., 1984, J. Phys. Oceanogr., 14, 666-673. 
    58       !! 
    59       !! History : 
    60       !!        !  90-10  (O. Marti)  Original code 
    61       !!        !  96-01  (G. Madec)  terrain following coordinates 
    62       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    6363      !!---------------------------------------------------------------------- 
    64       !! * Local declarations 
    6564      INTEGER ::   jk              ! dummy loop indice 
    6665      !!---------------------------------------------------------------------- 
     
    7776      atfp1 = 1. - 2. * atfp 
    7877 
    79  
    8078      SELECT CASE ( nacc ) 
    8179 
     
    9088            IF(lwp) WRITE(numout,*)'               accelerating the convergence' 
    9189            IF(lwp) WRITE(numout,*)'               dynamics time step = ', rdt/3600., ' hours' 
    92 #if defined key_s_coord 
    93             IF( rdtmin /= rdtmax ) THEN 
    94                IF(lwp) WRITE(numout,cform_err) 
    95                IF(lwp) WRITE(numout,*)' depth dependent acceleration of & 
    96                                       &convergence not implemented in s-coordinates' 
    97                nstop = nstop + 1 
    98             ENDIF 
    99 #endif 
    100 #if defined key_partial_steps 
    101             IF( rdtmin /= rdtmax ) THEN 
    102                IF(lwp) WRITE(numout,cform_err) 
    103                IF(lwp) WRITE(numout,*)' depth dependent acceleration of & 
    104                                       &convergence not implemented for partial steps case' 
    105                nstop = nstop + 1 
    106             ENDIF 
    107 #endif 
     90            IF( ln_sco .AND. rdtmin /= rdtmax )   & 
     91                 & CALL ctl_stop ( ' depth dependent acceleration of convergence not implemented in s-coordinates' ) 
    10892            IF(lwp) WRITE(numout,*)'         tracers   time step :  dt (hours)  level' 
    10993 
    11094            DO jk = 1, jpk 
    111                IF( fsdept(1,1,jk) <= rdth ) rdttra(jk) = rdtmin 
    112                IF( fsdept(1,1,jk) >  rdth ) THEN 
     95               IF( gdept_0(jk) <= rdth ) rdttra(jk) = rdtmin 
     96               IF( gdept_0(jk) >  rdth ) THEN 
    11397                  rdttra(jk) = rdtmin + ( rdtmax - rdtmin )   & 
    114                                       * ( EXP( ( fsdept(1,1,jk ) - rdth ) / rdth ) - 1. )   & 
    115                                       / ( EXP( ( fsdept(1,1,jpk) - rdth ) / rdth ) - 1. ) 
     98                                      * ( EXP( ( gdept_0(jk ) - rdth ) / rdth ) - 1. )   & 
     99                                      / ( EXP( ( gdept_0(jpk) - rdth ) / rdth ) - 1. ) 
    116100               ENDIF 
    117                IF(lwp) WRITE(numout,9200) rdttra(jk)/3600., jk 
     101               IF(lwp) WRITE(numout,"(36x,f5.2,5x,i3)") rdttra(jk)/3600., jk 
    118102            END DO   
    119  9200       FORMAT(36x,f5.2,'     ',i3) 
    120103 
    121104         CASE DEFAULT              ! E R R O R  
    122105 
    123             IF(lwp) WRITE(numout,cform_err) 
    124             IF(lwp) WRITE(numout,*) ' nacc value e r r o r, nacc= ',nacc 
    125             IF(lwp) WRITE(numout,*) ' we stop' 
    126             nstop = nstop + 1 
     106            WRITE(ctmp1,*) ' nacc value e r r o r, nacc= ',nacc 
     107            CALL ctl_stop( ctmp1 ) 
    127108 
    128109      END SELECT 
  • trunk/NEMO/OFF_SRC/DOM/domzgr_substitute.h90

    r343 r497  
    55   !!      factors depending on the vertical coord. used, using CPP macro. 
    66   !!---------------------------------------------------------------------- 
    7    !!   OPA 9.0 , LOCEAN-IPSL  (2005) 
    8    !!   $Header$ 
    9    !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    107   !!---------------------------------------------------------------------- 
    11 #if defined key_s_coord 
    12    !! s-coord:  substitution  fsdep.(,,) ==>  hbat.(,) * gsig.() 
    13    !!                         fse3.(,,)  ==>  hbat.(,) * esig.() 
    14 #   define  fsdept(i,j,k)   hbatt(i,j)*gsigt(k) 
    15 #   define  fsdepu(i,j,k)   hbatu(i,j)*gsigt(k) 
    16 #   define  fsdepv(i,j,k)   hbatv(i,j)*gsigt(k) 
    17 #   define  fsdepf(i,j,k)   hbatf(i,j)*gsigt(k) 
    18 #   define  fsdepw(i,j,k)   hbatt(i,j)*gsigw(k) 
    19 #   define  fsdepuw(i,j,k)  hbatu(i,j)*gsi3w(k) 
    20 #   define  fsdepvw(i,j,k)  hbatv(i,j)*gsi3w(k) 
    21 #   define  fsde3w(i,j,k)   hbatt(i,j)*gsi3w(k) 
    22 #   define  fse3t(i,j,k)    hbatt(i,j)*esigt(k) 
    23 #   define  fse3u(i,j,k)    hbatu(i,j)*esigt(k) 
    24 #   define  fse3v(i,j,k)    hbatv(i,j)*esigt(k) 
    25 #   define  fse3f(i,j,k)    hbatf(i,j)*esigt(k) 
    26 #   define  fse3w(i,j,k)    hbatt(i,j)*esigw(k) 
    27 #   define  fse3uw(i,j,k)   hbatu(i,j)*esigw(k) 
    28 #   define  fse3vw(i,j,k)   hbatv(i,j)*esigw(k) 
    29 #elif defined key_partial_steps 
    30    !! z-coord:  substitution  fsdep.(,,) ==>  gdep._ps() 
    31    !!                         fse3.(,,)  ==>  e3._ps() 
    32 #   define  fsdept(i,j,k)   gdept_ps(i,j,k) 
    33 #   define  fsdepw(i,j,k)   gdepw_ps(i,j,k) 
    34 #   define  fsde3w(i,j,k)   gdep3w(i,j,k) 
    35 #   define  fsdepuw(i,j,k)  gdepw(k) 
    36 #   define  fsdepvw(i,j,k)  gdepw(k) 
    37 #   define  fse3t(i,j,k)    e3t_ps(i,j,k) 
    38 #   define  fse3u(i,j,k)    e3u_ps(i,j,k) 
    39 #   define  fse3v(i,j,k)    e3v_ps(i,j,k) 
    40 #   define  fse3f(i,j,k)    e3f_ps(i,j,k) 
    41 #   define  fse3w(i,j,k)    e3w_ps(i,j,k) 
    42 #   define  fse3uw(i,j,k)   e3uw_ps(i,j,k) 
    43 #   define  fse3vw(i,j,k)   e3vw_ps(i,j,k) 
     8   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
     9   !! 
     10   !! History : 
     11   !!   9.0  !  05-10  (A. Beckmann, G. Madec) generalisation to all coord. 
     12   !!---------------------------------------------------------------------- 
     13#if defined key_zco 
     14#   define  fsdept(i,j,k)  gdept_0(k) 
     15 
     16#   define  fsdepw(i,j,k)  gdepw_0(k) 
     17#   define  fsde3w(i,j,k)  gdepw_0(k) 
     18 
     19#   define  fse3t(i,j,k)   e3t_0(k) 
     20#   define  fse3u(i,j,k)   e3t_0(k) 
     21#   define  fse3v(i,j,k)   e3t_0(k) 
     22#   define  fse3f(i,j,k)   e3t_0(k) 
     23 
     24#   define  fse3w(i,j,k)   e3w_0(k) 
     25#   define  fse3uw(i,j,k)  e3w_0(k) 
     26#   define  fse3vw(i,j,k)  e3w_0(k) 
    4427#else 
    45    !! z-coord:  substitution  fsdep.(,,) ==>  gdep() 
    46    !!                         fse3.(,,)  ==>  e3.() 
    47 #   define  fsdept(i,j,k)   gdept(k) 
    48 #   define  fsdepu(i,j,k)   gdept(k) 
    49 #   define  fsdepv(i,j,k)   gdept(k) 
    50 #   define  fsdepf(i,j,k)   gdept(k) 
    51 #   define  fsdepw(i,j,k)   gdepw(k) 
    52 #   define  fsdepuw(i,j,k)  gdepw(k) 
    53 #   define  fsdepvw(i,j,k)  gdepw(k) 
    54 #   define  fse3t(i,j,k)   e3t(k) 
    55 #   define  fse3u(i,j,k)   e3t(k) 
    56 #   define  fse3v(i,j,k)   e3t(k) 
    57 #   define  fse3f(i,j,k)   e3t(k) 
    58 #   define  fse3w(i,j,k)   e3w(k) 
    59 #   define  fse3uw(i,j,k)  e3w(k) 
    60 #   define  fse3vw(i,j,k)  e3w(k) 
     28#   define  fsdept(i,j,k)  gdept(i,j,k) 
     29 
     30#   define  fsdepw(i,j,k)  gdepw(i,j,k) 
     31#   define  fsde3w(i,j,k)  gdep3w(i,j,k) 
     32  
     33#   define  fse3t(i,j,k)   e3t(i,j,k) 
     34#   define  fse3u(i,j,k)   e3u(i,j,k) 
     35#   define  fse3v(i,j,k)   e3v(i,j,k) 
     36#   define  fse3f(i,j,k)   e3f(i,j,k) 
     37 
     38#   define  fse3w(i,j,k)   e3w(i,j,k) 
     39#   define  fse3uw(i,j,k)  e3uw(i,j,k) 
     40#   define  fse3vw(i,j,k)  e3vw(i,j,k) 
    6141#endif 
  • trunk/NEMO/OFF_SRC/LDF/ldfslp.F90

    r343 r497  
    2020   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2121   USE in_out_manager  ! I/O manager 
     22   USE prtctl          ! Print control 
    2223 
    2324   IMPLICIT NONE 
     
    4647#  include "vectopt_loop_substitute.h90" 
    4748   !!---------------------------------------------------------------------- 
    48    !!   OPA 9.0 , LOCEAN-IPSL  (2005) 
    49    !!   $Header$ 
    50    !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     49   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    5150   !!---------------------------------------------------------------------- 
    5251 
     
    6968      !!      of 10cm/s) 
    7069      !!        A horizontal shapiro filter is applied to the slopes 
    71       !!        'key_s_coord' defined: add to the previously computed slopes 
     70      !!        ln_sco=T, s-coordinate, add to the previously computed slopes 
    7271      !!      the slope of the model level surface. 
    7372      !!        macro-tasked on horizontal slab (jk-loop)  (2, jpk-1) 
    7473      !!      [slopes already set to zero at level 1, and to zero or the ocean 
    75       !!      bottom slope ('key_s_coord' defined) at level jpk in inildf] 
     74      !!      bottom slope (ln_sco=T) at level jpk in inildf] 
    7675      !! 
    7776      !! ** Action : - uslp, wslpi, and vslp, wslpj, the i- and  j-slopes  
     
    8382      !!   8.1  !  99-10  (A. Jouzeau)  NEW profile 
    8483      !!   8.5  !  99-10  (G. Madec)  Free form, F90 
     84      !!   9.0  !  05-10  (A. Beckmann)  correction for s-coordinates 
    8585      !!---------------------------------------------------------------------- 
    8686      !! * Modules used 
     
    9797      !! * Local declarations 
    9898      INTEGER  ::   ji, jj, jk              ! dummy loop indices 
    99       INTEGER  ::   ii0, ii1, ij0, ij1      ! temporary integer 
    100 #if defined key_partial_steps 
    101       INTEGER  ::   iku, ikv  ! temporary integers 
    102 #endif 
     99      INTEGER  ::   ii0, ii1, ij0, ij1,  &  ! temporary integer 
     100         &          iku, ikv                !    "          " 
    103101      REAL(wp) ::   & 
    104          zeps, zmg, zm05g, zcoef1, zcoef2,   &  ! temporary scalars 
    105          zau, zbu, zav, zbv,                 & 
    106          zai, zbi, zaj, zbj,                & 
    107          zcofu, zcofv, zcofw,                & 
    108          z1u, z1v, z1wu, z1wv,               & 
     102         zeps, zmg, zm05g,               &  ! temporary scalars 
     103         zcoef1, zcoef2, zcoef3,         &  ! 
     104         zau, zbu, zav, zbv,             & 
     105         zai, zbi, zaj, zbj,             & 
     106         zcofu, zcofv, zcofw,            & 
     107         z1u, z1v, z1wu, z1wv,           & 
    109108         zalpha 
    110109      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zww 
     
    138137      END DO 
    139138 
    140 #if defined key_partial_steps 
    141       ! partial steps correction at the bottom ocean level (zps_hde routine) 
    142 # if defined key_vectopt_loop   &&   ! defined key_autotasking 
    143       jj = 1 
    144       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     139      IF( ln_zps ) THEN      ! partial steps correction at the bottom ocean level (zps_hde routine) 
     140# if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
     141         jj = 1 
     142         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    145143# else 
    146       DO jj = 1, jpjm1 
    147          DO ji = 1, jpim1 
    148 # endif 
    149             ! last ocean level 
    150             iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj) ) - 1 
    151             ikv = MIN ( mbathy(ji,jj), mbathy(ji,jj+1) ) - 1 
    152             zgru(ji,jj,iku) = gru(ji,jj)  
    153             zgrv(ji,jj,ikv) = grv(ji,jj)                
    154 # if ! defined key_vectopt_loop   ||   defined key_autotasking 
    155          END DO 
    156 # endif 
    157       END DO 
    158 #endif 
     144         DO jj = 1, jpjm1 
     145            DO ji = 1, jpim1 
     146# endif 
     147               ! last ocean level 
     148               iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj) ) - 1 
     149               ikv = MIN ( mbathy(ji,jj), mbathy(ji,jj+1) ) - 1 
     150               zgru(ji,jj,iku) = gru(ji,jj)  
     151               zgrv(ji,jj,ikv) = grv(ji,jj)                
     152# if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
     153            END DO 
     154# endif 
     155         END DO 
     156      ENDIF 
    159157 
    160158      ! Slopes of isopycnal surfaces just below the mixed layer 
     
    203201               ! uslp and vslp output in zwz and zww, resp. 
    204202               zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 
    205 #if defined key_s_coord  
    206203               zwz (ji,jj,jk) = ( zau / ( zbu - zeps ) * ( 1. - zalpha)   & 
    207                   &        + zalpha * uslpml(ji,jj)   & 
    208                   &        * ( fsdepu(ji,jj,jk) - .5*fse3u(ji,jj,1) )   & 
    209                   &        / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5. ) )   & 
    210                   &        * umask(ji,jj,jk) 
     204                  &           + zalpha * uslpml(ji,jj)                    & 
     205                  &                    * 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) )   & 
     206                  &                          / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5. ) ) * umask(ji,jj,jk) 
    211207               zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 
    212208               zww (ji,jj,jk) = ( zav / ( zbv - zeps ) * ( 1. - zalpha)   & 
    213                   &        + zalpha * vslpml(ji,jj)   & 
    214                   &        * ( fsdepv(ji,jj,jk) - .5*fse3v(ji,jj,1) )   & 
    215                   &         / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) )   & 
    216                   &        * vmask(ji,jj,jk) 
    217 #else 
    218                ! z-coord and partial steps slope computed in the same way 
    219                zwz (ji,jj,jk) = ( zau / ( zbu - zeps ) * ( 1. - zalpha)    & 
    220                   &        + zalpha * uslpml(ji,jj)    & 
    221                   &        * ( fsdept(ji,jj,jk) - .5*fse3u(ji,jj,1))    & 
    222                   &        / MAX (hmlpt(ji,jj),hmlpt(ji+1,jj),5.) )    & 
    223                   &        * umask (ji,jj,jk) 
    224                zalpha = MAX(omlmask(ji,jj,jk),omlmask(ji,jj+1,jk)) 
    225                zww (ji,jj,jk) = ( zav / ( zbv - zeps ) * ( 1. - zalpha)    & 
    226                   &        + zalpha * vslpml(ji,jj)    & 
    227                   &        * ( fsdept(ji,jj,jk) - .5*fse3v(ji,jj,1))    & 
    228                   &        / MAX(hmlpt(ji,jj),hmlpt(ji,jj+1),5.) )    & 
    229                   &        * vmask (ji,jj,jk) 
    230 #endif 
     209                  &           + zalpha * vslpml(ji,jj)                    & 
     210                  &                    * 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) )   & 
     211                  &                          / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 
    231212            END DO 
    232213         END DO 
     
    292273            END DO 
    293274         END DO 
    294  
    295  
    296          IF( lk_sco ) THEN 
    297             ! Add the slope of level surfaces 
    298             ! ----------------------------------- 
    299             ! 'key_s_coord' defined but not 'key_traldfiso' the computation is done 
    300             ! in inildf, ldfslp never called 
    301             ! 'key_s_coord' and 'key_traldfiso' defined, the slope of level surfaces 
    302             ! is added to the slope of isopycnal surfaces. 
    303             ! c a u t i o n : minus sign as fsdep has positive value  
    304           
    305             DO jj = 2, jpjm1 
    306                DO ji = fs_2, fs_jpim1   ! vector opt. 
    307                   uslp(ji,jj,jk) = uslp(ji,jj,jk) - 1. / e1u(ji,jj)   & 
    308                      &           * ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) ) 
    309                   vslp(ji,jj,jk) = vslp(ji,jj,jk) - 1. / e2v(ji,jj)   & 
    310                      &           * ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) 
    311                END DO 
    312             END DO 
    313          ENDIF 
    314275 
    315276 
     
    354315               zbj = MIN( zwy (ji,jj,jk), -100.*ABS(zaj), -7.e+3/fse3w(ji,jj,jk)*ABS(zaj) ) 
    355316               ! wslpi and wslpj output in zwz and zww, resp. 
    356                zalpha = MAX(omlmask(ji,jj,jk),omlmask(ji,jj,jk-1)) 
    357                zwz(ji,jj,jk) = ( zai / ( zbi - zeps) * ( 1. - zalpha )   & 
    358                   &            + zalpha * wslpiml(ji,jj)   & 
    359                   &            * fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj),10. ) )   & 
    360                   &            * tmask (ji,jj,jk) 
    361                zww(ji,jj,jk) = ( zaj / ( zbj - zeps) * ( 1. - zalpha )   & 
    362                   &            + zalpha * wslpjml(ji,jj)   & 
    363                   &            * fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj),10. ) )   & 
    364                   &            * tmask (ji,jj,jk) 
     317               zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) 
     318               zcoef3 = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10. ) 
     319               zwz(ji,jj,jk) = (     zai / ( zbi - zeps)  * ( 1. - zalpha )   & 
     320                  &             + zcoef3 * wslpiml(ji,jj) *        zalpha   ) * tmask (ji,jj,jk) 
     321               zww(ji,jj,jk) = (     zaj / ( zbj - zeps)  * ( 1. - zalpha )   & 
     322                  &             + zcoef3 * wslpjml(ji,jj) *        zalpha   ) * tmask (ji,jj,jk) 
    365323            END DO 
    366324         END DO 
     
    424382         END DO 
    425383          
    426          IF( lk_sco ) THEN 
    427           
    428             ! Slope of level surfaces 
    429             ! ----------------------- 
    430             ! 'key_s_coord' defined but not 'key_traldfiso' the computation is done 
    431             ! in inildf, ldfslp never called 
    432             ! 'key_s_coord' and 'key_traldfiso' defined, the slope of level surfaces 
    433             ! is added to the slope of isopycnal surfaces. 
    434           
    435             DO jj = 2, jpjm1 
    436                DO ji = fs_2, fs_jpim1   ! vector opt. 
    437                   wslpi(ji,jj,jk) = wslpi(ji,jj,jk) - 1. / e1t(ji,jj)   & 
    438                      &                                   * ( fsdepuw(ji+1,jj,jk) - fsdepuw(ji,jj,jk) ) 
    439                   wslpj(ji,jj,jk) = wslpj(ji,jj,jk) - 1. / e2t(ji,jj)   & 
    440                      &                                   * ( fsdepvw(ji,jj+1,jk) - fsdepvw(ji,jj,jk) ) 
    441                END DO 
    442             END DO 
    443          ENDIF 
    444384          
    445385         ! III. Specific grid points 
     
    474414      ! III Lateral boundary conditions on all slopes (uslp , vslp,  
    475415      ! -------------------------------                wslpi, wslpj ) 
    476       CALL lbc_lnk( uslp , 'U', -1. ) 
    477       CALL lbc_lnk( vslp , 'V', -1. ) 
    478       CALL lbc_lnk( wslpi, 'W', -1. ) 
    479       CALL lbc_lnk( wslpj, 'W', -1. ) 
     416      CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. ) 
     417      CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. ) 
     418 
     419      IF(ln_ctl) THEN 
     420         CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp  - u : ', tab3d_2=vslp,  clinfo2=' v : ', kdim=jpk) 
     421         CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 
     422      ENDIF 
    480423 
    481424   END SUBROUTINE ldf_slp 
     
    546489      ! mask for mixed layer 
    547490      DO jk = 1, jpk 
    548 # if defined key_vectopt_loop   &&   ! defined key_autotasking 
     491# if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    549492         jj = 1 
    550493         DO ji = 1, jpij   ! vector opt. (forced unrolling) 
     
    560503                  omlmask(ji,jj,jk) = 0.e0 
    561504               ENDIF 
    562 # if ! defined key_vectopt_loop   ||   defined key_autotasking 
     505# if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    563506            END DO 
    564507# endif 
     
    578521      zwy(:,jpj) = 0.e0 
    579522      zwy(jpi,:) = 0.e0 
    580 # if defined key_vectopt_loop   &&   ! defined key_autotasking 
     523# if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    581524      jj = 1 
    582525      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     
    591534               &             * ( pn2(ji,jj,ik) + pn2(ji,jj,ik+1) )   & 
    592535               &             / MAX( tmask(ji,jj,ik) + tmask (ji,jj,ik+1), 1. ) 
    593 # if ! defined key_vectopt_loop   ||   defined key_autotasking 
     536# if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    594537         END DO 
    595538# endif 
     
    599542 
    600543      ! Slope at u points 
    601 # if defined key_vectopt_loop   &&   ! defined key_autotasking 
     544# if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    602545      jj = 1 
    603546      DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
     
    616559            ! uslpml 
    617560            uslpml (ji,jj) = zau / ( zbu - zeps ) * umask (ji,jj,ik) 
    618 # if ! defined key_vectopt_loop   ||   defined key_autotasking 
     561# if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    619562         END DO 
    620563# endif 
     
    628571      zwy ( :, jpj) = 0.e0 
    629572      zwy ( jpi, :) = 0.e0 
    630 # if defined key_vectopt_loop   &&   ! defined key_autotasking 
     573# if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    631574      jj = 1 
    632575      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     
    640583               &             * ( pn2(ji,jj,ik) + pn2(ji,jj,ik+1) )   & 
    641584               &             / MAX( tmask(ji,jj,ik) + tmask (ji,jj,ik+1), 1. ) 
    642 # if ! defined key_vectopt_loop   ||   defined key_autotasking 
     585# if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    643586         END DO 
    644587# endif 
     
    649592 
    650593      ! Slope at v points 
    651 # if defined key_vectopt_loop   &&   ! defined key_autotasking 
     594# if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    652595      jj = 1 
    653596      DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
     
    666609            ! vslpml 
    667610            vslpml (ji,jj) = zav / ( zbv - zeps ) * vmask (ji,jj,ik) 
    668 # if ! defined key_vectopt_loop   ||   defined key_autotasking 
     611# if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    669612         END DO 
    670613# endif 
     
    680623      ! Local vertical density gradient evaluated from N^2 
    681624      ! zwy = d/dz(prd)= - mk ( prd ) / grav * pn2 -- at w point 
    682 # if defined key_vectopt_loop   &&   ! defined key_autotasking 
     625# if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    683626      jj = 1 
    684627      DO ji = 1, jpij   ! vector opt. (forced unrolling) 
     
    692635            zwy (ji,jj) = zm05g * pn2 (ji,jj,ik) *     & 
    693636               &             ( prd (ji,jj,ik) + prd (ji,jj,ikm1) + 2. ) 
    694 # if ! defined key_vectopt_loop   ||   defined key_autotasking 
     637# if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    695638         END DO 
    696639# endif 
     
    698641 
    699642      ! Slope at w point 
    700 # if defined key_vectopt_loop   &&   ! defined key_autotasking 
     643# if defined key_vectopt_loop   &&   ! defined key_mpp_omp 
    701644      jj = 1 
    702645      DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
     
    728671            wslpiml (ji,jj) = zai / ( zbi - zeps) * tmask (ji,jj,ik) 
    729672            wslpjml (ji,jj) = zaj / ( zbj - zeps) * tmask (ji,jj,ik) 
    730 # if ! defined key_vectopt_loop   ||   defined key_autotasking 
     673# if ! defined key_vectopt_loop   ||   defined key_mpp_omp 
    731674         END DO 
    732675# endif 
     
    780723 
    781724      IF( ln_traldf_hor ) THEN 
     725         IF(lwp) THEN 
     726            WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 
     727         ENDIF 
    782728 
    783729         ! geopotential diffusion in s-coordinates on tracers and/or momentum 
     
    790736            DO jj = 2, jpjm1 
    791737               DO ji = fs_2, fs_jpim1   ! vector opt. 
    792                   uslp (ji,jj,jk) = -1. / e1u(ji,jj) * umask(ji,jj,jk)   & 
    793                      &                               * ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) ) 
    794                   vslp (ji,jj,jk) = -1. / e2v(ji,jj) * vmask(ji,jj,jk)   & 
    795                      &                               * ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) 
    796                   wslpi(ji,jj,jk) = -1. / e1t(ji,jj) * tmask(ji,jj,jk)   & 
    797                      &                               * ( fsdepuw(ji+1,jj,jk) - fsdepuw(ji,jj,jk) ) 
    798                   wslpj(ji,jj,jk) = -1. / e2t(ji,jj) * tmask(ji,jj,jk)   & 
    799                      &                               * ( fsdepvw(ji,jj+1,jk) - fsdepvw(ji,jj,jk) ) 
     738                  uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * umask(ji,jj,jk) 
     739                  vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * vmask(ji,jj,jk) 
     740                  wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5 
     741                  wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5 
    800742               END DO 
    801743            END DO 
     
    803745 
    804746         ! Lateral boundary conditions on the slopes 
    805          CALL lbc_lnk( uslp , 'U', -1. ) 
    806          CALL lbc_lnk( vslp , 'V', -1. ) 
    807          CALL lbc_lnk( wslpi, 'W', -1. ) 
    808          CALL lbc_lnk( wslpj, 'W', -1. ) 
     747         CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. ) 
     748         CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. ) 
    809749      ENDIF 
    810750 
  • trunk/NEMO/OFF_SRC/LDF/ldftra_oce.F90

    r343 r497  
    4545      l_traldf_iso_zps                 !: iso-neutral laplacian (partial steps) 
    4646 
    47 #if defined key_traldf_c3d 
     47#if defined key_traldf_c3d || defined key_off_degrad 
    4848   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: ** 3D coefficients ** 
    4949#elif defined key_traldf_c2d 
     
    6363   LOGICAL, PUBLIC, PARAMETER ::   lk_traldf_eiv   = .TRUE.   !: eddy induced velocity flag 
    6464       
    65 # if defined key_traldf_c3d 
     65# if defined key_traldf_c3d || defined key_off_degrad 
    6666   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: ** 3D coefficients ** 
    6767# elif defined key_traldf_c2d 
Note: See TracChangeset for help on using the changeset viewer.