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 11949 for NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/iscplrst.F90 – NEMO

Ignore:
Timestamp:
2019-11-22T15:29:17+01:00 (4 years ago)
Author:
acc
Message:

Merge in changes from 2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps. This just creates a fresh copy of this branch to use as the merge base. See ticket #2341

Location:
NEMO/branches/2019/dev_r11943_MERGE_2019/src
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src

    • Property svn:mergeinfo deleted

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/iscplrst.F90

    r10425 r11949  
    4040CONTAINS 
    4141 
    42    SUBROUTINE iscpl_stp 
     42   SUBROUTINE iscpl_stp( Kbb, Kmm ) 
    4343      !!----------------------------------------------------------------------  
    4444      !!                   ***  ROUTINE iscpl_stp  *** 
    4545      !!  
    4646      !! ** Purpose : compute initialisation 
    47       !!              compute extrapolation of restart variable un, vn, tsn, sshn (wetting/drying)    
     47      !!              compute extrapolation of restart variable uu(Kmm), vv(Kmm), ts(Kmm), ssh(Kmm) (wetting/drying)    
    4848      !!              compute correction term if needed 
    4949      !!  
    5050      !!---------------------------------------------------------------------- 
     51      INTEGER, INTENT(in) :: Kbb, Kmm   ! time level indices 
     52      ! 
    5153      INTEGER  ::   inum0 
    5254      REAL(wp), DIMENSION(jpi,jpj)     ::   zsmask_b 
    … …  
    6971      CALL iscpl_init()       ! read namelist 
    7072      !                       ! Extrapolation/interpolation of modify cell and new cells ... (maybe do it later after domvvl) 
    71       CALL iscpl_rst_interpol( ztmask_b, zumask_b, zvmask_b, zsmask_b, ze3t_b, ze3u_b, ze3v_b, zdepw_b ) 
     73      CALL iscpl_rst_interpol( Kbb, Kmm, ztmask_b, zumask_b, zvmask_b, zsmask_b, ze3t_b, ze3u_b, ze3v_b, zdepw_b ) 
    7274      ! 
    7375      IF ( ln_hsb ) THEN      ! compute correction if conservation needed 
    7476         IF( iscpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'rst_iscpl : unable to allocate rst_iscpl arrays' ) 
    75          CALL iscpl_cons(ztmask_b, zsmask_b, ze3t_b, htsc_iscpl, hdiv_iscpl, rdt_iscpl) 
     77         CALL iscpl_cons( Kbb, Kmm, ztmask_b, zsmask_b, ze3t_b, htsc_iscpl, hdiv_iscpl, rdt_iscpl ) 
    7678      END IF 
    7779          
    … …  
    9294      ! 
    9395      !                       ! set _b and _n variables equal 
    94       tsb (:,:,:,:) = tsn (:,:,:,:) 
    95       ub  (:,:,:)   = un  (:,:,:) 
    96       vb  (:,:,:)   = vn  (:,:,:) 
    97       sshb(:,:)     = sshn(:,:) 
     96      ts (:,:,:,:,Kbb) = ts (:,:,:,:,Kmm) 
     97      uu  (:,:,:,Kbb)   = uu  (:,:,:,Kmm) 
     98      vv  (:,:,:,Kbb)   = vv  (:,:,:,Kmm) 
     99      ssh(:,:,Kbb)     = ssh(:,:,Kmm) 
    98100      ! 
    99101      !                       ! set _b and _n vertical scale factor equal 
    100       e3t_b (:,:,:) = e3t_n (:,:,:) 
    101       e3u_b (:,:,:) = e3u_n (:,:,:) 
    102       e3v_b (:,:,:) = e3v_n (:,:,:) 
    103       ! 
    104       e3uw_b (:,:,:) = e3uw_n (:,:,:) 
    105       e3vw_b (:,:,:) = e3vw_n (:,:,:) 
    106       gdept_b(:,:,:) = gdept_n(:,:,:) 
    107       gdepw_b(:,:,:) = gdepw_n(:,:,:) 
    108       hu_b   (:,:)   = hu_n   (:,:) 
    109       hv_b   (:,:)   = hv_n   (:,:) 
    110       r1_hu_b(:,:)   = r1_hu_n(:,:) 
    111       r1_hv_b(:,:)   = r1_hv_n(:,:) 
     102      e3t (:,:,:,Kbb) = e3t (:,:,:,Kmm) 
     103      e3u (:,:,:,Kbb) = e3u (:,:,:,Kmm) 
     104      e3v (:,:,:,Kbb) = e3v (:,:,:,Kmm) 
     105      ! 
     106      e3uw (:,:,:,Kbb) = e3uw (:,:,:,Kmm) 
     107      e3vw (:,:,:,Kbb) = e3vw (:,:,:,Kmm) 
     108      gdept(:,:,:,Kbb) = gdept(:,:,:,Kmm) 
     109      gdepw(:,:,:,Kbb) = gdepw(:,:,:,Kmm) 
     110      hu   (:,:,Kbb)   = hu   (:,:,Kmm) 
     111      hv   (:,:,Kbb)   = hv   (:,:,Kmm) 
     112      r1_hu(:,:,Kbb)   = r1_hu(:,:,Kmm) 
     113      r1_hv(:,:,Kbb)   = r1_hv(:,:,Kmm) 
    112114      ! 
    113115   END SUBROUTINE iscpl_stp 
    114116 
    115117 
    116    SUBROUTINE iscpl_rst_interpol (ptmask_b, pumask_b, pvmask_b, psmask_b, pe3t_b, pe3u_b, pe3v_b, pdepw_b) 
     118   SUBROUTINE iscpl_rst_interpol ( Kbb, Kmm, ptmask_b, pumask_b, pvmask_b, psmask_b, pe3t_b, pe3u_b, pe3v_b, pdepw_b ) 
    117119      !!----------------------------------------------------------------------  
    118120      !!                   ***  ROUTINE iscpl_rst_interpol  *** 
    119121      !!  
    120       !! ** Purpose :   compute new tn, sn, un, vn and sshn in case of evolving geometry of ice shelves  
     122      !! ** Purpose :   compute new ts(Kmm), uu(Kmm), vv(Kmm) and ssh(Kmm) in case of evolving geometry of ice shelves  
    121123      !!                compute 2d fields of heat, salt and volume correction 
    122124      !!  
    123       !! ** Method  :   tn, sn : extrapolation from neigbourg cells 
    124       !!                un, vn : fill with 0 velocity and keep barotropic transport by modifing surface velocity or adjacent velocity 
     125      !! ** Method  :   ts(Kmm) : extrapolation from neigbourg cells 
     126      !!                uu(Kmm), vv(Kmm) : fill with 0 velocity and keep barotropic transport by modifing surface velocity or adjacent velocity 
    125127      !!---------------------------------------------------------------------- 
     128      INTEGER                     , INTENT(in ) :: Kbb, Kmm                        !! time level indices 
    126129      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: ptmask_b, pumask_b, pvmask_b    !! mask before 
    127130      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pe3t_b  , pe3u_b  , pe3v_b      !! scale factor before 
    … …  
    143146      ! 
    144147      !                 ! mask value to be sure 
    145       tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * ptmask_b(:,:,:) 
    146       tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * ptmask_b(:,:,:) 
     148      ts(:,:,:,jp_tem,Kmm) = ts(:,:,:,jp_tem,Kmm) * ptmask_b(:,:,:) 
     149      ts(:,:,:,jp_sal,Kmm) = ts(:,:,:,jp_sal,Kmm) * ptmask_b(:,:,:) 
    147150      ! 
    148151      !                 ! compute wmask 
    … …  
    155158      !     
    156159      !                 ! compute new ssh if we open a full water column (average of the closest neigbourgs)   
    157       sshb (:,:)=sshn(:,:) 
    158       zssh0(:,:)=sshn(:,:) 
     160      ssh (:,:,Kbb)=ssh(:,:,Kmm) 
     161      zssh0(:,:)=ssh(:,:,Kmm) 
    159162      zsmask0(:,:) = psmask_b(:,:) 
    160163      zsmask1(:,:) = psmask_b(:,:) 
    … …  
    167170               summsk=(zsmask0(jip1,jj)+zsmask0(jim1,jj)+zsmask0(ji,jjp1)+zsmask0(ji,jjm1)) 
    168171               IF (zdsmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN 
    169                   sshn(ji,jj)=( zssh0(jip1,jj)*zsmask0(jip1,jj)     & 
     172                  ssh(ji,jj,Kmm)=( zssh0(jip1,jj)*zsmask0(jip1,jj)     & 
    170173                  &           + zssh0(jim1,jj)*zsmask0(jim1,jj)     & 
    171174                  &           + zssh0(ji,jjp1)*zsmask0(ji,jjp1)     & 
    … …  
    175178            END DO 
    176179         END DO 
    177          CALL lbc_lnk_multi( 'iscplrst', sshn, 'T', 1., zsmask1, 'T', 1. ) 
    178          zssh0   = sshn 
     180         CALL lbc_lnk_multi( 'iscplrst', ssh(:,:,Kmm), 'T', 1., zsmask1, 'T', 1. ) 
     181         zssh0   = ssh(:,:,Kmm) 
    179182         zsmask0 = zsmask1 
    180183      END DO 
    181       sshn(:,:) = sshn(:,:) * ssmask(:,:) 
     184      ssh(:,:,Kmm) = ssh(:,:,Kmm) * ssmask(:,:) 
    182185 
    183186!============================================================================= 
    … …  
    192195               DO ji=1,jpi 
    193196                  IF (tmask(ji,jj,1) == 0._wp .OR. ptmask_b(ji,jj,1) == 0._wp) THEN 
    194                      e3t_n(ji,jj,jk) = e3t_0(ji,jj,jk) * ( 1._wp + sshn(ji,jj) /   & 
     197                     e3t(ji,jj,jk,Kmm) = e3t_0(ji,jj,jk) * ( 1._wp + ssh(ji,jj,Kmm) /   & 
    195198                     &   ( ht_0(ji,jj) + 1._wp - ssmask(ji,jj) ) * tmask(ji,jj,jk) ) 
    196199                  ENDIF 
    … …  
    199202         END DO 
    200203         ! 
    201          CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 
    202          CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 
    203          CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) 
     204         CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 
     205         CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 
     206         CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 
    204207 
    205208         ! Vertical scale factor interpolations 
    206209         ! ------------------------------------ 
    207          CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  ) 
    208          CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 
    209          CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 
     210         CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W'  ) 
     211         CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 
     212         CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 
    210213          
    211214         ! t- and w- points depth 
    212215         ! ---------------------- 
    213          gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 
    214          gdepw_n(:,:,1) = 0.0_wp 
    215          gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 
     216         gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 
     217         gdepw(:,:,1,Kmm) = 0.0_wp 
     218         gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 
    216219         DO jj = 1,jpj 
    217220            DO ji = 1,jpi 
    218221               DO jk = 2,mikt(ji,jj)-1 
    219                   gdept_n(ji,jj,jk) = gdept_0(ji,jj,jk) 
    220                   gdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk) 
    221                   gde3w_n(ji,jj,jk) = gdept_0(ji,jj,jk) - sshn(ji,jj) 
     222                  gdept(ji,jj,jk,Kmm) = gdept_0(ji,jj,jk) 
     223                  gdepw(ji,jj,jk,Kmm) = gdepw_0(ji,jj,jk) 
     224                  gde3w(ji,jj,jk) = gdept_0(ji,jj,jk) - ssh(ji,jj,Kmm) 
    222225               END DO 
    223226               IF (mikt(ji,jj) > 1) THEN 
    224227                  jk = mikt(ji,jj) 
    225                   gdept_n(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * e3w_n(ji,jj,jk) 
    226                   gdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk) 
    227                   gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk  ) - sshn   (ji,jj) 
     228                  gdept(ji,jj,jk,Kmm) = gdepw_0(ji,jj,jk) + 0.5_wp * e3w(ji,jj,jk,Kmm) 
     229                  gdepw(ji,jj,jk,Kmm) = gdepw_0(ji,jj,jk) 
     230                  gde3w(ji,jj,jk) = gdept(ji,jj,jk  ,Kmm) - ssh   (ji,jj,Kmm) 
    228231               END IF 
    229232               DO jk = mikt(ji,jj)+1, jpk 
    230                   gdept_n(ji,jj,jk) = gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk) 
    231                   gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 
    232                   gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk  ) - sshn (ji,jj) 
     233                  gdept(ji,jj,jk,Kmm) = gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm) 
     234                  gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
     235                  gde3w(ji,jj,jk) = gdept(ji,jj,jk  ,Kmm) - ssh (ji,jj,Kmm) 
    233236               END DO 
    234237            END DO 
    … …  
    237240      ! t-, u- and v- water column thickness 
    238241      ! ------------------------------------ 
    239          ht_n(:,:) = 0._wp ; hu_n(:,:) = 0._wp ; hv_n(:,:) = 0._wp 
     242         ht(:,:) = 0._wp ; hu(:,:,Kmm) = 0._wp ; hv(:,:,Kmm) = 0._wp 
    240243         DO jk = 1, jpkm1 
    241             hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk) 
    242             hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk) 
    243             ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 
     244            hu(:,:,Kmm) = hu(:,:,Kmm) + e3u(:,:,jk,Kmm) * umask(:,:,jk) 
     245            hv(:,:,Kmm) = hv(:,:,Kmm) + e3v(:,:,jk,Kmm) * vmask(:,:,jk) 
     246            ht(:,:) = ht(:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    244247         END DO 
    245248         !                                        ! Inverse of the local depth 
    246          r1_hu_n(:,:) = 1._wp / ( hu_n(:,:) + 1._wp - ssumask(:,:) ) * ssumask(:,:) 
    247          r1_hv_n(:,:) = 1._wp / ( hv_n(:,:) + 1._wp - ssvmask(:,:) ) * ssvmask(:,:) 
     249         r1_hu(:,:,Kmm) = 1._wp / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) ) * ssumask(:,:) 
     250         r1_hv(:,:,Kmm) = 1._wp / ( hv(:,:,Kmm) + 1._wp - ssvmask(:,:) ) * ssvmask(:,:) 
    248251 
    249252      END IF 
    … …  
    252255! compute velocity 
    253256! compute velocity in order to conserve barotropic velocity (modification by poderation of the scale factor). 
    254       ub(:,:,:)=un(:,:,:) 
    255       vb(:,:,:)=vn(:,:,:) 
     257      uu(:,:,:,Kbb)=uu(:,:,:,Kmm) 
     258      vv(:,:,:,Kbb)=vv(:,:,:,Kmm) 
    256259      DO jk = 1,jpk 
    257260         DO jj = 1,jpj 
    258261            DO ji = 1,jpi 
    259                un(ji,jj,jk) = ub(ji,jj,jk)*pe3u_b(ji,jj,jk)*pumask_b(ji,jj,jk)/e3u_n(ji,jj,jk)*umask(ji,jj,jk); 
    260                vn(ji,jj,jk) = vb(ji,jj,jk)*pe3v_b(ji,jj,jk)*pvmask_b(ji,jj,jk)/e3v_n(ji,jj,jk)*vmask(ji,jj,jk); 
     262               uu(ji,jj,jk,Kmm) = uu(ji,jj,jk,Kbb)*pe3u_b(ji,jj,jk)*pumask_b(ji,jj,jk)/e3u(ji,jj,jk,Kmm)*umask(ji,jj,jk); 
     263               vv(ji,jj,jk,Kmm) = vv(ji,jj,jk,Kbb)*pe3v_b(ji,jj,jk)*pvmask_b(ji,jj,jk)/e3v(ji,jj,jk,Kmm)*vmask(ji,jj,jk); 
    261264            END DO 
    262265         END DO 
    … …  
    265268! compute new velocity if we close a cell (check barotropic velocity and change velocity over the water column) 
    266269! compute barotropic velocity now and after  
    267       ztrp(:,:,:) = ub(:,:,:)*pe3u_b(:,:,:);  
     270      ztrp(:,:,:) = uu(:,:,:,Kbb)*pe3u_b(:,:,:);  
    268271      zbub(:,:)   = SUM(ztrp,DIM=3) 
    269       ztrp(:,:,:) = vb(:,:,:)*pe3v_b(:,:,:);  
     272      ztrp(:,:,:) = vv(:,:,:,Kbb)*pe3v_b(:,:,:);  
    270273      zbvb(:,:)   = SUM(ztrp,DIM=3) 
    271       ztrp(:,:,:) = un(:,:,:)*e3u_n(:,:,:);  
     274      ztrp(:,:,:) = uu(:,:,:,Kmm)*e3u(:,:,:,Kmm);  
    272275      zbun(:,:)   = SUM(ztrp,DIM=3) 
    273       ztrp(:,:,:) = vn(:,:,:)*e3v_n(:,:,:);  
     276      ztrp(:,:,:) = vv(:,:,:,Kmm)*e3v(:,:,:,Kmm);  
    274277      zbvn(:,:)   = SUM(ztrp,DIM=3) 
    275278 
    … …  
    278281      zhv1=0.0_wp ; 
    279282      DO jk  = 1,jpk 
    280         zhu1(:,:) = zhu1(:,:) + e3u_n(:,:,jk) * umask(:,:,jk) 
    281         zhv1(:,:) = zhv1(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk) 
     283        zhu1(:,:) = zhu1(:,:) + e3u(:,:,jk,Kmm) * umask(:,:,jk) 
     284        zhv1(:,:) = zhv1(:,:) + e3v(:,:,jk,Kmm) * vmask(:,:,jk) 
    282285      END DO 
    283286       
    … …  
    298301      ! update velocity 
    299302      DO jk  = 1,jpk 
    300          un(:,:,jk)=(un(:,:,jk) - zucorr(:,:))*umask(:,:,jk) 
    301          vn(:,:,jk)=(vn(:,:,jk) - zvcorr(:,:))*vmask(:,:,jk) 
     303         uu(:,:,jk,Kmm)=(uu(:,:,jk,Kmm) - zucorr(:,:))*umask(:,:,jk) 
     304         vv(:,:,jk,Kmm)=(vv(:,:,jk,Kmm) - zvcorr(:,:))*vmask(:,:,jk) 
    302305      END DO 
    303306 
    … …  
    305308      ! compute temp and salt 
    306309      ! compute new tn and sn if we open a new cell 
    307       tsb (:,:,:,:) = tsn(:,:,:,:) 
    308       zts0(:,:,:,:) = tsn(:,:,:,:) 
     310      ts (:,:,:,:,Kbb) = ts(:,:,:,:,Kmm) 
     311      zts0(:,:,:,:) = ts(:,:,:,:,Kmm) 
    309312      ztmask1(:,:,:) = ptmask_b(:,:,:) 
    310313      ztmask0(:,:,:) = ptmask_b(:,:,:) 
    … …  
    319322                      IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN 
    320323                      !! horizontal basic extrapolation 
    321                          tsn(ji,jj,jk,1)=( zts0(jip1,jj  ,jk,1)*ztmask0(jip1,jj  ,jk) & 
     324                         ts(ji,jj,jk,1,Kmm)=( zts0(jip1,jj  ,jk,1)*ztmask0(jip1,jj  ,jk) & 
    322325                         &                +zts0(jim1,jj  ,jk,1)*ztmask0(jim1,jj  ,jk) & 
    323326                         &                +zts0(ji  ,jjp1,jk,1)*ztmask0(ji  ,jjp1,jk) & 
    324327                         &                +zts0(ji  ,jjm1,jk,1)*ztmask0(ji  ,jjm1,jk) ) / summsk 
    325                          tsn(ji,jj,jk,2)=( zts0(jip1,jj  ,jk,2)*ztmask0(jip1,jj  ,jk) & 
     328                         ts(ji,jj,jk,2,Kmm)=( zts0(jip1,jj  ,jk,2)*ztmask0(jip1,jj  ,jk) & 
    326329                         &                +zts0(jim1,jj  ,jk,2)*ztmask0(jim1,jj  ,jk) & 
    327330                         &                +zts0(ji  ,jjp1,jk,2)*ztmask0(ji  ,jjp1,jk) & 
    … …  
    333336                         summsk=(ztmask0(ji,jj,jkm1)+ztmask0(ji,jj,jkp1)) 
    334337                         IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp ) THEN 
    335                             tsn(ji,jj,jk,1)=( zts0(ji,jj,jkp1,1)*ztmask0(ji,jj,jkp1)     & 
     338                            ts(ji,jj,jk,1,Kmm)=( zts0(ji,jj,jkp1,1)*ztmask0(ji,jj,jkp1)     & 
    336339                            &                +zts0(ji,jj,jkm1,1)*ztmask0(ji,jj,jkm1))/summsk 
    337                             tsn(ji,jj,jk,2)=( zts0(ji,jj,jkp1,2)*ztmask0(ji,jj,jkp1)     & 
     340                            ts(ji,jj,jk,2,Kmm)=( zts0(ji,jj,jkp1,2)*ztmask0(ji,jj,jkp1)     & 
    338341                            &                +zts0(ji,jj,jkm1,2)*ztmask0(ji,jj,jkm1))/summsk 
    339342                            ztmask1(ji,jj,jk)=1._wp 
    … …  
    344347          END DO 
    345348           
    346           CALL lbc_lnk_multi( 'iscplrst', tsn(:,:,:,jp_tem), 'T', 1., tsn(:,:,:,jp_sal), 'T', 1., ztmask1, 'T', 1.) 
     349          CALL lbc_lnk_multi( 'iscplrst', ts(:,:,:,jp_tem,Kmm), 'T', 1., ts(:,:,:,jp_sal,Kmm), 'T', 1., ztmask1, 'T', 1.) 
    347350 
    348351          ! update 
    349           zts0(:,:,:,:) = tsn(:,:,:,:) 
     352          zts0(:,:,:,:) = ts(:,:,:,:,Kmm) 
    350353          ztmask0 = ztmask1 
    351354 
    352355      END DO 
    353356 
    354       ! mask new tsn field 
    355       tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * tmask(:,:,:) 
    356       tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:) 
     357      ! mask new ts(:,:,:,:,Kmm) field 
     358      ts(:,:,:,jp_tem,Kmm) = ts(:,:,:,jp_tem,Kmm) * tmask(:,:,:) 
     359      ts(:,:,:,jp_sal,Kmm) = ts(:,:,:,jp_sal,Kmm) * tmask(:,:,:) 
    357360 
    358361      ! compute new T/S (interpolation) if vvl only for common wet cell in before and after wmask 
    … …  
    365368                  &      (tmask(ji,jj,1)==0._wp .OR. ptmask_b(ji,jj,1)==0._wp) ) THEN 
    366369                     !compute weight 
    367                      zdzp1 = MAX(0._wp,gdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk+1)) 
    368                      zdz   =           gdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk  )  
    369                      zdzm1 = MAX(0._wp,pdepw_b(ji,jj,jk  ) - gdepw_n(ji,jj,jk  )) 
     370                     zdzp1 = MAX(0._wp,gdepw(ji,jj,jk+1,Kmm) - pdepw_b(ji,jj,jk+1)) 
     371                     zdz   =           gdepw(ji,jj,jk+1,Kmm) - pdepw_b(ji,jj,jk  )  
     372                     zdzm1 = MAX(0._wp,pdepw_b(ji,jj,jk  ) - gdepw(ji,jj,jk  ,Kmm)) 
    370373                     IF (zdz .LT. 0._wp) THEN  
    371374                        CALL ctl_stop( 'STOP', 'rst_iscpl : unable to compute the interpolation' ) 
    372375                     END IF 
    373                      tsn(ji,jj,jk,jp_tem) = ( zdzp1*tsb(ji,jj,jk+1,jp_tem)      & 
    374                         &                   + zdz  *tsb(ji,jj,jk  ,jp_tem)      & 
    375                         &                   + zdzm1*tsb(ji,jj,jk-1,jp_tem)      )/e3t_n(ji,jj,jk) 
    376                      tsn(ji,jj,jk,jp_sal) = ( zdzp1*tsb(ji,jj,jk+1,jp_sal)      & 
    377                         &                   + zdz  *tsb(ji,jj,jk  ,jp_sal)      & 
    378                         &                   + zdzm1*tsb(ji,jj,jk-1,jp_sal)      )/e3t_n(ji,jj,jk) 
     376                     ts(ji,jj,jk,jp_tem,Kmm) = ( zdzp1*ts(ji,jj,jk+1,jp_tem,Kbb)      & 
     377                        &                   + zdz  *ts(ji,jj,jk  ,jp_tem,Kbb)      & 
     378                        &                   + zdzm1*ts(ji,jj,jk-1,jp_tem,Kbb)      )/e3t(ji,jj,jk,Kmm) 
     379                     ts(ji,jj,jk,jp_sal,Kmm) = ( zdzp1*ts(ji,jj,jk+1,jp_sal,Kbb)      & 
     380                        &                   + zdz  *ts(ji,jj,jk  ,jp_sal,Kbb)      & 
     381                        &                   + zdzm1*ts(ji,jj,jk-1,jp_sal,Kbb)      )/e3t(ji,jj,jk,Kmm) 
    379382                  END IF 
    380383               END DO 
    … …  
    386389      ! ----------------------------------------------------------------------------------------- 
    387390      ! case we open a cell but no neigbour cells available to get an estimate of T and S 
    388       WHERE (tmask(:,:,:) == 1._wp .AND. tsn(:,:,:,2) == 0._wp)  
    389          tsn(:,:,:,2) = -99._wp  ! Special value for closed pool (checking purpose in output.init) 
     391      WHERE (tmask(:,:,:) == 1._wp .AND. ts(:,:,:,2,Kmm) == 0._wp)  
     392         ts(:,:,:,2,Kmm) = -99._wp  ! Special value for closed pool (checking purpose in output.init) 
    390393         tmask(:,:,:) = 0._wp    ! set mask to 0 to run 
    391394         umask(:,:,:) = 0._wp 
Note: See TracChangeset for help on using the changeset viewer.