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 13337 – NEMO

Changeset 13337


Ignore:
Timestamp:
2020-07-24T16:01:24+02:00 (4 years ago)
Author:
jchanut
Message:

#2222, start suppressing key_vertical (add ln_vremap namelist flag)

Location:
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep
Files:
9 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/cfgs/SHARED/namelist_ref

    r13286 r13337  
    645645   ln_agrif_2way   = .true.  !  activate two way nesting 
    646646   ln_init_chfrpar = .false. !  initialize child grids from parent 
     647   ln_vremap       = .false. !  use vertical remapping 
     648   ln_chk_bathy    = .false. !  =T  check the parent bathymetry 
    647649   ln_spc_dyn      = .true.  !  use 0 as special value for dynamics 
    648650   rn_sponge_tra   = 0.002   !  coefficient for tracer   sponge layer [] 
     
    650652   rn_trelax_tra   = 0.01    !  inverse of relaxation time (in steps) for tracers [] 
    651653   rn_trelax_dyn   = 0.01    !  inverse of relaxation time (in steps) for dynamics [] 
    652    ln_chk_bathy    = .false. !  =T  check the parent bathymetry 
    653654/ 
    654655!----------------------------------------------------------------------- 
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_oce.F90

    r13334 r13337  
    2323   LOGICAL , PUBLIC ::   ln_spc_dyn    = .FALSE.   !: use zeros (.false.) or not (.true.) in 
    2424                                                   !: bdys dynamical fields interpolation 
    25    REAL(wp), PUBLIC ::   rn_sponge_tra = 2800.     !: sponge coeff. for tracers 
    26    REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.     !: sponge coeff. for dynamics 
     25   LOGICAL , PUBLIC ::   ln_vremap     = .FALSE.   !: use vertical remapping 
     26   REAL(wp), PUBLIC ::   rn_sponge_tra = 0.002     !: sponge coeff. for tracers 
     27   REAL(wp), PUBLIC ::   rn_sponge_dyn = 0.002     !: sponge coeff. for dynamics 
    2728   REAL(wp), PUBLIC ::   rn_trelax_tra = 0.01      !: time relaxation parameter for tracers 
    2829   REAL(wp), PUBLIC ::   rn_trelax_dyn = 0.01      !: time relaxation parameter for momentum 
     
    7677   REAL, PUBLIC :: sign_north 
    7778   LOGICAL, PUBLIC :: l_ini_child = .FALSE. 
    78 # if defined key_vertical 
    79    LOGICAL, PUBLIC :: l_vremap    = .TRUE. 
    80 # else 
    8179   LOGICAL, PUBLIC :: l_vremap    = .FALSE. 
    82 # endif 
    8380!$AGRIF_END_DO_NOT_TREAT 
    8481    
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_oce_interp.F90

    r13334 r13337  
    4747   PUBLIC   interpht0, interpmbkt 
    4848   PUBLIC   agrif_istate_oce, agrif_istate_ssh   ! called by icestate.F90 and domvvl.F90 
     49   PUBLIC   agrif_check_bat 
    4950 
    5051   INTEGER ::   bdy_tinterp = 0 
     
    7778         & CALL ctl_stop('AGRIF hot start should be desactivated in restarting mode') 
    7879 
    79       IF ( .NOT.Agrif_Parent(ln_1st_euler) ) &  
     80      IF ( .NOT.Agrif_Parent(l_1st_euler) ) &  
    8081         & CALL ctl_stop('AGRIF hot start requires to force Euler first step on parent') 
    8182 
     
    120121   END SUBROUTINE Agrif_istate_oce 
    121122 
     123 
    122124   SUBROUTINE Agrif_istate_ssh( Kbb, Kmm ) 
    123125      !!---------------------------------------------------------------------- 
     
    139141         & CALL ctl_stop('AGRIF hot start should be desactivated in restarting mode') 
    140142 
    141       IF ( .NOT.Agrif_Parent(ln_1st_euler) ) &  
     143      IF ( .NOT.Agrif_Parent(l_1st_euler) ) &  
    142144         & CALL ctl_stop('AGRIF hot start requires to force Euler first step on parent') 
    143145 
    144146      Kmm_a = Kmm 
    145147      ssh(:,:,Kmm) = 0._wp 
    146       l_ini_child = .TRUE. 
     148 
    147149      Agrif_SpecialValue    = 0._wp 
    148150      Agrif_UseSpecialValue = .TRUE. 
     151      l_ini_child           = .TRUE. 
     152      ! 
    149153      CALL Agrif_Init_Variable(sshini_id, procname=interpsshn) 
     154      ! 
    150155      Agrif_UseSpecialValue = .FALSE. 
    151       l_ini_child = .FALSE. 
     156      l_ini_child           = .FALSE. 
    152157      CALL lbc_lnk( 'dom_vvl_rst', ssh(:,:,Kmm), 'T', 1._wp ) 
    153158 
     
    164169      Agrif_SpecialValue    = 0._wp 
    165170      Agrif_UseSpecialValue = .TRUE. 
     171      l_vremap           = ln_vremap 
    166172      ! 
    167173      CALL Agrif_Bc_variable( tsn_id, procname=interptsn ) 
    168174      ! 
    169175      Agrif_UseSpecialValue = .FALSE. 
     176      l_vremap              = .FALSE. 
    170177      ! 
    171178   END SUBROUTINE Agrif_tra 
     
    187194      Agrif_SpecialValue    = 0.0_wp 
    188195      Agrif_UseSpecialValue = ln_spc_dyn 
     196      l_vremap              = ln_vremap 
    189197      ! 
    190198      use_sign_north = .TRUE. 
     
    195203      ! 
    196204      Agrif_UseSpecialValue = .FALSE. 
     205      l_vremap              = .FALSE. 
    197206      ! 
    198207      ! --- West --- ! 
     
    776785      Agrif_SpecialValue    = 0.e0 
    777786      Agrif_UseSpecialValue = .TRUE. 
     787      l_vremap              = ln_vremap 
    778788      ! 
    779789      CALL Agrif_Bc_variable( avm_id, calledweight=zalpha, procname=interpavm )        
    780790      ! 
    781791      Agrif_UseSpecialValue = .FALSE. 
     792      l_vremap              = .FALSE. 
    782793      ! 
    783794   END SUBROUTINE Agrif_avm 
     
    859870               DO ji=i1,i2 
    860871                  ts(ji,jj,:,:,Krhs_a) = 0.                   
    861                !   IF( l_ini_child) ts(ji,jj,:,:,Krhs_a) = ptab(ji,jj,:,1:jpts) 
    862872                  N_in = mbkt_parent(ji,jj) 
    863873                  zhtot = 0._wp 
     
    13741384                     WRITE(numout,*) ' Agrif error for e3t_0: parent , child, i, j, k ',  &  
    13751385                     &                 ptab(ji,jj,jk), tmask(ji,jj,jk) * e3t_0(ji,jj,jk), & 
    1376                      &                 mig0(ji), mig0(jj), jk 
     1386                     &                 mig0(ji), mjg0(jj), jk 
    13771387                !     kindic_agr = kindic_agr + 1 
    13781388                  ENDIF 
     
    15301540   SUBROUTINE interpmbkt( ptab, i1, i2, j1, j2, before ) 
    15311541      !!---------------------------------------------------------------------- 
    1532       !!                  ***  ROUTINE interpsshn  *** 
     1542      !!                  ***  ROUTINE interpmbkt  *** 
    15331543      !!----------------------------------------------------------------------   
    15341544      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     
    15491559   SUBROUTINE interpht0( ptab, i1, i2, j1, j2, before ) 
    15501560      !!---------------------------------------------------------------------- 
    1551       !!                  ***  ROUTINE interpsshn  *** 
     1561      !!                  ***  ROUTINE interpht0  *** 
    15521562      !!----------------------------------------------------------------------   
    15531563      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     
    15641574      ! 
    15651575   END SUBROUTINE interpht0 
     1576 
     1577   SUBROUTINE Agrif_check_bat( iindic ) 
     1578      !!---------------------------------------------------------------------- 
     1579      !!                  ***  ROUTINE Agrif_check_bat  *** 
     1580      !!----------------------------------------------------------------------   
     1581      INTEGER, INTENT(inout) ::   iindic 
     1582      !! 
     1583      INTEGER :: ji, jj 
     1584      INTEGER  :: istart, iend, jstart, jend, ispon 
     1585      !!----------------------------------------------------------------------   
     1586      ! 
     1587      ! 
     1588      ! --- West --- ! 
     1589      IF(lk_west) THEN 
     1590         ispon  = nn_sponge_len * Agrif_irhox() + 1 
     1591         istart = nn_hls + 2                                 ! halo + land + 1 
     1592         iend   = nn_hls + 1 + nbghostcells + ispon          ! halo + land + nbghostcells + sponge 
     1593         jstart = nn_hls + 2 
     1594         jend   = jpjglo - nn_hls - 1 
     1595         DO ji = mi0(istart), mi1(iend) 
     1596            DO jj = mj0(jstart), mj1(jend) 
     1597               IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1598            END DO 
     1599            DO jj = mj0(jstart), mj1(jend-1) 
     1600               IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1601            END DO 
     1602         END DO 
     1603         DO ji = mi0(istart), mi1(iend-1) 
     1604            DO jj = mj0(jstart), mj1(jend) 
     1605               IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1606            END DO 
     1607         END DO 
     1608      ENDIF 
     1609      ! 
     1610      ! --- East --- ! 
     1611      IF(lk_east) THEN 
     1612         ispon  = nn_sponge_len * Agrif_irhox() + 1 
     1613         istart = jpiglo - ( nn_hls + nbghostcells + ispon ) ! halo + land + nbghostcells + sponge - 1 
     1614         iend   = jpiglo - ( nn_hls + 1 )                    ! halo + land + 1                     - 1 
     1615         jstart = nn_hls + 2 
     1616         jend   = jpjglo - nn_hls - 1 
     1617         DO ji = mi0(istart), mi1(iend) 
     1618            DO jj = mj0(jstart), mj1(jend) 
     1619               IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1620            END DO 
     1621            DO jj = mj0(jstart), mj1(jend-1) 
     1622               IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1623            END DO 
     1624         END DO 
     1625         DO ji = mi0(istart), mi1(iend-1) 
     1626            DO jj = mj0(jstart), mj1(jend) 
     1627               IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1628            END DO 
     1629         END DO 
     1630      ENDIF 
     1631      ! 
     1632      ! --- South --- ! 
     1633      IF(lk_south) THEN 
     1634         ispon  = nn_sponge_len * Agrif_irhoy() + 1  
     1635         jstart = nn_hls + 2                                 ! halo + land + 1 
     1636         jend   = nn_hls + 1 + nbghostcells + ispon          ! halo + land + nbghostcells + sponge 
     1637         istart = nn_hls + 2 
     1638         iend   = jpiglo - nn_hls - 1 
     1639         DO jj = mj0(jstart), mj1(jend) 
     1640            DO ji = mi0(istart), mi1(iend) 
     1641               IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1642            END DO 
     1643            DO ji = mi0(istart), mi1(iend-1) 
     1644               IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1645            END DO 
     1646         END DO 
     1647         DO jj = mj0(jstart), mj1(jend-1) 
     1648            DO ji = mi0(istart), mi1(iend) 
     1649               IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1650            END DO 
     1651         END DO 
     1652      ENDIF 
     1653      ! 
     1654      ! --- North --- ! 
     1655      IF(lk_north) THEN 
     1656         ispon  = nn_sponge_len * Agrif_irhoy() + 1  
     1657         jstart = jpjglo - ( nn_hls + nbghostcells + ispon)  ! halo + land + nbghostcells +sponge - 1 
     1658         jend   = jpjglo - ( nn_hls + 1 )                    ! halo + land + 1            - 1 
     1659         istart = nn_hls + 2 
     1660         iend   = jpiglo - nn_hls - 1 
     1661         DO jj = mj0(jstart), mj1(jend) 
     1662            DO ji = mi0(istart), mi1(iend) 
     1663               IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1664            END DO 
     1665            DO ji = mi0(istart), mi1(iend-1) 
     1666               IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1667            END DO 
     1668         END DO 
     1669         DO jj = mj0(jstart), mj1(jend-1) 
     1670            DO ji = mi0(istart), mi1(iend) 
     1671               IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 
     1672            END DO 
     1673         END DO 
     1674      ENDIF 
     1675      ! 
     1676   END SUBROUTINE Agrif_check_bat 
    15661677    
    15671678#else 
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_oce_sponge.F90

    r13312 r13337  
    5555      Agrif_SpecialValue    = 0._wp 
    5656      Agrif_UseSpecialValue = .TRUE. 
     57      l_vremap              = ln_vremap 
    5758      tabspongedone_tsn     = .FALSE. 
    5859      ! 
     
    6061      ! 
    6162      Agrif_UseSpecialValue = .FALSE. 
     63      l_vremap              = .FALSE. 
    6264#endif 
    6365      ! 
     
    8082      Agrif_SpecialValue    = 0._wp 
    8183      Agrif_UseSpecialValue = ln_spc_dyn 
     84      l_vremap              = ln_vremap 
    8285      use_sign_north        = .TRUE. 
    8386      sign_north            = -1._wp 
     
    9396      Agrif_UseSpecialValue = .FALSE. 
    9497      use_sign_north        = .FALSE. 
     98      l_vremap              = .FALSE. 
    9599#endif 
    96100      ! 
     
    109113      REAL(wp) ::   z1_ispongearea, z1_jspongearea 
    110114      REAL(wp), DIMENSION(jpi,jpj) :: ztabramp 
    111 #if defined key_vertical 
    112115      REAL(wp), DIMENSION(jpi,jpj) :: ztabrampu 
    113116      REAL(wp), DIMENSION(jpi,jpj) :: ztabrampv 
    114 #endif 
    115       REAL(wp), DIMENSION(jpjmax)  :: zmskwest,  zmskeast 
    116       REAL(wp), DIMENSION(jpimax)  :: zmsknorth, zmsksouth 
    117117      !!---------------------------------------------------------------------- 
    118118      ! 
     
    130130#if defined SPONGE || defined SPONGE_TOP 
    131131      IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN 
    132          ! 
    133          ! Retrieve masks at open boundaries: 
    134  
    135          IF( lk_west ) THEN                             ! --- West --- ! 
    136             ztabramp(:,:) = 0._wp 
    137             ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    138             DO ji = mi0(ind1), mi1(ind1)                 
    139                ztabramp(ji,:) = ssumask(ji,:) 
    140             END DO 
    141             zmskwest(    1:jpj   ) = MAXVAL(ztabramp(:,:), dim=1) 
    142             zmskwest(jpj+1:jpjmax) = 0._wp 
    143          ENDIF 
    144          IF( lk_east ) THEN                             ! --- East --- ! 
    145             ztabramp(:,:) = 0._wp 
    146             ind1 = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    147             DO ji = mi0(ind1), mi1(ind1)                  
    148                ztabramp(ji,:) = ssumask(ji,:) 
    149             END DO 
    150             zmskeast(    1:jpj   ) = MAXVAL(ztabramp(:,:), dim=1) 
    151             zmskeast(jpj+1:jpjmax) = 0._wp 
    152          ENDIF 
    153          IF( lk_south ) THEN                            ! --- South --- ! 
    154             ztabramp(:,:) = 0._wp 
    155             ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    156             DO jj = mj0(ind1), mj1(ind1)                  
    157                ztabramp(:,jj) = ssvmask(:,jj) 
    158             END DO 
    159             zmsksouth(    1:jpi   ) = MAXVAL(ztabramp(:,:), dim=2) 
    160             zmsksouth(jpi+1:jpimax) = 0._wp 
    161          ENDIF 
    162          IF( lk_north ) THEN                            ! --- North --- ! 
    163             ztabramp(:,:) = 0._wp 
    164             ind1 = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    165             DO jj = mj0(ind1), mj1(ind1)                  
    166                ztabramp(:,jj) = ssvmask(:,jj) 
    167             END DO 
    168             zmsknorth(    1:jpi   ) = MAXVAL(ztabramp(:,:), dim=2) 
    169             zmsknorth(jpi+1:jpimax) = 0._wp 
    170          ENDIF 
    171  
    172          ! JC: SPONGE MASKING TO BE SORTED OUT: 
    173          zmskwest(:)  = 1._wp 
    174          zmskeast(:)  = 1._wp 
    175          zmsksouth(:) = 1._wp 
    176          zmsknorth(:) = 1._wp 
    177 #if defined key_mpp_mpi 
    178 !         CALL mpp_max( 'AGRIF_sponge', zmskwest(:) , jpjmax ) 
    179 !         CALL mpp_max( 'AGRIF_Sponge', zmskeast(:) , jpjmax ) 
    180 !         CALL mpp_max( 'AGRIF_Sponge', zmsksouth(:), jpimax ) 
    181 !         CALL mpp_max( 'AGRIF_Sponge', zmsknorth(:), jpimax ) 
    182 #endif 
    183  
    184132         ! Define ramp from boundaries towards domain interior at T-points 
    185133         ! Store it in ztabramp 
     
    201149            DO ji = mi0(ind1), mi1(ind2)    
    202150               DO jj = 1, jpj                
    203                   ztabramp(ji,jj) =                       REAL(ind2 - mig(ji), wp) * z1_ispongearea   * zmskwest(jj) 
     151                  ztabramp(ji,jj) =                       REAL(ind2 - mig(ji), wp) * z1_ispongearea 
    204152               END DO 
    205153            END DO 
     
    209157            DO ji = mi0(ind1), mi1(ind2)    
    210158               DO jj = 1, jpj                
    211                   ztabramp(ji,jj) = zmskwest(jj) 
     159                  ztabramp(ji,jj) = 1._wp 
    212160               END DO 
    213161            END DO 
     
    218166            DO ji = mi0(ind1), mi1(ind2) 
    219167               DO jj = 1, jpj 
    220                   ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea ) * zmskeast(jj) 
     168                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea )  
    221169               END DO 
    222170            END DO 
     
    226174            DO ji = mi0(ind1), mi1(ind2) 
    227175               DO jj = 1, jpj 
    228                   ztabramp(ji,jj) = zmskeast(jj) 
     176                  ztabramp(ji,jj) = 1._wp 
    229177               END DO 
    230178            END DO 
     
    235183            DO jj = mj0(ind1), mj1(ind2)  
    236184               DO ji = 1, jpi 
    237                   ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea ) * zmsksouth(ji) 
     185                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea ) 
    238186               END DO 
    239187            END DO 
     
    243191            DO jj = mj0(ind1), mj1(ind2)  
    244192               DO ji = 1, jpi 
    245                   ztabramp(ji,jj) = zmsksouth(ji) 
     193                  ztabramp(ji,jj) = 1._wp 
    246194               END DO 
    247195            END DO 
     
    252200            DO jj = mj0(ind1), mj1(ind2) 
    253201               DO ji = 1, jpi 
    254                   ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea ) * zmsknorth(ji) 
     202                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea )  
    255203               END DO 
    256204            END DO 
     
    260208            DO jj = mj0(ind1), mj1(ind2) 
    261209               DO ji = 1, jpi 
    262                   ztabramp(ji,jj) = zmsknorth(ji) 
     210                  ztabramp(ji,jj) = 1._wp 
    263211               END DO 
    264212            END DO 
     
    303251      ENDIF 
    304252 
    305 #if defined key_vertical 
    306253      ! Remove vertical interpolation where not needed: 
    307254      DO_2D( 0, 0, 0, 0 ) 
     
    327274      mbku_parent(:,:) = NINT( ztabrampu(:,:) ) 
    328275      mbkv_parent(:,:) = NINT( ztabrampv(:,:) ) 
    329 #endif 
    330276      ! 
    331277#endif 
     
    366312         END DO 
    367313 
    368 # if defined key_vertical 
    369         ! Interpolate thicknesses 
    370         ! Warning: these are masked, hence extrapolated prior interpolation. 
    371         DO jk=k1,k2 
    372            DO jj=j1,j2 
    373               DO ji=i1,i2 
    374                   tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kbb_a) 
     314        IF ( l_vremap ) THEN 
     315 
     316           ! Interpolate thicknesses 
     317           ! Warning: these are masked, hence extrapolated prior interpolation. 
     318           DO jk=k1,k2 
     319              DO jj=j1,j2 
     320                 DO ji=i1,i2 
     321                   tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kbb_a) 
     322                 END DO 
    375323              END DO 
    376324           END DO 
    377         END DO 
    378  
    379         ! Extrapolate thicknesses in partial bottom cells: 
    380         ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
    381         IF (ln_zps) THEN 
    382            DO jj=j1,j2 
    383               DO ji=i1,i2 
    384                   jk = mbkt(ji,jj) 
    385                   tabres(ji,jj,jk,jpts+1) = 0._wp 
    386               END DO 
    387            END DO            
     325 
     326           ! Extrapolate thicknesses in partial bottom cells: 
     327           ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
     328           IF (ln_zps) THEN 
     329              DO jj=j1,j2 
     330                 DO ji=i1,i2 
     331                    jk = mbkt(ji,jj) 
     332                    tabres(ji,jj,jk,jpts+1) = 0._wp 
     333                 END DO 
     334              END DO            
     335           END IF 
     336      
     337           ! Save ssh at last level: 
     338           IF (.NOT.ln_linssh) THEN 
     339              tabres(i1:i2,j1:j2,k2,jpts+1) = ssh(i1:i2,j1:j2,Kbb_a)*tmask(i1:i2,j1:j2,1)  
     340           ELSE 
     341              tabres(i1:i2,j1:j2,k2,jpts+1) = 0._wp 
     342           END IF       
    388343        END IF 
    389       
    390         ! Save ssh at last level: 
    391         IF (.NOT.ln_linssh) THEN 
    392            tabres(i1:i2,j1:j2,k2,jpts+1) = ssh(i1:i2,j1:j2,Kbb_a)*tmask(i1:i2,j1:j2,1)  
    393         ELSE 
    394            tabres(i1:i2,j1:j2,k2,jpts+1) = 0._wp 
    395         END IF       
    396 # endif 
    397344 
    398345      ELSE    
    399346         ! 
    400 # if defined key_vertical 
    401  
    402          IF (ln_linssh) tabres(i1:i2,j1:j2,k2,n2) = 0._wp 
    403  
    404          DO jj=j1,j2 
    405             DO ji=i1,i2 
    406                tabres_child(ji,jj,:,:) = 0._wp  
    407                N_in = mbkt_parent(ji,jj) 
    408                zhtot = 0._wp 
    409                DO jk=1,N_in !k2 = jpk of parent grid 
    410                   IF (jk==N_in) THEN 
    411                      h_in(jk) = ht0_parent(ji,jj) + tabres(ji,jj,k2,n2) - zhtot 
     347         IF ( l_vremap ) THEN 
     348 
     349            IF (ln_linssh) tabres(i1:i2,j1:j2,k2,n2) = 0._wp 
     350 
     351            DO jj=j1,j2 
     352               DO ji=i1,i2 
     353                  tabres_child(ji,jj,:,:) = 0._wp  
     354                  N_in = mbkt_parent(ji,jj) 
     355                  zhtot = 0._wp 
     356                  DO jk=1,N_in !k2 = jpk of parent grid 
     357                     IF (jk==N_in) THEN 
     358                        h_in(jk) = ht0_parent(ji,jj) + tabres(ji,jj,k2,n2) - zhtot 
     359                     ELSE 
     360                        h_in(jk) = tabres(ji,jj,jk,n2) 
     361                     END IF 
     362                     zhtot = zhtot + h_in(jk) 
     363                     tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1) 
     364                  END DO 
     365                  N_out = 0 
     366                  DO jk=1,jpk ! jpk of child grid 
     367                     IF (tmask(ji,jj,jk) == 0) EXIT  
     368                     N_out = N_out + 1 
     369                     h_out(jk) = e3t(ji,jj,jk,Kbb_a) !Child grid scale factors. Could multiply by e1e2t here instead of division above 
     370                  END DO 
     371 
     372                  ! Account for small differences in the free-surface 
     373                  IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 
     374                     h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 
    412375                  ELSE 
    413                      h_in(jk) = tabres(ji,jj,jk,n2) 
     376                     h_in(1)   = h_in(1)   - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 
     377                  END IF 
     378                  IF (N_in*N_out > 0) THEN 
     379                     CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts) 
    414380                  ENDIF 
    415                   zhtot = zhtot + h_in(jk) 
    416                   tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1) 
    417                END DO 
    418                N_out = 0 
    419                DO jk=1,jpk ! jpk of child grid 
    420                   IF (tmask(ji,jj,jk) == 0) EXIT  
    421                   N_out = N_out + 1 
    422                   h_out(jk) = e3t(ji,jj,jk,Kbb_a) !Child grid scale factors. Could multiply by e1e2t here instead of division above 
    423                END DO 
    424  
    425                ! Account for small differences in free-surface 
    426                IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 
    427                   h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 
    428                ELSE 
    429                   h_in(1)   = h_in(1)   - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 
    430                ENDIF 
    431                IF (N_in*N_out > 0) THEN 
    432                   CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts) 
    433                ENDIF 
    434             END DO 
    435          END DO 
    436 # endif 
    437  
    438          DO jj=j1,j2 
    439             DO ji=i1,i2 
    440                DO jk=1,jpkm1 
    441 # if defined key_vertical 
    442                   tsbdiff(ji,jj,jk,1:jpts) = (ts(ji,jj,jk,1:jpts,Kbb_a) - tabres_child(ji,jj,jk,1:jpts)) * tmask(ji,jj,jk) 
    443 # else 
    444                   tsbdiff(ji,jj,jk,1:jpts) = (ts(ji,jj,jk,1:jpts,Kbb_a) - tabres(ji,jj,jk,1:jpts))*tmask(ji,jj,jk) 
    445 # endif 
    446                END DO 
    447             END DO 
    448          END DO 
     381               END DO 
     382            END DO 
     383 
     384            DO jj=j1,j2 
     385               DO ji=i1,i2 
     386                  DO jk=1,jpkm1 
     387                     tsbdiff(ji,jj,jk,1:jpts) = (ts(ji,jj,jk,1:jpts,Kbb_a) - tabres_child(ji,jj,jk,1:jpts)) * tmask(ji,jj,jk) 
     388                  END DO 
     389               END DO 
     390            END DO 
     391 
     392         ELSE 
     393 
     394            DO jj=j1,j2 
     395               DO ji=i1,i2 
     396                  DO jk=1,jpkm1 
     397                     tsbdiff(ji,jj,jk,1:jpts) = (ts(ji,jj,jk,1:jpts,Kbb_a) - tabres(ji,jj,jk,1:jpts))*tmask(ji,jj,jk) 
     398                  END DO 
     399               END DO 
     400            END DO 
     401         END IF 
    449402 
    450403         DO jn = 1, jpts             
     
    528481               DO ji=i1,i2 
    529482                  tabres(ji,jj,jk,m1) = uu(ji,jj,jk,Kbb_a) 
    530 # if defined key_vertical 
    531                   tabres(ji,jj,jk,m2) = e3u(ji,jj,jk,Kbb_a)*umask(ji,jj,jk) 
    532 # endif 
    533                END DO 
    534             END DO 
    535          END DO 
    536  
    537 # if defined key_vertical 
    538          ! Extrapolate thicknesses in partial bottom cells: 
    539          ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
    540          IF (ln_zps) THEN 
     483               END DO 
     484            END DO 
     485         END DO 
     486 
     487         IF ( l_vremap ) THEN 
     488 
     489            DO jk=k1,k2 
     490               DO jj=j1,j2 
     491                  DO ji=i1,i2 
     492                     tabres(ji,jj,jk,m2) = e3u(ji,jj,jk,Kbb_a)*umask(ji,jj,jk) 
     493                  END DO 
     494               END DO 
     495            END DO 
     496 
     497            ! Extrapolate thicknesses in partial bottom cells: 
     498            ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
     499            IF (ln_zps) THEN 
     500               DO jj=j1,j2 
     501                  DO ji=i1,i2 
     502                     jk = mbku(ji,jj) 
     503                     tabres(ji,jj,jk,m2) = 0._wp 
     504                  END DO 
     505               END DO            
     506            END IF 
     507            ! Save ssh at last level: 
     508            tabres(i1:i2,j1:j2,k2,m2) = 0._wp 
     509            IF (.NOT.ln_linssh) THEN 
     510               ! This vertical sum below should be replaced by the sea-level at U-points (optimization): 
     511               DO jk=1,jpk 
     512                  tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) + e3u(i1:i2,j1:j2,jk,Kbb_a) * umask(i1:i2,j1:j2,jk) 
     513               END DO 
     514               tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) - hu_0(i1:i2,j1:j2) 
     515            END IF  
     516         END IF 
     517 
     518      ELSE 
     519 
     520         IF ( l_vremap ) THEN 
     521 
     522            IF (ln_linssh) tabres(i1:i2,j1:j2,k2,m2) = 0._wp 
     523 
    541524            DO jj=j1,j2 
    542525               DO ji=i1,i2 
    543                   jk = mbku(ji,jj) 
    544                   tabres(ji,jj,jk,m2) = 0._wp 
    545                END DO 
    546             END DO            
    547          END IF 
    548         ! Save ssh at last level: 
    549         tabres(i1:i2,j1:j2,k2,m2) = 0._wp 
    550         IF (.NOT.ln_linssh) THEN 
    551            ! This vertical sum below should be replaced by the sea-level at U-points (optimization): 
    552            DO jk=1,jpk 
    553               tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) + e3u(i1:i2,j1:j2,jk,Kbb_a) * umask(i1:i2,j1:j2,jk) 
    554            END DO 
    555            tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) - hu_0(i1:i2,j1:j2) 
    556         END IF  
    557 # endif 
    558  
    559       ELSE 
    560  
    561 # if defined key_vertical 
    562          IF (ln_linssh) tabres(i1:i2,j1:j2,k2,m2) = 0._wp 
    563  
    564          DO jj=j1,j2 
    565             DO ji=i1,i2 
    566                tabres_child(ji,jj,:) = 0._wp 
    567                N_in = mbku_parent(ji,jj) 
    568                zhtot = 0._wp 
    569                DO jk=1,N_in 
    570                   IF (jk==N_in) THEN 
    571                      h_in(jk) = hu0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 
     526                  tabres_child(ji,jj,:) = 0._wp 
     527                  N_in = mbku_parent(ji,jj) 
     528                  zhtot = 0._wp 
     529                  DO jk=1,N_in 
     530                     IF (jk==N_in) THEN 
     531                        h_in(jk) = hu0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 
     532                     ELSE 
     533                        h_in(jk) = tabres(ji,jj,jk,m2) 
     534                     ENDIF 
     535                     zhtot = zhtot + h_in(jk) 
     536                     tabin(jk) = tabres(ji,jj,jk,m1) 
     537                  END DO 
     538                  !          
     539                  N_out = 0 
     540                  DO jk=1,jpk 
     541                     IF (umask(ji,jj,jk) == 0) EXIT 
     542                     N_out = N_out + 1 
     543                     h_out(N_out) = e3u(ji,jj,jk,Kbb_a) 
     544                  END DO 
     545 
     546                  ! Account for small differences in free-surface 
     547                  IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 
     548                     h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 
    572549                  ELSE 
    573                      h_in(jk) = tabres(ji,jj,jk,m2) 
     550                     h_in(1)   = h_in(1)   - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 
    574551                  ENDIF 
    575                   zhtot = zhtot + h_in(jk) 
    576                   tabin(jk) = tabres(ji,jj,jk,m1) 
    577                END DO 
    578                !          
    579                N_out = 0 
    580                DO jk=1,jpk 
    581                   IF (umask(ji,jj,jk) == 0) EXIT 
    582                   N_out = N_out + 1 
    583                   h_out(N_out) = e3u(ji,jj,jk,Kbb_a) 
    584                END DO 
    585  
    586                ! Account for small differences in free-surface 
    587                IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 
    588                   h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 
    589                ELSE 
    590                   h_in(1)   = h_in(1)   - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 
    591                ENDIF 
    592552                   
    593                IF (N_in * N_out > 0) THEN 
    594                   CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
    595                ENDIF  
    596             END DO 
    597          END DO 
    598  
    599          ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:) 
    600 #else 
    601          ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*umask(i1:i2,j1:j2,:) 
    602 #endif 
     553                  IF (N_in * N_out > 0) THEN 
     554                     CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
     555                  ENDIF  
     556               END DO 
     557            END DO 
     558 
     559            ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:) 
     560 
     561         ELSE 
     562 
     563            ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*umask(i1:i2,j1:j2,:) 
     564 
     565         ENDIF 
    603566         ! 
    604567         DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    705668               DO ji=i1,i2 
    706669                  tabres(ji,jj,jk,m1) = vv(ji,jj,jk,Kbb_a) 
    707 # if defined key_vertical 
    708                   tabres(ji,jj,jk,m2) = vmask(ji,jj,jk) * e3v(ji,jj,jk,Kbb_a) 
    709 # endif 
    710                END DO 
    711             END DO 
    712          END DO 
    713  
    714 # if defined key_vertical 
    715          ! Extrapolate thicknesses in partial bottom cells: 
    716          ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
    717          IF (ln_zps) THEN 
     670               END DO 
     671            END DO 
     672         END DO 
     673 
     674         IF ( l_vremap ) THEN 
     675 
     676            DO jk=k1,k2 
     677               DO jj=j1,j2 
     678                  DO ji=i1,i2 
     679                     tabres(ji,jj,jk,m2) = vmask(ji,jj,jk) * e3v(ji,jj,jk,Kbb_a) 
     680                  END DO 
     681               END DO 
     682            END DO 
     683            ! Extrapolate thicknesses in partial bottom cells: 
     684            ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
     685            IF (ln_zps) THEN 
     686               DO jj=j1,j2 
     687                  DO ji=i1,i2 
     688                     jk = mbkv(ji,jj) 
     689                     tabres(ji,jj,jk,m2) = 0._wp 
     690                  END DO 
     691               END DO            
     692            END IF 
     693            ! Save ssh at last level: 
     694            tabres(i1:i2,j1:j2,k2,m2) = 0._wp 
     695            IF (.NOT.ln_linssh) THEN 
     696               ! This vertical sum below should be replaced by the sea-level at V-points (optimization): 
     697               DO jk=1,jpk 
     698                  tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) + e3v(i1:i2,j1:j2,jk,Kbb_a) * vmask(i1:i2,j1:j2,jk) 
     699               END DO 
     700               tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) - hv_0(i1:i2,j1:j2) 
     701            END IF 
     702 
     703         END IF  
     704 
     705      ELSE 
     706 
     707         IF ( l_vremap ) THEN 
     708            IF (ln_linssh) tabres(i1:i2,j1:j2,k2,m2) = 0._wp 
    718709            DO jj=j1,j2 
    719710               DO ji=i1,i2 
    720                   jk = mbkv(ji,jj) 
    721                   tabres(ji,jj,jk,m2) = 0._wp 
    722                END DO 
    723             END DO            
    724          END IF 
    725         ! Save ssh at last level: 
    726         tabres(i1:i2,j1:j2,k2,m2) = 0._wp 
    727         IF (.NOT.ln_linssh) THEN 
    728            ! This vertical sum below should be replaced by the sea-level at V-points (optimization): 
    729            DO jk=1,jpk 
    730               tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) + e3v(i1:i2,j1:j2,jk,Kbb_a) * vmask(i1:i2,j1:j2,jk) 
    731            END DO 
    732            tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) - hv_0(i1:i2,j1:j2) 
    733         END IF  
    734 # endif 
    735  
    736       ELSE 
    737  
    738 # if defined key_vertical 
    739          IF (ln_linssh) tabres(i1:i2,j1:j2,k2,m2) = 0._wp 
    740          DO jj=j1,j2 
    741             DO ji=i1,i2 
    742                tabres_child(ji,jj,:) = 0._wp 
    743                N_in = mbkv_parent(ji,jj) 
    744                zhtot = 0._wp 
    745                DO jk=1,N_in 
    746                   IF (jk==N_in) THEN 
    747                      h_in(jk) = hv0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 
     711                  tabres_child(ji,jj,:) = 0._wp 
     712                  N_in = mbkv_parent(ji,jj) 
     713                  zhtot = 0._wp 
     714                  DO jk=1,N_in 
     715                     IF (jk==N_in) THEN 
     716                        h_in(jk) = hv0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 
     717                     ELSE 
     718                        h_in(jk) = tabres(ji,jj,jk,m2) 
     719                     ENDIF 
     720                     zhtot = zhtot + h_in(jk) 
     721                     tabin(jk) = tabres(ji,jj,jk,m1) 
     722                  END DO 
     723                  !           
     724                  N_out = 0 
     725                  DO jk=1,jpk 
     726                     IF (vmask(ji,jj,jk) == 0) EXIT 
     727                     N_out = N_out + 1 
     728                     h_out(N_out) = e3v(ji,jj,jk,Kbb_a) 
     729                  END DO 
     730 
     731                  ! Account for small differences in free-surface 
     732                  IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 
     733                     h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 
    748734                  ELSE 
    749                      h_in(jk) = tabres(ji,jj,jk,m2) 
     735                     h_in(1)   = h_in(1) - (  sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 
    750736                  ENDIF 
    751                   zhtot = zhtot + h_in(jk) 
    752                   tabin(jk) = tabres(ji,jj,jk,m1) 
    753                END DO 
    754                !           
    755                N_out = 0 
    756                DO jk=1,jpk 
    757                   IF (vmask(ji,jj,jk) == 0) EXIT 
    758                   N_out = N_out + 1 
    759                   h_out(N_out) = e3v(ji,jj,jk,Kbb_a) 
    760                END DO 
    761  
    762                ! Account for small differences in free-surface 
    763                IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 
    764                   h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 
    765                ELSE 
    766                   h_in(1)   = h_in(1) - (  sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 
    767                ENDIF 
    768737          
    769                IF (N_in * N_out > 0) THEN 
    770                   CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
    771                ENDIF 
    772             END DO 
    773          END DO 
    774  
    775          vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:)   
    776 # else 
    777          vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*vmask(i1:i2,j1:j2,:) 
    778 # endif 
     738                  IF (N_in * N_out > 0) THEN 
     739                     CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
     740                  ENDIF 
     741               END DO 
     742            END DO 
     743 
     744            vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:)   
     745 
     746         ELSE 
     747 
     748            vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*vmask(i1:i2,j1:j2,:) 
     749 
     750         ENDIF 
    779751         ! 
    780752         DO jk = 1, jpkm1                                 ! Horizontal slab 
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_oce_update.F90

    r13286 r13337  
    5050      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers  from grid Number',Agrif_Fixed() 
    5151 
    52 #if defined key_vertical 
    53 ! Effect of this has to be carrefully checked  
    54 ! depending on what the nesting tools ensure for 
    55 ! volume conservation: 
    56       Agrif_UseSpecialValueInUpdate = .FALSE. 
    57 #else 
    58       Agrif_UseSpecialValueInUpdate = .TRUE. 
    59 #endif 
     52      Agrif_UseSpecialValueInUpdate = .NOT.l_vremap 
    6053      Agrif_SpecialValueFineGrid    = 0._wp 
     54      l_vremap                      = ln_vremap 
    6155      !  
    6256# if ! defined DECAL_FEEDBACK 
     
    7165      ! 
    7266      Agrif_UseSpecialValueInUpdate = .FALSE. 
     67      l_vremap                      = .FALSE. 
    7368      ! 
    7469      ! 
     
    8681      Agrif_UseSpecialValueInUpdate = .FALSE. 
    8782      Agrif_SpecialValueFineGrid    = 0._wp 
    88  
    89       use_sign_north = .TRUE. 
    90       sign_north     = -1._wp 
     83      l_vremap                      = ln_vremap 
     84      use_sign_north                = .TRUE. 
     85      sign_north                    = -1._wp 
    9186 
    9287      !      
     
    133128      ! 
    134129      use_sign_north = .FALSE. 
     130      ln_vremap = .FALSE. 
    135131      ! 
    136132   END SUBROUTINE Agrif_Update_Dyn 
     
    291287   END SUBROUTINE dom_vvl_update_UVF 
    292288 
    293 #if defined key_vertical 
    294289 
    295290   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
     
    311306      ! 
    312307      IF (before) THEN 
    313 !jc_alt 
    314 !         AGRIF_SpecialValue = -999._wp 
    315          DO jn = n1,n2-1 
     308         IF ( l_vremap ) THEN 
     309            DO jn = n1,n2-1 
     310               DO jk=k1,k2 
     311                  DO jj=j1,j2 
     312                     DO ji=i1,i2 
     313                        tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) 
     314                     END DO 
     315                  END DO 
     316               END DO 
     317            END DO 
    316318            DO jk=k1,k2 
    317319               DO jj=j1,j2 
    318320                  DO ji=i1,i2 
    319 !jc_alt 
    320 !                     tabres(ji,jj,jk,jn) = (ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) ) & 
    321 !                                         &  * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1._wp) * 999._wp 
    322                      tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) 
     321                     tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) 
    323322                  END DO 
    324323               END DO 
    325324            END DO 
    326          END DO 
    327          DO jk=k1,k2 
     325         ELSE 
     326            DO jn = 1,jpts 
     327               DO jk=k1,k2 
     328                  DO jj=j1,j2 
     329                     DO ji=i1,i2 
     330                        tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a)  * e3t(ji,jj,jk,Kmm_a) / e3t_0(ji,jj,jk) 
     331                     END DO 
     332                  END DO 
     333               END DO 
     334            END DO 
     335 
     336         ENDIF 
     337      ELSE 
     338         IF ( l_vremap ) THEN 
     339            tabres_child(:,:,:,:) = 0._wp 
     340            AGRIF_SpecialValue = 0._wp 
    328341            DO jj=j1,j2 
    329342               DO ji=i1,i2 
    330 !jc_alt 
    331 !                  tabres(ji,jj,jk,n2) =      tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) & 
    332 !                                      &   + (tmask(ji,jj,jk) - 1._wp) * 999._wp 
    333                   tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) 
    334                END DO 
    335             END DO 
    336          END DO 
    337       ELSE 
    338          tabres_child(:,:,:,:) = 0._wp 
    339          AGRIF_SpecialValue = 0._wp 
    340          DO jj=j1,j2 
    341             DO ji=i1,i2 
    342                N_in = 0 
    343                DO jk=k1,k2 !k2 = jpk of child grid 
    344 ! jc_alt 
    345 !                  IF (tabres(ji,jj,jk,n2) < -900._wp  ) EXIT 
    346                   IF (tabres(ji,jj,jk,n2) == 0._wp  ) EXIT 
    347                   N_in = N_in + 1 
    348                   tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)/tabres(ji,jj,jk,n2) 
    349                   h_in(N_in) = tabres(ji,jj,jk,n2) 
     343                  N_in = 0 
     344                  DO jk=k1,k2 !k2 = jpk of child grid 
     345                     IF (tabres(ji,jj,jk,n2) == 0._wp  ) EXIT 
     346                     N_in = N_in + 1 
     347                     tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)/tabres(ji,jj,jk,n2) 
     348                     h_in(N_in) = tabres(ji,jj,jk,n2) 
     349                  ENDDO 
     350                  N_out = 0 
     351                  DO jk=1,jpk ! jpk of parent grid 
     352                     IF (tmask(ji,jj,jk) == 0 ) EXIT ! TODO: Will not work with ISF 
     353                     N_out = N_out + 1 
     354                     h_out(N_out) = e3t(ji,jj,jk,Kmm_a)  
     355                  ENDDO 
     356                  IF (N_in*N_out > 0) THEN !Remove this? 
     357                     CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts) 
     358                  ENDIF 
    350359               ENDDO 
    351                N_out = 0 
    352                DO jk=1,jpk ! jpk of parent grid 
    353                   IF (tmask(ji,jj,jk) == 0 ) EXIT ! TODO: Will not work with ISF 
    354                   N_out = N_out + 1 
    355                   h_out(N_out) = e3t(ji,jj,jk,Kmm_a)  
    356                ENDDO 
    357                IF (N_in*N_out > 0) THEN !Remove this? 
    358                   CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts) 
    359                ENDIF 
    360360            ENDDO 
    361          ENDDO 
    362  
    363          IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN 
    364             ! Add asselin part 
     361 
     362            IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN 
     363               ! Add asselin part 
     364               DO jn = 1,jpts 
     365                  DO jk = 1, jpkm1 
     366                     DO jj = j1, j2 
     367                        DO ji = i1, i2 
     368                           IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN 
     369                              ztb  = ts(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used 
     370                              ztnu = tabres_child(ji,jj,jk,jn) * e3t(ji,jj,jk,Kmm_a) 
     371                              ztno = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a) 
     372                              ts(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) )  &  
     373                                        &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a) 
     374                           ENDIF 
     375                        END DO 
     376                     END DO 
     377                  END DO 
     378               END DO 
     379            ENDIF 
    365380            DO jn = 1,jpts 
    366381               DO jk = 1, jpkm1 
    367382                  DO jj = j1, j2 
    368383                     DO ji = i1, i2 
    369                         IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN 
    370                            ztb  = ts(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used 
    371                            ztnu = tabres_child(ji,jj,jk,jn) * e3t(ji,jj,jk,Kmm_a) 
    372                            ztno = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a) 
    373                            ts(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) )  &  
    374                                      &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a) 
    375                         ENDIF 
     384                        IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN  
     385                           ts(ji,jj,jk,jn,Kmm_a) = tabres_child(ji,jj,jk,jn) 
     386                        END IF 
    376387                     END DO 
    377388                  END DO 
    378389               END DO 
    379390            END DO 
    380          ENDIF 
    381          DO jn = 1,jpts 
    382             DO jk = 1, jpkm1 
    383                DO jj = j1, j2 
    384                   DO ji = i1, i2 
    385                      IF( tabres_child(ji,jj,jk,jn) /= 0._wp ) THEN  
    386                         ts(ji,jj,jk,jn,Kmm_a) = tabres_child(ji,jj,jk,jn) 
    387                      END IF 
     391         ELSE 
     392            DO jn = 1,jpts 
     393               tabres(i1:i2,j1:j2,k1:k2,jn) =  tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) & 
     394                                            & * tmask(i1:i2,j1:j2,k1:k2) 
     395            ENDDO 
     396  
     397            IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN 
     398               ! Add asselin part 
     399               DO jn = 1,jpts 
     400                  DO jk = k1, k2 
     401                     DO jj = j1, j2 
     402                        DO ji = i1, i2 
     403                           IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN 
     404                              ztb  = ts(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used 
     405                              ztnu = tabres(ji,jj,jk,jn) 
     406                              ztno = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a) 
     407                              ts(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) )  &  
     408                                        &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a) 
     409                           ENDIF 
     410                        END DO 
     411                     END DO 
    388412                  END DO 
    389413               END DO 
    390             END DO 
    391          END DO 
    392          ! 
     414            ENDIF 
     415            DO jn = 1,jpts 
     416               DO jk=k1,k2 
     417                  DO jj=j1,j2 
     418                     DO ji=i1,i2 
     419                        IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN  
     420                           ts(ji,jj,jk,jn,Kmm_a) = tabres(ji,jj,jk,jn) / e3t(ji,jj,jk,Kmm_a) 
     421                        END IF 
     422                     END DO 
     423                  END DO 
     424               END DO 
     425            END DO 
     426            ! 
     427         ENDIF 
    393428         IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN 
    394429            ts(i1:i2,j1:j2,1:jpkm1,1:jpts,Kbb_a)  = ts(i1:i2,j1:j2,1:jpkm1,1:jpts,Kmm_a) 
     
    398433   END SUBROUTINE updateTS 
    399434 
    400 # else 
    401  
    402    SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    403       !!--------------------------------------------- 
    404       !!           *** ROUTINE updateT *** 
    405       !!--------------------------------------------- 
    406       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    407       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    408       LOGICAL, INTENT(in) :: before 
    409       !! 
    410       INTEGER :: ji,jj,jk,jn 
    411       REAL(wp) :: ztb, ztnu, ztno 
    412       !!--------------------------------------------- 
    413       ! 
    414       IF (before) THEN 
    415          DO jn = 1,jpts 
    416             DO jk=k1,k2 
    417                DO jj=j1,j2 
    418                   DO ji=i1,i2 
    419 !> jc tmp 
    420                      tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a)  * e3t(ji,jj,jk,Kmm_a) / e3t_0(ji,jj,jk) 
    421 !                     tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a)  * e3t(ji,jj,jk,Kmm_a) 
    422 !< jc tmp 
    423                   END DO 
    424                END DO 
    425             END DO 
    426          END DO 
    427       ELSE 
    428 !> jc tmp 
    429          DO jn = 1,jpts 
    430             tabres(i1:i2,j1:j2,k1:k2,jn) =  tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) & 
    431                                          & * tmask(i1:i2,j1:j2,k1:k2) 
    432          ENDDO 
    433 !< jc tmp 
    434          IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN 
    435             ! Add asselin part 
    436             DO jn = 1,jpts 
    437                DO jk = k1, k2 
    438                   DO jj = j1, j2 
    439                      DO ji = i1, i2 
    440                         IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN 
    441                            ztb  = ts(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used 
    442                            ztnu = tabres(ji,jj,jk,jn) 
    443                            ztno = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a) 
    444                            ts(ji,jj,jk,jn,Kbb_a) = ( ztb + rn_atfp * ( ztnu - ztno) )  &  
    445                                      &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a) 
    446                         ENDIF 
    447                      END DO 
    448                   END DO 
    449                END DO 
    450             END DO 
    451          ENDIF 
    452          DO jn = 1,jpts 
    453             DO jk=k1,k2 
    454                DO jj=j1,j2 
    455                   DO ji=i1,i2 
    456                      IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN  
    457                         ts(ji,jj,jk,jn,Kmm_a) = tabres(ji,jj,jk,jn) / e3t(ji,jj,jk,Kmm_a) 
    458                      END IF 
    459                   END DO 
    460                END DO 
    461             END DO 
    462          END DO 
    463          ! 
    464          IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN 
    465             ts(i1:i2,j1:j2,k1:k2,1:jpts,Kbb_a)  = ts(i1:i2,j1:j2,k1:k2,1:jpts,Kmm_a) 
    466          ENDIF 
    467          ! 
    468       ENDIF 
    469       !  
    470    END SUBROUTINE updateTS 
    471  
    472 # endif 
    473  
    474 # if defined key_vertical 
    475435 
    476436   SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
     
    496456      IF( before ) THEN 
    497457         zrhoy = Agrif_Rhoy() 
    498 !jc_alt 
    499 !         AGRIF_SpecialValue = -999._wp 
    500458         DO jk=k1,k2 
     459            tabres(i1:i2,j1:j2,jk,1) = zrhoy * e2u(i1:i2,j1:j2) * e3u(i1:i2,j1:j2,jk,Kmm_a) &  
     460                                     &   * umask(i1:i2,j1:j2,jk) * uu(i1:i2,j1:j2,jk,Kmm_a)   
     461         END DO 
     462 
     463         IF ( l_vremap ) THEN 
     464            DO jk=k1,k2 
     465               tabres(i1:i2,j1:j2,jk,2) = zrhoy * umask(i1:i2,j1:j2,jk) * e2u(i1:i2,j1:j2) * e3u(i1:i2,j1:j2,jk,Kmm_a) 
     466            END DO 
     467         ENDIF 
     468 
     469      ELSE 
     470 
     471         tabres_child(:,:,:) = 0._wp 
     472         AGRIF_SpecialValue = 0._wp 
     473 
     474         IF ( l_vremap ) THEN 
     475 
    501476            DO jj=j1,j2 
    502477               DO ji=i1,i2 
    503 !jc_alt 
    504 !                  tabres(ji,jj,jk,1) = zrhoy * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * umask(ji,jj,jk) * uu(ji,jj,jk,Kmm_a)  & 
    505 !                                     &  + (umask(ji,jj,jk)-1._wp)*999._wp 
    506                   tabres(ji,jj,jk,1) = zrhoy * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * umask(ji,jj,jk) * uu(ji,jj,jk,Kmm_a)   
    507 !jc_alt 
    508 !                  tabres(ji,jj,jk,2) = zrhoy * umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a)  & 
    509 !                                     &  + (umask(ji,jj,jk)-1._wp)*999._wp 
    510                   tabres(ji,jj,jk,2) = zrhoy * umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) 
    511                END DO 
    512             END DO 
    513          END DO 
    514       ELSE 
    515          tabres_child(:,:,:) = 0. 
    516          AGRIF_SpecialValue = 0._wp 
    517          DO jj=j1,j2 
    518             DO ji=i1,i2 
    519                N_in = 0 
    520                h_in(:) = 0._wp 
    521                tabin(:) = 0._wp 
    522                DO jk=k1,k2 !k2=jpk of child grid 
    523 !jc_alt 
    524 !                  IF( tabres(ji,jj,jk,2) < -900._wp) EXIT 
    525                   IF( tabres(ji,jj,jk,2) == 0.) EXIT 
    526                   N_in = N_in + 1 
    527                   tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2) 
    528                   h_in(N_in) = tabres(ji,jj,jk,2)/e2u(ji,jj) 
     478                  N_in = 0 
     479                  h_in(:) = 0._wp 
     480                  tabin(:) = 0._wp 
     481                  DO jk=k1,k2 !k2=jpk of child grid 
     482                     IF( tabres(ji,jj,jk,2) == 0.) EXIT 
     483                     N_in = N_in + 1 
     484                     tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2) 
     485                     h_in(N_in) = tabres(ji,jj,jk,2) * r1_e2u(ji,jj) 
     486                  ENDDO 
     487                  N_out = 0 
     488                  DO jk=1,jpk 
     489                     IF (umask(ji,jj,jk) == 0) EXIT 
     490                     N_out = N_out + 1 
     491                     h_out(N_out) = e3u(ji,jj,jk,Kmm_a) 
     492                  ENDDO 
     493                  IF (N_in * N_out > 0) THEN 
     494                     h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
     495                     excess = 0._wp 
     496                     IF (h_diff < -1.e-4) THEN 
     497                        DO jk=N_in,1,-1 
     498                           thick = MIN(-1*h_diff, h_in(jk)) 
     499                           excess = excess + tabin(jk)*thick*e2u(ji,jj) 
     500                           tabin(jk) = tabin(jk)*(1. - thick/h_in(jk)) 
     501                           h_diff = h_diff + thick 
     502                           IF ( h_diff == 0) THEN 
     503                              N_in = jk 
     504                              h_in(jk) = h_in(jk) - thick 
     505                              EXIT 
     506                           ENDIF 
     507                        ENDDO 
     508                     ENDIF 
     509                     CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
     510                     tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/(e2u(ji,jj)*h_out(N_out)) 
     511                  ENDIF 
    529512               ENDDO 
    530                N_out = 0 
    531                DO jk=1,jpk 
    532                   IF (umask(ji,jj,jk) == 0) EXIT 
    533                   N_out = N_out + 1 
    534                   h_out(N_out) = e3u(ji,jj,jk,Kmm_a) 
    535                ENDDO 
    536                IF (N_in * N_out > 0) THEN 
    537                   h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
    538                   excess = 0._wp 
    539                   IF (h_diff < -1.e-4) THEN 
    540 !Even if bathy at T points match it's possible for the U points to be deeper in the child grid.  
    541 !In this case we need to move transport from the child grid cells below bed of parent grid into the bottom cell. 
    542                      DO jk=N_in,1,-1 
    543                         thick = MIN(-1*h_diff, h_in(jk)) 
    544                         excess = excess + tabin(jk)*thick*e2u(ji,jj) 
    545                         tabin(jk) = tabin(jk)*(1. - thick/h_in(jk)) 
    546                         h_diff = h_diff + thick 
    547                         IF ( h_diff == 0) THEN 
    548                            N_in = jk 
    549                            h_in(jk) = h_in(jk) - thick 
    550                            EXIT 
    551                         ENDIF 
    552                      ENDDO 
    553                   ENDIF 
    554                   CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
    555                   tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/(e2u(ji,jj)*h_out(N_out)) 
    556                ENDIF 
    557513            ENDDO 
    558          ENDDO 
     514 
     515         ELSE 
     516            DO jk=1,jpk 
     517               DO jj=j1,j2 
     518                  DO ji=i1,i2 
     519                     tabres_child(ji,jj,jk) = tabres(ji,jj,jk,1) * r1_e2u(ji,jj) /  e3u(ji,jj,jk,Kmm_a) 
     520                  END DO 
     521               END DO 
     522            END DO 
     523         ENDIF 
    559524         ! 
    560525         DO jk=1,jpk 
     
    582547   END SUBROUTINE updateu 
    583548 
    584 #else 
    585  
    586    SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    587       !!--------------------------------------------- 
    588       !!           *** ROUTINE updateu *** 
    589       !!--------------------------------------------- 
    590       INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2 
    591       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    592       LOGICAL                                     , INTENT(in   ) :: before 
    593       ! 
    594       INTEGER  :: ji, jj, jk 
    595       REAL(wp) :: zrhoy, zub, zunu, zuno 
    596       !!--------------------------------------------- 
    597       !  
    598       IF( before ) THEN 
    599          zrhoy = Agrif_Rhoy() 
    600          DO jk = k1, k2 
    601             tabres(i1:i2,j1:j2,jk,1) = zrhoy * e2u(i1:i2,j1:j2) * e3u(i1:i2,j1:j2,jk,Kmm_a) * uu(i1:i2,j1:j2,jk,Kmm_a) 
    602          END DO 
    603       ELSE 
    604          DO jk=k1,k2 
    605             DO jj=j1,j2 
    606                DO ji=i1,i2 
    607                   tabres(ji,jj,jk,1) = tabres(ji,jj,jk,1) * r1_e2u(ji,jj)  
    608                   ! 
    609                   IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN ! Add asselin part 
    610                      zub  = uu(ji,jj,jk,Kbb_a) * e3u(ji,jj,jk,Kbb_a)  ! fse3t_b prior update should be used 
    611                      zuno = uu(ji,jj,jk,Kmm_a) * e3u(ji,jj,jk,Krhs_a) 
    612                      zunu = tabres(ji,jj,jk,1) 
    613                      uu(ji,jj,jk,Kbb_a) = ( zub + rn_atfp * ( zunu - zuno) ) &       
    614                                     & * umask(ji,jj,jk) / e3u(ji,jj,jk,Kbb_a) 
    615                   ENDIF 
    616                   ! 
    617                   uu(ji,jj,jk,Kmm_a) = tabres(ji,jj,jk,1) * umask(ji,jj,jk) / e3u(ji,jj,jk,Kmm_a) 
    618                END DO 
    619             END DO 
    620          END DO 
    621          ! 
    622          IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN 
    623             uu(i1:i2,j1:j2,k1:k2,Kbb_a)  = uu(i1:i2,j1:j2,k1:k2,Kmm_a) 
    624          ENDIF 
    625          ! 
    626       ENDIF 
    627       !  
    628    END SUBROUTINE updateu 
    629  
    630 # endif 
    631  
    632549   SUBROUTINE correct_u_bdy( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 
    633550      !!--------------------------------------------- 
     
    674591   END SUBROUTINE correct_u_bdy 
    675592 
    676 # if  defined key_vertical 
    677593 
    678594   SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
     
    698614      IF( before ) THEN 
    699615         zrhox = Agrif_Rhox() 
    700 !jc_alt 
    701 !         AGRIF_SpecialValue = -999._wp 
    702616         DO jk=k1,k2 
     617            tabres(i1:i2,j1:j2,jk,1) = zrhox * e1v(i1:i2,j1:j2) * e3v(i1:i2,j1:j2,jk,Kmm_a) &  
     618                                     &   * vmask(i1:i2,j1:j2,jk) * vv(i1:i2,j1:j2,jk,Kmm_a)   
     619         END DO 
     620 
     621         IF ( l_vremap ) THEN 
     622            DO jk=k1,k2 
     623               tabres(i1:i2,j1:j2,jk,2) = zrhox * e1v(i1:i2,j1:j2) * e3v(i1:i2,j1:j2,jk,Kmm_a) * vmask(i1:i2,j1:j2,jk) 
     624            END DO 
     625         ENDIF 
     626 
     627      ELSE 
     628 
     629         tabres_child(:,:,:) = 0._wp 
     630         AGRIF_SpecialValue = 0._wp 
     631 
     632         IF ( l_vremap ) THEN 
     633 
    703634            DO jj=j1,j2 
    704635               DO ji=i1,i2 
    705 !jc_alt 
    706 !                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk) * vv(ji,jj,jk,Kmm_a) & 
    707 !                                     & + (vmask(ji,jj,jk)-1._wp) * 999._wp 
    708                   tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk) * vv(ji,jj,jk,Kmm_a)  
    709 !jc_alt 
    710 !                  tabres(ji,jj,jk,2) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk) & 
    711 !                                     & + (vmask(ji,jj,jk)-1._wp) * 999._wp 
    712                   tabres(ji,jj,jk,2) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk) 
    713                END DO 
    714             END DO 
    715          END DO 
    716       ELSE 
    717          tabres_child(:,:,:) = 0. 
    718          AGRIF_SpecialValue = 0._wp 
    719          DO jj=j1,j2 
    720             DO ji=i1,i2 
    721                N_in = 0 
    722                DO jk=k1,k2 
    723 !jc_alt 
    724 !                  IF (tabres(ji,jj,jk,2) < -900._wp) EXIT 
    725                   IF (tabres(ji,jj,jk,2) == 0) EXIT 
    726                   N_in = N_in + 1 
    727                   tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2) 
    728                   h_in(N_in) = tabres(ji,jj,jk,2)/e1v(ji,jj) 
    729                ENDDO 
    730                N_out = 0 
    731                DO jk=1,jpk 
    732                   IF (vmask(ji,jj,jk) == 0) EXIT 
    733                   N_out = N_out + 1 
    734                   h_out(N_out) = e3v(ji,jj,jk,Kmm_a) 
    735                ENDDO 
    736                IF (N_in * N_out > 0) THEN 
    737                   h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
    738                   excess = 0._wp 
    739                   IF (h_diff < -1.e-4) then 
     636                  N_in = 0 
     637                  DO jk=k1,k2 
     638                     IF (tabres(ji,jj,jk,2) == 0) EXIT 
     639                     N_in = N_in + 1 
     640                     tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2) 
     641                     h_in(N_in) = tabres(ji,jj,jk,2) * r1_e1v(ji,jj) 
     642                  ENDDO 
     643                  N_out = 0 
     644                  DO jk=1,jpk 
     645                     IF (vmask(ji,jj,jk) == 0) EXIT 
     646                     N_out = N_out + 1 
     647                     h_out(N_out) = e3v(ji,jj,jk,Kmm_a) 
     648                  ENDDO 
     649                  IF (N_in * N_out > 0) THEN 
     650                     h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
     651                     excess = 0._wp 
     652                     IF (h_diff < -1.e-4) then 
    740653!Even if bathy at T points match it's possible for the V points to be deeper in the child grid.  
    741654!In this case we need to move transport from the child grid cells below bed of parent grid into the bottom cell. 
    742                      DO jk=N_in,1,-1 
    743                         thick = MIN(-1*h_diff, h_in(jk)) 
    744                         excess = excess + tabin(jk)*thick*e2u(ji,jj) 
    745                         tabin(jk) = tabin(jk)*(1. - thick/h_in(jk)) 
    746                         h_diff = h_diff + thick 
    747                         IF ( h_diff == 0) THEN 
    748                            N_in = jk 
    749                            h_in(jk) = h_in(jk) - thick 
    750                            EXIT 
    751                         ENDIF 
    752                      ENDDO 
     655                        DO jk=N_in,1,-1 
     656                           thick = MIN(-1*h_diff, h_in(jk)) 
     657                           excess = excess + tabin(jk)*thick*e2u(ji,jj) 
     658                           tabin(jk) = tabin(jk)*(1. - thick/h_in(jk)) 
     659                           h_diff = h_diff + thick 
     660                           IF ( h_diff == 0) THEN 
     661                              N_in = jk 
     662                              h_in(jk) = h_in(jk) - thick 
     663                              EXIT 
     664                           ENDIF 
     665                        ENDDO 
     666                     ENDIF 
     667                     CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
     668                     tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/(e1v(ji,jj)*h_out(N_out)) 
    753669                  ENDIF 
    754                   CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
    755                   tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/(e1v(ji,jj)*h_out(N_out)) 
    756                ENDIF 
     670               ENDDO 
    757671            ENDDO 
    758          ENDDO 
     672 
     673         ELSE 
     674            DO jk=1,jpk 
     675               DO jj=j1,j2 
     676                  DO ji=i1,i2 
     677                     tabres_child(ji,jj,jk) = tabres(ji,jj,jk,1) * r1_e1v(ji,jj) /  e3v(ji,jj,jk,Kmm_a) 
     678                  END DO 
     679               END DO 
     680            END DO 
     681         ENDIF 
    759682         ! 
    760683         DO jk=1,jpkm1 
     
    782705   END SUBROUTINE updatev 
    783706 
    784 # else 
    785  
    786    SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before) 
    787       !!--------------------------------------------- 
    788       !!           *** ROUTINE updatev *** 
    789       !!--------------------------------------------- 
    790       INTEGER                                     , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2 
    791       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    792       LOGICAL                                     , INTENT(in   ) :: before 
    793       ! 
    794       INTEGER  :: ji, jj, jk 
    795       REAL(wp) :: zrhox, zvb, zvnu, zvno 
    796       !!---------------------------------------------       
    797       ! 
    798       IF (before) THEN 
    799          zrhox = Agrif_Rhox() 
    800          DO jk=k1,k2 
    801             DO jj=j1,j2 
    802                DO ji=i1,i2 
    803                   tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vv(ji,jj,jk,Kmm_a) 
    804                END DO 
    805             END DO 
    806          END DO 
    807       ELSE 
    808          DO jk=k1,k2 
    809             DO jj=j1,j2 
    810                DO ji=i1,i2 
    811                   tabres(ji,jj,jk,1) = tabres(ji,jj,jk,1) * r1_e1v(ji,jj) 
    812                   ! 
    813                   IF (.NOT.(lk_agrif_fstep.AND.(l_1st_euler))) THEN ! Add asselin part 
    814                      zvb  = vv(ji,jj,jk,Kbb_a) * e3v(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used 
    815                      zvno = vv(ji,jj,jk,Kmm_a) * e3v(ji,jj,jk,Krhs_a) 
    816                      zvnu = tabres(ji,jj,jk,1) 
    817                      vv(ji,jj,jk,Kbb_a) = ( zvb + rn_atfp * ( zvnu - zvno) ) &       
    818                                     & * vmask(ji,jj,jk) / e3v(ji,jj,jk,Kbb_a) 
    819                   ENDIF 
    820                   ! 
    821                   vv(ji,jj,jk,Kmm_a) = tabres(ji,jj,jk,1) * vmask(ji,jj,jk) / e3v(ji,jj,jk,Kmm_a) 
    822                END DO 
    823             END DO 
    824          END DO 
    825          ! 
    826          IF  ((l_1st_euler).AND.(Agrif_Nb_Step()==0) ) THEN 
    827             vv(i1:i2,j1:j2,k1:k2,Kbb_a)  = vv(i1:i2,j1:j2,k1:k2,Kmm_a) 
    828          ENDIF 
    829          ! 
    830       ENDIF 
    831       !  
    832    END SUBROUTINE updatev 
    833  
    834 # endif 
    835707 
    836708   SUBROUTINE correct_v_bdy( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_top_interp.F90

    r13216 r13337  
    4343      Agrif_SpecialValue    = 0._wp 
    4444      Agrif_UseSpecialValue = .TRUE. 
     45      l_vremap = ln_vremap 
    4546      ! 
    4647      CALL Agrif_Bc_variable( trn_id, procname=interptrn ) 
    4748      Agrif_UseSpecialValue = .FALSE. 
     49      l_vremap = .FALSE. 
    4850      ! 
    4951   END SUBROUTINE Agrif_trc 
     
    5759      LOGICAL                                     , INTENT(in   ) ::   before 
    5860      ! 
    59       INTEGER  ::   ji, jj, jk, jn, ibdy, jbdy   ! dummy loop indices 
    60       INTEGER  ::   imin, imax, jmin, jmax, N_in, N_out 
    61       REAL(wp) ::   zrho, z1, z2, z3, z4, z5, z6, z7 
    62  
     61      INTEGER  ::   ji, jj, jk, jn  ! dummy loop indices 
     62      INTEGER  ::   N_in, N_out 
     63      INTEGER  :: item 
    6364      ! vertical interpolation: 
    64       REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,1:jptra) :: ptab_child 
     65      REAL(wp) :: zhtot 
    6566      REAL(wp), DIMENSION(k1:k2,1:jptra) :: tabin 
    66       REAL(wp), DIMENSION(k1:k2) :: h_in 
    67       REAL(wp), DIMENSION(1:jpk) :: h_out 
     67      REAL(wp), DIMENSION(k1:k2) :: h_in, z_in 
     68      REAL(wp), DIMENSION(1:jpk) :: h_out, z_out 
    6869      !!---------------------------------------------------------------------- 
    6970 
    70       IF( before ) THEN          
     71      IF( before ) THEN 
     72 
     73         item = Kmm_a 
     74         IF( l_ini_child )   Kmm_a = Kbb_a   
     75 
    7176         DO jn = 1,jptra 
    7277            DO jk=k1,k2 
     
    7782              END DO 
    7883           END DO 
    79         END DO 
     84         END DO 
    8085 
    81 # if defined key_vertical 
    82         DO jk=k1,k2 
    83            DO jj=j1,j2 
    84               DO ji=i1,i2 
    85                  ptab(ji,jj,jk,jptra+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a)  
    86               END DO 
    87            END DO 
    88         END DO 
    89 # endif 
     86         IF( l_vremap .OR. l_ini_child) THEN 
     87            ! Interpolate thicknesses 
     88            ! Warning: these are masked, hence extrapolated prior interpolation. 
     89            DO jk=k1,k2 
     90               DO jj=j1,j2 
     91                  DO ji=i1,i2 
     92                      ptab(ji,jj,jk,jptra+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) 
     93 
     94                  END DO 
     95               END DO 
     96            END DO 
     97 
     98            ! Extrapolate thicknesses in partial bottom cells: 
     99            ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
     100            IF (ln_zps) THEN 
     101               DO jj=j1,j2 
     102                  DO ji=i1,i2 
     103                      jk = mbkt(ji,jj) 
     104                      ptab(ji,jj,jk,jptra+1) = 0._wp 
     105                  END DO 
     106               END DO            
     107            END IF 
     108         
     109            ! Save ssh at last level: 
     110            IF (.NOT.ln_linssh) THEN 
     111               ptab(i1:i2,j1:j2,k2,jptra+1) = ssh(i1:i2,j1:j2,Kmm_a)*tmask(i1:i2,j1:j2,1)  
     112            ELSE 
     113               ptab(i1:i2,j1:j2,k2,jptra+1) = 0._wp 
     114            END IF       
     115         ENDIF 
     116         Kmm_a = item 
     117 
    90118      ELSE  
     119         item = Krhs_a 
     120         IF( l_ini_child )   Krhs_a = Kbb_a   
    91121 
    92 # if defined key_vertical 
    93          DO jj=j1,j2 
    94             DO ji=i1,i2 
    95                ptab_child(ji,jj,:) = 0._wp 
    96                N_in = 0 
    97                DO jk=k1,k2 !k2 = jpk of parent grid 
    98                   IF (ptab(ji,jj,jk,n2) == 0) EXIT 
    99                   N_in = N_in + 1 
    100                   tabin(jk,:) = ptab(ji,jj,jk,n1:n2-1) 
    101                   h_in(N_in) = ptab(ji,jj,jk,n2) 
     122         IF( l_vremap .OR. l_ini_child ) THEN 
     123            IF (ln_linssh) ptab(i1:i2,j1:j2,k2,n2) = 0._wp  
     124                
     125            DO jj=j1,j2 
     126               DO ji=i1,i2 
     127                  tr(ji,jj,:,:,Krhs_a) = 0.                   
     128                  N_in = mbkt_parent(ji,jj) 
     129                  zhtot = 0._wp 
     130                  DO jk=1,N_in !k2 = jpk of parent grid 
     131                     IF (jk==N_in) THEN 
     132                        h_in(jk) = ht0_parent(ji,jj) + ptab(ji,jj,k2,n2) - zhtot 
     133                     ELSE 
     134                        h_in(jk) = ptab(ji,jj,jk,n2) 
     135                     ENDIF 
     136                     zhtot = zhtot + h_in(jk) 
     137                     tabin(jk,:) = ptab(ji,jj,jk,n1:n2-1) 
     138                  END DO 
     139                  z_in(1) = 0.5_wp * h_in(1) - zhtot + ht0_parent(ji,jj) 
     140                  DO jk=2,N_in 
     141                     z_in(jk) = z_in(jk-1) + 0.5_wp * h_in(jk) 
     142                  END DO 
     143 
     144                  N_out = 0 
     145                  DO jk=1,jpk ! jpk of child grid 
     146                     IF (tmask(ji,jj,jk) == 0._wp) EXIT  
     147                     N_out = N_out + 1 
     148                     h_out(jk) = e3t(ji,jj,jk,Krhs_a) 
     149                  END DO 
     150 
     151                  z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + ht_0(ji,jj) 
     152                  DO jk=2,N_out 
     153                     z_out(jk) = z_out(jk-1) + 0.5_wp * h_out(jk) 
     154                  END DO 
     155 
     156                  IF (N_in*N_out > 0) THEN 
     157                     IF( l_ini_child ) THEN 
     158                        CALL remap_linear(tabin(1:N_in,1:jptra),z_in(1:N_in),tr(ji,jj,1:N_out,1:jptra,Krhs_a),          & 
     159                                      &   z_out(1:N_out),N_in,N_out,jptra)   
     160                     ELSE  
     161                        CALL reconstructandremap(tabin(1:N_in,1:jptra),h_in(1:N_in),tr(ji,jj,1:N_out,1:jptra,Krhs_a),   & 
     162                                      &   h_out(1:N_out),N_in,N_out,jptra)   
     163                     ENDIF 
     164                  ENDIF 
    102165               END DO 
    103                N_out = 0 
    104                DO jk=1,jpk ! jpk of child grid 
    105                   IF (tmask(ji,jj,jk) == 0) EXIT  
    106                   N_out = N_out + 1 
    107                   h_out(jk) = e3t(ji,jj,jk,Krhs_a) 
    108                ENDDO 
    109                IF (N_in > 0) THEN 
    110                   CALL reconstructandremap(tabin(1:N_in,1:jptra),h_in,ptab_child(ji,jj,1:N_out,1:jptra),h_out,N_in,N_out,jptra) 
    111                ENDIF 
    112             ENDDO 
    113          ENDDO 
    114 # else 
    115          ptab_child(i1:i2,j1:j2,1:jpk,1:jptra) = ptab(i1:i2,j1:j2,1:jpk,1:jptra) 
    116 # endif 
    117          ! 
    118          DO jn=1, jptra 
    119             tr(i1:i2,j1:j2,1:jpk,jn,Krhs_a)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk)  
    120          END DO 
     166            END DO 
     167            Krhs_a = item 
     168  
     169         ELSE 
     170          
     171            DO jn=1, jptra 
     172                tr(i1:i2,j1:j2,1:jpk,jn,Krhs_a)=ptab(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk)  
     173            END DO 
     174         ENDIF 
     175 
    121176      ENDIF 
    122177      ! 
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_user.F90

    r13335 r13337  
    148148 
    149149 
    150    SUBROUTINE Agrif_Init_Domain( Kbb, Kmm, Kaa )  
     150   SUBROUTINE Agrif_Init_Domain 
    151151      !!---------------------------------------------------------------------- 
    152152      !!                 *** ROUTINE Agrif_Init_Domain *** 
     
    168168      IMPLICIT NONE 
    169169      ! 
    170       INTEGER, INTENT(in) ::  Kbb, Kmm, Kaa 
    171170      ! 
    172171      LOGICAL :: check_namelist 
     
    186185      mbkt_parent(:,:) = 0 
    187186      ! 
    188   !    CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 
    189   !    CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 
     187!     CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 
     188!     CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 
    190189      CALL Agrif_Init_Variable(ht0_id , procname=interpht0 ) 
    191190      CALL Agrif_Init_Variable(mbkt_id, procname=interpmbkt) 
     
    214213         zk(ji,jj) = REAL( mbku_parent(ji,jj), wp ) 
    215214      END_2D 
    216       CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1.0_wp ) 
     215      CALL lbc_lnk( 'Agrif_InitValues_Domain', zk, 'U', 1.0_wp ) 
    217216      mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
    218217      DO_2D( 0, 0, 0, 0 ) 
    219218         zk(ji,jj) = REAL( mbkv_parent(ji,jj), wp ) 
    220219      END_2D 
    221       CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1.0_wp ) 
     220      CALL lbc_lnk( 'Agrif_InitValues_Domain', zk, 'V', 1.0_wp ) 
    222221      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )    
    223222 
     
    231230         ! 
    232231         kindic_agr = 0 
    233          IF( .NOT. l_vremap ) THEN 
     232         IF( .NOT. ln_vremap ) THEN 
    234233            ! 
    235234            ! check if tmask and vertical scale factors agree with parent in sponge area: 
     
    239238            ! 
    240239            ! In case of vertical interpolation, check only that total depths agree between child and parent: 
    241             DO ji = 1, jpi 
    242                DO jj = 1, jpj 
    243                   IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
    244                   IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
    245                   IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
    246                END DO 
    247             END DO 
    248  
    249             CALL mpp_sum( 'agrif_user', kindic_agr ) 
     240                   
     241            CALL Agrif_check_bat( kindic_agr )            
     242 
     243            CALL mpp_sum( 'agrif_InitValues_Domain', kindic_agr ) 
    250244            IF( kindic_agr /= 0 ) THEN 
    251245               CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.') 
     
    257251      ENDIF 
    258252 
    259       IF( l_vremap ) THEN 
     253      IF( ln_vremap ) THEN 
    260254      ! Additional constrain that should be removed someday: 
    261255         IF ( Agrif_Parent(jpk).GT.jpk ) THEN 
    262             CALL ctl_stop( ' With l_vremap, child grids must have jpk greater or equal to the parent value' ) 
     256            CALL ctl_stop( ' With ln_vremap, child grids must have jpk greater or equal to the parent value' ) 
    263257         ENDIF 
    264258      ENDIF 
     
    291285      LOGICAL :: check_namelist 
    292286      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
    293       REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace 
    294       INTEGER :: ji, jj 
    295287 
    296288      ! 1. Declaration of the type of variable which have to be interpolated 
     
    302294      Agrif_SpecialValue    = 0._wp 
    303295      Agrif_UseSpecialValue = .TRUE. 
     296      l_vremap              = ln_vremap 
     297 
    304298      CALL Agrif_Bc_variable(       tsn_id,calledweight=1.,procname=interptsn) 
    305299      CALL Agrif_Sponge 
     
    342336      ENDIF 
    343337      Agrif_UseSpecialValue = .FALSE.  
     338      l_vremap              = .FALSE. 
    344339 
    345340      !----------------- 
     
    398393      ind2 = nn_hls + 2 + nbghostcells_x 
    399394      ind3 = nn_hls + 2 + nbghostcells_y_s 
    400 # if defined key_vertical 
    401       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id) 
    402       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id) 
     395 
     396      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/)  ,(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id) 
     397      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/)  ,(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id) 
    403398      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id) 
    404399      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id) 
     
    407402      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id) 
    408403      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id) 
    409 # else 
    410       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
    411       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_sponge_id) 
    412       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_interp_id) 
    413       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_interp_id) 
    414       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_update_id) 
    415       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_update_id) 
    416       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_sponge_id) 
    417       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_sponge_id) 
    418 # endif 
     404 
    419405      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id) 
    420406      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id) 
     
    432418!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
    433419!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
    434 # if defined key_vertical 
    435420         CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id) 
    436 # else 
    437          CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),avm_id) 
    438 # endif 
    439421      ENDIF 
    440422      
     
    608590      CALL Agrif_Set_bcinterp(tra_iceini_id, interp  = AGRIF_linear) 
    609591      CALL Agrif_Set_interp  (tra_iceini_id, interp  = AGRIF_linear) 
    610       CALL Agrif_Set_bcinterp(u_iceini_id  , interp  = AGRIF_linear  ) 
    611       CALL Agrif_Set_interp  (u_iceini_id  , interp  = AGRIF_linear   ) 
     592      CALL Agrif_Set_bcinterp(u_iceini_id  , interp  = AGRIF_linear) 
     593      CALL Agrif_Set_interp  (u_iceini_id  , interp  = AGRIF_linear) 
    612594      CALL Agrif_Set_bcinterp(v_iceini_id  , interp  = AGRIF_linear) 
    613595      CALL Agrif_Set_interp  (v_iceini_id  , interp  = AGRIF_linear) 
     
    731713      ind2 = nn_hls + 2 + nbghostcells_x 
    732714      ind3 = nn_hls + 2 + nbghostcells_y_s 
    733 # if defined key_vertical 
     715 
    734716      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id) 
    735717      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id) 
    736 # else 
    737       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
    738       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id) 
    739 # endif 
    740718 
    741719      ! 2. Type of interpolation 
     
    788766      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    789767      NAMELIST/namagrif/ ln_agrif_2way, ln_init_chfrpar, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, & 
    790                        & ln_spc_dyn, ln_chk_bathy 
     768                       & ln_spc_dyn, ln_vremap, ln_chk_bathy 
    791769      !!-------------------------------------------------------------------------------------- 
    792770      ! 
     
    809787         WRITE(numout,*) '      ad. time relaxation for dynamics  rn_trelax_dyn = ', rn_trelax_dyn 
    810788         WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn 
     789         WRITE(numout,*) '      vertical remapping                ln_vremap     = ', ln_vremap 
    811790         WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy 
    812791      ENDIF 
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/DOM/domain.F90

    r13334 r13337  
    215215 
    216216#if defined key_agrif 
    217       IF( .NOT. Agrif_Root() ) CALL Agrif_Init_Domain( Kbb, Kmm, Kaa ) 
     217      IF( .NOT. Agrif_Root() ) CALL Agrif_Init_Domain 
    218218#endif 
    219219      IF( ln_meshmask    )   CALL dom_wri       ! Create a domain file 
  • NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/DOM/istate.F90

    r13334 r13337  
    8888#endif 
    8989 
     90#if defined key_agrif 
    9091      IF ( (.NOT.Agrif_root()).AND.ln_init_chfrpar ) THEN 
    91 #if defined key_agrif 
    9292         numror = 0                           ! define numror = 0 -> no restart file to read 
    9393         ln_1st_euler = .true.                ! Set time-step indicator at nit000 (euler forward) 
     
    169169         !  
    170170         ENDIF  
    171  
     171#if defined key_agrif 
    172172      ENDIF 
     173#endif 
    173174      !  
    174175      ! Initialize "now" and "before" barotropic velocities: 
Note: See TracChangeset for help on using the changeset viewer.