Changeset 2436


Ignore:
Timestamp:
2010-11-25T20:03:49+01:00 (10 years ago)
Author:
gm
Message:

v3.3beta: suppress obsolete key_orca_lev10

Location:
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r2435 r2436  
    77   !!                 ! 1997-07  (G. Madec)  lbc_lnk call 
    88   !!                 ! 1997-04  (J.-O. Beismann)  
    9    !!            8.5  ! 2002-09 (A. Bozec, G. Madec)  F90: Free form and module 
    10    !!             -   ! 2002-09 (A. de Miranda)  rigid-lid + islands 
     9   !!            8.5  ! 2002-09  (A. Bozec, G. Madec)  F90: Free form and module 
     10   !!             -   ! 2002-09  (A. de Miranda)  rigid-lid + islands 
    1111   !!  NEMO      1.0  ! 2003-08  (G. Madec)  F90: Free form and module 
    1212   !!             -   ! 2005-10  (A. Beckmann)  modifications for hybrid s-ccordinates & new stretching function 
     
    1717 
    1818   !!---------------------------------------------------------------------- 
    19    !!   dom_zgr          : defined the ocean vertical coordinate system 
    20    !!       zgr_bat      : bathymetry fields (levels and meters) 
    21    !!       zgr_bat_zoom : modify the bathymetry field if zoom domain 
    22    !!       zgr_bat_ctl  : check the bathymetry files 
    23    !!       zgr_z        : reference z-coordinate  
    24    !!       zgr_zco      : z-coordinate  
    25    !!       zgr_zps      : z-coordinate with partial steps 
    26    !!       zgr_sco      : s-coordinate 
    27    !!       fssig        : sigma coordinate non-dimensional function 
    28    !!       dfssig       : derivative of the sigma coordinate function    !!gm  (currently missing!) 
     19   !!   dom_zgr         : defined the ocean vertical coordinate system 
     20   !!       zgr_bat     : bathymetry fields (levels and meters) 
     21   !!       zgr_bat_zoom: modify the bathymetry field if zoom domain 
     22   !!       zgr_bat_ctl : check the bathymetry files 
     23   !!       zgr_z       : reference z-coordinate  
     24   !!       zgr_zco     : z-coordinate  
     25   !!       zgr_zps     : z-coordinate with partial steps 
     26   !!       zgr_sco     : s-coordinate 
     27   !!       fssig       : sigma coordinate non-dimensional function 
     28   !!       dfssig      : derivative of the sigma coordinate function    !!gm  (currently missing!) 
    2929   !!--------------------------------------------------------------------- 
    30    USE oce             ! ocean dynamics and tracers 
    31    USE dom_oce         ! ocean space and time domain 
    32    USE in_out_manager  ! I/O manager 
    33    USE lib_mpp         ! distributed memory computing library 
    34    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    35    USE closea          ! closed seas 
    36    USE c1d 
     30   USE oce              ! ocean variables 
     31   USE dom_oce          ! ocean domain 
     32   USE closea           ! closed seas 
     33   USE c1d              ! 1D vertical configuration 
     34   USE in_out_manager   ! I/O manager 
     35   USE iom              ! I/O library 
     36   USE lbclnk           ! ocean lateral boundary conditions (or mpp link) 
     37   USE lib_mpp          ! distributed memory computing library 
    3738 
    3839   IMPLICIT NONE 
    3940   PRIVATE 
    4041 
    41    PUBLIC   dom_zgr    ! called by dom_init.F90 
    42  
    43 !!gm   DOCTOR name for the namelist parameter... 
    44    !                                    !!! ** Namelist namzgr_sco ** 
    45    REAL(wp) ::   rn_sbot_min =  300.     ! minimum depth of s-bottom surface (>0) (m) 
    46    REAL(wp) ::   rn_sbot_max = 5250.     ! maximum depth of s-bottom surface (= ocean depth) (>0) (m) 
    47    REAL(wp) ::   rn_theta    =    6.0    ! surface control parameter (0<=rn_theta<=20) 
    48    REAL(wp) ::   rn_thetb    =    0.75   ! bottom control parameter  (0<=rn_thetb<= 1) 
    49    REAL(wp) ::   rn_rmax     =    0.15   ! maximum cut-off r-value allowed (0<rn_rmax<1) 
    50    LOGICAL  ::   ln_s_sigma  = .false.   ! use hybrid s-sigma -coordinate & stretching function fssig1 (ln_sco=T) 
    51    REAL(wp) ::   rn_bb       =    0.8    ! stretching parameter for song and haidvogel stretching 
    52    !                                     ! ( rn_bb=0; top only, rn_bb =1; top and bottom) 
    53    REAL(wp) ::   rn_hc       = 150.      ! Critical depth for s-sigma coordinates 
     42   PUBLIC   dom_zgr     ! called by dom_init.F90 
     43 
     44   !                                       !!* Namelist namzgr_sco * 
     45   REAL(wp) ::   rn_sbot_min =  300._wp     ! minimum depth of s-bottom surface (>0) (m) 
     46   REAL(wp) ::   rn_sbot_max = 5250._wp     ! maximum depth of s-bottom surface (= ocean depth) (>0) (m) 
     47   REAL(wp) ::   rn_theta    =    6.00_wp   ! surface control parameter (0<=rn_theta<=20) 
     48   REAL(wp) ::   rn_thetb    =    0.75_wp   ! bottom control parameter  (0<=rn_thetb<= 1) 
     49   REAL(wp) ::   rn_rmax     =    0.15_wp   ! maximum cut-off r-value allowed (0<rn_rmax<1) 
     50   LOGICAL  ::   ln_s_sigma  = .false.      ! use hybrid s-sigma -coordinate & stretching function fssig1 (ln_sco=T) 
     51   REAL(wp) ::   rn_bb       =    0.80_wp   ! stretching parameter for song and haidvogel stretching 
     52   !                                        ! ( rn_bb=0; top only, rn_bb =1; top and bottom) 
     53   REAL(wp) ::   rn_hc       =  150._wp     ! Critical depth for s-sigma coordinates 
    5454  
    5555   !! * Substitutions 
     
    5959   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    6060   !! $Id$ 
    61    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     61   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6262   !!---------------------------------------------------------------------- 
    63  
    6463CONTAINS        
    6564 
     
    8281      !!---------------------------------------------------------------------- 
    8382      INTEGER ::   ioptio = 0   ! temporary integer 
    84       !! 
     83      ! 
    8584      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco 
    8685      !!---------------------------------------------------------------------- 
    8786 
    88       REWIND ( numnam )                ! Read Namelist namzgr : vertical coordinate' 
    89       READ   ( numnam, namzgr ) 
     87      REWIND( numnam )                 ! Read Namelist namzgr : vertical coordinate' 
     88      READ  ( numnam, namzgr ) 
    9089 
    9190      IF(lwp) THEN                     ! Control print 
     
    103102      IF( ln_zps ) ioptio = ioptio + 1 
    104103      IF( ln_sco ) ioptio = ioptio + 1 
    105       IF ( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' ) 
     104      IF( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' ) 
    106105 
    107106      ! Build the vertical coordinate system 
     
    113112      IF( ln_sco )   CALL zgr_sco      ! s-coordinate or hybrid z-s coordinate 
    114113 
    115 !!bug gm control print: 
    116114      IF( nprint == 1 .AND. lwp )   THEN 
    117115         WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) 
     
    130128            &                   ' w ',   MAXVAL( fse3w(:,:,:) ) 
    131129      ENDIF 
    132 !!!bug gm 
    133  
     130      ! 
    134131   END SUBROUTINE dom_zgr 
    135132 
     
    172169      ! If ppa1 and ppa0 and ppsur are et to pp_to_be_computed 
    173170      !  za0, za1, zsur are computed from ppdzmin , pphmax, ppkth, ppacr 
    174       ! 
    175171      IF(   ppa1  == pp_to_be_computed  .AND.  & 
    176172         &  ppa0  == pp_to_be_computed  .AND.  & 
     
    191187         WRITE(numout,*) '    zgr_z   : Reference vertical z-coordinates' 
    192188         WRITE(numout,*) '    ~~~~~~~' 
    193          IF(  ppkth == 0. ) THEN               
     189         IF(  ppkth == 0._wp ) THEN               
    194190              WRITE(numout,*) '            Uniform grid with ',jpk-1,' layers' 
    195191              WRITE(numout,*) '            Total depth    :', zhmax 
    196192              WRITE(numout,*) '            Layer thickness:', zhmax/(jpk-1) 
    197193         ELSE 
    198             IF( ppa1 == 0. .AND. ppa0 == 0. .AND. ppsur == 0. ) THEN 
     194            IF( ppa1 == 0._wp .AND. ppa0 == 0._wp .AND. ppsur == 0._wp ) THEN 
    199195               WRITE(numout,*) '         zsur, za0, za1 computed from ' 
    200196               WRITE(numout,*) '                 zdzmin = ', zdzmin 
     
    218214      ! Reference z-coordinate (depth - scale factor at T- and W-points) 
    219215      ! ====================== 
    220       IF( ppkth == 0.e0 ) THEN            !  uniform vertical grid        
     216      IF( ppkth == 0._wp ) THEN            !  uniform vertical grid        
    221217         za1 = zhmax / FLOAT(jpk-1)  
    222218         DO jk = 1, jpk 
    223219            zw = FLOAT( jk ) 
    224             zt = FLOAT( jk ) + 0.5 
     220            zt = FLOAT( jk ) + 0.5_wp 
    225221            gdepw_0(jk) = ( zw - 1 ) * za1 
    226222            gdept_0(jk) = ( zt - 1 ) * za1 
     
    232228            DO jk = 1, jpk 
    233229               zw = FLOAT( jk ) 
    234                zt = FLOAT( jk ) + 0.5 
     230               zt = FLOAT( jk ) + 0.5_wp 
    235231               gdepw_0(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) )  ) 
    236232               gdept_0(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth) / zacr ) )  ) 
     
    241237            DO jk = 1, jpk 
    242238               zw = FLOAT( jk ) 
    243                zt = FLOAT( jk ) + 0.5 
     239               zt = FLOAT( jk ) + 0.5_wp 
    244240               ! Double tanh function 
    245241               gdepw_0(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) )    & 
     
    253249            END DO 
    254250         ENDIF 
    255          gdepw_0(1) = 0.e0                     ! force first w-level to be exactly at zero 
     251         gdepw_0(1) = 0._wp                    ! force first w-level to be exactly at zero 
    256252      ENDIF 
    257253 
    258254!!gm BUG in s-coordinate this does not work! 
    259255      ! deepest/shallowest W level Above/Below ~10m 
    260       zrefdep = 10. - ( 0.1*MINVAL(e3w_0) )                          ! ref. depth with tolerance (10% of minimum layer thickness) 
     256      zrefdep = 10._wp - 0.1_wp * MINVAL( e3w_0 )                    ! ref. depth with tolerance (10% of minimum layer thickness) 
    261257      nlb10 = MINLOC( gdepw_0, mask = gdepw_0 > zrefdep, dim = 1 )   ! shallowest W level Below ~10m 
    262258      nla10 = nlb10 - 1                                              ! deepest    W level Above ~10m 
     
    270266      ENDIF 
    271267      DO jk = 1, jpk                      ! control positivity 
    272          IF( e3w_0  (jk) <= 0.e0 .OR. e3t_0  (jk) <= 0.e0 )   CALL ctl_stop( ' e3w or e3t =< 0 '    ) 
    273          IF( gdepw_0(jk) <  0.e0 .OR. gdept_0(jk) <  0.e0 )   CALL ctl_stop( ' gdepw or gdept < 0 ' ) 
     268         IF( e3w_0  (jk) <= 0._wp .OR. e3t_0  (jk) <= 0._wp )   CALL ctl_stop( 'dom:zgr_z: e3w or e3t =< 0 '    ) 
     269         IF( gdepw_0(jk) <  0._wp .OR. gdept_0(jk) <  0._wp )   CALL ctl_stop( 'dom:zgr_z: gdepw or gdept < 0 ' ) 
    274270      END DO 
    275271      ! 
     
    310306      !!              - bathy : meter bathymetry (in meters) 
    311307      !!---------------------------------------------------------------------- 
    312       USE iom 
    313       !! 
    314308      INTEGER  ::   ji, jj, jl, jk            ! dummy loop indices 
    315309      INTEGER  ::   inum                      ! temporary logical unit 
     
    342336            ii_bump = jpidta / 2                           ! i-index of the bump center 
    343337            ij_bump = jpjdta / 2                           ! j-index of the bump center 
    344             r_bump  = 50000.e0                             ! bump radius (meters)        
    345             h_bump  = 2700.e0                              ! bump height (meters) 
     338            r_bump  = 50000._wp                            ! bump radius (meters)        
     339            h_bump  =  2700._wp                            ! bump height (meters) 
    346340            h_oce   = gdepw_0(jpk)                         ! background ocean depth (meters) 
    347341            IF(lwp) WRITE(numout,*) '            bump characteristics: ' 
     
    364358               idta(:,:) = jpkm1 
    365359               DO jk = 1, jpkm1 
    366                   DO jj = 1, jpjdta 
    367                      DO ji = 1, jpidta 
    368                         IF( gdept_0(jk) < zdta(ji,jj) .AND. zdta(ji,jj) <= gdept_0(jk+1) )   idta(ji,jj) = jk 
    369                      END DO 
    370                   END DO 
     360                  WHERE( gdept_0(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_0(jk+1) )   idta(:,:) = jk 
    371361               END DO 
    372362            ENDIF 
     
    375365         !                                            ! Caution : idta on the global domain: use of jperio, not nperio 
    376366         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN 
    377             idta( :    , 1    ) = -1                ;      zdta( :    , 1    ) = -1.e0 
    378             idta( :    ,jpjdta) =  0                ;      zdta( :    ,jpjdta) =  0.e0 
     367            idta( :    , 1    ) = -1                ;      zdta( :    , 1    ) = -1._wp 
     368            idta( :    ,jpjdta) =  0                ;      zdta( :    ,jpjdta) =  0._wp 
    379369         ELSEIF( jperio == 2 ) THEN 
    380370            idta( :    , 1    ) = idta( : ,  3  )   ;      zdta( :    , 1    ) = zdta( : ,  3  ) 
    381             idta( :    ,jpjdta) = 0                 ;      zdta( :    ,jpjdta) =  0.e0 
    382             idta( 1    , :    ) = 0                 ;      zdta( 1    , :    ) =  0.e0 
    383             idta(jpidta, :    ) = 0                 ;      zdta(jpidta, :    ) =  0.e0 
     371            idta( :    ,jpjdta) = 0                 ;      zdta( :    ,jpjdta) =  0._wp 
     372            idta( 1    , :    ) = 0                 ;      zdta( 1    , :    ) =  0._wp 
     373            idta(jpidta, :    ) = 0                 ;      zdta(jpidta, :    ) =  0._wp 
    384374         ELSE 
    385             ih = 0                                  ;      zh = 0.e0 
     375            ih = 0                                  ;      zh = 0._wp 
    386376            IF( ln_sco )   ih = jpkm1               ;      IF( ln_sco )   zh = h_oce 
    387377            idta( :    , 1    ) = ih                ;      zdta( :    , 1    ) =  zh 
     
    393383         !                                            ! local domain level and meter bathymetries (mbathy,bathy) 
    394384         mbathy(:,:) = 0                                   ! set to zero extra halo points 
    395          bathy (:,:) = 0.e0                                ! (require for mpp case) 
     385         bathy (:,:) = 0._wp                               ! (require for mpp case) 
    396386         DO jj = 1, nlcj                                   ! interior values 
    397387            DO ji = 1, nlci 
     
    406396         ! 
    407397         IF( ln_zco )   THEN                          ! zco : read level bathymetry  
    408             CALL iom_open( 'bathy_level.nc', inum )   
    409             CALL iom_get ( inum, jpdom_data, 'Bathy_level', bathy ) 
    410             CALL iom_close (inum) 
     398            CALL iom_open ( 'bathy_level.nc', inum )   
     399            CALL iom_get  ( inum, jpdom_data, 'Bathy_level', bathy ) 
     400            CALL iom_close( inum ) 
    411401            mbathy(:,:) = INT( bathy(:,:) ) 
    412402            !                                                ! ===================== 
     
    439429         ENDIF 
    440430         IF( ln_zps .OR. ln_sco )   THEN              ! zps or sco : read meter bathymetry 
    441             CALL iom_open( 'bathy_meter.nc', inum )  
    442             CALL iom_get ( inum, jpdom_data, 'Bathymetry', bathy ) 
    443             CALL iom_close (inum) 
     431            CALL iom_open ( 'bathy_meter.nc', inum )  
     432            CALL iom_get  ( inum, jpdom_data, 'Bathymetry', bathy ) 
     433            CALL iom_close( inum ) 
    444434            !                                                ! ===================== 
    445435            IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration 
     
    448438               DO ji = mi0(ii0), mi1(ii1)                    ! Close Halmera Strait 
    449439                  DO jj = mj0(ij0), mj1(ij1) 
    450                      bathy(ji,jj) = 0.0  
     440                     bathy(ji,jj) = 0._wp 
    451441                  END DO 
    452442               END DO 
     
    462452                 DO ji = mi0(ii0), mi1(ii1) 
    463453                    DO jj = mj0(ij0), mj1(ij1) 
    464                        bathy(ji,jj) = 284.e0 
     454                       bathy(ji,jj) = 284._wp 
    465455                    END DO 
    466456                 END DO 
     
    472462                 DO ji = mi0(ii0), mi1(ii1) 
    473463                    DO jj = mj0(ij0), mj1(ij1) 
    474                        bathy(ji,jj) = 137.e0 
     464                       bathy(ji,jj) = 137._wp 
    475465                    END DO 
    476466                 END DO 
     
    495485               DO ji = ncsi1(jl), ncsi2(jl) 
    496486                  mbathy(ji,jj) = 0                   ! suppress closed seas and lakes from bathymetry 
    497                   bathy (ji,jj) = 0.e0                 
     487                  bathy (ji,jj) = 0._wp                
    498488               END DO 
    499489            END DO 
    500490         END DO 
    501491      ENDIF 
    502 #if defined key_orca_lev10 
    503       !                                               ! ================= ! 
    504       mbathy(:,:) = 10 * mbathy(:,:)                  !   key_orca_lev10  ! 
    505       !                                               ! ================= ! 
    506       IF( ln_zps .OR. ln_sco )   CALL ctl_stop( ' CAUTION: 300 levels only with level bathymetry' ) 
    507 #endif 
    508492      !                                               ! =============== ! 
    509       IF( lzoom        )   CALL zgr_bat_zoom          !   Zoom domain   ! 
     493      IF( lzoom       )   CALL zgr_bat_zoom           !   Zoom domain   ! 
    510494      !                                               ! =============== ! 
    511  
     495      ! 
    512496      !                                               ! =================== ! 
    513       IF( .NOT. lk_c1d )    CALL zgr_bat_ctl          !   Bathymetry check  ! 
     497      IF( .NOT.lk_c1d )   CALL zgr_bat_ctl            !   Bathymetry check  ! 
    514498      !                                               ! =================== ! 
    515499   END SUBROUTINE zgr_bat 
     
    629613      IF( lk_mpp ) THEN 
    630614         zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    631          CALL lbc_lnk( zbathy, 'T', 1. ) 
     615         CALL lbc_lnk( zbathy, 'T', 1._wp ) 
    632616         mbathy(:,:) = INT( zbathy(:,:) ) 
    633617      ENDIF 
     
    669653         !   ... mono- or macro-tasking: T-point, >0, 2D array, no slab 
    670654         zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    671          CALL lbc_lnk( zbathy, 'T', 1. ) 
     655         CALL lbc_lnk( zbathy, 'T', 1._wp ) 
    672656         mbathy(:,:) = INT( zbathy(:,:) ) 
    673657      ENDIF 
     
    792776      IF(lwp) WRITE(numout,*) '              mbathy is recomputed : bathy_level file is NOT used' 
    793777 
    794       ll_print=.FALSE.                     ! Local variable for debugging 
    795 !!    ll_print=.TRUE. 
     778      ll_print = .FALSE.                   ! Local variable for debugging 
     779!!    ll_print = .TRUE. 
    796780       
    797781      IF(lwp .AND. ll_print) THEN          ! control print of the ocean depth 
     
    806790      zmax = gdepw_0(jpk) + e3t_0(jpk)     ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_0(jpkm1) ) 
    807791 
    808       zrefdep = 25. 
     792      zrefdep = 25._wp 
    809793      nlbelow = MINLOC( gdepw_0, mask = gdepw_0 > zrefdep, dim = 1 )   ! shallowest W level Below zrefdep 
    810794      IF(lwp) write(numout,*) 'Minimum depth level selected: ', nlbelow 
     
    814798 
    815799      !                                    ! storage of land and island's number (zera and negative values) in mbathy 
    816       WHERE( bathy(:,:) <= 0. )   mbathy(:,:) = INT( bathy(:,:) ) 
     800      WHERE( bathy(:,:) <= 0._wp )   mbathy(:,:) = INT( bathy(:,:) ) 
    817801 
    818802      ! bounded value of bathy 
     
    820804      DO jj = 1, jpj 
    821805         DO ji= 1, jpi 
    822             IF( bathy(ji,jj) <= 0. ) THEN   ;   bathy(ji,jj) = 0.e0 
    823             ELSE                            ;   bathy(ji,jj) = MIN(  zmax,  MAX( bathy(ji,jj), zmin )  ) 
     806            IF( bathy(ji,jj) <= 0._wp ) THEN   ;   bathy(ji,jj) = 0._wp 
     807            ELSE                               ;   bathy(ji,jj) = MIN(  zmax,  MAX( bathy(ji,jj), zmin )  ) 
    824808            ENDIF 
    825809         END DO 
     
    832816      DO jk = jpkm1, 1, -1 
    833817         zdepth = gdepw_0(jk) + MIN( e3zps_min, e3t_0(jk)*e3zps_rat ) 
    834          DO jj = 1, jpj 
    835             DO ji = 1, jpi 
    836                IF( 0. < bathy(ji,jj) .AND. bathy(ji,jj) <= zdepth )   mbathy(ji,jj) = jk-1 
    837             END DO 
    838          END DO 
     818         WHERE( 0._wp < bathy(:,:) .AND. bathy(:,:) <= zdepth )   mbathy(:,:) = jk-1 
    839819      END DO 
    840820 
     
    857837                  zdepwp = bathy(ji,jj) 
    858838                  ze3tp  = bathy(ji,jj) - gdepw_0(ik) 
    859                   ze3wp = 0.5 * e3w_0(ik) * ( 1. + ( ze3tp/e3t_0(ik) ) ) 
     839                  ze3wp = 0.5_wp * e3w_0(ik) * ( 1._wp + ( ze3tp/e3t_0(ik) ) ) 
    860840                  e3t(ji,jj,ik  ) = ze3tp 
    861841                  e3t(ji,jj,ik+1) = ze3tp 
     
    877857                  e3t  (ji,jj,ik) = e3t_0  (ik) * ( gdepw  (ji,jj,ik+1) - gdepw_0(ik) )   &  
    878858                     &                          / ( gdepw_0(      ik+1) - gdepw_0(ik) )  
    879                   e3w  (ji,jj,ik) = 0.5 * ( gdepw(ji,jj,ik+1) + gdepw_0(ik+1) - 2.*gdepw_0(ik) )   & 
    880                      &                  * ( e3w_0(ik) / ( gdepw_0(ik+1) - gdepw_0(ik) ) ) 
     859                  e3w  (ji,jj,ik) = 0.5_wp * ( gdepw(ji,jj,ik+1) + gdepw_0(ik+1) - 2._wp * gdepw_0(ik) )   & 
     860                     &                     * ( e3w_0(ik) / ( gdepw_0(ik+1) - gdepw_0(ik) ) ) 
    881861                  !       ... on ik+1 
    882862                  e3w  (ji,jj,ik+1) = e3t  (ji,jj,ik) 
     
    899879               ! test 
    900880               zdiff= gdepw(ji,jj,ik+1) - gdept(ji,jj,ik  ) 
    901                IF( zdiff <= 0. .AND. lwp ) THEN  
     881               IF( zdiff <= 0._wp .AND. lwp ) THEN  
    902882                  it = it + 1 
    903883                  WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj 
     
    920900         DO jj = 1, jpjm1 
    921901            DO ji = 1, fs_jpim1   ! vector opt. 
    922                e3u (ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji+1,jj,jk)) 
    923                e3v (ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji,jj+1,jk)) 
     902               e3u (ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji+1,jj,jk) ) 
     903               e3v (ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji,jj+1,jk) ) 
    924904               e3uw(ji,jj,jk) = MIN( e3w(ji,jj,jk), e3w(ji+1,jj,jk) ) 
    925905               e3vw(ji,jj,jk) = MIN( e3w(ji,jj,jk), e3w(ji,jj+1,jk) ) 
     
    927907         END DO 
    928908      END DO 
    929       !                                     ! Boundary conditions 
    930       CALL lbc_lnk( e3u , 'U', 1. )   ;   CALL lbc_lnk( e3uw, 'U', 1. ) 
    931       CALL lbc_lnk( e3v , 'V', 1. )   ;   CALL lbc_lnk( e3vw, 'V', 1. ) 
     909      CALL lbc_lnk( e3u , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw, 'U', 1._wp )   ! lateral boundary conditions 
     910      CALL lbc_lnk( e3v , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw, 'V', 1._wp ) 
    932911      ! 
    933912      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries) 
    934          WHERE( e3u (:,:,jk) == 0.e0 )   e3u (:,:,jk) = e3t_0(jk) 
    935          WHERE( e3v (:,:,jk) == 0.e0 )   e3v (:,:,jk) = e3t_0(jk) 
    936          WHERE( e3uw(:,:,jk) == 0.e0 )   e3uw(:,:,jk) = e3w_0(jk) 
    937          WHERE( e3vw(:,:,jk) == 0.e0 )   e3vw(:,:,jk) = e3w_0(jk) 
     913         WHERE( e3u (:,:,jk) == 0._wp )   e3u (:,:,jk) = e3t_0(jk) 
     914         WHERE( e3v (:,:,jk) == 0._wp )   e3v (:,:,jk) = e3t_0(jk) 
     915         WHERE( e3uw(:,:,jk) == 0._wp )   e3uw(:,:,jk) = e3w_0(jk) 
     916         WHERE( e3vw(:,:,jk) == 0._wp )   e3vw(:,:,jk) = e3w_0(jk) 
    938917      END DO 
    939918       
    940919      ! Scale factor at F-point 
    941920      DO jk = 1, jpk                        ! initialisation to z-scale factors 
    942          e3f (:,:,jk) = e3t_0(jk) 
     921         e3f(:,:,jk) = e3t_0(jk) 
    943922      END DO 
    944923      DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors 
     
    949928         END DO 
    950929      END DO 
    951       CALL lbc_lnk( e3f, 'F', 1. )          ! Boundary conditions 
     930      CALL lbc_lnk( e3f, 'F', 1._wp )       ! Lateral boundary conditions 
    952931      ! 
    953932      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries) 
    954          WHERE( e3f(:,:,jk) == 0.e0 )   e3f(:,:,jk) = e3t_0(jk) 
     933         WHERE( e3f(:,:,jk) == 0._wp )   e3f(:,:,jk) = e3t_0(jk) 
    955934      END DO 
    956935!!gm  bug ? :  must be a do loop with mj0,mj1 
     
    963942 
    964943      ! Control of the sign 
    965       IF( MINVAL( e3t  (:,:,:) ) <= 0.e0 )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t   <= 0' ) 
    966       IF( MINVAL( e3w  (:,:,:) ) <= 0.e0 )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w   <= 0' ) 
    967       IF( MINVAL( gdept(:,:,:) ) <  0.e0 )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw <  0' ) 
    968       IF( MINVAL( gdepw(:,:,:) ) <  0.e0 )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw <  0' ) 
     944      IF( MINVAL( e3t  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t   <= 0' ) 
     945      IF( MINVAL( e3w  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w   <= 0' ) 
     946      IF( MINVAL( gdept(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw <  0' ) 
     947      IF( MINVAL( gdepw(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw <  0' ) 
    969948      
    970949      ! Compute gdep3w (vertical sum of e3w) 
    971       gdep3w(:,:,1) = 0.5 * e3w(:,:,1) 
     950      gdep3w(:,:,1) = 0.5_wp * e3w(:,:,1) 
    972951      DO jk = 2, jpk 
    973952         gdep3w(:,:,jk) = gdep3w(:,:,jk-1) + e3w(:,:,jk)  
     
    1001980         WRITE(numout,*) 'domzgr gdep3w(mbathy)'   ;   CALL prihre(zprt(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    1002981      ENDIF   
    1003         
     982      ! 
    1004983      !                                               ! =============== ! 
    1005984      IF( lzoom )   CALL zgr_bat_zoom                 !   Zoom domain   ! 
    1006985      !                                               ! =============== ! 
    1007  
    1008  
     986      ! 
    1009987      !                                               ! =================== ! 
    1010988      IF( .NOT. lk_c1d )    CALL zgr_bat_ctl          !   Bathymetry check  ! 
     
    10231001      !!                T-points at integer values (between 1 and jpk) 
    10241002      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5) 
    1025       !! 
    1026       !! Reference  :   ??? 
    1027       !!---------------------------------------------------------------------- 
    1028       REAL(wp), INTENT(in   ) ::   pk   ! continuous "k" coordinate 
    1029       REAL(wp)                ::   pf   ! sigma value 
    1030       !!---------------------------------------------------------------------- 
    1031       ! 
    1032       pf =   (   TANH( rn_theta * ( -(pk-0.5) / REAL(jpkm1) + rn_thetb )  )      & 
     1003      !!---------------------------------------------------------------------- 
     1004      REAL(wp), INTENT(in) ::   pk   ! continuous "k" coordinate 
     1005      REAL(wp)             ::   pf   ! sigma value 
     1006      !!---------------------------------------------------------------------- 
     1007      ! 
     1008      pf =   (   TANH( rn_theta * ( -(pk-0.5_wp) / REAL(jpkm1) + rn_thetb )  )   & 
    10331009         &     - TANH( rn_thetb * rn_theta                                )  )   & 
    1034          & * (   COSH( rn_theta                           )                   & 
    1035          &     + COSH( rn_theta * ( 2.e0 * rn_thetb - 1.e0 ) )  )                & 
    1036          & / ( 2.e0 * SINH( rn_theta ) ) 
     1010         & * (   COSH( rn_theta                           )                      & 
     1011         &     + COSH( rn_theta * ( 2._wp * rn_thetb - 1._wp ) )  )              & 
     1012         & / ( 2._wp * SINH( rn_theta ) ) 
    10371013      ! 
    10381014   END FUNCTION fssig 
     
    10491025      !!                T-points at integer values (between 1 and jpk) 
    10501026      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5) 
    1051       !! 
    1052       !! Reference  :   ??? 
    1053       !!---------------------------------------------------------------------- 
    1054       REAL(wp), INTENT(in   ) ::   pk1   ! continuous "k" coordinate 
    1055       REAL(wp), INTENT(in   ) ::   pbb   ! Stretching coefficient 
    1056       REAL(wp)                ::   pf1   ! sigma value 
     1027      !!---------------------------------------------------------------------- 
     1028      REAL(wp), INTENT(in) ::   pk1   ! continuous "k" coordinate 
     1029      REAL(wp), INTENT(in) ::   pbb   ! Stretching coefficient 
     1030      REAL(wp)             ::   pf1   ! sigma value 
    10571031      !!---------------------------------------------------------------------- 
    10581032      ! 
    10591033      IF ( rn_theta == 0 ) then      ! uniform sigma 
    1060          pf1 = -(pk1-0.5) / REAL( jpkm1 ) 
     1034         pf1 = - ( pk1 - 0.5_wp ) / REAL( jpkm1 ) 
    10611035      ELSE                        ! stretched sigma 
    1062          pf1 =   (1.0-pbb) * (sinh( rn_theta*(-(pk1-0.5)/REAL(jpkm1)) ) ) / sinh(rn_theta) + & 
    1063             &    pbb * ( (tanh( rn_theta*( (-(pk1-0.5)/REAL(jpkm1)) + 0.5) ) - tanh(0.5*rn_theta) ) / & 
    1064             &    (2*tanh(0.5*rn_theta) ) ) 
     1036         pf1 =   ( 1._wp - pbb ) * ( SINH( rn_theta*(-(pk1-0.5_wp)/REAL(jpkm1)) ) ) / SINH( rn_theta )              & 
     1037            &  + pbb * (  (TANH( rn_theta*( (-(pk1-0.5_wp)/REAL(jpkm1)) + 0.5_wp) ) - TANH( 0.5_wp * rn_theta )  ) & 
     1038            &        / ( 2._wp * TANH( 0.5_wp * rn_theta ) ) ) 
    10651039      ENDIF 
    10661040      ! 
     
    11391113      ENDIF 
    11401114 
    1141       gsigw3  = 0.0d0   ;   gsigt3  = 0.0d0   ; gsi3w3 = 0.0d0 
    1142       esigt3  = 0.0d0   ;   esigw3  = 0.0d0  
    1143       esigtu3 = 0.0d0   ;   esigtv3 = 0.0d0   ; esigtf3 = 0.0d0 
    1144       esigwu3 = 0.0d0   ;   esigwv3 = 0.0d0 
     1115      gsigw3  = 0._wp   ;   gsigt3  = 0._wp   ;   gsi3w3  = 0._wp 
     1116      esigt3  = 0._wp   ;   esigw3  = 0._wp  
     1117      esigtu3 = 0._wp   ;   esigtv3 = 0._wp   ;   esigtf3 = 0._wp 
     1118      esigwu3 = 0._wp   ;   esigwv3 = 0._wp 
    11451119 
    11461120      hift(:,:) = rn_sbot_min                     ! set the minimum depth for the s-coordinate 
     
    11541128      DO jj = 1, jpj 
    11551129         DO ji = 1, jpi 
    1156            IF (bathy(ji,jj) .gt. 0.0) THEN 
     1130           IF( bathy(ji,jj) > 0._wp ) THEN 
    11571131              bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) ) 
    11581132           ENDIF 
     
    11701144      !  
    11711145      ! Smooth the bathymetry (if required) 
    1172       scosrf(:,:) = 0.e0              ! ocean surface depth (here zero: no under ice-shelf sea) 
     1146      scosrf(:,:) = 0._wp             ! ocean surface depth (here zero: no under ice-shelf sea) 
    11731147      scobot(:,:) = bathy(:,:)        ! ocean bottom  depth 
    11741148      ! 
    11751149      jl = 0 
    1176       zrmax = 1.e0 
     1150      zrmax = 1._wp 
    11771151      !                                                     ! ================ ! 
    1178       DO WHILE ( jl <= 10000 .AND. zrmax > rn_rmax )          !  Iterative loop  ! 
     1152      DO WHILE( jl <= 10000 .AND. zrmax > rn_rmax )         !  Iterative loop  ! 
    11791153         !                                                  ! ================ ! 
    11801154         jl = jl + 1 
    1181          zrmax = 0.e0 
    1182          zmsk(:,:) = 0.e0 
     1155         zrmax = 0._wp 
     1156         zmsk(:,:) = 0._wp 
    11831157         DO jj = 1, nlcj 
    11841158            DO ji = 1, nlci 
     
    11881162               zrj(ji,jj) = ABS( zenv(ji  ,ijp1) - zenv(ji,jj) ) / ( zenv(ji  ,ijp1) + zenv(ji,jj) ) 
    11891163               zrmax = MAX( zrmax, zri(ji,jj), zrj(ji,jj) ) 
    1190                IF( zri(ji,jj) > rn_rmax )   zmsk(ji  ,jj  ) = 1.0 
    1191                IF( zri(ji,jj) > rn_rmax )   zmsk(iip1,jj  ) = 1.0 
    1192                IF( zrj(ji,jj) > rn_rmax )   zmsk(ji  ,jj  ) = 1.0 
    1193                IF( zrj(ji,jj) > rn_rmax )   zmsk(ji  ,ijp1) = 1.0 
     1164               IF( zri(ji,jj) > rn_rmax )   zmsk(ji  ,jj  ) = 1._wp 
     1165               IF( zri(ji,jj) > rn_rmax )   zmsk(iip1,jj  ) = 1._wp 
     1166               IF( zrj(ji,jj) > rn_rmax )   zmsk(ji  ,jj  ) = 1._wp 
     1167               IF( zrj(ji,jj) > rn_rmax )   zmsk(ji  ,ijp1) = 1._wp 
    11941168            END DO 
    11951169         END DO 
    11961170         IF( lk_mpp )   CALL mpp_max( zrmax )   ! max over the global domain 
    11971171         ! lateral boundary condition on zmsk: keep 1 along closed boundary (use of MAX) 
    1198          ztmp(:,:) = zmsk(:,:)   ;   CALL lbc_lnk( zmsk, 'T', 1. ) 
     1172         ztmp(:,:) = zmsk(:,:)   ;   CALL lbc_lnk( zmsk, 'T', 1._wp ) 
    11991173         DO jj = 1, nlcj 
    12001174            DO ji = 1, nlci 
     
    12111185               iim1 = MAX( ji-1,  1  )      ! first line (ji=nlci) 
    12121186               ijm1 = MAX( jj-1,  1  )      ! first raw  (jj=nlcj) 
    1213                IF( zmsk(ji,jj) == 1.0 ) THEN 
     1187               IF( zmsk(ji,jj) == 1._wp ) THEN 
    12141188                  ztmp(ji,jj) =   (                                                                                   & 
    12151189             &      zenv(iim1,ijp1)*zmsk(iim1,ijp1) + zenv(ji,ijp1)*zmsk(ji,ijp1) + zenv(iip1,ijp1)*zmsk(iip1,ijp1)   & 
    1216              &    + zenv(iim1,jj  )*zmsk(iim1,jj  ) + zenv(ji,jj  )*    2.e0      + zenv(iip1,jj  )*zmsk(iip1,jj  )   & 
     1190             &    + zenv(iim1,jj  )*zmsk(iim1,jj  ) + zenv(ji,jj  )*    2._wp     + zenv(iip1,jj  )*zmsk(iip1,jj  )   & 
    12171191             &    + zenv(iim1,ijm1)*zmsk(iim1,ijm1) + zenv(ji,ijm1)*zmsk(ji,ijm1) + zenv(iip1,ijm1)*zmsk(iip1,ijm1)   & 
    12181192             &                    ) / (                                                                               & 
    12191193             &                      zmsk(iim1,ijp1) +               zmsk(ji,ijp1) +                 zmsk(iip1,ijp1)   & 
    1220              &    +                 zmsk(iim1,jj  ) +                   2.e0      +                 zmsk(iip1,jj  )   & 
     1194             &    +                 zmsk(iim1,jj  ) +                   2._wp     +                 zmsk(iip1,jj  )   & 
    12211195             &    +                 zmsk(iim1,ijm1) +               zmsk(ji,ijm1) +                 zmsk(iip1,ijm1)   & 
    12221196             &                        ) 
     
    12271201         DO jj = 1, nlcj 
    12281202            DO ji = 1, nlci 
    1229                IF( zmsk(ji,jj) == 1.0 )   zenv(ji,jj) = MAX( ztmp(ji,jj), bathy(ji,jj) ) 
     1203               IF( zmsk(ji,jj) == 1._wp )   zenv(ji,jj) = MAX( ztmp(ji,jj), bathy(ji,jj) ) 
    12301204            END DO 
    12311205         END DO 
    12321206         ! 
    12331207         ! Apply lateral boundary condition   CAUTION: kept the value when the lbc field is zero 
    1234          ztmp(:,:) = zenv(:,:)   ;   CALL lbc_lnk( zenv, 'T', 1. ) 
     1208         ztmp(:,:) = zenv(:,:)   ;   CALL lbc_lnk( zenv, 'T', 1._wp ) 
    12351209         DO jj = 1, nlcj 
    12361210            DO ji = 1, nlci 
    1237                IF( zenv(ji,jj) == 0.e0 )   zenv(ji,jj) = ztmp(ji,jj) 
     1211               IF( zenv(ji,jj) == 0._wp )   zenv(ji,jj) = ztmp(ji,jj) 
    12381212            END DO 
    12391213         END DO 
     
    12441218      !                                        ! envelop bathymetry saved in hbatt 
    12451219      hbatt(:,:) = zenv(:,:)  
    1246       IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0.e0 ) THEN 
     1220      IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0._wp ) THEN 
    12471221         CALL ctl_warn( ' s-coordinates are tapered in vicinity of the Equator' ) 
    12481222         DO jj = 1, jpj 
    12491223            DO ji = 1, jpi 
    1250                ztaper = EXP( -(gphit(ji,jj)/8)**2 ) 
    1251                hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * (1.-ztaper) 
     1224               ztaper = EXP( -(gphit(ji,jj)/8._wp)**2 ) 
     1225               hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1._wp - ztaper ) 
    12521226            END DO 
    12531227         END DO 
     
    12581232         WRITE(numout,*) ' domzgr: hbatt field; ocean depth in meters' 
    12591233         WRITE(numout,*) 
    1260          CALL prihre( hbatt(1,1), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 0., numout ) 
     1234         CALL prihre( hbatt(1,1), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 0._wp, numout ) 
    12611235         IF( nprint == 1 )   THEN         
    12621236            WRITE(numout,*) ' bathy  MAX ', MAXVAL( bathy(:,:) ), ' MIN ', MINVAL( bathy(:,:) ) 
     
    12771251      DO jj = 1, jpjm1 
    12781252        DO ji = 1, jpim1   ! NO vector opt. 
    1279            hbatu(ji,jj) = 0.5 * ( hbatt(ji  ,jj) + hbatt(ji+1,jj  ) ) 
    1280            hbatv(ji,jj) = 0.5 * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1) ) 
    1281            hbatf(ji,jj) = 0.25* ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1)   & 
    1282               &                 + hbatt(ji+1,jj) + hbatt(ji+1,jj+1) ) 
     1253           hbatu(ji,jj) = 0.50_wp * ( hbatt(ji  ,jj) + hbatt(ji+1,jj  ) ) 
     1254           hbatv(ji,jj) = 0.50_wp * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1) ) 
     1255           hbatf(ji,jj) = 0.25_wp * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1)   & 
     1256              &                     + hbatt(ji+1,jj) + hbatt(ji+1,jj+1) ) 
    12831257        END DO 
    12841258      END DO 
     
    12861260      ! Apply lateral boundary condition 
    12871261!!gm  ! CAUTION: retain non zero value in the initial file this should be OK for orca cfg, not for EEL 
    1288       zhbat(:,:) = hbatu(:,:)   ;   CALL lbc_lnk( hbatu, 'U', 1. ) 
     1262      zhbat(:,:) = hbatu(:,:)   ;   CALL lbc_lnk( hbatu, 'U', 1._wp ) 
    12891263      DO jj = 1, jpj 
    12901264         DO ji = 1, jpi 
    1291             IF( hbatu(ji,jj) == 0.e0 ) THEN 
    1292                IF( zhbat(ji,jj) == 0.e0 )   hbatu(ji,jj) = rn_sbot_min 
    1293                IF( zhbat(ji,jj) /= 0.e0 )   hbatu(ji,jj) = zhbat(ji,jj) 
     1265            IF( hbatu(ji,jj) == 0._wp ) THEN 
     1266               IF( zhbat(ji,jj) == 0._wp )   hbatu(ji,jj) = rn_sbot_min 
     1267               IF( zhbat(ji,jj) /= 0._wp )   hbatu(ji,jj) = zhbat(ji,jj) 
    12941268            ENDIF 
    12951269         END DO 
    12961270      END DO 
    1297       zhbat(:,:) = hbatv(:,:)   ;   CALL lbc_lnk( hbatv, 'V', 1. ) 
     1271      zhbat(:,:) = hbatv(:,:)   ;   CALL lbc_lnk( hbatv, 'V', 1._wp ) 
    12981272      DO jj = 1, jpj 
    12991273         DO ji = 1, jpi 
    1300             IF( hbatv(ji,jj) == 0.e0 ) THEN 
    1301                IF( zhbat(ji,jj) == 0.e0 )   hbatv(ji,jj) = rn_sbot_min 
    1302                IF( zhbat(ji,jj) /= 0.e0 )   hbatv(ji,jj) = zhbat(ji,jj) 
     1274            IF( hbatv(ji,jj) == 0._wp ) THEN 
     1275               IF( zhbat(ji,jj) == 0._wp )   hbatv(ji,jj) = rn_sbot_min 
     1276               IF( zhbat(ji,jj) /= 0._wp )   hbatv(ji,jj) = zhbat(ji,jj) 
    13031277            ENDIF 
    13041278         END DO 
    13051279      END DO 
    1306       zhbat(:,:) = hbatf(:,:)   ;   CALL lbc_lnk( hbatf, 'F', 1. ) 
     1280      zhbat(:,:) = hbatf(:,:)   ;   CALL lbc_lnk( hbatf, 'F', 1._wp ) 
    13071281      DO jj = 1, jpj 
    13081282         DO ji = 1, jpi 
    1309             IF( hbatf(ji,jj) == 0.e0 ) THEN 
    1310                IF( zhbat(ji,jj) == 0.e0 )   hbatf(ji,jj) = rn_sbot_min 
    1311                IF( zhbat(ji,jj) /= 0.e0 )   hbatf(ji,jj) = zhbat(ji,jj) 
     1283            IF( hbatf(ji,jj) == 0._wp ) THEN 
     1284               IF( zhbat(ji,jj) == 0._wp )   hbatf(ji,jj) = rn_sbot_min 
     1285               IF( zhbat(ji,jj) /= 0._wp )   hbatf(ji,jj) = zhbat(ji,jj) 
    13121286            ENDIF 
    13131287         END DO 
     
    13431317            DO jj = 1, jpj 
    13441318 
    1345              IF (hbatt(ji,jj).GT.rn_hc) THEN !deep water, stretched sigma 
     1319               IF( hbatt(ji,jj) > rn_hc ) THEN    !deep water, stretched sigma 
     1320                  DO jk = 1, jpk 
     1321                     gsigw3(ji,jj,jk) = -fssig1( REAL(jk,wp)-0.5_wp, rn_bb ) 
     1322                     gsigt3(ji,jj,jk) = -fssig1( REAL(jk,wp)       , rn_bb ) 
     1323                  END DO 
     1324               ELSE ! shallow water, uniform sigma 
     1325                  DO jk = 1, jpk 
     1326                     gsigw3(ji,jj,jk) =   REAL(jk-1,wp)            / REAL(jpk-1,wp) 
     1327                     gsigt3(ji,jj,jk) = ( REAL(jk-1,wp) + 0.5_wp ) / REAL(jpk-1,wp) 
     1328                  END DO 
     1329               ENDIF 
     1330               IF( nprint == 1 .AND. lwp )   WRITE(numout,*) 'gsigw3 1 jpk    ', gsigw3(ji,jj,1), gsigw3(ji,jj,jpk) 
     1331               ! 
     1332               DO jk = 1, jpkm1 
     1333                  esigt3(ji,jj,jk  ) = gsigw3(ji,jj,jk+1) - gsigw3(ji,jj,jk) 
     1334                  esigw3(ji,jj,jk+1) = gsigt3(ji,jj,jk+1) - gsigt3(ji,jj,jk) 
     1335               END DO 
     1336               esigw3(ji,jj,1  ) = 2._wp * ( gsigt3(ji,jj,1  ) - gsigw3(ji,jj,1  ) ) 
     1337               esigt3(ji,jj,jpk) = 2._wp * ( gsigt3(ji,jj,jpk) - gsigw3(ji,jj,jpk) ) 
     1338               ! 
     1339               ! Coefficients for vertical depth as the sum of e3w scale factors 
     1340               gsi3w3(ji,jj,1) = 0.5_wp * esigw3(ji,jj,1) 
     1341               DO jk = 2, jpk 
     1342                  gsi3w3(ji,jj,jk) = gsi3w3(ji,jj,jk-1) + esigw3(ji,jj,jk) 
     1343               END DO 
     1344               ! 
    13461345               DO jk = 1, jpk 
    1347                   gsigw3(ji,jj,jk) = -fssig1( REAL(jk,wp)-0.5_wp, rn_bb ) 
    1348                   gsigt3(ji,jj,jk) = -fssig1( REAL(jk,wp)       , rn_bb ) 
     1346                  zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp) 
     1347                  zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp) 
     1348                  gdept (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*gsigt3(ji,jj,jk)+rn_hc*zcoeft ) 
     1349                  gdepw (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*gsigw3(ji,jj,jk)+rn_hc*zcoefw ) 
     1350                  gdep3w(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*gsi3w3(ji,jj,jk)+rn_hc*zcoeft ) 
    13491351               END DO 
    1350              ELSE ! shallow water, uniform sigma 
     1352               ! 
     1353            END DO   ! for all jj's 
     1354         END DO    ! for all ji's 
     1355 
     1356         DO ji = 1, jpi 
     1357            DO jj = 1, jpj 
    13511358               DO jk = 1, jpk 
    1352                  gsigw3(ji,jj,jk) =  REAL(jk-1,wp)     /REAL(jpk-1,wp) 
    1353                  gsigt3(ji,jj,jk) = (REAL(jk-1,wp)+0.5)/REAL(jpk-1,wp) 
     1359                  esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji+1,jj)*esigt3(ji+1,jj,jk) )   & 
     1360                     &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) ) 
     1361                  esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji,jj+1)*esigt3(ji,jj+1,jk) )   & 
     1362                     &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) ) 
     1363                  esigtf3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji+1,jj)*esigt3(ji+1,jj,jk)     & 
     1364                     &                + hbatt(ji,jj+1)*esigt3(ji,jj+1,jk)+hbatt(ji+1,jj+1)*esigt3(ji+1,jj+1,jk) )   & 
     1365                     &              / ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) ) 
     1366                  esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*esigw3(ji,jj,jk)+hbatt(ji+1,jj)*esigw3(ji+1,jj,jk) )   & 
     1367                     &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) ) 
     1368                  esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*esigw3(ji,jj,jk)+hbatt(ji,jj+1)*esigw3(ji,jj+1,jk) )   & 
     1369                     &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) ) 
     1370                  ! 
     1371                  e3t(ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*esigt3 (ji,jj,jk) + rn_hc/FLOAT(jpkm1) ) 
     1372                  e3u(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*esigtu3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) ) 
     1373                  e3v(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*esigtv3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) ) 
     1374                  e3f(ji,jj,jk) = ( (hbatf(ji,jj)-rn_hc)*esigtf3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) ) 
     1375                  ! 
     1376                  e3w (ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*esigw3 (ji,jj,jk) + rn_hc/FLOAT(jpkm1) ) 
     1377                  e3uw(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*esigwu3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) ) 
     1378                  e3vw(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*esigwv3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) ) 
    13541379               END DO 
    1355              ENDIF 
    1356              IF( nprint == 1 .AND. lwp ) WRITE(numout,*) 'gsigw3 1 jpk    ', gsigw3(ji,jj,1), gsigw3(ji,jj,jpk) 
    1357  
    1358  
    1359              DO jk = 1, jpkm1 
    1360                 esigt3(ji,jj,jk) = gsigw3(ji,jj,jk+1) - gsigw3(ji,jj,jk) 
    1361                 esigw3(ji,jj,jk+1) = gsigt3(ji,jj,jk+1) - gsigt3(ji,jj,jk) 
    1362              END DO 
    1363              esigw3(ji,jj,1  ) = 2.0_wp * (gsigt3(ji,jj,1  ) - gsigw3(ji,jj,1  )) 
    1364              esigt3(ji,jj,jpk) = 2.0_wp * (gsigt3(ji,jj,jpk) - gsigw3(ji,jj,jpk)) 
    1365  
    1366              ! Coefficients for vertical depth as the sum of e3w scale factors 
    1367              gsi3w3(ji,jj,1) = 0.5 * esigw3(ji,jj,1) 
    1368              DO jk = 2, jpk 
    1369                 gsi3w3(ji,jj,jk) = gsi3w3(ji,jj,jk-1) + esigw3(ji,jj,jk) 
    1370              END DO 
    1371  
    1372              DO jk = 1, jpk 
    1373                 zcoeft = ( REAL(jk,wp) - 0.5 ) / REAL(jpkm1,wp) 
    1374                 zcoefw = ( REAL(jk,wp) - 1.0 ) / REAL(jpkm1,wp) 
    1375                 gdept (ji,jj,jk) = (scosrf(ji,jj)+(hbatt(ji,jj)-rn_hc)*gsigt3(ji,jj,jk)+rn_hc*zcoeft) 
    1376                 gdepw (ji,jj,jk) = (scosrf(ji,jj)+(hbatt(ji,jj)-rn_hc)*gsigw3(ji,jj,jk)+rn_hc*zcoefw) 
    1377                 gdep3w(ji,jj,jk) = (scosrf(ji,jj)+(hbatt(ji,jj)-rn_hc)*gsi3w3(ji,jj,jk)+rn_hc*zcoeft) 
    1378              END DO 
    1379  
    1380            ENDDO   ! for all jj's 
    1381          ENDDO    ! for all ji's 
    1382  
    1383  
    1384          DO ji=1,jpi 
    1385            DO jj=1,jpj 
    1386  
    1387              DO jk = 1, jpk 
    1388                 esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji+1,jj)*esigt3(ji+1,jj,jk) ) / & 
    1389                                    ( hbatt(ji,jj)+hbatt(ji+1,jj) ) 
    1390                 esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji,jj+1)*esigt3(ji,jj+1,jk) ) / & 
    1391                                    ( hbatt(ji,jj)+hbatt(ji,jj+1) ) 
    1392                 esigtf3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji+1,jj)*esigt3(ji+1,jj,jk) +  & 
    1393                                      hbatt(ji,jj+1)*esigt3(ji,jj+1,jk)+hbatt(ji+1,jj+1)*esigt3(ji+1,jj+1,jk) ) / & 
    1394                                    ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) ) 
    1395                 esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*esigw3(ji,jj,jk)+hbatt(ji+1,jj)*esigw3(ji+1,jj,jk) ) / & 
    1396                                    ( hbatt(ji,jj)+hbatt(ji+1,jj) ) 
    1397                 esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*esigw3(ji,jj,jk)+hbatt(ji,jj+1)*esigw3(ji,jj+1,jk) ) / & 
    1398                                    ( hbatt(ji,jj)+hbatt(ji,jj+1) ) 
    1399  
    1400                 e3t(ji,jj,jk)=((hbatt(ji,jj)-rn_hc)*esigt3(ji,jj,jk) + rn_hc/FLOAT(jpkm1)) 
    1401                 e3u(ji,jj,jk)=((hbatu(ji,jj)-rn_hc)*esigtu3(ji,jj,jk) + rn_hc/FLOAT(jpkm1)) 
    1402                 e3v(ji,jj,jk)=((hbatv(ji,jj)-rn_hc)*esigtv3(ji,jj,jk) + rn_hc/FLOAT(jpkm1)) 
    1403                 e3f(ji,jj,jk)=((hbatf(ji,jj)-rn_hc)*esigtf3(ji,jj,jk) + rn_hc/FLOAT(jpkm1)) 
    1404                 ! 
    1405                 e3w (ji,jj,jk)=((hbatt(ji,jj)-rn_hc)*esigw3(ji,jj,jk) + rn_hc/FLOAT(jpkm1)) 
    1406                 e3uw(ji,jj,jk)=((hbatu(ji,jj)-rn_hc)*esigwu3(ji,jj,jk) + rn_hc/FLOAT(jpkm1)) 
    1407                 e3vw(ji,jj,jk)=((hbatv(ji,jj)-rn_hc)*esigwv3(ji,jj,jk) + rn_hc/FLOAT(jpkm1)) 
    1408              END DO 
    1409  
    1410            ENDDO 
    1411          ENDDO 
    1412  
     1380            END DO 
     1381         END DO 
     1382         ! 
    14131383      ELSE   ! not ln_s_sigma 
    1414  
     1384         ! 
    14151385         DO jk = 1, jpk 
    14161386           gsigw(jk) = -fssig( REAL(jk,wp)-0.5_wp ) 
    1417            gsigt(jk) = -fssig( REAL(jk,wp)     ) 
    1418          END DO 
    1419          IF( nprint == 1 .AND. lwp ) WRITE(numout,*) 'gsigw 1 jpk    ', gsigw(1), gsigw(jpk) 
     1387           gsigt(jk) = -fssig( REAL(jk,wp)        ) 
     1388         END DO 
     1389         IF( nprint == 1 .AND. lwp )   WRITE(numout,*) 'gsigw 1 jpk    ', gsigw(1), gsigw(jpk) 
    14201390         ! 
    1421      ! Coefficients for vertical scale factors at w-, t- levels 
     1391         ! Coefficients for vertical scale factors at w-, t- levels 
    14221392!!gm bug :  define it from analytical function, not like juste bellow.... 
    14231393!!gm        or betteroffer the 2 possibilities.... 
     
    14261396            esigw(jk+1) = gsigt(jk+1) - gsigt(jk) 
    14271397         END DO 
    1428          esigw( 1 ) = 2.0_wp * (gsigt(1) - gsigw(1))  
    1429          esigt(jpk) = 2.0_wp * (gsigt(jpk) - gsigw(jpk)) 
     1398         esigw( 1 ) = 2._wp * ( gsigt(1  ) - gsigw(1  ) )  
     1399         esigt(jpk) = 2._wp * ( gsigt(jpk) - gsigw(jpk) ) 
    14301400 
    14311401!!gm  original form 
     
    14371407         ! 
    14381408         ! Coefficients for vertical depth as the sum of e3w scale factors 
    1439          gsi3w(1) = 0.5 * esigw(1) 
     1409         gsi3w(1) = 0.5_wp * esigw(1) 
    14401410         DO jk = 2, jpk 
    14411411            gsi3w(jk) = gsi3w(jk-1) + esigw(jk) 
     
    14431413!!gm: depuw, depvw can be suppressed (modif in ldfslp) and depw=dep3w can be set (save 3 3D arrays) 
    14441414         DO jk = 1, jpk 
    1445             zcoeft = ( FLOAT(jk) - 0.5 ) / FLOAT(jpkm1) 
    1446             zcoefw = ( FLOAT(jk) - 1.0 ) / FLOAT(jpkm1) 
    1447             gdept (:,:,jk) = (scosrf(:,:)+(hbatt(:,:)-hift(:,:))*gsigt(jk)+hift(:,:)*zcoeft) 
    1448             gdepw (:,:,jk) = (scosrf(:,:)+(hbatt(:,:)-hift(:,:))*gsigw(jk)+hift(:,:)*zcoefw) 
    1449             gdep3w(:,:,jk) = (scosrf(:,:)+(hbatt(:,:)-hift(:,:))*gsi3w(jk)+hift(:,:)*zcoeft) 
     1415            zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp) 
     1416            zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp) 
     1417            gdept (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*gsigt(jk) + hift(:,:)*zcoeft ) 
     1418            gdepw (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*gsigw(jk) + hift(:,:)*zcoefw ) 
     1419            gdep3w(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*gsi3w(jk) + hift(:,:)*zcoeft ) 
    14501420         END DO 
    14511421!!gm: e3uw, e3vw can be suppressed  (modif in dynzdf, dynzdf_iso, zdfbfr) (save 2 3D arrays) 
     
    14531423            DO ji = 1, jpi 
    14541424               DO jk = 1, jpk 
    1455                  e3t(ji,jj,jk)=((hbatt(ji,jj)-hift(ji,jj))*esigt(jk) + hift(ji,jj)/FLOAT(jpkm1)) 
    1456                  e3u(ji,jj,jk)=((hbatu(ji,jj)-hifu(ji,jj))*esigt(jk) + hifu(ji,jj)/FLOAT(jpkm1)) 
    1457                  e3v(ji,jj,jk)=((hbatv(ji,jj)-hifv(ji,jj))*esigt(jk) + hifv(ji,jj)/FLOAT(jpkm1)) 
    1458                  e3f(ji,jj,jk)=((hbatf(ji,jj)-hiff(ji,jj))*esigt(jk) + hiff(ji,jj)/FLOAT(jpkm1)) 
     1425                 e3t(ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*esigt(jk) + hift(ji,jj)/REAL(jpkm1,wp) ) 
     1426                 e3u(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*esigt(jk) + hifu(ji,jj)/REAL(jpkm1,wp) ) 
     1427                 e3v(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*esigt(jk) + hifv(ji,jj)/REAL(jpkm1,wp) ) 
     1428                 e3f(ji,jj,jk) = ( (hbatf(ji,jj)-hiff(ji,jj))*esigt(jk) + hiff(ji,jj)/REAL(jpkm1,wp) ) 
    14591429                 ! 
    1460                  e3w (ji,jj,jk)=((hbatt(ji,jj)-hift(ji,jj))*esigw(jk) + hift(ji,jj)/FLOAT(jpkm1)) 
    1461                  e3uw(ji,jj,jk)=((hbatu(ji,jj)-hifu(ji,jj))*esigw(jk) + hifu(ji,jj)/FLOAT(jpkm1)) 
    1462                  e3vw(ji,jj,jk)=((hbatv(ji,jj)-hifv(ji,jj))*esigw(jk) + hifv(ji,jj)/FLOAT(jpkm1)) 
     1430                 e3w (ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*esigw(jk) + hift(ji,jj)/REAL(jpkm1,wp) ) 
     1431                 e3uw(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*esigw(jk) + hifu(ji,jj)/REAL(jpkm1,wp) ) 
     1432                 e3vw(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*esigw(jk) + hifv(ji,jj)/REAL(jpkm1,wp) ) 
    14631433               END DO 
    14641434            END DO 
    14651435         END DO 
    1466  
     1436         ! 
    14671437      ENDIF ! ln_s_sigma 
    14681438 
     
    14871457            DO jk = 1, jpkm1 
    14881458               IF( scobot(ji,jj) >= fsdept(ji,jj,jk) )   mbathy(ji,jj) = MAX( 2, jk ) 
    1489                IF( scobot(ji,jj) == 0.e0             )   mbathy(ji,jj) = 0 
     1459               IF( scobot(ji,jj) == 0._wp            )   mbathy(ji,jj) = 0 
    14901460            END DO 
    14911461         END DO 
     
    14981468      IF( lzoom )   CALL zgr_bat_zoom                 ! Zoom domain  
    14991469      !                                               ! =========== 
    1500  
    1501  
     1470      ! 
    15021471      !                                               ! =================== ! 
    15031472      IF( .NOT. lk_c1d )    CALL zgr_bat_ctl          !   Bathymetry check  ! 
    15041473      !                                               ! =================== ! 
    1505  
     1474      ! 
    15061475      !                                               ! ============= 
    15071476      IF(lwp) THEN                                    ! Control print 
     
    15621531         DO jj = 1, jpj 
    15631532            DO ji = 1, jpi 
    1564                IF( fse3w(ji,jj,jk) <= 0. .OR. fse3t(ji,jj,jk) <= 0. ) THEN 
     1533               IF( fse3w(ji,jj,jk) <= 0._wp .OR. fse3t(ji,jj,jk) <= 0._wp ) THEN 
    15651534                  WRITE(ctmp1,*) 'zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk 
    15661535                  CALL ctl_stop( ctmp1 ) 
    15671536               ENDIF 
    1568                IF( fsdepw(ji,jj,jk) < 0. .OR. fsdept(ji,jj,jk) < 0. ) THEN 
     1537               IF( fsdepw(ji,jj,jk) < 0._wp .OR. fsdept(ji,jj,jk) < 0._wp ) THEN 
    15691538                  WRITE(ctmp1,*) 'zgr_sco :   gdepw or gdept =< 0  at point (i,j,k)= ', ji, jj, jk 
    15701539                  CALL ctl_stop( ctmp1 ) 
  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DTA/dtasal.F90

    r2392 r2436  
    2121   USE in_out_manager  ! I/O manager 
    2222   USE phycst          ! physical constants 
    23 #if defined key_orca_lev10 
    24    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    25 #endif 
    2623 
    2724   IMPLICIT NONE 
     
    6360#endif 
    6461      REAL(wp)::   zl 
    65 #if defined key_orca_lev10 
    66       INTEGER ::   ikr, ikw, ikt, jjk  
    67       REAL(wp)::   zfac 
    68 #endif 
    6962      REAL(wp), DIMENSION(jpk) :: zsaldta         ! auxiliary array for interpolation 
    7063      CHARACTER(len=100)       :: cn_dir          ! Root directory for location of ssr files 
     
    9992             CALL ctl_stop( 'dta_sal: unable to allocate sf_sal structure' )   ;   RETURN 
    10093         ENDIF 
    101  
    102 #if defined key_orca_lev10 
    103                                 ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpkdta)   ) 
    104          IF( sn_sal%ln_tint )   ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpkdta,2) ) 
    105 #else 
    10694                                ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk)   ) 
    10795         IF( sn_sal%ln_tint )   ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2) ) 
    108 #endif 
    10996         !                         ! fill sf_sal with sn_sal and control print 
    11097         CALL fld_fill( sf_sal, (/ sn_sal /), cn_dir, 'dta_sal', 'Salinity data', 'namdta_sal' ) 
     
    166153#endif    
    167154         
    168 #if defined key_orca_lev10 
    169       DO jjk = 1, 5 
    170          s_dta(:,:,jjk) = sf_sal(1)%fnow(:,:,1) 
    171       ENDDO 
    172       DO jk = 1, jpk-20,10 
    173          ikr =  INT(jk/10) + 1 
    174          ikw =  (ikr-1) *10 + 1 
    175          ikt =  ikw + 5 
    176          DO jjk=ikt,ikt+9 
    177             zfac = ( gdept_0(jjk   ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 
    178             s_dta(:,:,jjk) = sf_sal(1)%fnow(:,:,ikr) + ( sf_sal(1)%fnow(:,:,ikr+1) - sf_sal(1)%fnow(:,:,ikr) ) * zfac 
    179          END DO 
    180       END DO 
    181       DO jjk = jpk-5, jpk 
    182          s_dta(:,:,jjk) = sf_sal(1)%fnow(:,:,jpkdta-1) 
    183       END DO 
    184       ! fill the overlap areas 
    185       CALL lbc_lnk (s_dta(:,:,:),'Z',-999.,'no0')         
    186 #else 
    187155      s_dta(:,:,:)=sf_sal(1)%fnow(:,:,:) 
    188 #endif 
    189156         
    190157      IF( ln_sco ) THEN 
  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90

    r2392 r2436  
    2121   USE in_out_manager  ! I/O manager 
    2222   USE phycst          ! physical constants 
    23 #if defined key_orca_lev10 
    24    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    25 #endif 
     23 
    2624   IMPLICIT NONE 
    2725   PRIVATE 
     
    6866#endif 
    6967      REAL(wp)::   zl 
    70 #if defined key_orca_lev10 
    71       INTEGER ::   ikr, ikw, ikt, jjk  
    72       REAL(wp)::   zfac 
    73 #endif 
    7468      REAL(wp), DIMENSION(jpk) ::   ztemdta            ! auxiliary array for interpolation 
     69      ! 
    7570      CHARACTER(len=100)       ::   cn_dir             ! Root directory for location of ssr files 
    7671      TYPE(FLD_N)              ::   sn_tem 
     
    10499             CALL ctl_stop( 'dta_tem: unable to allocate sf_tem structure' )   ;   RETURN 
    105100         ENDIF 
    106  
    107 #if defined key_orca_lev10 
    108                                 ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpkdta)   ) 
    109          IF( sn_tem%ln_tint )   ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpkdta,2) ) 
    110 #else 
    111101                                ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk)   ) 
    112102         IF( sn_tem%ln_tint )   ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) ) 
    113 #endif 
    114103         !                         ! fill sf_tem with sn_tem and control print 
    115104         CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' ) 
     
    177166#endif 
    178167          
    179 #if defined key_orca_lev10 
    180       DO jjk = 1, 5 
    181          t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,1) 
    182       END DO 
    183       DO jk = 1, jpk-20,10 
    184          ik = jk+5 
    185          ikr =  INT(jk/10) + 1 
    186          ikw =  (ikr-1) *10 + 1 
    187          ikt =  ikw + 5 
    188          DO jjk=ikt,ikt+9 
    189             zfac = ( gdept_0(jjk   ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 
    190             t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,ikr) + ( sf_tem(1)%fnow(:,:,ikr+1) - sf_tem(1)%fnow(:,:,ikr) ) * zfac 
    191          END DO 
    192       END DO 
    193       DO jjk = jpk-5, jpk 
    194          t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,jpkdta-1) 
    195       END DO 
    196       ! fill the overlap areas 
    197       CALL lbc_lnk (t_dta(:,:,:),'Z',-999.,'no0') 
    198 #else 
    199168      t_dta(:,:,:) = sf_tem(1)%fnow(:,:,:)  
    200 #endif 
    201169          
    202170      IF( ln_sco ) THEN 
  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90

    r2287 r2436  
    2626      !!       ??? explanation of the default is missing 
    2727      !!---------------------------------------------------------------------- 
    28       !! * Modules used 
    2928      USE ldftra_oce, ONLY : aht0 
    30  
    31       !! * Arguments 
     29      !! 
    3230      LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
    33  
    34       !! * local variables 
     31      !! 
    3532      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    3633      REAL(wp) ::   & 
     
    196193      !! ** Method  :   blah blah blah .... 
    197194      !!---------------------------------------------------------------------- 
    198       !! * Modules used 
    199195      USE ldftra_oce, ONLY : aht0 
    200  
    201       !! * Arguments 
     196      !! 
    202197      LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
    203  
    204       !! * local variables 
     198      !! 
    205199      INTEGER ::   ji, jj, jk, jn      ! dummy loop indices 
    206200      INTEGER ::   ii0, ii1, ij0, ij1  ! temporary integers 
     
    359353 
    360354      ! other level: re-increase the coef in the deep ocean 
    361        
    362 #if defined key_orca_lev10 
    363       DO jk = 1, 210 
    364          zcoef(jk) = 1. 
    365       END DO 
    366       DO jk= 211, 230 
    367          zcoef(jk) = 1. + 0.1 * FLOAT(jk-210) 
    368       END DO 
    369       DO jk= 231, 260 
    370          zcoef(jk) = 3. + 0.2 * FLOAT(jk-230) 
    371       END DO 
    372       DO jk= 261, 270 
    373          zcoef(jk) = 9. + 0.1 * FLOAT(jk-260) 
    374       END DO 
    375       DO jk= 271, jpk 
    376          zcoef(jk) = 10. 
    377       END DO 
    378       DO jk= 1, jpk 
    379          IF(lwp) WRITE(numout,*) 'k= ',jk, 'cof ', zcoef(jk) 
    380       END DO 
    381 #else 
    382355       DO jk = 1, 21 
    383          zcoef(jk) = 1. 
    384       END DO 
    385       zcoef(22) = 2. 
    386       zcoef(23) = 3. 
    387       zcoef(24) = 5. 
    388       zcoef(25) = 7. 
    389       zcoef(26) = 9. 
     356         zcoef(jk) = 1._wp 
     357      END DO 
     358      zcoef(22) = 2._wp 
     359      zcoef(23) = 3._wp 
     360      zcoef(24) = 5._wp 
     361      zcoef(25) = 7._wp 
     362      zcoef(26) = 9._wp 
    390363      DO jk = 27, jpk 
    391          zcoef(jk) = 10. 
    392       END DO 
    393 #endif 
    394  
     364         zcoef(jk) = 10._wp 
     365      END DO 
     366      ! 
    395367      DO jk = 2, jpk 
    396368         ahm1(:,:,jk) = MIN( zahm0(:,:), zcoef(jk) * ahm1(:,:,1) ) 
     
    398370      END DO 
    399371 
    400       IF( jp_cfg == 4 )   THEN 
    401          ! Limit AHM in Gibraltar strait 
     372      IF( jp_cfg == 4 )   THEN         ! Limit AHM in Gibraltar strait 
    402373         ij0 = 50   ;   ij1 = 53 
    403374         ii0 = 69   ;   ii1 = 71 
    404375         DO jk = 1, jpk 
    405             ahm1(mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk) = min( zahmm, ahm1 (mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk) )  
    406             ahm2(mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk) = min( zahmm, ahm2 (mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk) ) 
    407          END DO 
    408       ENDIF 
    409        
    410       ! Lateral boundary conditions on ( ahm1, ahm2 ) 
    411       !                                ============== 
    412       CALL lbc_lnk( ahm1, 'T', 1. )   ! T-point, unchanged sign 
    413       CALL lbc_lnk( ahm2, 'F', 1. )   ! F-point, unchanged sign 
    414  
    415       ! Control print 
    416  
    417       IF(lwp) THEN 
     376            ahm1(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) = MIN( zahmm, ahm1(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) )  
     377            ahm2(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) = MIN( zahmm, ahm2(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) ) 
     378         END DO 
     379      ENDIF 
     380      CALL lbc_lnk( ahm1, 'T', 1. )   ! Lateral boundary conditions (unchanged sign) 
     381      CALL lbc_lnk( ahm2, 'F', 1. ) 
     382 
     383 
     384      IF(lwp) THEN                    ! Control print 
    418385         WRITE(numout,*) 
    419386         WRITE(numout,*) '         3D ahm1 array (k=1)' 
     
    447414      ahm4 ( :, 1, :) = ahm4 ( :, 2, :) 
    448415       
    449       ! Lateral boundary conditions on ( ahm3, ahm4 ) 
    450       !                                ============== 
    451       CALL lbc_lnk( ahm3, 'U', 1. )   ! U-point, unchanged sign 
    452       CALL lbc_lnk( ahm4, 'V', 1. )   ! V-point, unchanged sign 
     416      CALL lbc_lnk( ahm3, 'U', 1. )    ! Lateral boundary conditions (unchanged sign) 
     417      CALL lbc_lnk( ahm4, 'V', 1. ) 
    453418 
    454419      ! Control print 
Note: See TracChangeset for help on using the changeset viewer.