Ignore:
Timestamp:
2020-04-09T21:06:01+02:00 (11 months ago)
Author:
techene
Message:

some cleaning and proper module/routine name, mini bug introduced and corrected in sbcice_cice

File:
1 moved

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domqco.F90

    r12731 r12732  
    1 MODULE domqe 
     1MODULE domqco 
    22   !!====================================================================== 
    3    !!                       ***  MODULE domqe   *** 
     3   !!                       ***  MODULE domqco   *** 
    44   !! Ocean : 
    55   !!====================================================================== 
     
    1414   !!---------------------------------------------------------------------- 
    1515   !!   dom_qe_init   : define initial vertical scale factors, depths and column thickness 
    16    !!   dom_qe_sf_nxt : Compute next vertical scale factors 
    17    !!   dom_qe_sf_update: Swap vertical scale factors and update the vertical grid 
    18    !!   dom_qe_interpol : Interpolate vertical scale factors from one grid point to another 
    1916   !!   dom_qe_r3c    : Compute ssh/h_0 ratioat t-, u-, v-, and optionally f-points 
    2017   !!       qe_rst_read : read/write restart file 
     
    4037   PRIVATE 
    4138 
    42    PUBLIC  dom_qe_init       ! called by domain.F90 
    43    PUBLIC  dom_qe_zgr        ! called by isfcpl.F90 
    44 !!st   PUBLIC  dom_qe_sf_nxt     ! called by steplf.F90 
    45 !!st   PUBLIC  dom_qe_sf_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 
    48    PUBLIC  dom_qe_r3c        ! called by steplf.F90 
     39   PUBLIC  dom_qco_init       ! called by domain.F90 
     40   PUBLIC  dom_qco_zgr        ! called by isfcpl.F90 
     41   PUBLIC  dom_qco_r3c        ! called by steplf.F90 
    4942 
    5043   !                                                      !!* Namelist nam_vvl 
     
    7366CONTAINS 
    7467 
    75    SUBROUTINE dom_qe_init( Kbb, Kmm, Kaa ) 
    76       !!---------------------------------------------------------------------- 
    77       !!                ***  ROUTINE dom_qe_init  *** 
    78       !! 
    79       !! ** Purpose :  Initialization of all scale factors, depths 
    80       !!               and water column heights 
     68   SUBROUTINE dom_qco_init( Kbb, Kmm, Kaa ) 
     69      !!---------------------------------------------------------------------- 
     70      !!                ***  ROUTINE dom_qco_init  *** 
     71      !! 
     72      !! ** Purpose :  Initialization of all ssh. to h._0 ratio 
    8173      !! 
    8274      !! ** Method  :  - use restart file and/or initialize 
    83       !!               - interpolate scale factors 
    84       !! 
    85       !! ** Action  : - e3t_(n/b) 
    86       !!              - Regrid: e3[u/v](:,:,:,Kmm) 
    87       !!                        e3[u/v](:,:,:,Kmm) 
    88       !!                        e3w(:,:,:,Kmm) 
    89       !!                        e3[u/v]w_b 
    90       !!                        e3[u/v]w_n 
    91       !!                        gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w 
    92       !!              - h(t/u/v)_0 
    93       !! 
    94       !! Reference  : Leclair, M., and G. Madec, 2011, Ocean Modelling. 
     75      !!               - compute ssh. to h._0 ratio 
     76      !! 
     77      !! ** Action  : - r3(t/u/v)_b 
     78      !!              - r3(t/u/v/f)_n 
     79      !! 
    9580      !!---------------------------------------------------------------------- 
    9681      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 
    9782      ! 
    9883      IF(lwp) WRITE(numout,*) 
    99       IF(lwp) WRITE(numout,*) 'dom_qe_init : Variable volume activated' 
     84      IF(lwp) WRITE(numout,*) 'dom_qco_init : Variable volume activated' 
    10085      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    10186      ! 
    102       CALL dom_qe_ctl     ! choose vertical coordinate (z_star, z_tilde or layer) 
     87      CALL dom_qco_ctl     ! choose vertical coordinate (z_star, z_tilde or layer) 
    10388      ! 
    10489      !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 
    10590      CALL qe_rst_read( nit000, Kbb, Kmm ) 
    106 !!st      e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk)  ! last level always inside the sea floor set one for all 
    107       ! 
    108       CALL dom_qe_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column 
     91      ! 
     92      CALL dom_qco_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column 
    10993      ! 
    11094      ! IF(lwxios) THEN   ! define variables in restart file when writing with XIOS 
     
    11397      ! ENDIF 
    11498      ! 
    115    END SUBROUTINE dom_qe_init 
    116  
    117  
    118    SUBROUTINE dom_qe_zgr(Kbb, Kmm, Kaa) 
    119       !!---------------------------------------------------------------------- 
    120       !!                ***  ROUTINE dom_qe_init  *** 
    121       !! 
    122       !! ** Purpose :  Interpolation of all scale factors, 
    123       !!               depths and water column heights 
     99   END SUBROUTINE dom_qco_init 
     100 
     101 
     102   SUBROUTINE dom_qco_zgr(Kbb, Kmm, Kaa) 
     103      !!---------------------------------------------------------------------- 
     104      !!                ***  ROUTINE dom_qco_init  *** 
     105      !! 
     106      !! ** Purpose :  Initialization of all ssh. to h._0 ratio 
    124107      !! 
    125108      !! ** Method  :  - interpolate scale factors 
    126109      !! 
    127       !! ** Action  : - e3t_(n/b) 
    128       !!              - Regrid: e3(u/v)_n 
    129       !!                        e3(u/v)_b 
    130       !!                        e3w_n 
    131       !!                        e3(u/v)w_b 
    132       !!                        e3(u/v)w_n 
    133       !!                        gdept_n, gdepw_n and gde3w_n 
    134       !!              - h(t/u/v)_0 
     110      !! ** Action  : - r3(t/u/v)_b 
     111      !!              - r3(t/u/v/f)_n 
    135112      !! 
    136113      !! Reference  : Leclair, M., and G. Madec, 2011, Ocean Modelling. 
     
    145122      !                    !== Set of all other vertical scale factors  ==!  (now and before) 
    146123      !                                ! Horizontal interpolation of e3t 
    147       CALL dom_qe_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb) ) 
    148       CALL dom_qe_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) ) 
    149       ! 
    150 ! !!st 
    151 !       DO jk = 1, jpkm1                    ! Horizontal interpolation of e3t 
    152 !          e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) * tmask(:,:,jk) )   ! Kbb time level 
    153 !          e3u(:,:,jk,Kbb) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) * umask(:,:,jk) ) 
    154 !          e3v(:,:,jk,Kbb) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) * vmask(:,:,jk) ) 
    155 !          e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) * tmask(:,:,jk) )   ! Kmm time level 
    156 !          e3u(:,:,jk,Kmm) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) * umask(:,:,jk) ) 
    157 !          e3v(:,:,jk,Kmm) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) * vmask(:,:,jk) ) 
    158 !          e3f(:,:,jk)     = e3f_0(:,:,jk) * ( 1._wp + r3f(:,:)     * fmask(:,:,jk) ) 
    159 !       END DO 
    160 !       ! 
    161 !       DO jk = 1, jpk                      ! Vertical interpolation of e3t,u,v 
    162 !          !                                   ! The ratio does not have to be masked at w-level 
    163 !          e3w (:,:,jk,Kbb) =  e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) )   ! Kbb time level 
    164 !          e3uw(:,:,jk,Kbb) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) ) 
    165 !          e3vw(:,:,jk,Kbb) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) ) 
    166 !          e3w (:,:,jk,Kmm) =  e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) )   ! Kmm time level 
    167 !          e3uw(:,:,jk,Kmm) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) ) 
    168 !          e3vw(:,:,jk,Kmm) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) ) 
    169 !       END DO 
    170 !       ! 
    171 !       ! We need to define e3[tuv]_a for AGRIF initialisation (should not be a problem for the restartability...) 
    172 !       e3t(:,:,:,Kaa) = e3t(:,:,:,Kmm) 
    173 !       e3u(:,:,:,Kaa) = e3u(:,:,:,Kmm) 
    174 !       e3v(:,:,:,Kaa) = e3v(:,:,:,Kmm) 
    175 !!st end 
    176       ! 
    177 !!st ATTENTION CAS ISF A GERER !!!  
    178       !                    !==  depth of t and w-point  ==!   (set the isf depth as it is in the initial timestep) 
    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 
    211       ! 
    212       !                    !==  thickness of the water column  !!   (ocean portion only) 
    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 
    225       ! 
    226    END SUBROUTINE dom_qe_zgr 
    227  
    228 ! !!st 
    229 !    SUBROUTINE dom_qe_sf_nxt( kt, Kbb, Kmm, Kaa, kcall ) 
    230 !       !!---------------------------------------------------------------------- 
    231 !       !!                ***  ROUTINE dom_qe_sf_nxt  *** 
    232 !       !! 
    233 !       !! ** Purpose :  - compute the after scale factors used in tra_zdf, dynnxt, 
    234 !       !!                 tranxt and dynspg routines 
    235 !       !! 
    236 !       !! ** Method  :  - z_star case:  Repartition of ssh INCREMENT proportionnaly to the level thickness. 
    237 !       !! 
    238 !       !! ** Action  :  - hdiv_lf    : restoring towards full baroclinic divergence in z_tilde case 
    239 !       !!               - tilde_e3t_a: after increment of vertical scale factor 
    240 !       !!                              in z_tilde case 
    241 !       !!               - e3(t/u/v)_a 
    242 !       !! 
    243 !       !! Reference  : Leclair, M., and Madec, G. 2011, Ocean Modelling. 
    244 !       !!---------------------------------------------------------------------- 
    245 !       INTEGER, INTENT( in )           ::   kt             ! time step 
    246 !       INTEGER, INTENT( in )           ::   Kbb, Kmm, Kaa  ! time step 
    247 !       INTEGER, INTENT( in ), OPTIONAL ::   kcall          ! optional argument indicating call sequence 
    248 !       ! 
    249 !       INTEGER                ::   ji, jj, jk            ! dummy loop indices 
    250 !       INTEGER , DIMENSION(3) ::   ijk_max, ijk_min      ! temporary integers 
    251 !       REAL(wp)               ::   z2dt, z_tmin, z_tmax  ! local scalars 
    252 !       LOGICAL                ::   ll_do_bclinic         ! local logical 
    253 !       REAL(wp), DIMENSION(jpi,jpj)     ::   zht, z_scale, zwu, zwv, zhdiv 
    254 !       !!---------------------------------------------------------------------- 
    255 !       ! 
    256 !       IF( ln_linssh )   RETURN      ! No calculation in linear free surface 
    257 !       ! 
    258 !       IF( ln_timing )   CALL timing_start('dom_qe_sf_nxt') 
    259 !       ! 
    260 !       IF( kt == nit000 ) THEN 
    261 !          IF(lwp) WRITE(numout,*) 
    262 !          IF(lwp) WRITE(numout,*) 'dom_qe_sf_nxt : compute after scale factors' 
    263 !          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 
    264 !       ENDIF 
    265 ! 
    266 ! 
    267 !       ! ******************************* ! 
    268 !       ! After acale factors at t-points ! 
    269 !       ! ******************************* ! 
    270 !       !                                                ! --------------------------------------------- ! 
    271 !       !                                                ! z_star coordinate and barotropic z-tilde part ! 
    272 !       !                                                ! --------------------------------------------- ! 
    273 !       ! 
    274 !       ! 
    275 !       ! *********************************** ! 
    276 !       ! After scale factors at u- v- points ! 
    277 !       ! *********************************** ! 
    278 !       ! 
    279 !       DO jk = 1, jpkm1 
    280 !          e3t(:,:,jk,Kaa) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kaa) * tmask(:,:,jk) ) 
    281 !          e3u(:,:,jk,Kaa) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kaa) * umask(:,:,jk) ) 
    282 !          e3v(:,:,jk,Kaa) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kaa) * vmask(:,:,jk) ) 
    283 !       END DO 
    284 !       ! 
    285 !       ! *********************************** ! 
    286 !       ! After depths at u- v points         ! 
    287 !       ! *********************************** ! 
    288 !       hu(:,:,Kaa) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kaa) ) 
    289 !       hv(:,:,Kaa) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kaa) ) 
    290 !       !                                        ! Inverse of the local depth 
    291 !       r1_hu(:,:,Kaa) = ssumask(:,:) / ( hu(:,:,Kaa) + 1._wp - ssumask(:,:) ) 
    292 !       r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) ) 
    293 !       ! 
    294 !       IF( ln_timing )   CALL timing_stop('dom_qe_sf_nxt') 
    295 !       ! 
    296 !    END SUBROUTINE dom_qe_sf_nxt 
    297 !!st end 
    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 
    340 ! !!st 
    341 !    SUBROUTINE dom_qe_sf_update( kt, Kbb, Kmm, Kaa ) 
    342 !       !!---------------------------------------------------------------------- 
    343 !       !!                ***  ROUTINE dom_qe_sf_update  *** 
    344 !       !! 
    345 !       !! ** Purpose :  for z tilde case: compute time filter and swap of scale factors 
    346 !       !!               compute all depths and related variables for next time step 
    347 !       !!               write outputs and restart file 
    348 !       !! 
    349 !       !! ** Method  :  - reconstruct scale factor at other grid points (interpolate) 
    350 !       !!               - recompute depths and water height fields 
    351 !       !! 
    352 !       !! ** Action  :  - Recompute: 
    353 !       !!                    e3(u/v)_b 
    354 !       !!                    e3w(:,:,:,Kmm) 
    355 !       !!                    e3(u/v)w_b 
    356 !       !!                    e3(u/v)w_n 
    357 !       !!                    gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm)  and gde3w 
    358 !       !!                    h(u/v) and h(u/v)r 
    359 !       !! 
    360 !       !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling. 
    361 !       !!              Leclair, M., and G. Madec, 2011, Ocean Modelling. 
    362 !       !!---------------------------------------------------------------------- 
    363 !       INTEGER, INTENT( in ) ::   kt              ! time step 
    364 !       INTEGER, INTENT( in ) ::   Kbb, Kmm, Kaa   ! time level indices 
    365 !       ! 
    366 !       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    367 !       REAL(wp) ::   zcoef        ! local scalar 
    368 !       !!---------------------------------------------------------------------- 
    369 !       ! 
    370 !       IF( ln_linssh )   RETURN      ! No calculation in linear free surface 
    371 !       ! 
    372 !       IF( ln_timing )   CALL timing_start('dom_qe_sf_update') 
    373 !       ! 
    374 !       IF( kt == nit000 )   THEN 
    375 !          IF(lwp) WRITE(numout,*) 
    376 !          IF(lwp) WRITE(numout,*) 'dom_qe_sf_update : - interpolate scale factors and compute depths for next time step' 
    377 !          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 
    378 !       ENDIF 
    379 !       ! 
    380 !       ! Compute all missing vertical scale factor and depths 
    381 !       ! ==================================================== 
    382 !       ! Horizontal scale factor interpolations 
    383 !       ! -------------------------------------- 
    384 !       ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt 
    385 !       ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 
    386 ! 
    387 ! 
    388 !       ! Scale factor computation 
    389 !       DO jk = 1, jpk             ! Horizontal interpolation 
    390 !          e3f(:,:,jk)      =  e3f_0(:,:,jk) * ( 1._wp + r3f(:,:) * fmask(:,:,jk) )   ! Kmm time level 
    391 !          !                       ! Vertical interpolation 
    392 !        !                                   ! The ratio does not have to be masked at w-level 
    393 !          e3w (:,:,jk,Kmm) =  e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) )   ! Kmm time level 
    394 !          e3uw(:,:,jk,Kmm) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) ) 
    395 !          e3vw(:,:,jk,Kmm) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) ) 
    396 !          e3w (:,:,jk,Kbb) =  e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) )   ! Kbb time level 
    397 !          e3uw(:,:,jk,Kbb) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) ) 
    398 !          e3vw(:,:,jk,Kbb) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) ) 
    399 !       END DO 
    400 ! 
    401 ! 
    402 !       IF( ln_isf ) THEN          !** IceShelF cavities 
    403 !       !                             ! to be created depending of the new names in isf 
    404 !       !                             ! it should be something like that :  (with h_isf = thickness of iceshelf) 
    405 !       !                             !  in fact currently, h_isf(:,:) is called : risfdep(:,:) 
    406 ! !!gm - depth idea 0  : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask ! 
    407 !          gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) ) 
    408 !          gdepw(:,:,1,Kmm) = 0._wp                            ! Initialized to zero one for all 
    409 !          gde3w(:,:,1)     = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)  ! reference to a common level z=0 for hpg 
    410 !          DO jk = 2, jpk 
    411 !             gdept(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdept_0(:,:,jk) )            & 
    412 !                               + MAX(   0._wp    , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 
    413 !             gdepw(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) )    & 
    414 !                               + MAX(   0._wp    , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 
    415 !             gde3w(:,:,jk)     = gdept(:,:,jk,Kmm) - ssh(:,:,Kmm) 
    416 !             gdept(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdept_0(:,:,jk) )            & 
    417 !                               + MAX(   0._wp    , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 
    418 !             gdepw(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) )    & 
    419 !                               + MAX(   0._wp    , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 
    420 !          END DO 
    421 !          ! 
    422 !       ELSE                       !** No cavities   (all depth rescaled, even inside topography: no mask) 
    423 !          ! 
    424 ! !!gm idea 0 :   just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask ! 
    425 !          DO jk = 1, jpk 
    426 !             gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 
    427 !             gdepw(:,:,jk,Kmm) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 
    428 !             gde3w(:,:,jk)     = gdept  (:,:,jk,Kmm)       - ssh(:,:,Kmm) 
    429 !             gdept(:,:,jk,Kbb) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 
    430 !             gdepw(:,:,jk,Kbb) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 
    431 !          END DO 
    432 !          ! 
    433 !       ENDIF 
    434 ! 
    435 !       ! Local depth and Inverse of the local depth of the water 
    436 !       ! ------------------------------------------------------- 
    437 !       ! 
    438 !       ht(:,:) = ht_0(:,:) + ssh(:,:,Kmm) 
    439 ! 
    440 !       ! write restart file 
    441 !       ! ================== 
    442 !       IF( lrst_oce  )   CALL dom_qe_rst( kt, Kbb, Kmm, 'WRITE' ) 
    443 !       ! 
    444 !       IF( ln_timing )   CALL timing_stop('dom_qe_sf_update') 
    445 !       ! 
    446 !    END SUBROUTINE dom_qe_sf_update 
    447 !!st end 
    448  
    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 
    534  
    535    SUBROUTINE dom_qe_r3c( pssh, pr3t, pr3u, pr3v, pr3f ) 
     124      CALL dom_qco_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb) ) 
     125      CALL dom_qco_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) ) 
     126      ! 
     127   END SUBROUTINE dom_qco_zgr 
     128 
     129 
     130   SUBROUTINE dom_qco_r3c( pssh, pr3t, pr3u, pr3v, pr3f ) 
    536131      !!--------------------------------------------------------------------- 
    537132      !!                   ***  ROUTINE r3c  *** 
     
    572167      ! 
    573168      IF( .NOT.PRESENT( pr3f ) ) THEN              !- lbc on ratio at u-, v-points only 
    574          CALL lbc_lnk_multi( 'dom_qe_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp ) 
     169         CALL lbc_lnk_multi( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp ) 
    575170         ! 
    576171         ! 
     
    591186         ENDIF 
    592187         !                                                 ! lbc on ratio at u-,v-,f-points 
    593          CALL lbc_lnk_multi( 'dom_qe_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp ) 
     188         CALL lbc_lnk_multi( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp ) 
    594189         ! 
    595190      ENDIF 
    596191      ! 
    597    END SUBROUTINE dom_qe_r3c 
     192   END SUBROUTINE dom_qco_r3c 
    598193 
    599194 
     
    704299 
    705300 
    706    SUBROUTINE dom_qe_ctl 
     301   SUBROUTINE dom_qco_ctl 
    707302      !!--------------------------------------------------------------------- 
    708       !!                  ***  ROUTINE dom_qe_ctl  *** 
     303      !!                  ***  ROUTINE dom_qco_ctl  *** 
    709304      !! 
    710305      !! ** Purpose :   Control the consistency between namelist options 
     
    726321      IF(lwp) THEN                    ! Namelist print 
    727322         WRITE(numout,*) 
    728          WRITE(numout,*) 'dom_qe_ctl : choice/control of the variable vertical coordinate' 
     323         WRITE(numout,*) 'dom_qco_ctl : choice/control of the variable vertical coordinate' 
    729324         WRITE(numout,*) '~~~~~~~~~~~' 
    730325         WRITE(numout,*) '   Namelist nam_vvl : chose a vertical coordinate' 
     
    771366#endif 
    772367      ! 
    773    END SUBROUTINE dom_qe_ctl 
     368   END SUBROUTINE dom_qco_ctl 
    774369 
    775370   !!====================================================================== 
    776 END MODULE domqe 
     371END MODULE domqco 
Note: See TracChangeset for help on using the changeset viewer.