Changeset 12731


Ignore:
Timestamp:
2020-04-09T19:30:08+02:00 (6 months ago)
Author:
techene
Message:

replace h. and gde. in case key_qco is activated - quick and dirty

Location:
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src
Files:
19 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/icedyn_rhg_evp.F90

    r12724 r12731  
    4949   !! * Substitutions 
    5050#  include "do_loop_substitute.h90" 
     51#  include "domzgr_substitute.h90" 
    5152   !!---------------------------------------------------------------------- 
    5253   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ASM/asminc.F90

    r12724 r12731  
    803803      ELSE 
    804804         ALLOCATE( ztim(jpi,jpj) ) 
    805          ztim(:,:) = ssh_iau(:,:) / ( ht(:,:) + 1.0 - ssmask(:,:) ) 
     805!!st         ztim(:,:) = ssh_iau(:,:) / ( ht_(:,:) + 1.0 - ssmask(:,:) ) 
     806         DO_2D_11_11 
     807            ztim(ji,jj) = ssh_iau(ji,jj) / ( ht(ji,jj) + 1.0 - ssmask(ji,jj) ) 
     808         END_2D 
    806809         DO jk = 1, jpkm1 
    807810            phdivn(:,:,jk) = phdivn(:,:,jk) - ztim(:,:) * tmask(:,:,jk) 
     
    900903         IF ( kt == nitdin_r ) THEN 
    901904            ! 
    902             l_1st_euler = 0              ! Force Euler forward step 
     905            l_1st_euler = .TRUE.              ! Force Euler forward step 
    903906            ! 
    904907            ! Sea-ice : SI3 case 
     
    974977!           ! set to bottom of a level 
    975978!                 DO jk = jpk-1, 2, -1 
    976 !                   IF ((mld > gdepw(ji,jj,jk)) .and. (mld < gdepw(ji,jj,jk+1))) THEN 
    977 !                     mld=gdepw(ji,jj,jk+1) 
     979!                   IF ((mld > gdepw(ji,jj,jk,Kmm)) .and. (mld < gdepw(ji,jj,jk+1,Kmm))) THEN 
     980!                     mld=gdepw(ji,jj,jk+1,Kmm) 
    978981!                     jkmax=jk 
    979982!                   ENDIF 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diaar5.F90

    r12724 r12731  
    7878      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 2D workspace  
    7979      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z2d, zpe                   ! 2D workspace  
    80       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   :: z3d, zrhd , zrhop, ztpot   ! 3D workspace 
     80      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   :: z3d, zrhd , zrhop, ztpot, zgdept   ! 3D workspace 
    8181      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn                       ! 4D workspace 
    8282 
     
    132132         ztsn(:,:,:,jp_tem) = ts(:,:,:,jp_tem,Kmm)                    ! thermosteric ssh 
    133133         ztsn(:,:,:,jp_sal) = sn0(:,:,:) 
    134          CALL eos( ztsn, zrhd, gdept(:,:,:,Kmm) )                       ! now in situ density using initial salinity 
     134!!st to be improved 
     135         DO jk = 1, jpkm1 
     136            zgdept(:,:,jk) = gdept(:,:,jk,Kmm) 
     137         END DO 
     138         CALL eos( ztsn, zrhd, zgdept)                       ! now in situ density using initial salinity 
    135139         ! 
    136140         zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
     
    159163       
    160164         !                                         ! steric sea surface height 
    161          CALL eos( ts(:,:,:,:,Kmm), zrhd, zrhop, gdept(:,:,:,Kmm) )                 ! now in situ and potential density 
     165         CALL eos( ts(:,:,:,:,Kmm), zrhd, zrhop, zgdept )                 ! now in situ and potential density 
    162166         zrhop(:,:,jpk) = 0._wp 
    163167         CALL iom_put( 'rhop', zrhop ) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diawri.F90

    r12724 r12731  
    435435      ! 
    436436      REAL(wp), DIMENSION(jpi,jpj)   :: zw2d       ! 2D workspace 
    437       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d, ze3t       ! 3D workspace 
     437      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d, ze3t, zgdept       ! 3D workspace 
    438438      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl   ! ABL 3D workspace 
    439439      !!---------------------------------------------------------------------- 
     
    479479      DO jk = 1, jpk 
    480480         ze3t(:,:,jk) =  e3t(:,:,jk,Kmm) 
     481         zgdept(:,:,jk) =  gdept(:,:,jk,Kmm) 
    481482      END DO 
    482483 
     
    805806         zw3d(:,:,:) = ( ( ze3t(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 
    806807         CALL histwrite( nid_T, "vovvle3t", it, ze3t (:,:,:)     , ndim_T , ndex_T  )   ! level thickness 
    807          CALL histwrite( nid_T, "vovvldep", it, gdept(:,:,:,Kmm) , ndim_T , ndex_T  )   ! t-point depth 
     808         CALL histwrite( nid_T, "vovvldep", it, zgdept , ndim_T , ndex_T  )   ! t-point depth !!st patch 
    808809         CALL histwrite( nid_T, "vovvldef", it, zw3d             , ndim_T , ndex_T  )   ! level thickness deformation 
    809810      ENDIF 
     
    944945      !! 
    945946      INTEGER :: inum, jk 
    946       REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t       ! 3D workspace 
     947      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, zgdept      ! 3D workspace 
    947948      !!---------------------------------------------------------------------- 
    948949      !  
     
    954955      ENDIF  
    955956      ! 
     957!!st patch 
    956958      DO jk = 1, jpk 
    957959         ze3t(:,:,jk) =  e3t(:,:,jk,Kmm) 
     960         zgdept(:,:,jk) =  gdept(:,:,jk,Kmm) 
    958961      END DO 
    959962      ! 
     
    962965      CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) )    ! now temperature 
    963966      CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) )    ! now salinity 
    964       CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,:,Kmm)              )    ! sea surface height 
    965       CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,:,Kmm)                )    ! now i-velocity 
    966       CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,:,Kmm)                )    ! now j-velocity 
     967      CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,:        ,Kmm) )    ! sea surface height 
     968      CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,:       ,Kmm) )    ! now i-velocity 
     969      CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,:       ,Kmm) )    ! now j-velocity 
    967970      IF( ln_zad_Aimp ) THEN 
    968971         CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww + wi        )    ! now k-velocity 
     
    971974      ENDIF 
    972975      CALL iom_rstput( 0, 0, inum, 'risfdep', risfdep            )    ! now k-velocity 
    973       CALL iom_rstput( 0, 0, inum, 'ht'     , ht                 )    ! now water column height 
     976      CALL iom_rstput( 0, 0, inum, 'ht'     , ht(:,:)            )    ! now water column height 
    974977      ! 
    975978      IF ( ln_isf ) THEN 
     
    10071010      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau              )    ! i-wind stress 
    10081011      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress 
    1009       IF(  .NOT.ln_linssh  ) THEN              
    1010          CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept(:,:,:,Kmm)        )    !  T-cell depth  
    1011          CALL iom_rstput( 0, 0, inum, 'vovvle3t', ze3t(:,:,:)          )    !  T-cell thickness   
     1012      IF(  .NOT.ln_linssh  ) THEN 
     1013!!st patch 
     1014         CALL iom_rstput( 0, 0, inum, 'vovvldep', zgdept        )    !  T-cell depth  
     1015         CALL iom_rstput( 0, 0, inum, 'vovvle3t', ze3t          )    !  T-cell thickness   
    10121016      END IF 
    10131017      IF( ln_wave .AND. ln_sdw ) THEN 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/dom_oce.F90

    r12724 r12731  
    159159   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hf_0, r1_hf_0   !: f-depth        [m] and [1/m] 
    160160   !                                                        ! time-dependent heights of ocean water column 
     161#if ! defined key_qco 
    161162   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   ht          !: t-points           [m] 
     163#endif 
    162164   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hu, r1_hu   !: u-depth            [m] and [1/m] 
    163165   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hv, r1_hv   !: v-depth            [m] and [1/m] 
     
    293295      ii = ii+1 
    294296      ALLOCATE( ht_0(jpi,jpj) ,    hu_0(jpi,jpj)    ,    hv_0(jpi,jpj)     , hf_0(jpi,jpj) ,       & 
    295          &      ht  (jpi,jpj) ,    hu  (jpi,jpj,jpt),    hv  (jpi,jpj,jpt)                 ,       & 
    296          &                      r1_hu  (jpi,jpj,jpt), r1_hv  (jpi,jpj,jpt)                 ,       & 
    297297         &   r1_ht_0(jpi,jpj) , r1_hu_0(jpi,jpj) ,    r1_hv_0(jpi,jpj),   r1_hf_0(jpi,jpj) ,   STAT=ierr(ii)  ) 
     298         ! 
     299#if ! defined key_qco 
     300      ii = ii+1 
     301      ALLOCATE( ht  (jpi,jpj) ,    hu  (jpi,jpj,jpt),    hv  (jpi,jpj,jpt)                 ,       & 
     302         &                      r1_hu  (jpi,jpj,jpt), r1_hv  (jpi,jpj,jpt)                 ,   STAT=ierr(ii)  ) 
     303#else 
     304      ii = ii+1 
     305      ALLOCATE(                    hu  (jpi,jpj,jpt),    hv  (jpi,jpj,jpt)                 ,       & 
     306         &                      r1_hu  (jpi,jpj,jpt), r1_hv  (jpi,jpj,jpt)                 ,   STAT=ierr(ii)  ) 
     307#endif 
    298308         ! 
    299309      ii = ii+1 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domain.F90

    r12724 r12731  
    149149      CALL dom_msk( ik_top, ik_bot )    ! Masks 
    150150      ! 
    151       ht_0(:,:) = 0._wp  ! Reference ocean thickness 
     151!!st      ht_0(:,:) = 0._wp  ! Reference ocean thickness 
    152152      hu_0(:,:) = 0._wp 
    153153      hv_0(:,:) = 0._wp 
     
    166166 
    167167      ! 
     168#if defined key_qco 
     169      !           !==  initialisation of time varying coordinate  ==!   Quasi-Euerian coordinate case 
     170      ! 
     171      IF( .NOT.l_offline )   CALL dom_qe_init( Kbb, Kmm, Kaa ) 
     172      ! 
     173      IF( ln_linssh )        CALL ctl_stop('STOP','domain: key_qco and ln_linssh = T are incompatible') 
     174      ! 
     175#else 
    168176      !           !==  time varying part of coordinate system  ==! 
    169177      ! 
     
    176184            gde3w(:,:,:)    = gde3w_0(:,:,:)    ! = gdept as the sum of e3t 
    177185         ! 
    178 #if defined key_qco 
    179          !  Quasi-Euerian coordinate : no initialisation of e3. scale factors 
    180 #else 
    181186         DO jt = 1, jpt                         ! vertical scale factors 
    182187            e3t(:,:,:,jt) =  e3t_0(:,:,:) 
     
    189194            e3f(:,:,:)    =  e3f_0(:,:,:) 
    190195         ! 
    191 #endif 
    192          ! 
    193196         DO jt = 1, jpt                         ! water column thickness and its inverse 
    194197            hu(:,:,jt)    =    hu_0(:,:) 
     
    201204      ELSE                       != time varying : initialize before/now/after variables 
    202205         ! 
    203 #if defined key_qco 
    204          IF( .NOT.l_offline )   CALL dom_qe_init( Kbb, Kmm, Kaa ) 
    205 #else 
    206206         IF( .NOT.l_offline )   CALL dom_vvl_init( Kbb, Kmm, Kaa ) 
     207         ! 
     208      ENDIF 
    207209#endif 
    208          ! 
    209       ENDIF 
     210 
    210211      ! 
    211212      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domqe.F90

    r12724 r12731  
    4444!!st   PUBLIC  dom_qe_sf_nxt     ! called by steplf.F90 
    4545!!st   PUBLIC  dom_qe_sf_update  ! called by steplf.F90 
    46    PUBLIC  dom_h_nxt         ! called by steplf.F90 
    47    PUBLIC  dom_h_update      ! called by steplf.F90 
     46!!st   PUBLIC  dom_h_nxt         ! called by steplf.F90 
     47!!st   PUBLIC  dom_h_update      ! called by steplf.F90 
    4848   PUBLIC  dom_qe_r3c        ! called by steplf.F90 
    4949 
     
    175175!!st end 
    176176      ! 
     177!!st ATTENTION CAS ISF A GERER !!!  
    177178      !                    !==  depth of t and w-point  ==!   (set the isf depth as it is in the initial timestep) 
    178       IF( ln_isf ) THEN          !** IceShelF cavities 
    179       !                             ! to be created depending of the new names in isf 
    180       !                             ! it should be something like that :  (with h_isf = thickness of iceshelf) 
    181       !                             !  in fact currently, h_isf(:,:) is called : risfdep(:,:) 
    182 !!gm - depth idea 0  : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask ! 
    183          gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) ) 
    184          gdepw(:,:,1,Kmm) = 0._wp                            ! Initialized to zero one for all 
    185          gde3w(:,:,1)     = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)  ! reference to a common level z=0 for hpg 
    186          DO jk = 2, jpk 
    187             gdept(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdept_0(:,:,jk) )            & 
    188                               + MAX(   0._wp    , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 
    189             gdepw(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) )    & 
    190                               + MAX(   0._wp    , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 
    191             gde3w(:,:,jk)     = gdept(:,:,jk,Kmm) - ssh(:,:,Kmm) 
    192             gdept(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdept_0(:,:,jk) )            & 
    193                               + MAX(   0._wp    , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 
    194             gdepw(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) )    & 
    195                               + MAX(   0._wp    , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 
    196          END DO 
    197          ! 
    198       ELSE                       !** No cavities   (all depth rescaled, even inside topography: no mask) 
    199          ! 
    200 !!gm idea 0 :   just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask ! 
    201          DO jk = 1, jpk 
    202             gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 
    203             gdepw(:,:,jk,Kmm) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 
    204             gde3w(:,:,jk)     = gdept  (:,:,jk,Kmm)       - ssh(:,:,Kmm) 
    205             gdept(:,:,jk,Kbb) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 
    206             gdepw(:,:,jk,Kbb) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 
    207          END DO 
    208          ! 
    209       ENDIF 
     179!!$      IF( ln_isf ) THEN          !** IceShelF cavities 
     180!!$      !                             ! to be created depending of the new names in isf 
     181!!$      !                             ! it should be something like that :  (with h_isf = thickness of iceshelf) 
     182!!$      !                             !  in fact currently, h_isf(:,:) is called : risfdep(:,:) 
     183!!$!!gm - depth idea 0  : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask ! 
     184!!$         gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) ) 
     185!!$         gdepw(:,:,1,Kmm) = 0._wp                            ! Initialized to zero one for all 
     186!!$         gde3w(:,:,1)     = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)  ! reference to a common level z=0 for hpg 
     187!!$         DO jk = 2, jpk 
     188!!$            gdept(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdept_0(:,:,jk) )            & 
     189!!$                              + MAX(   0._wp    , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 
     190!!$            gdepw(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) )    & 
     191!!$                              + MAX(   0._wp    , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 
     192!!$            gde3w(:,:,jk)     = gdept(:,:,jk,Kmm) - ssh(:,:,Kmm) 
     193!!$            gdept(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdept_0(:,:,jk) )            & 
     194!!$                              + MAX(   0._wp    , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 
     195!!$            gdepw(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) )    & 
     196!!$                              + MAX(   0._wp    , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 
     197!!$         END DO 
     198!!$         ! 
     199!!$      ELSE                       !** No cavities   (all depth rescaled, even inside topography: no mask) 
     200!!$         ! 
     201!!$!!gm idea 0 :   just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask ! 
     202!!$         DO jk = 1, jpk 
     203!!$            gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 
     204!!$            gdepw(:,:,jk,Kmm) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 
     205!!$            gde3w(:,:,jk)     = gdept  (:,:,jk,Kmm)       - ssh(:,:,Kmm) 
     206!!$            gdept(:,:,jk,Kbb) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 
     207!!$            gdepw(:,:,jk,Kbb) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 
     208!!$         END DO 
     209!!$         ! 
     210!!$      ENDIF 
    210211      ! 
    211212      !                    !==  thickness of the water column  !!   (ocean portion only) 
    212       ht(:,:)     = ht_0(:,:)           + ssh(:,:,Kmm) 
    213       hu(:,:,Kbb) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kbb) ) 
    214       hu(:,:,Kmm) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kmm) ) 
    215       hv(:,:,Kbb) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kbb) ) 
    216       hv(:,:,Kmm) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kmm) ) 
    217       ! 
    218       !                    !==  inverse of water column thickness   ==!   (u- and v- points) 
    219       r1_hu(:,:,Kbb) = ssumask(:,:) / ( hu(:,:,Kbb) + 1._wp - ssumask(:,:) )    ! _i mask due to ISF 
    220       r1_hu(:,:,Kmm) = ssumask(:,:) / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) ) 
    221       r1_hv(:,:,Kbb) = ssvmask(:,:) / ( hv(:,:,Kbb) + 1._wp - ssvmask(:,:) ) 
    222       r1_hv(:,:,Kmm) = ssvmask(:,:) / ( hv(:,:,Kmm) + 1._wp - ssvmask(:,:) ) 
     213!!st ht(:,:)     = ht_0(:,:)           + ssh(:,:,Kmm) 
     214!!$      hu(:,:,Kbb) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kbb) ) 
     215!!$      hu(:,:,Kmm) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kmm) ) 
     216!!$      hv(:,:,Kbb) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kbb) ) 
     217!!$      hv(:,:,Kmm) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kmm) ) 
     218!!$      ! 
     219!!$      !                    !==  inverse of water column thickness   ==!   (u- and v- points) 
     220!!$      r1_hu(:,:,Kbb) = ssumask(:,:) / ( hu(:,:,Kbb) + 1._wp - ssumask(:,:) )    ! _i mask due to ISF 
     221!!$      r1_hu(:,:,Kmm) = ssumask(:,:) / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) ) 
     222!!$      r1_hv(:,:,Kbb) = ssvmask(:,:) / ( hv(:,:,Kbb) + 1._wp - ssvmask(:,:) ) 
     223!!$      r1_hv(:,:,Kmm) = ssvmask(:,:) / ( hv(:,:,Kmm) + 1._wp - ssvmask(:,:) ) 
     224!!st end 
    223225      ! 
    224226   END SUBROUTINE dom_qe_zgr 
     
    294296!    END SUBROUTINE dom_qe_sf_nxt 
    295297!!st end 
    296  
    297    SUBROUTINE dom_h_nxt( kt, Kbb, Kmm, Kaa, kcall ) 
    298       !!---------------------------------------------------------------------- 
    299       !!                ***  ROUTINE dom_qe_sf_nxt  *** 
    300       !! 
    301       !! ** Purpose :  - compute the after water heigh used in tra_zdf, dynnxt, 
    302       !!                 tranxt and dynspg routines 
    303       !! 
    304       !! ** Method  :  - z_star case:  Proportionnaly to the water column thickness. 
    305       !! 
    306       !! ** Action  :  - h(u/v) update wrt ssh/h(u/v)_0 
    307       !! 
    308       !!---------------------------------------------------------------------- 
    309       INTEGER, INTENT( in )           ::   kt             ! time step 
    310       INTEGER, INTENT( in )           ::   Kbb, Kmm, Kaa  ! time step 
    311       INTEGER, INTENT( in ), OPTIONAL ::   kcall          ! optional argument indicating call sequence 
    312       ! 
    313       !!---------------------------------------------------------------------- 
    314       ! 
    315       IF( ln_linssh )   RETURN      ! No calculation in linear free surface 
    316       ! 
    317       IF( ln_timing )   CALL timing_start('dom_h_nxt') 
    318       ! 
    319       IF( kt == nit000 ) THEN 
    320          IF(lwp) WRITE(numout,*) 
    321          IF(lwp) WRITE(numout,*) 'dom_h_nxt : compute after scale factors' 
    322          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 
    323       ENDIF 
    324       ! 
    325       ! *********************************** ! 
    326       ! After depths at u- v points         ! 
    327       ! *********************************** ! 
    328       hu(:,:,Kaa) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kaa) ) 
    329       hv(:,:,Kaa) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kaa) ) 
    330       !                                        ! Inverse of the local depth 
    331       r1_hu(:,:,Kaa) = ssumask(:,:) / ( hu(:,:,Kaa) + 1._wp - ssumask(:,:) ) 
    332       r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) ) 
    333       ! 
    334       IF( ln_timing )   CALL timing_stop('dom_h_nxt') 
    335       ! 
    336    END SUBROUTINE dom_h_nxt 
    337  
     298!!st  
     299!!$   SUBROUTINE dom_h_nxt( kt, Kbb, Kmm, Kaa, kcall ) 
     300!!$      !!---------------------------------------------------------------------- 
     301!!$      !!                ***  ROUTINE dom_qe_sf_nxt  *** 
     302!!$      !! 
     303!!$      !! ** Purpose :  - compute the after water heigh used in tra_zdf, dynnxt, 
     304!!$      !!                 tranxt and dynspg routines 
     305!!$      !! 
     306!!$      !! ** Method  :  - z_star case:  Proportionnaly to the water column thickness. 
     307!!$      !! 
     308!!$      !! ** Action  :  - h(u/v) update wrt ssh/h(u/v)_0 
     309!!$      !! 
     310!!$      !!---------------------------------------------------------------------- 
     311!!$      INTEGER, INTENT( in )           ::   kt             ! time step 
     312!!$      INTEGER, INTENT( in )           ::   Kbb, Kmm, Kaa  ! time step 
     313!!$      INTEGER, INTENT( in ), OPTIONAL ::   kcall          ! optional argument indicating call sequence 
     314!!$      ! 
     315!!$      !!---------------------------------------------------------------------- 
     316!!$      ! 
     317!!$      IF( ln_linssh )   RETURN      ! No calculation in linear free surface 
     318!!$      ! 
     319!!$      IF( ln_timing )   CALL timing_start('dom_h_nxt') 
     320!!$      ! 
     321!!$      IF( kt == nit000 ) THEN 
     322!!$         IF(lwp) WRITE(numout,*) 
     323!!$         IF(lwp) WRITE(numout,*) 'dom_h_nxt : compute after scale factors' 
     324!!$         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 
     325!!$      ENDIF 
     326!!$      ! 
     327!!$      ! *********************************** ! 
     328!!$      ! After depths at u- v points         ! 
     329!!$      ! *********************************** ! 
     330!!$      hu(:,:,Kaa) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kaa) ) 
     331!!$      hv(:,:,Kaa) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kaa) ) 
     332!!$      !                                        ! Inverse of the local depth 
     333!!$      r1_hu(:,:,Kaa) = ssumask(:,:) / ( hu(:,:,Kaa) + 1._wp - ssumask(:,:) ) 
     334!!$      r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) ) 
     335!!$      ! 
     336!!$      IF( ln_timing )   CALL timing_stop('dom_h_nxt') 
     337!!$      ! 
     338!!$   END SUBROUTINE dom_h_nxt 
     339!!st end 
    338340! !!st 
    339341!    SUBROUTINE dom_qe_sf_update( kt, Kbb, Kmm, Kaa ) 
     
    445447!!st end 
    446448 
    447    SUBROUTINE dom_h_update( kt, Kbb, Kmm, Kaa ) 
    448       !!---------------------------------------------------------------------- 
    449       !!                ***  ROUTINE dom_qe_sf_update  *** 
    450       !! 
    451       !! ** Purpose :  for z tilde case: compute time filter and swap of scale factors 
    452       !!               compute all depths and related variables for next time step 
    453       !!               write outputs and restart file 
    454       !! 
    455       !! ** Method  :  - reconstruct scale factor at other grid points (interpolate) 
    456       !!               - recompute depths and water height fields 
    457       !! 
    458       !! ** Action  :  - Recompute: 
    459       !!                    gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm)  and gde3w 
    460       !!                    h(u/v) and h(u/v)r 
    461       !! 
    462       !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling. 
    463       !!              Leclair, M., and G. Madec, 2011, Ocean Modelling. 
    464       !!---------------------------------------------------------------------- 
    465       INTEGER, INTENT( in ) ::   kt              ! time step 
    466       INTEGER, INTENT( in ) ::   Kbb, Kmm, Kaa   ! time level indices 
    467       ! 
    468       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    469       REAL(wp) ::   zcoef        ! local scalar 
    470       !!---------------------------------------------------------------------- 
    471       ! 
    472       IF( ln_linssh )   RETURN      ! No calculation in linear free surface 
    473       ! 
    474       IF( ln_timing )   CALL timing_start('dom_qe_sf_update') 
    475       ! 
    476       IF( kt == nit000 )   THEN 
    477          IF(lwp) WRITE(numout,*) 
    478          IF(lwp) WRITE(numout,*) 'dom_qe_sf_update : - interpolate scale factors and compute depths for next time step' 
    479          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 
    480       ENDIF 
    481       ! 
    482       ! Compute all missing vertical scale factor and depths 
    483       ! ==================================================== 
    484       ! Horizontal scale factor interpolations 
    485       ! -------------------------------------- 
    486       ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 
    487  
    488       IF( ln_isf ) THEN          !** IceShelF cavities 
    489       !                             ! to be created depending of the new names in isf 
    490       !                             ! it should be something like that :  (with h_isf = thickness of iceshelf) 
    491       !                             !  in fact currently, h_isf(:,:) is called : risfdep(:,:) 
    492    !!gm - depth idea 0  : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask ! 
    493          gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) ) 
    494          gdepw(:,:,1,Kmm) = 0._wp                            ! Initialized to zero one for all 
    495          gde3w(:,:,1)     = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)  ! reference to a common level z=0 for hpg 
    496          DO jk = 2, jpk 
    497             gdept(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdept_0(:,:,jk) )            & 
    498                               + MAX(   0._wp    , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 
    499             gdepw(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) )    & 
    500                               + MAX(   0._wp    , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 
    501             gde3w(:,:,jk)     = gdept(:,:,jk,Kmm) - ssh(:,:,Kmm) 
    502             gdept(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdept_0(:,:,jk) )            & 
    503                               + MAX(   0._wp    , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 
    504             gdepw(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) )    & 
    505                               + MAX(   0._wp    , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 
    506          END DO 
    507          ! 
    508       ELSE                       !** No cavities   (all depth rescaled, even inside topography: no mask) 
    509          ! 
    510    !!gm idea 0 :   just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask ! 
    511          DO jk = 1, jpk 
    512             gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 
    513             gdepw(:,:,jk,Kmm) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 
    514             gde3w(:,:,jk)     = gdept  (:,:,jk,Kmm)       - ssh(:,:,Kmm) 
    515             gdept(:,:,jk,Kbb) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 
    516             gdepw(:,:,jk,Kbb) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 
    517          END DO 
    518          ! 
    519       ENDIF 
    520  
    521       ! Local depth and Inverse of the local depth of the water 
    522       ! ------------------------------------------------------- 
    523       ! 
    524       ht(:,:) = ht_0(:,:) + ssh(:,:,Kmm) 
    525  
    526       ! write restart file 
    527       ! ================== 
    528       IF( ln_timing )   CALL timing_stop('dom_qe_sf_update') 
    529       ! 
    530    END SUBROUTINE dom_h_update 
    531  
     449!!$   SUBROUTINE dom_h_update( kt, Kbb, Kmm, Kaa ) 
     450!!$      !!---------------------------------------------------------------------- 
     451!!$      !!                ***  ROUTINE dom_qe_sf_update  *** 
     452!!$      !! 
     453!!$      !! ** Purpose :  for z tilde case: compute time filter and swap of scale factors 
     454!!$      !!               compute all depths and related variables for next time step 
     455!!$      !!               write outputs and restart file 
     456!!$      !! 
     457!!$      !! ** Method  :  - reconstruct scale factor at other grid points (interpolate) 
     458!!$      !!               - recompute depths and water height fields 
     459!!$      !! 
     460!!$      !! ** Action  :  - Recompute: 
     461!!$      !!                    gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm)  and gde3w 
     462!!$      !!                    h(u/v) and h(u/v)r 
     463!!$      !! 
     464!!$      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling. 
     465!!$      !!              Leclair, M., and G. Madec, 2011, Ocean Modelling. 
     466!!$      !!---------------------------------------------------------------------- 
     467!!$      INTEGER, INTENT( in ) ::   kt              ! time step 
     468!!$      INTEGER, INTENT( in ) ::   Kbb, Kmm, Kaa   ! time level indices 
     469!!$      ! 
     470!!$      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     471!!$      REAL(wp) ::   zcoef        ! local scalar 
     472!!$      !!---------------------------------------------------------------------- 
     473!!$      ! 
     474!!$      IF( ln_linssh )   RETURN      ! No calculation in linear free surface 
     475!!$      ! 
     476!!$      IF( ln_timing )   CALL timing_start('dom_qe_sf_update') 
     477!!$      ! 
     478!!$      IF( kt == nit000 )   THEN 
     479!!$         IF(lwp) WRITE(numout,*) 
     480!!$         IF(lwp) WRITE(numout,*) 'dom_qe_sf_update : - interpolate scale factors and compute depths for next time step' 
     481!!$         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 
     482!!$      ENDIF 
     483!!$      ! 
     484!!$      ! Compute all missing vertical scale factor and depths 
     485!!$      ! ==================================================== 
     486!!$      ! Horizontal scale factor interpolations 
     487!!$      ! -------------------------------------- 
     488!!$      ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 
     489!!$ 
     490!!$      IF( ln_isf ) THEN          !** IceShelF cavities 
     491!!$      !                             ! to be created depending of the new names in isf 
     492!!$      !                             ! it should be something like that :  (with h_isf = thickness of iceshelf) 
     493!!$      !                             !  in fact currently, h_isf(:,:) is called : risfdep(:,:) 
     494!!$   !!gm - depth idea 0  : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask ! 
     495!!$         gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) ) 
     496!!$         gdepw(:,:,1,Kmm) = 0._wp                            ! Initialized to zero one for all 
     497!!$         gde3w(:,:,1)     = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)  ! reference to a common level z=0 for hpg 
     498!!$         DO jk = 2, jpk 
     499!!$            gdept(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdept_0(:,:,jk) )            & 
     500!!$                              + MAX(   0._wp    , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 
     501!!$            gdepw(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) )    & 
     502!!$                              + MAX(   0._wp    , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 
     503!!$            gde3w(:,:,jk)     = gdept(:,:,jk,Kmm) - ssh(:,:,Kmm) 
     504!!$            gdept(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdept_0(:,:,jk) )            & 
     505!!$                              + MAX(   0._wp    , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 
     506!!$            gdepw(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) )    & 
     507!!$                              + MAX(   0._wp    , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 
     508!!$         END DO 
     509!!$         ! 
     510!!$      ELSE                       !** No cavities   (all depth rescaled, even inside topography: no mask) 
     511!!$         ! 
     512!!$   !!gm idea 0 :   just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask ! 
     513!!$         DO jk = 1, jpk 
     514!!$            gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 
     515!!$            gdepw(:,:,jk,Kmm) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 
     516!!$            gde3w(:,:,jk)     = gdept  (:,:,jk,Kmm)       - ssh(:,:,Kmm) 
     517!!$            gdept(:,:,jk,Kbb) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 
     518!!$            gdepw(:,:,jk,Kbb) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 
     519!!$         END DO 
     520!!$         ! 
     521!!$      ENDIF 
     522!!$ 
     523!!$      ! Local depth and Inverse of the local depth of the water 
     524!!$      ! ------------------------------------------------------- 
     525!!$      ! 
     526!!$!!st      ht(:,:) = ht_0(:,:) + ssh(:,:,Kmm) 
     527!!$ 
     528!!$      ! write restart file 
     529!!$      ! ================== 
     530!!$      IF( ln_timing )   CALL timing_stop('dom_qe_sf_update') 
     531!!$      ! 
     532!!$   END SUBROUTINE dom_h_update 
     533!!st end 
    532534 
    533535   SUBROUTINE dom_qe_r3c( pssh, pr3t, pr3u, pr3v, pr3f ) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domzgr_substitute.h90

    r12680 r12731  
    1919#   define  e3uw(i,j,k,t)  (e3uw_0(i,j,k)*(1._wp+r3u(i,j,t))) 
    2020#   define  e3vw(i,j,k,t)  (e3vw_0(i,j,k)*(1._wp+r3v(i,j,t))) 
     21#   define  ht(i,j)        (ht_0(i,j)+ssh(i,j,Kmm)) 
     22#   define  hu(i,j,t)      (hu_0(i,j)*(1._wp+r3u(i,j,t))) 
     23#   define  hv(i,j,t)      (hv_0(i,j)*(1._wp+r3v(i,j,t))) 
     24#   define  r1_hu(i,j,t)   (r1_hu_0(i,j)/(1._wp+r3u(i,j,t))) 
     25#   define  r1_hv(i,j,t)   (r1_hv_0(i,j)/(1._wp+r3v(i,j,t))) 
     26#   define  gdept(i,j,k,t) (gdept_0(i,j,k)*(1._wp+r3t(i,j,t))) 
     27#   define  gdepw(i,j,k,t) (gdepw_0(i,j,k)*(1._wp+r3t(i,j,t))) 
     28#   define  gde3w(i,j,k)   (gdept_0(i,j,k)*(1._wp+r3t(i,j,Kmm))-ssh(i,j,Kmm)) 
    2129#endif 
    2230!!---------------------------------------------------------------------- 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/istate.F90

    r12724 r12731  
    6060      ! 
    6161      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     62      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zgdept     !!st temporary modif to be able to use gdept subtitute 
    6263!!gm see comment further down 
    6364      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace 
     
    116117            ! 
    117118         ELSE                                 ! user defined initial T and S 
    118             CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )          
     119!!st zgdept  
     120            DO jk = 1, jpkm1 
     121               zgdept(:,:,jk) = gdept(:,:,jk,Kbb) 
     122            END DO 
     123            CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )          
    119124         ENDIF 
    120125         ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones 
     
    128133!!gm POTENTIAL BUG : 
    129134!!gm  ISSUE :  if ssh(:,:,Kbb) /= 0  then, in non linear free surface, the e3._n, e3._b should be recomputed 
    130 !!             as well as gdept and gdepw....   !!!!!  
     135!!             as well as gdept_ and gdepw_....   !!!!!  
    131136!!      ===>>>>   probably a call to domvvl initialisation here.... 
    132137 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynatf.F90

    r12724 r12731  
    215215            zwfld(:,:) = emp_b(:,:) - emp(:,:) 
    216216            IF ( ln_rnf ) zwfld(:,:) =  zwfld(:,:) - ( rnf_b(:,:) - rnf(:,:) ) 
    217             DO jk = 1, jpkm1 
    218                ze3t_f(:,:,jk) = ze3t_f(:,:,jk) - zcoef * zwfld(:,:) * tmask(:,:,jk) & 
    219                               &                        * pe3t(:,:,jk,Kmm) / ( ht(:,:) + 1._wp - ssmask(:,:) ) 
    220             END DO 
     217!!st 
     218!!$            DO jk = 1, jpkm1 
     219!!$               ze3t_f(:,:,jk) = ze3t_f(:,:,jk) - zcoef * zwfld(:,:) * tmask(:,:,jk) & 
     220!!$                              &                        * pe3t(:,:,jk,Kmm) / ( ht_(:,:) + 1._wp - ssmask(:,:) ) 
     221!!$            END DO 
     222!!st end             
     223            DO_3D_11_11( 1, jpkm1 ) 
     224               ze3t_f(ji,jj,jk) = ze3t_f(ji,jj,jk) - zcoef * zwfld(ji,jj) * tmask(ji,jj,jk) & 
     225                              &                * pe3t(ji,jj,jk,Kmm) / ( ht(ji,jj) + 1._wp - ssmask(ji,jj) ) 
     226            END_3D 
    221227            ! 
    222228            ! ice shelf melting (deal separately as it can be in depth) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynatfQCO.F90

    r12724 r12731  
    221221      ! integration 
    222222      ! 
    223       IF(.NOT.ln_linssh ) THEN 
    224          hu(:,:,Kmm) = e3u(:,:,1,Kmm ) * umask(:,:,1) 
    225          hv(:,:,Kmm) = e3v(:,:,1,Kmm ) * vmask(:,:,1) 
    226          DO jk = 2, jpkm1 
    227             hu(:,:,Kmm) = hu(:,:,Kmm) + e3u(:,:,jk,Kmm ) * umask(:,:,jk) 
    228             hv(:,:,Kmm) = hv(:,:,Kmm) + e3v(:,:,jk,Kmm ) * vmask(:,:,jk) 
    229          END DO 
    230          r1_hu(:,:,Kmm) = ssumask(:,:) / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) ) 
    231          r1_hv(:,:,Kmm) = ssvmask(:,:) / ( hv(:,:,Kmm) + 1._wp - ssvmask(:,:) ) 
    232       ENDIF 
     223!!st 
     224!!$      IF(.NOT.ln_linssh ) THEN 
     225!!$         hu(:,:,Kmm) = e3u(:,:,1,Kmm ) * umask(:,:,1) 
     226!!$         hv(:,:,Kmm) = e3v(:,:,1,Kmm ) * vmask(:,:,1) 
     227!!$         DO jk = 2, jpkm1 
     228!!$            hu(:,:,Kmm) = hu(:,:,Kmm) + e3u(:,:,jk,Kmm ) * umask(:,:,jk) 
     229!!$            hv(:,:,Kmm) = hv(:,:,Kmm) + e3v(:,:,jk,Kmm ) * vmask(:,:,jk) 
     230!!$         END DO 
     231!!$         r1_hu(:,:,Kmm) = ssumask(:,:) / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) ) 
     232!!$         r1_hv(:,:,Kmm) = ssvmask(:,:) / ( hv(:,:,Kmm) + 1._wp - ssvmask(:,:) ) 
     233!!$      ENDIF 
    233234      ! 
    234235      uu_b(:,:,Kaa) = e3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynhpg.F90

    r12616 r12731  
    781781      !------------------------------------------------------------- 
    782782 
    783 !!bug gm   :  e3w-gde3w = 0.5*e3w  ....  and gde3w(2)-gde3w(1)=e3w(:,:,2,:) ....   to be verified 
    784 !          true if gde3w is really defined as the sum of the e3w scale factors as, it seems to me, it should be 
     783!!bug gm   :  e3w-gde3w(:,:,:) = 0.5*e3w  ....  and gde3w(:,:,2)-gde3w(:,:,1)=e3w(:,:,2,Kmm) ....   to be verified 
     784!          true if gde3w(:,:,:) is really defined as the sum of the e3w scale factors as, it seems to me, it should be 
    785785 
    786786      DO_2D_00_00 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynspg_ts.F90

    r12724 r12731  
    257257      zhV(:,:) = pvv_b(:,:,Kmm) * hv(:,:,Kmm) * e1v(:,:)        ! NB: FULL domain : put a value in last row and column 
    258258      ! 
    259       CALL dyn_cor_2d( hu(:,:,Kmm), hv(:,:,Kmm), puu_b(:,:,Kmm), pvv_b(:,:,Kmm), zhU, zhV,  &   ! <<== in 
     259      CALL dyn_cor_2d( ht(:,:), hu(:,:,Kmm), hv(:,:,Kmm), puu_b(:,:,Kmm), pvv_b(:,:,Kmm), zhU, zhV,  &   ! <<== in 
    260260         &                                                                     zu_trd, zv_trd   )   ! ==>> out 
    261261      ! 
     
    388388         zhup2_e(:,:) = hu(:,:,Kmm) 
    389389         zhvp2_e(:,:) = hv(:,:,Kmm) 
    390          zhtp2_e(:,:) = ht(:,:) 
     390!!st not used ?         zhtp2_e(:,:) = ht_(:,:) 
    391391      ENDIF 
    392392      ! 
     
    574574         ! at each time step. We however keep them constant here for optimization. 
    575575         ! Recall that zhU and zhV hold fluxes at jn+0.5 (extrapolated not backward interpolated) 
    576          CALL dyn_cor_2d( zhup2_e, zhvp2_e, ua_e, va_e, zhU, zhV,    zu_trd, zv_trd   ) 
     576         CALL dyn_cor_2d( zhtp2_e, zhup2_e, zhvp2_e, ua_e, va_e, zhU, zhV,    zu_trd, zv_trd   ) 
    577577         ! 
    578578         ! Add tidal astronomical forcing if defined 
     
    11861186 
    11871187 
    1188    SUBROUTINE dyn_cor_2d( phu, phv, punb, pvnb, zhU, zhV,    zu_trd, zv_trd   ) 
     1188   SUBROUTINE dyn_cor_2d( pht, phu, phv, punb, pvnb, zhU, zhV,    zu_trd, zv_trd   ) 
    11891189      !!--------------------------------------------------------------------- 
    11901190      !!                   ***  ROUTINE dyn_cor_2d  *** 
     
    11941194      INTEGER  ::   ji ,jj                             ! dummy loop indices 
    11951195      REAL(wp) ::   zx1, zx2, zy1, zy2, z1_hu, z1_hv   !   -      - 
    1196       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: phu, phv, punb, pvnb, zhU, zhV 
     1196      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pht, phu, phv, punb, pvnb, zhU, zhV 
    11971197      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: zu_trd, zv_trd 
    11981198      !!---------------------------------------------------------------------- 
     
    12031203            z1_hv = ssvmask(ji,jj) / ( phv(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
    12041204            zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * z1_hu                    & 
    1205                &               * (  e1e2t(ji+1,jj)*ht(ji+1,jj)*ff_t(ji+1,jj) * ( pvnb(ji+1,jj) + pvnb(ji+1,jj-1) )   & 
    1206                &                  + e1e2t(ji  ,jj)*ht(ji  ,jj)*ff_t(ji  ,jj) * ( pvnb(ji  ,jj) + pvnb(ji  ,jj-1) )   ) 
     1205               &               * (  e1e2t(ji+1,jj)*pht(ji+1,jj)*ff_t(ji+1,jj) * ( pvnb(ji+1,jj) + pvnb(ji+1,jj-1) )   & 
     1206               &                  + e1e2t(ji  ,jj)*pht(ji  ,jj)*ff_t(ji  ,jj) * ( pvnb(ji  ,jj) + pvnb(ji  ,jj-1) )   ) 
    12071207               ! 
    12081208            zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * z1_hv                    & 
    1209                &               * (  e1e2t(ji,jj+1)*ht(ji,jj+1)*ff_t(ji,jj+1) * ( punb(ji,jj+1) + punb(ji-1,jj+1) )   &  
    1210                &                  + e1e2t(ji,jj  )*ht(ji,jj  )*ff_t(ji,jj  ) * ( punb(ji,jj  ) + punb(ji-1,jj  ) )   )  
     1209               &               * (  e1e2t(ji,jj+1)*pht(ji,jj+1)*ff_t(ji,jj+1) * ( punb(ji,jj+1) + punb(ji-1,jj+1) )   &  
     1210               &                  + e1e2t(ji,jj  )*pht(ji,jj  )*ff_t(ji,jj  ) * ( punb(ji,jj  ) + punb(ji-1,jj  ) )   )  
    12111211         END_2D 
    12121212         !          
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isfcpl.F90

    r12724 r12731  
    142142      !!---------------------------------------------------------------------- 
    143143      INTEGER :: jk                               ! loop index 
    144       REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v    ! e3t , e3u, e3v 
    145       !!---------------------------------------------------------------------- 
    146       ! 
     144      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, zgdepw  ! e3t , e3u, e3v 
     145      !!---------------------------------------------------------------------- 
     146      ! 
     147!!st patch to be able to use substitution 
    147148      DO jk = 1, jpk 
    148149         ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 
    149150         ze3u(:,:,jk) = e3u(:,:,jk,Kmm) 
    150151         ze3v(:,:,jk) = e3v(:,:,jk,Kmm) 
     152         zgdepw(:,:,jk) = gdepw(:,:,jk,Kmm) 
    151153      END DO  
    152154      ! 
     
    157159      CALL iom_rstput( kt, nitrst, numrow, 'e3u_n'  , ze3u , ldxios = lwxios ) 
    158160      CALL iom_rstput( kt, nitrst, numrow, 'e3v_n'  , ze3v , ldxios = lwxios ) 
    159       CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw(:,:,:,Kmm) , ldxios = lwxios ) 
     161      CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', zgdepw , ldxios = lwxios ) 
    160162      IF( lwxios ) CALL iom_swap( cxios_context ) 
    161163      ! 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isfdynatf.F90

    r12724 r12731  
    1515   USE phycst , ONLY: r1_rho0         ! physical constant 
    1616   USE dom_oce                        ! time and space domain 
    17  
     17   USE oce, ONLY : ssh                ! sea-surface height 
     18!!st 
    1819   USE in_out_manager 
    1920 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isfstp.F90

    r12625 r12731  
    1111 
    1212   !!---------------------------------------------------------------------- 
    13    !!   isfstp       : compute iceshelf melt and heat flux 
    14    !!---------------------------------------------------------------------- 
    15    ! 
    16    USE isf_oce                                      ! isf variables 
    17    USE isfload, ONLY: isf_load                      ! ice shelf load 
    18    USE isftbl , ONLY: isf_tbl_lvl                   ! ice shelf boundary layer 
    19    USE isfpar , ONLY: isf_par, isf_par_init         ! ice shelf parametrisation 
    20    USE isfcav , ONLY: isf_cav, isf_cav_init         ! ice shelf cavity 
    21    USE isfcpl , ONLY: isfcpl_rst_write, isfcpl_init ! isf variables 
    22  
    23    USE dom_oce                                          ! ocean space and time domain 
    24    USE domvvl,  ONLY: ln_vvl_zstar                      ! zstar logical 
    25    USE zdfdrg,  ONLY: r_Cdmin_top, r_ke0_top            ! vertical physics: top/bottom drag coef. 
     13   !!   isfstp        : compute iceshelf melt and heat flux 
     14   !!---------------------------------------------------------------------- 
     15   USE isf_oce        ! isf variables 
     16   USE isfload  , ONLY: isf_load                      ! ice shelf load 
     17   USE isftbl   , ONLY: isf_tbl_lvl                   ! ice shelf boundary layer 
     18   USE isfpar   , ONLY: isf_par, isf_par_init         ! ice shelf parametrisation 
     19   USE isfcav   , ONLY: isf_cav, isf_cav_init         ! ice shelf cavity 
     20   USE isfcpl   , ONLY: isfcpl_rst_write, isfcpl_init ! isf variables 
     21 
     22   USE dom_oce        ! ocean space and time domain 
     23   USE oce      , ONLY: ssh                           ! sea surface height 
     24   USE domvvl   , ONLY: ln_vvl_zstar                  ! zstar logical 
     25   USE zdfdrg   , ONLY: r_Cdmin_top, r_ke0_top        ! vertical physics: top/bottom drag coef. 
    2626   ! 
    2727   USE lib_mpp, ONLY: ctl_stop, ctl_nam 
     
    3131 
    3232   IMPLICIT NONE 
    33  
    3433   PRIVATE 
    3534 
     
    8786            ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 
    8887         END DO  
    89          CALL isf_tbl_lvl(ht, ze3t, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav) 
     88         CALL isf_tbl_lvl(ht(:,:), ze3t, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav) 
    9089         ! 
    9190         ! 1.3: compute ice shelf melt 
     
    112111            ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 
    113112         END DO 
    114          CALL isf_tbl_lvl(ht, ze3t, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par) 
     113         CALL isf_tbl_lvl(ht(:,:), ze3t, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par) 
    115114         ! 
    116115         ! 2.3: compute ice shelf melt 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/LDF/ldfslp.F90

    r12622 r12731  
    298298!               !                                         ! jk must be >= ML level for zfk=1. otherwise  zfk=0. 
    299299!               zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp ) 
    300 !               zck = gdepw(ji,jj,jk)    / MAX( hmlp(ji,jj), 10. ) 
     300!               zck = gdepw(ji,jj,jk,Kmm)    / MAX( hmlp(ji,jj), 10. ) 
    301301!               zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk) 
    302302!               zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ZDF/zdfosm.F90

    r12724 r12731  
    475475 
    476476      zhbl_t(:,:) = hbl(:,:) + (zdhdt(:,:) - ww(ji,jj,ibld(ji,jj)))* rn_Dt ! certainly need wb here, so subtract it 
    477       zhbl_t(:,:) = MIN(zhbl_t(:,:), ht(:,:)) 
     477!!st      zhbl_t(:,:) = MIN(zhbl_t(:,:), ht_(:,:)) 
     478      DO_2D_11_11 
     479         zhbl_t(ji,jj) = MIN(zhbl_t(ji,jj), ht(ji,jj)) 
     480      END_2D 
    478481      zdhdt(:,:) = MIN(zdhdt(:,:), (zhbl_t(:,:) - hbl(:,:))/rn_Dt + ww(ji,jj,ibld(ji,jj))) ! adjustment to represent limiting by ocean bottom 
    479482 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/stepLF.F90

    r12724 r12731  
    9090!!gm kcall can be removed, I guess 
    9191      INTEGER ::   kcall        ! optional integer argument (dom_vvl_sf_nxt) 
     92!!st patch 
     93      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgdept  ! st patch 
    9294      !! --------------------------------------------------------------------- 
    9395#if defined key_agrif 
     
    194196      !  Ocean dynamics : hdiv, ssh, e3, u, v, w 
    195197      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    196  
     198!!st patch 
     199!!st patch to be able to use substitution 
     200      DO jk = 1, jpk 
     201         zgdept(:,:,jk) = gdept(:,:,jk,Nnn) 
     202      END DO 
     203!!st end 
    197204                            CALL ssh_nxt       ( kstp, Nbb, Nnn, ssh,  Naa )    ! after ssh (includes call to div_hor) 
    198205      IF( .NOT.ln_linssh )  CALL dom_qe_r3c    ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa) ) 
    199       IF( .NOT.ln_linssh )  CALL dom_h_nxt     ( kstp, Nbb, Nnn,       Naa )    ! after vertical scale factors 
     206!!st      IF( .NOT.ln_linssh )  CALL dom_h_nxt     ( kstp, Nbb, Nnn,       Naa )    ! after vertical scale factors 
    200207      !IF( .NOT.ln_linssh )  CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn,      Naa )    ! after vertical scale factors 
    201208                            CALL wzv           ( kstp, Nbb, Nnn, Naa, ww  )    ! Nnn cross-level velocity 
    202209      IF( ln_zad_Aimp )     CALL wAimp         ( kstp,      Nnn           )  ! Adaptive-implicit vertical advection partitioning 
    203                             CALL eos    ( ts(:,:,:,:,Nnn), rhd, rhop, gdept(:,:,:,Nnn) )  ! now in situ density for hpg computation 
     210                            CALL eos    ( ts(:,:,:,:,Nnn), rhd, rhop, zgdept )  ! now in situ density for hpg computation 
    204211 
    205212 
     
    226233         IF(.NOT.ln_linssh) CALL dom_qe_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) ) 
    227234         !IF(.NOT.ln_linssh) CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn, Naa, kcall=2 )  ! after vertical scale factors (update depth average component) 
    228          IF(.NOT.ln_linssh) CALL dom_h_nxt  ( kstp, Nbb, Nnn, Naa, kcall=2 )  ! after vertical scale factors (update depth average component) 
     235!!st         IF(.NOT.ln_linssh) CALL dom_h_nxt  ( kstp, Nbb, Nnn, Naa, kcall=2 )  ! after vertical scale factors (update depth average component) 
    229236      ENDIF 
    230237                            CALL dyn_zdf    ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa  )  ! vertical diffusion 
     
    322329      ! 
    323330      !IF(.NOT.ln_linssh) CALL dom_qe_sf_update( kstp, Nbb, Nnn, Naa )  ! recompute vertical scale factors 
    324       IF(.NOT.ln_linssh) CALL dom_h_update  ( kstp, Nbb, Nnn, Naa )  ! recompute vertical scale factors 
     331!!st      IF(.NOT.ln_linssh) CALL dom_h_update  ( kstp, Nbb, Nnn, Naa )  ! recompute vertical scale factors 
    325332      ! 
    326333      IF( ln_diahsb  )   CALL dia_hsb       ( kstp, Nbb, Nnn )  ! - ML - global conservation diagnostics 
Note: See TracChangeset for help on using the changeset viewer.