New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 12492 for NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domqe.F90 – NEMO

Ignore:
Timestamp:
2020-03-01T21:49:40+01:00 (4 years ago)
Author:
techene
Message:

change the way to compute e3, gde and h where it makes small (10-7 or 10-10) and localised errors wrt to the reference version in the GYRE configuration

File:
1 edited

Legend:

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

    r12482 r12492  
    2323   USE phycst          ! physical constant 
    2424   USE dom_oce         ! ocean space and time domain 
     25   USE dynadv  , ONLY : ln_dynadv_vec 
     26   USE isf_oce         ! iceshelf cavities 
    2527   USE sbc_oce         ! ocean surface boundary condition 
    2628   USE wet_dry         ! wetting and drying 
     
    109111      ! 
    110112   END SUBROUTINE dom_qe_init 
    111    ! 
     113 
     114 
    112115   SUBROUTINE dom_qe_zgr(Kbb, Kmm, Kaa) 
    113116      !!---------------------------------------------------------------------- 
     
    139142      !                    !== Set of all other vertical scale factors  ==!  (now and before) 
    140143      !                                ! Horizontal interpolation of e3t 
    141       CALL dom_qe_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' )    ! from T to U 
    142       CALL dom_qe_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 
    143       CALL dom_qe_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' )    ! from T to V 
    144       CALL dom_qe_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 
    145       CALL dom_qe_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' )    ! from U to F 
    146       !                                ! Vertical interpolation of e3t,u,v 
    147       CALL dom_qe_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W'  )  ! from T to W 
    148       CALL dom_qe_interpol( e3t(:,:,:,Kbb), e3w (:,:,:,Kbb), 'W'  ) 
    149       CALL dom_qe_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' )  ! from U to UW 
    150       CALL dom_qe_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 
    151       CALL dom_qe_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' )  ! from V to UW 
    152       CALL dom_qe_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 
    153  
     144      CALL dom_qe_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb) ) 
     145      CALL dom_qe_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) ) 
     146      ! 
     147      DO jk = 1, jpkm1                    ! Horizontal interpolation of e3t 
     148         e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) * tmask(:,:,jk) )   ! Kbb time level 
     149         e3u(:,:,jk,Kbb) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) * umask(:,:,jk) ) 
     150         e3v(:,:,jk,Kbb) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) * vmask(:,:,jk) ) 
     151         e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) * tmask(:,:,jk) )   ! Kmm time level 
     152         e3u(:,:,jk,Kmm) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) * umask(:,:,jk) ) 
     153         e3v(:,:,jk,Kmm) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) * vmask(:,:,jk) ) 
     154         e3f(:,:,jk)     = e3f_0(:,:,jk) * ( 1._wp + r3f(:,:)     * fmask(:,:,jk) ) 
     155      END DO 
     156      ! 
     157      DO jk = 1, jpk                      ! Vertical interpolation of e3t,u,v 
     158         !                                   ! The ratio does not have to be masked at w-level 
     159         e3w (:,:,jk,Kbb) =  e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) )   ! Kbb time level 
     160         e3uw(:,:,jk,Kbb) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) ) 
     161         e3vw(:,:,jk,Kbb) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) ) 
     162         e3w (:,:,jk,Kmm) =  e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) )   ! Kmm time level 
     163         e3uw(:,:,jk,Kmm) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) ) 
     164         e3vw(:,:,jk,Kmm) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) ) 
     165      END DO 
     166      ! 
    154167      ! We need to define e3[tuv]_a for AGRIF initialisation (should not be a problem for the restartability...) 
    155168      e3t(:,:,:,Kaa) = e3t(:,:,:,Kmm) 
     
    158171      ! 
    159172      !                    !==  depth of t and w-point  ==!   (set the isf depth as it is in the initial timestep) 
    160       gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm)       ! reference to the ocean surface (used for MLD and light penetration) 
    161       gdepw(:,:,1,Kmm) = 0.0_wp 
    162       gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)  ! reference to a common level z=0 for hpg 
    163       gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb) 
    164       gdepw(:,:,1,Kbb) = 0.0_wp 
    165       DO_3D_11_11( 2, jpk ) 
    166          !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    167          !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 
    168          !                             ! 0.5 where jk = mikt 
    169 !!gm ???????   BUG ?  gdept(:,:,:,Kmm) as well as gde3w  does not include the thickness of ISF ?? 
    170          zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 
    171          gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
    172          gdept(ji,jj,jk,Kmm) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm))  & 
    173             &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm)) 
    174          gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
    175          gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 
    176          gdept(ji,jj,jk,Kbb) =      zcoef  * ( gdepw(ji,jj,jk  ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb))  & 
    177             &                + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) +       e3w(ji,jj,jk,Kbb)) 
    178       END_3D 
     173      IF( ln_isf ) THEN          !** IceShelF cavities 
     174      !                             ! to be created depending of the new names in isf 
     175      !                             ! it should be something like that :  (with h_isf = thickness of iceshelf) 
     176      !                             !  in fact currently, h_isf(:,:) is called : risfdep(:,:) 
     177!!gm - depth idea 0  : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask ! 
     178         gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) ) 
     179         gdepw(:,:,1,Kmm) = 0._wp                            ! Initialized to zero one for all 
     180         gde3w(:,:,1)     = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)  ! reference to a common level z=0 for hpg 
     181         DO jk = 2, jpk 
     182            gdept(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdept_0(:,:,jk) )            & 
     183                              + MAX(   0._wp    , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 
     184            gdepw(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) )    & 
     185                              + MAX(   0._wp    , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 
     186            gde3w(:,:,jk)     = gdept(:,:,jk,Kmm) - ssh(:,:,Kmm) 
     187            gdept(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdept_0(:,:,jk) )            & 
     188                              + MAX(   0._wp    , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 
     189            gdepw(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) )    & 
     190                              + MAX(   0._wp    , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 
     191         END DO 
     192         ! 
     193      ELSE                       !** No cavities   (all depth rescaled, even inside topography: no mask) 
     194         ! 
     195!!gm idea 0 :   just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask ! 
     196         DO jk = 1, jpk 
     197            gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 
     198            gdepw(:,:,jk,Kmm) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 
     199            gde3w(:,:,jk)     = gdept  (:,:,jk,Kmm)       - ssh(:,:,Kmm) 
     200            gdept(:,:,jk,Kbb) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 
     201            gdepw(:,:,jk,Kbb) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 
     202         END DO 
     203         ! 
     204      ENDIF 
    179205      ! 
    180206      !                    !==  thickness of the water column  !!   (ocean portion only) 
    181       ht(:,:) = e3t(:,:,1,Kmm) * tmask(:,:,1)   !!gm  BUG  :  this should be 1/2 * e3w(k=1) .... 
    182       hu(:,:,Kbb) = e3u(:,:,1,Kbb) * umask(:,:,1) 
    183       hu(:,:,Kmm) = e3u(:,:,1,Kmm) * umask(:,:,1) 
    184       hv(:,:,Kbb) = e3v(:,:,1,Kbb) * vmask(:,:,1) 
    185       hv(:,:,Kmm) = e3v(:,:,1,Kmm) * vmask(:,:,1) 
    186       DO jk = 2, jpkm1 
    187          ht(:,:) = ht(:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    188          hu(:,:,Kbb) = hu(:,:,Kbb) + e3u(:,:,jk,Kbb) * umask(:,:,jk) 
    189          hu(:,:,Kmm) = hu(:,:,Kmm) + e3u(:,:,jk,Kmm) * umask(:,:,jk) 
    190          hv(:,:,Kbb) = hv(:,:,Kbb) + e3v(:,:,jk,Kbb) * vmask(:,:,jk) 
    191          hv(:,:,Kmm) = hv(:,:,Kmm) + e3v(:,:,jk,Kmm) * vmask(:,:,jk) 
    192       END DO 
     207      ht(:,:)     = ht_0(:,:)           + ssh(:,:,Kmm) 
     208      hu(:,:,Kbb) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kbb) ) 
     209      hu(:,:,Kmm) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kmm) ) 
     210      hv(:,:,Kbb) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kbb) ) 
     211      hv(:,:,Kmm) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kmm) ) 
    193212      ! 
    194213      !                    !==  inverse of water column thickness   ==!   (u- and v- points) 
     
    251270      !                                                ! --------------------------------------------- ! 
    252271      ! 
    253       z_scale(:,:) = ( ssh(:,:,Kaa) - ssh(:,:,Kbb) ) * ssmask(:,:) / ( ht_0(:,:) + ssh(:,:,Kmm) + 1. - ssmask(:,:) ) 
    254       DO jk = 1, jpkm1 
    255          ! formally this is the same as e3t(:,:,:,Kaa) = e3t_0*(1+ssha/ht_0) 
    256          e3t(:,:,jk,Kaa) = e3t(:,:,jk,Kbb) + e3t(:,:,jk,Kmm) * z_scale(:,:) * tmask(:,:,jk) 
    257       END DO 
    258272      ! 
    259273      ! *********************************** ! 
    260274      ! After scale factors at u- v- points ! 
    261275      ! *********************************** ! 
    262  
    263       CALL dom_qe_interpol( e3t(:,:,:,Kaa), e3u(:,:,:,Kaa), 'U' ) 
    264       CALL dom_qe_interpol( e3t(:,:,:,Kaa), e3v(:,:,:,Kaa), 'V' ) 
    265  
     276      ! 
     277      CALL dom_qe_r3c( ssh(:,:,Kaa), r3t(:,:,Kaa), r3u(:,:,Kaa), r3v(:,:,Kaa) ) 
     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      ! 
    266285      ! *********************************** ! 
    267286      ! After depths at u- v points         ! 
    268287      ! *********************************** ! 
    269  
    270       hu(:,:,Kaa) = e3u(:,:,1,Kaa) * umask(:,:,1) 
    271       hv(:,:,Kaa) = e3v(:,:,1,Kaa) * vmask(:,:,1) 
    272       DO jk = 2, jpkm1 
    273          hu(:,:,Kaa) = hu(:,:,Kaa) + e3u(:,:,jk,Kaa) * umask(:,:,jk) 
    274          hv(:,:,Kaa) = hv(:,:,Kaa) + e3v(:,:,jk,Kaa) * vmask(:,:,jk) 
    275       END DO 
     288      hu(:,:,Kaa) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kaa) ) 
     289      hv(:,:,Kaa) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kaa) ) 
    276290      !                                        ! Inverse of the local depth 
    277 !!gm BUG ?  don't understand the use of umask_i here ..... 
    278291      r1_hu(:,:,Kaa) = ssumask(:,:) / ( hu(:,:,Kaa) + 1._wp - ssumask(:,:) ) 
    279292      r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) ) 
     
    329342      ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt 
    330343      ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 
    331  
    332       CALL dom_qe_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F'  ) 
     344      !!st  ! r3t/u/v should be unchanged 
     345      CALL dom_qe_r3c( ssh(:,:,Kmm), r3t_f(:,:), r3u_f(:,:), r3v_f(:,:), r3f(:,:) ) 
     346      ! 
     347      DO jk = 1, jpkm1                    ! Horizontal interpolation of e3t 
     348         e3f(:,:,jk)     = e3f_0(:,:,jk) * ( 1._wp + r3f(:,:)     * fmask(:,:,jk) )   ! Kmm time level 
     349      END DO 
     350      !CALL dom_qe_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F'  ) 
    333351 
    334352      ! Vertical scale factor interpolations 
     353      ! DO jk = 1, jpk                      ! Vertical interpolation of e3t,u,v 
     354      !    !                                   ! The ratio does not have to be masked at w-level 
     355      !    e3w (:,:,jk,Kmm) =  e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) )   ! Kmm time level 
     356      !    e3uw(:,:,jk,Kmm) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) ) 
     357      !    e3vw(:,:,jk,Kmm) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) ) 
     358      ! END DO 
    335359      CALL dom_qe_interpol( e3t(:,:,:,Kmm),  e3w(:,:,:,Kmm), 'W'  ) 
    336360      CALL dom_qe_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 
     
    353377         gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 
    354378      END_3D 
     379!       IF( ln_isf ) THEN          !** IceShelF cavities 
     380!       !                             ! to be created depending of the new names in isf 
     381!       !                             ! it should be something like that :  (with h_isf = thickness of iceshelf) 
     382!       !                             !  in fact currently, h_isf(:,:) is called : risfdep(:,:) 
     383! !!gm - depth idea 0  : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask ! 
     384!          gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) ) 
     385!          gdepw(:,:,1,Kmm) = 0._wp                            ! Initialized to zero one for all 
     386!          gde3w(:,:,1)     = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)  ! reference to a common level z=0 for hpg 
     387!          DO jk = 2, jpk 
     388!             gdept(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdept_0(:,:,jk) )            & 
     389!                               + MAX(   0._wp    , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 
     390!             gdepw(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) )    & 
     391!                               + MAX(   0._wp    , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 
     392!             gde3w(:,:,jk)     = gdept(:,:,jk,Kmm) - ssh(:,:,Kmm) 
     393!          END DO 
     394!          ! 
     395!       ELSE                       !** No cavities   (all depth rescaled, even inside topography: no mask) 
     396!          ! 
     397! !!gm idea 0 :   just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask ! 
     398!          DO jk = 1, jpk 
     399!             gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 
     400!             gdepw(:,:,jk,Kmm) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 
     401!             gde3w(:,:,jk)     = gdept  (:,:,jk,Kmm)       - ssh(:,:,Kmm) 
     402!          END DO 
     403!          ! 
     404!       ENDIF 
    355405 
    356406      ! Local depth and Inverse of the local depth of the water 
    357407      ! ------------------------------------------------------- 
    358408      ! 
    359       ht(:,:) = e3t(:,:,1,Kmm) * tmask(:,:,1) 
    360       DO jk = 2, jpkm1 
    361          ht(:,:) = ht(:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    362       END DO 
     409      ht(:,:) = ht_0(:,:) + ssh(:,:,Kmm) 
    363410 
    364411      ! write restart file 
     
    464511      ! 
    465512   END SUBROUTINE dom_qe_interpol 
     513 
     514 
     515   SUBROUTINE dom_qe_r3c( pssh, pr3t, pr3u, pr3v, pr3f ) 
     516      !!--------------------------------------------------------------------- 
     517      !!                   ***  ROUTINE r3c  *** 
     518      !! 
     519      !! ** Purpose :   compute the filtered ratio ssh/h_0 at t-,u-,v-,f-points 
     520      !! 
     521      !! ** Method  : - compute the ssh at u- and v-points (f-point optional) 
     522      !!                   Vector Form : surface weighted averaging 
     523      !!                   Flux   Form : simple           averaging 
     524      !!              - compute the ratio ssh/h_0 at t-,u-,v-pts, (f-pt optional) 
     525      !!---------------------------------------------------------------------- 
     526      REAL(wp), DIMENSION(:,:)          , INTENT(in   )  ::   pssh               ! sea surface height   [m] 
     527      REAL(wp), DIMENSION(:,:)          , INTENT(  out)  ::   pr3t, pr3u, pr3v   ! ssh/h0 ratio at t-, u-, v-,points  [-] 
     528      REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(  out)  ::   pr3f               ! ssh/h0 ratio at f-point   [-] 
     529      ! 
     530      INTEGER ::   ji, jj   ! dummy loop indices 
     531      !!---------------------------------------------------------------------- 
     532      ! 
     533      ! 
     534      pr3t(:,:) = pssh(:,:) * r1_ht_0(:,:)   !==  ratio at t-point  ==! 
     535      ! 
     536      ! 
     537      !                                      !==  ratio at u-,v-point  ==! 
     538      ! 
     539      IF( ln_dynadv_vec ) THEN                     !- Vector Form   (thickness weighted averaging) 
     540         DO_2D_11_11 
     541            pr3u(ji,jj) = 0.5_wp * (  e1e2t(ji  ,jj) * pssh(ji  ,jj)  & 
     542               &                    + e1e2t(ji+1,jj) * pssh(ji+1,jj)  ) * r1_hu_0(ji,jj) * r1_e1e2u(ji,jj) 
     543            pr3v(ji,jj) = 0.5_wp * (  e1e2t(ji,jj  ) * pssh(ji,jj  )  & 
     544               &                    + e1e2t(ji,jj+1) * pssh(ji,jj+1)  ) * r1_hv_0(ji,jj) * r1_e1e2v(ji,jj) 
     545         END_2D 
     546      ELSE                                         !- Flux Form   (simple averaging) 
     547         DO_2D_11_11 
     548            pr3u(ji,jj) = 0.5_wp * (  pssh(ji  ,jj) + pssh(ji+1,jj)  ) * r1_hu_0(ji,jj) 
     549            pr3v(ji,jj) = 0.5_wp * (  pssh(ji,jj  ) + pssh(ji,jj+1)  ) * r1_hv_0(ji,jj) 
     550         END_2D 
     551      ENDIF 
     552      ! 
     553      IF( .NOT.PRESENT( pr3f ) ) THEN              !- lbc on ratio at u-, v-points only 
     554         CALL lbc_lnk_multi( 'dom_qe_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp ) 
     555         ! 
     556         ! 
     557      ELSE                                   !==  ratio at f-point  ==! 
     558         ! 
     559         IF( ln_dynadv_vec )   THEN                !- Vector Form   (thickness weighted averaging) 
     560            DO_2D_01_01                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
     561               pr3f(ji,jj) = 0.25_wp * (  e1e2t(ji  ,jj  ) * pssh(ji  ,jj  )  & 
     562                  &                     + e1e2t(ji+1,jj  ) * pssh(ji+1,jj  )  & 
     563                  &                     + e1e2t(ji  ,jj+1) * pssh(ji  ,jj+1)  & 
     564                  &                     + e1e2t(ji+1,jj+1) * pssh(ji+1,jj+1)  ) * r1_hf_0(ji,jj) * r1_e1e2f(ji,jj) 
     565            END_2D 
     566         ELSE                                      !- Flux Form   (simple averaging) 
     567            DO_2D_01_01                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
     568               pr3f(ji,jj) = 0.25_wp * (  pssh(ji  ,jj  ) + pssh(ji+1,jj  )  & 
     569                  &                     + pssh(ji  ,jj+1) + pssh(ji+1,jj+1)  ) * r1_hf_0(ji,jj) 
     570            END_2D 
     571         ENDIF 
     572         !                                                 ! lbc on ratio at u-,v-,f-points 
     573         CALL lbc_lnk_multi( 'dom_qe_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp ) 
     574         ! 
     575      ENDIF 
     576      ! 
     577   END SUBROUTINE dom_qe_r3c 
    466578 
    467579 
Note: See TracChangeset for help on using the changeset viewer.