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 11053 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE – NEMO

Ignore:
Timestamp:
2019-05-24T12:53:06+02:00 (5 years ago)
Author:
davestorkey
Message:

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap : Merge in latest changes from main branch and finish conversion of "h" variables. NB. This version still doesn't work!

Location:
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE
Files:
29 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/BDY/bdydta.F90

    r10957 r11053  
    255255                  CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 
    256256                       & map=nbmap_ptr(jstart:jend), kt_offset=time_offset, jpk_bdy=nb_jpk_bdy,   & 
    257                        & fvl=ln_full_vel_array(jbdy) ) 
     257                       & fvl=ln_full_vel_array(jbdy), Kmm=Kmm ) 
    258258               ENDIF 
    259259               ! If full velocities in boundary data then split into barotropic and baroclinic data 
    … …  
    270270                             &                       + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta%u3d(ib,ik) 
    271271                     END DO 
    272                      dta%u2d(ib) =  dta%u2d(ib) * r1_hu_n(ii,ij) 
     272                     dta%u2d(ib) =  dta%u2d(ib) * r1_hu(ii,ij,Kmm) 
    273273                     DO ik = 1, jpkm1 
    274274                        dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib) 
    … …  
    284284                             &                       + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 
    285285                     END DO 
    286                      dta%v2d(ib) =  dta%v2d(ib) * r1_hv_n(ii,ij) 
     286                     dta%v2d(ib) =  dta%v2d(ib) * r1_hv(ii,ij,Kmm) 
    287287                     DO ik = 1, jpkm1 
    288288                        dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/BDY/bdydyn.F90

    r10957 r11053  
    7878         zva2d(:,:) = zva2d(:,:) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 
    7979      END DO 
    80       zua2d(:,:) = zua2d(:,:) * r1_hu_a(:,:) 
    81       zva2d(:,:) = zva2d(:,:) * r1_hv_a(:,:) 
     80      zua2d(:,:) = zua2d(:,:) * r1_hu(:,:,Kaa) 
     81      zva2d(:,:) = zva2d(:,:) * r1_hv(:,:,Kaa) 
    8282 
    8383      DO jk = 1 , jpkm1 
    … …  
    9999      !------------------------------------------------------- 
    100100 
    101       IF( ll_dyn2d )   CALL bdy_dyn2d( kt, zua2d, zva2d, uu_b(:,:,Kbb), vv_b(:,:,Kbb), r1_hu_a(:,:), r1_hv_a(:,:), ssh(:,:,Kaa) ) 
     101      IF( ll_dyn2d )   CALL bdy_dyn2d( kt, zua2d, zva2d, uu_b(:,:,Kbb), vv_b(:,:,Kbb), r1_hu(:,:,Kaa), r1_hv(:,:,Kaa), ssh(:,:,Kaa) ) 
    102102 
    103103      IF( ll_dyn3d )   CALL bdy_dyn3d( kt, Kbb, puu, pvv, Kaa ) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/DIA/diawri.F90

    r10989 r11053  
    138138 
    139139      IF( ll_wd ) THEN 
    140          CALL iom_put( "ssh" , (sshn+ssh_ref)*tmask(:,:,1) )   ! sea surface height (brought back to the reference used for wetting and drying) 
     140         CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) )   ! sea surface height (brought back to the reference used for wetting and drying) 
    141141      ELSE 
    142142         CALL iom_put( "ssh" , ssh(:,:,Kmm) )              ! sea surface height 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/DOM/dom_oce.F90

    r11050 r11053  
    121121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point 
    122122   ! 
    123    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   ff_f  , ff_t                    !: Coriolis factor at f- & t-points  [1/s] 
     123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ff_f  , ff_t                    !: Coriolis factor at f- & t-points  [1/s] 
    124124   !!---------------------------------------------------------------------- 
    125125   !! vertical coordinate and scale factors 
    … …  
    138138   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3vw_0   !: vw-vert. scale factor [m] 
    139139   !                                                        !  time-dependent scale factors 
    140    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:,:,:) ::   e3t, e3u, e3v, e3w, e3uw, e3vw  !: vert. scale factor [m] 
    141    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:,:) ::     e3f                             !: F-point vert. scale factor [m] 
     140   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e3t, e3u, e3v, e3w, e3uw, e3vw  !: vert. scale factor [m] 
     141   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   e3f                             !: F-point vert. scale factor [m] 
    142142 
    143143   !                                                        !  reference depths of cells 
    … …  
    146146   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gde3w_0  !: w- depth (sum of e3w) [m] 
    147147   !                                                        !  time-dependent depths of cells 
    148    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:,:,:) ::  gdept, gdepw   
    149    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:,:)   ::  gde3w   
     148   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  gdept, gdepw   
     149   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  gde3w   
    150150    
    151151   !                                                      !  reference heights of water column 
    … …  
    154154   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hv_0  !: v-depth              [m] 
    155155                                                          ! time-dependent heights of water column 
    156    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:)   ::   ht                     !: height of water column at T-points [m] 
    157    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:,:) ::   hu, hv, r1_hu, r1_hv   !: height of water column [m] and reciprocal [1/m] 
    158  
    159    !! TEMPORARY POINTERS FOR DEVELOPMENT ONLY 
    160    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::     e3t_b ,   e3t_n ,  e3t_a   !: t- vert. scale factor [m] 
    161    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::     e3u_b ,   e3u_n ,  e3u_a   !: u- vert. scale factor [m] 
    162    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::     e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m] 
    163    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::               e3f_n            !: f- vert. scale factor [m] 
    164    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::     e3w_b ,   e3w_n            !: w- vert. scale factor [m] 
    165    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m] 
    166    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m] 
    167    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    gdept_b , gdept_n           !: t- depth              [m]     
    168    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    gdepw_b , gdepw_n           !: w- depth              [m] 
    169    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    gde3w_n                     !: w- depth (sum of e3w) [m] 
    170    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)   ::              ht_n              !: t-depth              [m] 
    171    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)   ::    hu_b ,    hu_n ,    hu_a    !: u-depth              [m] 
    172    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)   ::    hv_b ,    hv_n ,    hv_a    !: v-depth              [m] 
    173    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)   :: r1_hu_b , r1_hu_n , r1_hu_a    !: inverse of u-depth [1/m] 
    174    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)   :: r1_hv_b , r1_hv_n , r1_hv_a    !: inverse of v-depth [1/m] 
    175    !! TEMPORARY POINTERS FOR DEVELOPMENT ONLY 
     156   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ht                     !: height of water column at T-points [m] 
     157   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hu, hv, r1_hu, r1_hv   !: height of water column [m] and reciprocal [1/m] 
    176158 
    177159   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/DOM/domain.F90

    r10978 r11053  
    179179         ! 
    180180         !        before       !          now          !       after         ! 
    181                                       ht_n =    ht_0   !                     ! water column thickness 
    182                hu_b =    hu_0  ;      hu_n =    hu_0   ;    hu_a =    hu_0   !  
    183                hv_b =    hv_0  ;      hv_n =    hv_0   ;    hv_a =    hv_0   ! 
    184             r1_hu_b = z1_hu_0  ;   r1_hu_n = z1_hu_0   ; r1_hu_a = z1_hu_0   ! inverse of water column thickness 
    185             r1_hv_b = z1_hv_0  ;   r1_hv_n = z1_hv_0   ; r1_hv_a = z1_hv_0   ! 
     181                                      ht =    ht_0   !                     ! water column thickness 
     182               hu(:,:,Kbb) =    hu_0  ;      hu(:,:,Kmm) =    hu_0   ;    hu(:,:,Kaa) =    hu_0   !  
     183               hv(:,:,Kbb) =    hv_0  ;      hv(:,:,Kmm) =    hv_0   ;    hv(:,:,Kaa) =    hv_0   ! 
     184            r1_hu(:,:,Kbb) = z1_hu_0  ;   r1_hu(:,:,Kmm) = z1_hu_0   ; r1_hu(:,:,Kaa) = z1_hu_0   ! inverse of water column thickness 
     185            r1_hv(:,:,Kbb) = z1_hv_0  ;   r1_hv(:,:,Kmm) = z1_hv_0   ; r1_hv(:,:,Kaa) = z1_hv_0   ! 
    186186         ! 
    187187         ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/DOM/domvvl.F90

    r11050 r11053  
    181181      ! 
    182182      !                    !==  thickness of the water column  !!   (ocean portion only) 
    183       ht_n(:,:) = e3t(:,:,1,Kmm) * tmask(:,:,1)   !!gm  BUG  :  this should be 1/2 * e3w(k=1) .... 
    184       hu_b(:,:) = e3u(:,:,1,Kbb) * umask(:,:,1) 
    185       hu_n(:,:) = e3u(:,:,1,Kmm) * umask(:,:,1) 
    186       hv_b(:,:) = e3v(:,:,1,Kbb) * vmask(:,:,1) 
    187       hv_n(:,:) = e3v(:,:,1,Kmm) * vmask(:,:,1) 
     183      ht(:,:) = e3t(:,:,1,Kmm) * tmask(:,:,1)   !!gm  BUG  :  this should be 1/2 * e3w(k=1) .... 
     184      hu(:,:,Kbb) = e3u(:,:,1,Kbb) * umask(:,:,1) 
     185      hu(:,:,Kmm) = e3u(:,:,1,Kmm) * umask(:,:,1) 
     186      hv(:,:,Kbb) = e3v(:,:,1,Kbb) * vmask(:,:,1) 
     187      hv(:,:,Kmm) = e3v(:,:,1,Kmm) * vmask(:,:,1) 
    188188      DO jk = 2, jpkm1 
    189          ht_n(:,:) = ht_n(:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    190          hu_b(:,:) = hu_b(:,:) + e3u(:,:,jk,Kbb) * umask(:,:,jk) 
    191          hu_n(:,:) = hu_n(:,:) + e3u(:,:,jk,Kmm) * umask(:,:,jk) 
    192          hv_b(:,:) = hv_b(:,:) + e3v(:,:,jk,Kbb) * vmask(:,:,jk) 
    193          hv_n(:,:) = hv_n(:,:) + e3v(:,:,jk,Kmm) * vmask(:,:,jk) 
     189         ht(:,:) = ht(:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
     190         hu(:,:,Kbb) = hu(:,:,Kbb) + e3u(:,:,jk,Kbb) * umask(:,:,jk) 
     191         hu(:,:,Kmm) = hu(:,:,Kmm) + e3u(:,:,jk,Kmm) * umask(:,:,jk) 
     192         hv(:,:,Kbb) = hv(:,:,Kbb) + e3v(:,:,jk,Kbb) * vmask(:,:,jk) 
     193         hv(:,:,Kmm) = hv(:,:,Kmm) + e3v(:,:,jk,Kmm) * vmask(:,:,jk) 
    194194      END DO 
    195195      ! 
    196196      !                    !==  inverse of water column thickness   ==!   (u- and v- points) 
    197       r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) )    ! _i mask due to ISF 
    198       r1_hu_n(:,:) = ssumask(:,:) / ( hu_n(:,:) + 1._wp - ssumask(:,:) ) 
    199       r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) ) 
    200       r1_hv_n(:,:) = ssvmask(:,:) / ( hv_n(:,:) + 1._wp - ssvmask(:,:) ) 
     197      r1_hu(:,:,Kbb) = ssumask(:,:) / ( hu(:,:,Kbb) + 1._wp - ssumask(:,:) )    ! _i mask due to ISF 
     198      r1_hu(:,:,Kmm) = ssumask(:,:) / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) ) 
     199      r1_hv(:,:,Kbb) = ssvmask(:,:) / ( hv(:,:,Kbb) + 1._wp - ssvmask(:,:) ) 
     200      r1_hv(:,:,Kmm) = ssvmask(:,:) / ( hv(:,:,Kmm) + 1._wp - ssvmask(:,:) ) 
    201201 
    202202      !                    !==   z_tilde coordinate case  ==!   (Restoring frequencies) 
    … …  
    550550      ! *********************************** ! 
    551551 
    552       hu_a(:,:) = e3u(:,:,1,Kaa) * umask(:,:,1) 
    553       hv_a(:,:) = e3v(:,:,1,Kaa) * vmask(:,:,1) 
     552      hu(:,:,Kaa) = e3u(:,:,1,Kaa) * umask(:,:,1) 
     553      hv(:,:,Kaa) = e3v(:,:,1,Kaa) * vmask(:,:,1) 
    554554      DO jk = 2, jpkm1 
    555          hu_a(:,:) = hu_a(:,:) + e3u(:,:,jk,Kaa) * umask(:,:,jk) 
    556          hv_a(:,:) = hv_a(:,:) + e3v(:,:,jk,Kaa) * vmask(:,:,jk) 
     555         hu(:,:,Kaa) = hu(:,:,Kaa) + e3u(:,:,jk,Kaa) * umask(:,:,jk) 
     556         hv(:,:,Kaa) = hv(:,:,Kaa) + e3v(:,:,jk,Kaa) * vmask(:,:,jk) 
    557557      END DO 
    558558      !                                        ! Inverse of the local depth 
    559559!!gm BUG ?  don't understand the use of umask_i here ..... 
    560       r1_hu_a(:,:) = ssumask(:,:) / ( hu_a(:,:) + 1._wp - ssumask(:,:) ) 
    561       r1_hv_a(:,:) = ssvmask(:,:) / ( hv_a(:,:) + 1._wp - ssvmask(:,:) ) 
     560      r1_hu(:,:,Kaa) = ssumask(:,:) / ( hu(:,:,Kaa) + 1._wp - ssumask(:,:) ) 
     561      r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) ) 
    562562      ! 
    563563      IF( ln_timing )   CALL timing_stop('dom_vvl_sf_nxt') 
    … …  
    625625      ! -------------------------------------- 
    626626      ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are allready computed in dynnxt 
    627       ! - JC - hu_b, hv_b, hur_b, hvr_b also 
     627      ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 
    628628       
    629629      CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F'  ) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/DOM/iscplrst.F90

    r10978 r11053  
    108108      gdept(:,:,:,Kbb) = gdept(:,:,:,Kmm) 
    109109      gdepw(:,:,:,Kbb) = gdepw(:,:,:,Kmm) 
    110       hu_b   (:,:)   = hu_n   (:,:) 
    111       hv_b   (:,:)   = hv_n   (:,:) 
    112       r1_hu_b(:,:)   = r1_hu_n(:,:) 
    113       r1_hv_b(:,:)   = r1_hv_n(:,:) 
     110      hu   (:,:,Kbb)   = hu   (:,:,Kmm) 
     111      hv   (:,:,Kbb)   = hv   (:,:,Kmm) 
     112      r1_hu(:,:,Kbb)   = r1_hu(:,:,Kmm) 
     113      r1_hv(:,:,Kbb)   = r1_hv(:,:,Kmm) 
    114114      ! 
    115115   END SUBROUTINE iscpl_stp 
    … …  
    240240      ! t-, u- and v- water column thickness 
    241241      ! ------------------------------------ 
    242          ht_n(:,:) = 0._wp ; hu_n(:,:) = 0._wp ; hv_n(:,:) = 0._wp 
     242         ht(:,:) = 0._wp ; hu(:,:,Kmm) = 0._wp ; hv(:,:,Kmm) = 0._wp 
    243243         DO jk = 1, jpkm1 
    244             hu_n(:,:) = hu_n(:,:) + e3u(:,:,jk,Kmm) * umask(:,:,jk) 
    245             hv_n(:,:) = hv_n(:,:) + e3v(:,:,jk,Kmm) * vmask(:,:,jk) 
    246             ht_n(:,:) = ht_n(:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
     244            hu(:,:,Kmm) = hu(:,:,Kmm) + e3u(:,:,jk,Kmm) * umask(:,:,jk) 
     245            hv(:,:,Kmm) = hv(:,:,Kmm) + e3v(:,:,jk,Kmm) * vmask(:,:,jk) 
     246            ht(:,:) = ht(:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    247247         END DO 
    248248         !                                        ! Inverse of the local depth 
    249          r1_hu_n(:,:) = 1._wp / ( hu_n(:,:) + 1._wp - ssumask(:,:) ) * ssumask(:,:) 
    250          r1_hv_n(:,:) = 1._wp / ( hv_n(:,:) + 1._wp - ssvmask(:,:) ) * ssvmask(:,:) 
     249         r1_hu(:,:,Kmm) = 1._wp / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) ) * ssumask(:,:) 
     250         r1_hv(:,:,Kmm) = 1._wp / ( hv(:,:,Kmm) + 1._wp - ssvmask(:,:) ) * ssvmask(:,:) 
    251251 
    252252      END IF 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/DOM/istate.F90

    r10978 r11053  
    175175      END DO 
    176176      ! 
    177       uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu_n(:,:) 
    178       vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv_n(:,:) 
     177      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm) 
     178      vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm) 
    179179      ! 
    180       uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu_b(:,:) 
    181       vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv_b(:,:) 
     180      uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu(:,:,Kbb) 
     181      vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv(:,:,Kbb) 
    182182      ! 
    183183   END SUBROUTINE istate_init 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/DYN/dynspg_ts.F90

    r10919 r11053  
    250250               DO jj = 1, jpjm1 
    251251                  DO ji = 1, jpim1 
    252                      zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                    & 
    253                         &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   ) * 0.25_wp   
     252                     zwz(ji,jj) =   ( ht(ji  ,jj+1) + ht(ji+1,jj+1) +                    & 
     253                        &             ht(ji  ,jj  ) + ht(ji+1,jj  )   ) * 0.25_wp   
    254254                     IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj) 
    255255                  END DO 
    … …  
    258258               DO jj = 1, jpjm1 
    259259                  DO ji = 1, jpim1 
    260                      zwz(ji,jj) =             (  ht_n  (ji  ,jj+1) + ht_n  (ji+1,jj+1)      & 
    261                         &                      + ht_n  (ji  ,jj  ) + ht_n  (ji+1,jj  )  )   & 
     260                     zwz(ji,jj) =             (  ht  (ji  ,jj+1) + ht  (ji+1,jj+1)      & 
     261                        &                      + ht  (ji  ,jj  ) + ht  (ji+1,jj  )  )   & 
    262262                        &       / ( MAX( 1._wp,  ssmask(ji  ,jj+1) + ssmask(ji+1,jj+1)      & 
    263263                        &                      + ssmask(ji  ,jj  ) + ssmask(ji+1,jj  )  )   ) 
    … …  
    282282            DO jj = 2, jpj 
    283283               DO ji = 2, jpi 
    284                   z1_ht = ssmask(ji,jj) / ( ht_n(ji,jj) + 1._wp - ssmask(ji,jj) ) 
     284                  z1_ht = ssmask(ji,jj) / ( ht(ji,jj) + 1._wp - ssmask(ji,jj) ) 
    285285                  ftne(ji,jj) = ( ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) ) * z1_ht 
    286286                  ftnw(ji,jj) = ( ff_f(ji-1,jj-1) + ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) ) * z1_ht 
    … …  
    367367      END DO 
    368368      ! 
    369       zu_frc(:,:) = zu_frc(:,:) * r1_hu_n(:,:) 
    370       zv_frc(:,:) = zv_frc(:,:) * r1_hv_n(:,:) 
     369      zu_frc(:,:) = zu_frc(:,:) * r1_hu(:,:,Kmm) 
     370      zv_frc(:,:) = zv_frc(:,:) * r1_hv(:,:,Kmm) 
    371371      ! 
    372372      ! 
    … …  
    388388      !                                   ! -------------------------------------------------------- 
    389389      ! 
    390       zwx(:,:) = puu_b(:,:,Kmm) * hu_n(:,:) * e2u(:,:)        ! now fluxes  
    391       zwy(:,:) = pvv_b(:,:,Kmm) * hv_n(:,:) * e1v(:,:) 
     390      zwx(:,:) = puu_b(:,:,Kmm) * hu(:,:,Kmm) * e2u(:,:)        ! now fluxes  
     391      zwy(:,:) = pvv_b(:,:,Kmm) * hv(:,:,Kmm) * e1v(:,:) 
    392392      ! 
    393393      SELECT CASE( nvor_scheme ) 
    … …  
    395395         DO jj = 2, jpjm1 
    396396            DO ji = 2, jpim1   ! vector opt. 
    397                zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * r1_hu_n(ji,jj)                    & 
    398                   &               * (  e1e2t(ji+1,jj)*ht_n(ji+1,jj)*ff_t(ji+1,jj) * ( pvv_b(ji+1,jj,Kmm) + pvv_b(ji+1,jj-1,Kmm) )   & 
    399                   &                  + e1e2t(ji  ,jj)*ht_n(ji  ,jj)*ff_t(ji  ,jj) * ( pvv_b(ji  ,jj,Kmm) + pvv_b(ji  ,jj-1,Kmm) )   ) 
     397               zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * r1_hu(ji,jj,Kmm)                    & 
     398                  &               * (  e1e2t(ji+1,jj)*ht(ji+1,jj)*ff_t(ji+1,jj) * ( pvv_b(ji+1,jj,Kmm) + pvv_b(ji+1,jj-1,Kmm) )   & 
     399                  &                  + e1e2t(ji  ,jj)*ht(ji  ,jj)*ff_t(ji  ,jj) * ( pvv_b(ji  ,jj,Kmm) + pvv_b(ji  ,jj-1,Kmm) )   ) 
    400400                  ! 
    401                zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * r1_hv_n(ji,jj)                    & 
    402                   &               * (  e1e2t(ji,jj+1)*ht_n(ji,jj+1)*ff_t(ji,jj+1) * ( puu_b(ji,jj+1,Kmm) + puu_b(ji-1,jj+1,Kmm) )   &  
    403                   &                  + e1e2t(ji,jj  )*ht_n(ji,jj  )*ff_t(ji,jj  ) * ( puu_b(ji,jj  ,Kmm) + puu_b(ji-1,jj  ,Kmm) )   )  
     401               zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * r1_hv(ji,jj,Kmm)                    & 
     402                  &               * (  e1e2t(ji,jj+1)*ht(ji,jj+1)*ff_t(ji,jj+1) * ( puu_b(ji,jj+1,Kmm) + puu_b(ji-1,jj+1,Kmm) )   &  
     403                  &                  + e1e2t(ji,jj  )*ht(ji,jj  )*ff_t(ji,jj  ) * ( puu_b(ji,jj  ,Kmm) + puu_b(ji-1,jj  ,Kmm) )   )  
    404404            END DO   
    405405         END DO   
    … …  
    546546            DO ji = fs_2, fs_jpim1   ! vector opt. 
    547547               zu_frc(ji,jj) = zu_frc(ji,jj) + &  
    548                & MAX(r1_hu_n(ji,jj) * r1_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ), zztmp ) * zwx(ji,jj) *  wdrampu(ji,jj) 
     548               & MAX(r1_hu(ji,jj,Kmm) * r1_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ), zztmp ) * zwx(ji,jj) *  wdrampu(ji,jj) 
    549549               zv_frc(ji,jj) = zv_frc(ji,jj) + &  
    550                & MAX(r1_hv_n(ji,jj) * r1_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ), zztmp ) * zwy(ji,jj) *  wdrampv(ji,jj) 
     550               & MAX(r1_hv(ji,jj,Kmm) * r1_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ), zztmp ) * zwy(ji,jj) *  wdrampv(ji,jj) 
    551551            END DO 
    552552         END DO 
    … …  
    554554         DO jj = 2, jpjm1 
    555555            DO ji = fs_2, fs_jpim1   ! vector opt. 
    556                zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * r1_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zwx(ji,jj) 
    557                zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * r1_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zwy(ji,jj) 
     556               zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu(ji,jj,Kmm) * r1_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zwx(ji,jj) 
     557               zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv(ji,jj,Kmm) * r1_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zwy(ji,jj) 
    558558            END DO 
    559559         END DO 
    … …  
    584584         DO jj = 2, jpjm1               
    585585            DO ji = fs_2, fs_jpim1   ! vector opt. 
    586                zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * r1_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zwx(ji,jj) 
    587                zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * r1_2 * ( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zwy(ji,jj) 
     586               zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu(ji,jj,Kmm) * r1_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zwx(ji,jj) 
     587               zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv(ji,jj,Kmm) * r1_2 * ( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zwy(ji,jj) 
    588588            END DO 
    589589         END DO 
    … …  
    593593         DO jj = 2, jpjm1 
    594594            DO ji = fs_2, fs_jpim1   ! vector opt. 
    595                zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rau0 * utau(ji,jj) * r1_hu_n(ji,jj) 
    596                zv_frc(ji,jj) =  zv_frc(ji,jj) + r1_rau0 * vtau(ji,jj) * r1_hv_n(ji,jj) 
     595               zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rau0 * utau(ji,jj) * r1_hu(ji,jj,Kmm) 
     596               zv_frc(ji,jj) =  zv_frc(ji,jj) + r1_rau0 * vtau(ji,jj) * r1_hv(ji,jj,Kmm) 
    597597            END DO 
    598598         END DO 
    … …  
    601601         DO jj = 2, jpjm1 
    602602            DO ji = fs_2, fs_jpim1   ! vector opt. 
    603                zu_frc(ji,jj) =  zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu_n(ji,jj) 
    604                zv_frc(ji,jj) =  zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv_n(ji,jj) 
     603               zu_frc(ji,jj) =  zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu(ji,jj,Kmm) 
     604               zv_frc(ji,jj) =  zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv(ji,jj,Kmm) 
    605605            END DO 
    606606         END DO 
    … …  
    681681         vn_e  (:,:) =    pvv_b(:,:,Kmm) 
    682682         ! 
    683          hu_e  (:,:) =    hu_n(:,:)        
    684          hv_e  (:,:) =    hv_n(:,:)  
    685          hur_e (:,:) = r1_hu_n(:,:)     
    686          hvr_e (:,:) = r1_hv_n(:,:) 
     683         hu_e  (:,:) =    hu(:,:,Kmm)        
     684         hv_e  (:,:) =    hv(:,:,Kmm)  
     685         hur_e (:,:) = r1_hu(:,:,Kmm)     
     686         hvr_e (:,:) = r1_hv(:,:,Kmm) 
    687687      ELSE                                ! CENTRED integration: start from BEFORE fields 
    688688         sshn_e(:,:) =    pssh(:,:,Kbb) 
    … …  
    690690         vn_e  (:,:) =    pvv_b(:,:,Kbb) 
    691691         ! 
    692          hu_e  (:,:) =    hu_b(:,:)        
    693          hv_e  (:,:) =    hv_b(:,:)  
    694          hur_e (:,:) = r1_hu_b(:,:)     
    695          hvr_e (:,:) = r1_hv_b(:,:) 
     692         hu_e  (:,:) =    hu(:,:,Kbb)        
     693         hv_e  (:,:) =    hv(:,:,Kbb)  
     694         hur_e (:,:) = r1_hu(:,:,Kbb)     
     695         hvr_e (:,:) = r1_hv(:,:,Kbb) 
    696696      ENDIF 
    697697      ! 
    … …  
    790790            zhtp2_e(:,:) = ht_0(:,:) + zsshp2_e(:,:) 
    791791         ELSE 
    792             zhup2_e(:,:) = hu_n(:,:) 
    793             zhvp2_e(:,:) = hv_n(:,:) 
    794             zhtp2_e(:,:) = ht_n(:,:) 
     792            zhup2_e(:,:) = hu(:,:,Kmm) 
     793            zhvp2_e(:,:) = hv(:,:,Kmm) 
     794            zhtp2_e(:,:) = ht(:,:) 
    795795         ENDIF 
    796796         !                                                !* after ssh 
    … …  
    11381138                            &     + rdtbt * ( zhust_e(ji,jj)  *    zwx(ji,jj)   &  
    11391139                            &               + zhup2_e(ji,jj)  * zu_trd(ji,jj)   & 
    1140                             &               +    hu_n(ji,jj)  * zu_frc(ji,jj) ) & 
     1140                            &               +    hu(ji,jj,Kmm)  * zu_frc(ji,jj) ) & 
    11411141                            &   ) * zhura 
    11421142 
    … …  
    11441144                            &     + rdtbt * ( zhvst_e(ji,jj)  *    zwy(ji,jj)   & 
    11451145                            &               + zhvp2_e(ji,jj)  * zv_trd(ji,jj)   & 
    1146                             &               +    hv_n(ji,jj)  * zv_frc(ji,jj) ) & 
     1146                            &               +    hv(ji,jj,Kmm)  * zv_frc(ji,jj) ) & 
    11471147                            &   ) * zhvra 
    11481148               END DO 
    … …  
    12571257         ! 
    12581258         DO jk=1,jpkm1 
    1259             puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + r1_hu_n(:,:) * ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) * hu_b(:,:) ) * r1_2dt_b 
    1260             pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + r1_hv_n(:,:) * ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) * hv_b(:,:) ) * r1_2dt_b 
     1259            puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + r1_hu(:,:,Kmm) * ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) * hu(:,:,Kbb) ) * r1_2dt_b 
     1260            pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + r1_hv(:,:,Kmm) * ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) * hv(:,:,Kbb) ) * r1_2dt_b 
    12611261         END DO 
    12621262         ! Save barotropic velocities not transport: 
    … …  
    12681268      ! Correct velocities so that the barotropic velocity equals (un_adv, vn_adv) (in all cases)   
    12691269      DO jk = 1, jpkm1 
    1270          puu(:,:,jk,Kmm) = ( puu(:,:,jk,Kmm) + un_adv(:,:)*r1_hu_n(:,:) - puu_b(:,:,Kmm) ) * umask(:,:,jk) 
    1271          pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) + vn_adv(:,:)*r1_hv_n(:,:) - pvv_b(:,:,Kmm) ) * vmask(:,:,jk) 
     1270         puu(:,:,jk,Kmm) = ( puu(:,:,jk,Kmm) + un_adv(:,:)*r1_hu(:,:,Kmm) - puu_b(:,:,Kmm) ) * umask(:,:,jk) 
     1271         pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) + vn_adv(:,:)*r1_hv(:,:,Kmm) - pvv_b(:,:,Kmm) ) * vmask(:,:,jk) 
    12721272      END DO 
    12731273 
    12741274      IF ( ln_wd_dl .and. ln_wd_dl_bc) THEN  
    12751275         DO jk = 1, jpkm1 
    1276             puu(:,:,jk,Kmm) = ( un_adv(:,:)*r1_hu_n(:,:) & 
    1277                        & + zuwdav2(:,:)*(puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu_n(:,:)) ) * umask(:,:,jk)  
    1278             pvv(:,:,jk,Kmm) = ( vn_adv(:,:)*r1_hv_n(:,:) &  
    1279                        & + zvwdav2(:,:)*(pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv_n(:,:)) ) * vmask(:,:,jk)   
     1276            puu(:,:,jk,Kmm) = ( un_adv(:,:)*r1_hu(:,:,Kmm) & 
     1277                       & + zuwdav2(:,:)*(puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu(:,:,Kmm)) ) * umask(:,:,jk)  
     1278            pvv(:,:,jk,Kmm) = ( vn_adv(:,:)*r1_hv(:,:,Kmm) &  
     1279                       & + zvwdav2(:,:)*(pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv(:,:,Kmm)) ) * vmask(:,:,jk)   
    12801280         END DO 
    12811281      END IF  
    12821282 
    12831283       
    1284       CALL iom_put(  "ubar", un_adv(:,:)*r1_hu_n(:,:) )    ! barotropic i-current 
    1285       CALL iom_put(  "vbar", vn_adv(:,:)*r1_hv_n(:,:) )    ! barotropic i-current 
     1284      CALL iom_put(  "ubar", un_adv(:,:)*r1_hu(:,:,Kmm) )    ! barotropic i-current 
     1285      CALL iom_put(  "vbar", vn_adv(:,:)*r1_hv(:,:,Kmm) )    ! barotropic i-current 
    12861286      ! 
    12871287#if defined key_agrif 
    … …  
    13071307      ! 
    13081308      IF( ln_diatmb ) THEN 
    1309          CALL iom_put( "baro_u" , un_b*ssumask(:,:)+zmdi*(1.-ssumask(:,:) ) )  ! Barotropic  U Velocity 
    1310          CALL iom_put( "baro_v" , vn_b*ssvmask(:,:)+zmdi*(1.-ssvmask(:,:) ) )  ! Barotropic  V Velocity 
     1309         CALL iom_put( "baro_u" , uu_b(:,:,Kmm)*ssumask(:,:)+zmdi*(1.-ssumask(:,:) ) )  ! Barotropic  U Velocity 
     1310         CALL iom_put( "baro_v" , vv_b(:,:,Kmm)*ssvmask(:,:)+zmdi*(1.-ssvmask(:,:) ) )  ! Barotropic  V Velocity 
    13111311      ENDIF 
    13121312      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/DYN/sshwzv.F90

    r10978 r11053  
    9393      !                                           !------------------------------! 
    9494      IF(ln_wd_il) THEN 
    95          CALL wad_lmt(pssh(:,:,Kbb), zcoef * (emp_b(:,:) + emp(:,:)), z2dt) 
     95         CALL wad_lmt(pssh(:,:,Kbb), zcoef * (emp_b(:,:) + emp(:,:)), z2dt, Kmm, uu, vv ) 
    9696      ENDIF 
    9797 
    … …  
    109109      ! 
    110110#if defined key_agrif 
    111       CALL agrif_ssh( kt ) 
     111      Krhs_a = Kaa ; CALL agrif_ssh( kt ) 
    112112#endif 
    113113      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/DYN/wet_dry.F90

    r10499 r11053  
    122122 
    123123 
    124    SUBROUTINE wad_lmt( sshb1, sshemp, z2dt ) 
     124   SUBROUTINE wad_lmt( psshb1, psshemp, z2dt, Kmm, puu, pvv ) 
    125125      !!---------------------------------------------------------------------- 
    126126      !!                  ***  ROUTINE wad_lmt  *** 
    … …  
    132132      !! ** Action  : - calculate flux limiter and W/D flag 
    133133      !!---------------------------------------------------------------------- 
    134       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   sshb1        !!gm DOCTOR names: should start with p ! 
    135       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   sshemp 
    136       REAL(wp)                , INTENT(in   ) ::   z2dt 
     134      REAL(wp), DIMENSION(:,:)            , INTENT(inout) ::   psshb1 
     135      REAL(wp), DIMENSION(:,:)            , INTENT(in   ) ::   psshemp 
     136      REAL(wp)                            , INTENT(in   ) ::   z2dt 
     137      INTEGER                             , INTENT(in   ) ::   Kmm       ! time level index 
     138      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv  ! velocity arrays 
    137139      ! 
    138140      INTEGER  ::   ji, jj, jk, jk1     ! dummy loop indices 
    … …  
    150152      ! 
    151153      DO jk = 1, jpkm1 
    152          un(:,:,jk) = un(:,:,jk) * zwdlmtu(:,:)  
    153          vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:,:)  
     154         puu(:,:,jk,Kmm) = puu(:,:,jk,Kmm) * zwdlmtu(:,:)  
     155         pvv(:,:,jk,Kmm) = pvv(:,:,jk,Kmm) * zwdlmtv(:,:)  
    154156      END DO 
    155157      jflag  = 0 
    … …  
    165167      ! 
    166168      DO jk = 1, jpkm1     ! Horizontal Flux in u and v direction 
    167          zflxu(:,:) = zflxu(:,:) + e3u_n(:,:,jk) * un(:,:,jk) * umask(:,:,jk) 
    168          zflxv(:,:) = zflxv(:,:) + e3v_n(:,:,jk) * vn(:,:,jk) * vmask(:,:,jk) 
     169         zflxu(:,:) = zflxu(:,:) + e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 
     170         zflxv(:,:) = zflxv(:,:) + e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 
    169171      END DO 
    170172      zflxu(:,:) = zflxu(:,:) * e2u(:,:) 
    … …  
    183185               &         + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji,  jj-1) , 0._wp )  
    184186            ! 
    185             zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 
     187            zdep2 = ht_0(ji,jj) + psshb1(ji,jj) - rn_wdmin1 
    186188            IF( zdep2 <= 0._wp ) THEN     ! add more safty, but not necessary 
    187                sshb1(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 
     189               psshb1(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 
    188190               IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp 
    189191               IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp 
    … …  
    196198      ! 
    197199      !           ! HPG limiter from jholt 
    198       wdramp(:,:) = min((ht_0(:,:) + sshb1(:,:) - rn_wdmin1)/(rn_wdmin0 - rn_wdmin1),1.0_wp) 
     200      wdramp(:,:) = min((ht_0(:,:) + psshb1(:,:) - rn_wdmin1)/(rn_wdmin0 - rn_wdmin1),1.0_wp) 
    199201      !jth assume don't need a lbc_lnk here 
    200202      DO jj = 1, jpjm1 
    … …  
    226228               ! 
    227229               zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 
    228                zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj) 
     230               zdep2 = ht_0(ji,jj) + psshb1(ji,jj) - rn_wdmin1 - z2dt * psshemp(ji,jj) 
    229231               ! 
    230232               IF( zdep1 > zdep2 ) THEN 
    … …  
    255257      ! 
    256258      DO jk = 1, jpkm1 
    257          un(:,:,jk) = un(:,:,jk) * zwdlmtu(:,:)  
    258          vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:,:)  
    259       END DO 
    260       un_b(:,:) = un_b(:,:) * zwdlmtu(:, :) 
    261       vn_b(:,:) = vn_b(:,:) * zwdlmtv(:, :) 
     259         puu(:,:,jk,Kmm) = puu(:,:,jk,Kmm) * zwdlmtu(:,:)  
     260         pvv(:,:,jk,Kmm) = pvv(:,:,jk,Kmm) * zwdlmtv(:,:)  
     261      END DO 
     262      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * zwdlmtu(:, :) 
     263      vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * zwdlmtv(:, :) 
    262264      ! 
    263265!!gm TO BE SUPPRESSED ?  these lbc_lnk are useless since zwdlmtu and zwdlmtv are defined everywhere ! 
    264       CALL lbc_lnk_multi( 'wet_dry', un  , 'U', -1., vn  , 'V', -1. ) 
    265       CALL lbc_lnk_multi( 'wet_dry', un_b, 'U', -1., vn_b, 'V', -1. ) 
     266      CALL lbc_lnk_multi( 'wet_dry', puu(:,:,:,Kmm)  , 'U', -1., pvv(:,:,:,Kmm)  , 'V', -1. ) 
     267      CALL lbc_lnk_multi( 'wet_dry', uu_b(:,:,Kmm), 'U', -1., vv_b(:,:,Kmm), 'V', -1. ) 
    266268!!gm 
    267269      ! 
    268270      IF(jflag == 1 .AND. lwp)   WRITE(numout,*) 'Need more iterations in wad_lmt!!!' 
    269271      ! 
    270       !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
     272      !IF( ln_rnf      )   CALL sbc_rnf_div( hdiv )          ! runoffs (update hdiv field) 
    271273      ! 
    272274      IF( ln_timing )   CALL timing_stop('wad_lmt')      ! 
    … …  
    392394      IF( jflag == 1 .AND. lwp )   WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!' 
    393395      ! 
    394       !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
     396      !IF( ln_rnf      )   CALL sbc_rnf_div( hdiv )          ! runoffs (update hdiv field) 
    395397      ! 
    396398      IF( ln_timing )   CALL timing_stop('wad_lmt_bt')      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/IOM/restart.F90

    r10989 r11053  
    148148 
    149149      IF ( .NOT. ln_diurnal_only ) THEN 
    150                      CALL iom_rstput( kt, nitrst, numrow, 'ub'     , uu(:,:,:,Kbb), ldxios = lwxios        )     ! before fields 
    151                      CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vv(:,:,:,Kbb), ldxios = lwxios        ) 
     150                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , uu(:,:,:       ,Kbb), ldxios = lwxios        )     ! before fields 
     151                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vv(:,:,:       ,Kbb), ldxios = lwxios        ) 
    152152                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , ts(:,:,:,jp_tem,Kbb), ldxios = lwxios ) 
    153153                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , ts(:,:,:,jp_sal,Kbb), ldxios = lwxios ) 
    154                      CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb, ldxios = lwxios      ) 
     154                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   ,ssh(:,:         ,Kbb), ldxios = lwxios      ) 
    155155                     ! 
    156                      CALL iom_rstput( kt, nitrst, numrow, 'un'     , uu(:,:,:,Kmm), ldxios = lwxios        )     ! now fields 
    157                      CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vv(:,:,:,Kmm), ldxios = lwxios        ) 
     156                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , uu(:,:,:       ,Kmm), ldxios = lwxios        )     ! now fields 
     157                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vv(:,:,:       ,Kmm), ldxios = lwxios        ) 
    158158                     CALL iom_rstput( kt, nitrst, numrow, 'tn'     , ts(:,:,:,jp_tem,Kmm), ldxios = lwxios ) 
    159159                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , ts(:,:,:,jp_sal,Kmm), ldxios = lwxios ) 
    160                      CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn, ldxios = lwxios      ) 
     160                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   ,ssh(:,:         ,Kmm), ldxios = lwxios      ) 
    161161                     CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop, ldxios = lwxios      ) 
    162162                  ! extra variable needed for the ice sheet coupling 
    … …  
    275275       
    276276      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 
    277          CALL iom_get( numror, jpdom_autoglo, 'ub'     , uu(:,:,:,Kbb), ldxios = lrxios        )   ! before fields 
    278          CALL iom_get( numror, jpdom_autoglo, 'vb'     , vv(:,:,:,Kbb), ldxios = lrxios        ) 
     277         CALL iom_get( numror, jpdom_autoglo, 'ub'     , uu(:,:,:       ,Kbb), ldxios = lrxios )   ! before fields 
     278         CALL iom_get( numror, jpdom_autoglo, 'vb'     , vv(:,:,:       ,Kbb), ldxios = lrxios ) 
    279279         CALL iom_get( numror, jpdom_autoglo, 'tb'     , ts(:,:,:,jp_tem,Kbb), ldxios = lrxios ) 
    280280         CALL iom_get( numror, jpdom_autoglo, 'sb'     , ts(:,:,:,jp_sal,Kbb), ldxios = lrxios ) 
    281          CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb, ldxios = lrxios                ) 
     281         CALL iom_get( numror, jpdom_autoglo, 'sshb'   ,ssh(:,:         ,Kbb), ldxios = lrxios ) 
    282282      ELSE 
    283283         neuler = 0 
    284284      ENDIF 
    285285      ! 
    286       CALL iom_get( numror, jpdom_autoglo, 'un'     , uu(:,:,:,Kmm), ldxios = lrxios        )   ! now    fields 
    287       CALL iom_get( numror, jpdom_autoglo, 'vn'     , vv(:,:,:,Kmm), ldxios = lrxios        ) 
     286      CALL iom_get( numror, jpdom_autoglo, 'un'     , uu(:,:,:       ,Kmm), ldxios = lrxios )       ! now    fields 
     287      CALL iom_get( numror, jpdom_autoglo, 'vn'     , vv(:,:,:       ,Kmm), ldxios = lrxios ) 
    288288      CALL iom_get( numror, jpdom_autoglo, 'tn'     , ts(:,:,:,jp_tem,Kmm), ldxios = lrxios ) 
    289289      CALL iom_get( numror, jpdom_autoglo, 'sn'     , ts(:,:,:,jp_sal,Kmm), ldxios = lrxios ) 
    290       CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn, ldxios = lrxios ) 
     290      CALL iom_get( numror, jpdom_autoglo, 'sshn'   ,ssh(:,:         ,Kmm), ldxios = lrxios ) 
    291291      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 
    292292         CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop, ldxios = lrxios )   ! now    potential density 
    … …  
    297297      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0) 
    298298         ts   (:,:,:,:,Kbb) = ts   (:,:,:,:,Kmm)              ! all before fields set to now values 
    299          uu   (:,:,:,Kbb)   = uu   (:,:,:,Kmm) 
    300          vv   (:,:,:,Kbb)   = vv   (:,:,:,Kmm) 
    301          sshb (:,:)         = sshn (:,:) 
     299         uu   (:,:,:  ,Kbb) = uu   (:,:,:  ,Kmm) 
     300         vv   (:,:,:  ,Kbb) = vv   (:,:,:  ,Kmm) 
     301         ssh  (:,:    ,Kbb) = ssh  (:,:    ,Kmm) 
    302302         ! 
    303303         IF( .NOT.ln_linssh ) THEN 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/OBS/diaobs.F90

    r10922 r11053  
    460460            ! 
    461461            IF( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 
    462                CALL obs_rea_mdt( surfdataqc(jtype), n2dintsurf(jtype) ) 
     462               CALL obs_rea_mdt( surfdataqc(jtype), n2dintsurf(jtype), Kmm ) 
    463463               IF( ln_altbias )   & 
    464464                  & CALL obs_rea_altbias ( surfdataqc(jtype), n2dintsurf(jtype), cn_altbiasfile ) 
    … …  
    499499      USE dom_oce, ONLY : gdept, gdept_1d     ! Ocean space domain variables (Kmm time-level only) 
    500500      USE phycst , ONLY : rday                ! Physical constants 
    501       USE oce    , ONLY : ts, uu, vv, sshn    ! Ocean dynamics and tracers variables (Kmm time-level only) 
     501      USE oce    , ONLY : ts, uu, vv, ssh     ! Ocean dynamics and tracers variables (Kmm time-level only) 
    502502      USE phycst , ONLY : rday                ! Physical constants 
    503503#if defined  key_si3 
    … …  
    598598               zsurfvar(:,:) = ts(:,:,1,jp_tem,Kmm) 
    599599            CASE('sla') 
    600                zsurfvar(:,:) = sshn(:,:) 
     600               zsurfvar(:,:) = ssh(:,:,Kmm) 
    601601            CASE('sss') 
    602602               zsurfvar(:,:) = ts(:,:,1,jp_sal,Kmm) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/OBS/obs_read_altbias.F90

    r10068 r11053  
    2929      & gphit 
    3030   USE oce, ONLY : &           ! Model variables 
    31       & sshn 
     31      & ssh 
    3232   USE obs_inter_h2d 
    3333   USE obs_utils               ! Various observation tools 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/OBS/obs_readmdt.F90

    r10425 r11053  
    2525      &                    tmask, tmask_i, e1e2t, gphit, glamt 
    2626   USE obs_const, ONLY :   obfillflt      ! Fillvalue 
    27    USE oce      , ONLY :   sshn           ! Model variables 
     27   USE oce      , ONLY :   ssh            ! Model variables 
    2828 
    2929   IMPLICIT NONE 
    … …  
    4444CONTAINS 
    4545 
    46    SUBROUTINE obs_rea_mdt( sladata, k2dint ) 
     46   SUBROUTINE obs_rea_mdt( sladata, k2dint, Kmm ) 
    4747      !!--------------------------------------------------------------------- 
    4848      !! 
    … …  
    5959      TYPE(obs_surf), INTENT(inout) ::   sladata   ! SLA data 
    6060      INTEGER       , INTENT(in)    ::   k2dint    ! ? 
     61      INTEGER       , INTENT(in)    ::   Kmm       ! ? 
    6162      ! 
    6263      CHARACTER(LEN=12), PARAMETER ::   cpname  = 'obs_rea_mdt' 
    … …  
    106107      ! Remove the offset between the MDT used with the sla and the model MDT 
    107108      IF( nn_msshc == 1 .OR. nn_msshc == 2 ) & 
    108          & CALL obs_offset_mdt( jpi, jpj, z_mdt, zfill ) 
     109         & CALL obs_offset_mdt( jpi, jpj, z_mdt, zfill, Kmm ) 
    109110 
    110111      ! Intepolate the MDT already on the model grid at the observation point 
    … …  
    169170 
    170171 
    171    SUBROUTINE obs_offset_mdt( kpi, kpj, mdt, zfill ) 
     172   SUBROUTINE obs_offset_mdt( kpi, kpj, mdt, zfill, Kmm ) 
    172173      !!--------------------------------------------------------------------- 
    173174      !! 
    … …  
    183184      !!---------------------------------------------------------------------- 
    184185      INTEGER, INTENT(IN) ::  kpi, kpj 
     186      INTEGER, INTENT(IN) ::  Kmm 
    185187      REAL(wp), DIMENSION(kpi,kpj), INTENT(INOUT) ::   mdt     ! MDT used on the model grid 
    186188      REAL(wp)                    , INTENT(IN   ) ::   zfill  
    … …  
    216218          zarea = zarea + zdxdy 
    217219          zeta1 = zeta1 + mdt(ji,jj) * zdxdy 
    218           zeta2 = zeta2 + sshn (ji,jj) * zdxdy 
     220          zeta2 = zeta2 + ssh(ji,jj,Kmm) * zdxdy 
    219221        END DO       
    220222      END DO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/OBS/obs_sstbias.F90

    r9023 r11053  
    2828      & glamt 
    2929   USE oce, ONLY : &           ! Model variables 
    30       & sshn 
     30      & ssh 
    3131   USE obs_inter_h2d 
    3232   USE obs_utils               ! Various observation tools 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/SBC/fldread.F90

    r10922 r11053  
    130130CONTAINS 
    131131 
    132    SUBROUTINE fld_read( kt, kn_fsbc, sd, map, kit, kt_offset, jpk_bdy, fvl ) 
     132   SUBROUTINE fld_read( kt, kn_fsbc, sd, map, kit, kt_offset, jpk_bdy, fvl, Kmm ) 
    133133      !!--------------------------------------------------------------------- 
    134134      !!                    ***  ROUTINE fld_read  *** 
    … …  
    153153      INTEGER  , INTENT(in   ), OPTIONAL     ::   jpk_bdy   ! number of vertical levels in the BDY data 
    154154      LOGICAL  , INTENT(in   ), OPTIONAL     ::   fvl   ! number of vertical levels in the BDY data 
     155      INTEGER  , INTENT(in   ), OPTIONAL     ::   Kmm   ! ocean time level index 
    155156      !! 
    156157      INTEGER  ::   itmp         ! local variable 
    … …  
    287288               ! read after data 
    288289               IF( PRESENT(jpk_bdy) ) THEN 
    289                   CALL fld_get( sd(jf), imap, jpk_bdy, fvl) 
     290                  CALL fld_get( sd(jf), imap, jpk_bdy, fvl, Kmm ) 
    290291               ELSE 
    291292                  CALL fld_get( sd(jf), imap ) 
    … …  
    614615 
    615616 
    616    SUBROUTINE fld_get( sdjf, map, jpk_bdy, fvl ) 
     617   SUBROUTINE fld_get( sdjf, map, jpk_bdy, fvl, Kmm ) 
    617618      !!--------------------------------------------------------------------- 
    618619      !!                    ***  ROUTINE fld_get  *** 
    … …  
    624625      INTEGER  , INTENT(in), OPTIONAL  ::   jpk_bdy ! number of vertical levels in the bdy data 
    625626      LOGICAL  , INTENT(in), OPTIONAL  ::   fvl     ! number of vertical levels in the bdy data 
     627      INTEGER  , INTENT(in), OPTIONAL  ::   Kmm     ! ocean time level index 
    626628      ! 
    627629      INTEGER ::   ipk      ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    … …  
    638640         IF( PRESENT(jpk_bdy) ) THEN 
    639641            IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2),                & 
    640                                                         sdjf%nrec_a(1), map, sdjf%igrd, sdjf%ibdy, jpk_bdy, fvl ) 
     642                                                        sdjf%nrec_a(1), map, sdjf%igrd, sdjf%ibdy, jpk_bdy, fvl, Kmm ) 
    641643            ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ),                & 
    642                                                         sdjf%nrec_a(1), map, sdjf%igrd, sdjf%ibdy, jpk_bdy, fvl ) 
     644                                                        sdjf%nrec_a(1), map, sdjf%igrd, sdjf%ibdy, jpk_bdy, fvl, Kmm ) 
    643645            ENDIF 
    644646         ELSE 
    … …  
    701703   END SUBROUTINE fld_get 
    702704 
    703    SUBROUTINE fld_map( num, clvar, dta, nrec, map, igrd, ibdy, jpk_bdy, fvl ) 
     705   SUBROUTINE fld_map( num, clvar, dta, nrec, map, igrd, ibdy, jpk_bdy, fvl, Kmm ) 
    704706      !!--------------------------------------------------------------------- 
    705707      !!                    ***  ROUTINE fld_map  *** 
    … …  
    718720      INTEGER  , INTENT(in), OPTIONAL         ::   igrd, ibdy, jpk_bdy  ! grid type, set number and number of vertical levels in the bdy data 
    719721      LOGICAL  , INTENT(in), OPTIONAL         ::   fvl     ! grid type, set number and number of vertical levels in the bdy data 
     722      INTEGER  , INTENT(in), OPTIONAL         ::   Kmm     ! ocean time level index  
    720723      INTEGER                                 ::   jpkm1_bdy! number of vertical levels in the bdy data minus 1 
    721724      !! 
    … …  
    813816 
    814817      IF ( ln_bdy ) &  
    815          CALL fld_bdy_interp(dta_read, dta_read_z, dta_read_dz, map, jpk_bdy, igrd, ibdy, fv, dta, fvl, ilendta) 
     818         CALL fld_bdy_interp(dta_read, dta_read_z, dta_read_dz, map, jpk_bdy, igrd, ibdy, fv, dta, fvl, ilendta, Kmm) 
    816819 
    817820      ELSE ! boundary data assumed to be on model grid 
    … …  
    838841   END SUBROUTINE fld_map 
    839842    
    840    SUBROUTINE fld_bdy_interp(dta_read, dta_read_z, dta_read_dz, map, jpk_bdy, igrd, ibdy, fv, dta, fvl, ilendta) 
     843   SUBROUTINE fld_bdy_interp(dta_read, dta_read_z, dta_read_dz, map, jpk_bdy, igrd, ibdy, fv, dta, fvl, ilendta, Kmm) 
    841844 
    842845      !!--------------------------------------------------------------------- 
    … …  
    857860      INTEGER  , INTENT(in)                   ::   igrd, ibdy, jpk_bdy        ! number of levels in bdy data 
    858861      INTEGER  , INTENT(in)                   ::   ilendta                    ! length of data in file 
     862      INTEGER  , INTENT(in), OPTIONAL         ::   Kmm                        ! ocean time level index 
    859863      !! 
    860864      INTEGER                                 ::   ipi                        ! length of boundary data on local process 
    … …  
    900904            SELECT CASE( igrd )                          
    901905               CASE(1) 
    902                   IF( ABS( (zh - ht_n(zij,zjj)) / ht_n(zij,zjj)) * tmask(zij,zjj,1) > 0.01_wp ) THEN 
     906                  IF( ABS( (zh - ht(zij,zjj)) / ht(zij,zjj)) * tmask(zij,zjj,1) > 0.01_wp ) THEN 
    903907                     WRITE(ibstr,"(I10.10)") map%ptr(ib)  
    904908                     CALL ctl_warn('fld_bdy_interp: T depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%') 
    905                  !   IF(lwp) WRITE(*,*) 'DEPTHT', zh, sum(e3t(zij,zjj,:,nfld_Nnn), mask=tmask(zij,zjj,:)==1),  ht_n(zij,zjj), map%ptr(ib), ib, zij, zjj 
     909                 !   IF(lwp) WRITE(*,*) 'DEPTHT', zh, sum(e3t(zij,zjj,:,Kmm), mask=tmask(zij,zjj,:)==1),  ht(zij,zjj), map%ptr(ib), ib, zij, zjj 
    906910                  ENDIF 
    907911               CASE(2) 
    908                   IF( ABS( (zh - hu_n(zij,zjj)) * r1_hu_n(zij,zjj)) * umask(zij,zjj,1) > 0.01_wp ) THEN 
     912                  IF( ABS( (zh - hu(zij,zjj,Kmm)) * r1_hu(zij,zjj,Kmm)) * umask(zij,zjj,1) > 0.01_wp ) THEN 
    909913                     WRITE(ibstr,"(I10.10)") map%ptr(ib)  
    910914                     CALL ctl_warn('fld_bdy_interp: U depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%') 
    911                      IF(lwp) WRITE(*,*) 'DEPTHU', zh, sum(e3u(zij,zjj,:,nfld_Nnn), mask=umask(zij,zjj,:)==1),  sum(umask(zij,zjj,:)), & 
    912                        &                hu_n(zij,zjj), map%ptr(ib), ib, zij, zjj, narea-1  , & 
     915                     IF(lwp) WRITE(*,*) 'DEPTHU', zh, sum(e3u(zij,zjj,:,Kmm), mask=umask(zij,zjj,:)==1),  sum(umask(zij,zjj,:)), & 
     916                       &                hu(zij,zjj,Kmm), map%ptr(ib), ib, zij, zjj, narea-1  , & 
    913917                        &                dta_read(map%ptr(ib),1,:) 
    914918                  ENDIF 
    915919               CASE(3) 
    916                   IF( ABS( (zh - hv_n(zij,zjj)) * r1_hv_n(zij,zjj)) * vmask(zij,zjj,1) > 0.01_wp ) THEN 
     920                  IF( ABS( (zh - hv(zij,zjj,Kmm)) * r1_hv(zij,zjj,Kmm)) * vmask(zij,zjj,1) > 0.01_wp ) THEN 
    917921                     WRITE(ibstr,"(I10.10)") map%ptr(ib)  
    918922                     CALL ctl_warn('fld_bdy_interp: V depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%') 
    … …  
    922926               SELECT CASE( igrd )                        
    923927                  CASE(1) 
    924                      zl =  gdept(zij,zjj,ik,nfld_Nnn)                                          ! if using in step could use fsdept instead of gdept_n? 
     928                     zl =  gdept(zij,zjj,ik,Kmm)                                          ! if using in step could use fsdept instead of gdept_n? 
    925929                  CASE(2) 
    926930                     IF(ln_sco) THEN 
    927                         zl =  ( gdept(zij,zjj,ik,nfld_Nnn) + gdept(zij+1,zjj,ik,nfld_Nnn) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
     931                        zl =  ( gdept(zij,zjj,ik,Kmm) + gdept(zij+1,zjj,ik,Kmm) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
    928932                     ELSE 
    929                         zl =  MIN( gdept(zij,zjj,ik,nfld_Nnn), gdept(zij+1,zjj,ik,nfld_Nnn) )  
     933                        zl =  MIN( gdept(zij,zjj,ik,Kmm), gdept(zij+1,zjj,ik,Kmm) )  
    930934                     ENDIF 
    931935                  CASE(3) 
    932936                     IF(ln_sco) THEN 
    933                         zl =  ( gdept(zij,zjj,ik,nfld_Nnn) + gdept(zij,zjj+1,ik,nfld_Nnn) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
     937                        zl =  ( gdept(zij,zjj,ik,Kmm) + gdept(zij,zjj+1,ik,Kmm) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
    934938                     ELSE 
    935                         zl =  MIN( gdept(zij,zjj,ik,nfld_Nnn), gdept(zij,zjj+1,ik,nfld_Nnn) ) 
     939                        zl =  MIN( gdept(zij,zjj,ik,Kmm), gdept(zij,zjj+1,ik,Kmm) ) 
    936940                     ENDIF 
    937941               END SELECT 
    … …  
    941945                  dta(ib,1,ik) =  dta_read(map%ptr(ib),1,MAXLOC(dta_read_z(map%ptr(ib),1,:),1)) 
    942946               ELSE                                                                                ! inbetween : vertical interpolation between ikk & ikk+1 
    943                   DO ikk = 1, jpkm1_bdy                                                            ! when  gdept(ikk,nfld_Nnn) < zl < gdept(ikk+1,nfld_Nnn) 
     947                  DO ikk = 1, jpkm1_bdy                                                            ! when  gdept(ikk,Kmm) < zl < gdept(ikk+1,Kmm) 
    944948                     IF( ( (zl-dta_read_z(map%ptr(ib),1,ikk)) * (zl-dta_read_z(map%ptr(ib),1,ikk+1)) <= 0._wp) & 
    945949                    &    .AND. (dta_read_z(map%ptr(ib),1,ikk+1) /= fv_alt)) THEN 
    … …  
    965969              ENDDO 
    966970              DO ik = 1, ipk                                ! calculate transport on model grid 
    967                   ztrans_new = ztrans_new + dta(ib,1,ik) * e3u(zij,zjj,ik,nfld_Nnn) * umask(zij,zjj,ik) 
     971                  ztrans_new = ztrans_new + dta(ib,1,ik) * e3u(zij,zjj,ik,Kmm) * umask(zij,zjj,ik) 
    968972              ENDDO 
    969973              DO ik = 1, ipk                                ! make transport correction 
    970974                 IF(fvl) THEN ! bdy data are total velocity so adjust bt transport term to match input data 
    971                     dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hu_n(zij,zjj) ) * umask(zij,zjj,ik) 
     975                    dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hu(zij,zjj,Kmm) ) * umask(zij,zjj,ik) 
    972976                 ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero 
    973                     IF( ABS(ztrans * r1_hu_n(zij,zjj)) > 0.01_wp ) & 
     977                    IF( ABS(ztrans * r1_hu(zij,zjj,Kmm)) > 0.01_wp ) & 
    974978                   &   CALL ctl_warn('fld_bdy_interp: barotropic component of > 0.01 ms-1 found in baroclinic velocities at') 
    975                     dta(ib,1,ik) = dta(ib,1,ik) + ( 0._wp - ztrans_new ) * r1_hu_n(zij,zjj) * umask(zij,zjj,ik) 
     979                    dta(ib,1,ik) = dta(ib,1,ik) + ( 0._wp - ztrans_new ) * r1_hu(zij,zjj,Kmm) * umask(zij,zjj,ik) 
    976980                 ENDIF 
    977981              ENDDO 
    … …  
    990994              ENDDO 
    991995              DO ik = 1, ipk                                ! calculate transport on model grid 
    992                   ztrans_new = ztrans_new + dta(ib,1,ik) * e3v(zij,zjj,ik,nfld_Nnn) * vmask(zij,zjj,ik) 
     996                  ztrans_new = ztrans_new + dta(ib,1,ik) * e3v(zij,zjj,ik,Kmm) * vmask(zij,zjj,ik) 
    993997              ENDDO 
    994998              DO ik = 1, ipk                                ! make transport correction 
    995999                 IF(fvl) THEN ! bdy data are total velocity so adjust bt transport term to match input data 
    996                     dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hv_n(zij,zjj) ) * vmask(zij,zjj,ik) 
     1000                    dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hv(zij,zjj,Kmm) ) * vmask(zij,zjj,ik) 
    9971001                 ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero 
    998                     dta(ib,1,ik) = dta(ib,1,ik) + ( 0._wp - ztrans_new ) * r1_hv_n(zij,zjj) * vmask(zij,zjj,ik) 
     1002                    dta(ib,1,ik) = dta(ib,1,ik) + ( 0._wp - ztrans_new ) * r1_hv(zij,zjj,Kmm) * vmask(zij,zjj,ik) 
    9991003                 ENDIF 
    10001004              ENDDO 
    … …  
    10251029            SELECT CASE( igrd )                          
    10261030               CASE(1) 
    1027                   IF( ABS( (zh - ht_n(zij,zjj)) / ht_n(zij,zjj)) * tmask(zij,zjj,1) > 0.01_wp ) THEN 
     1031                  IF( ABS( (zh - ht(zij,zjj)) / ht(zij,zjj)) * tmask(zij,zjj,1) > 0.01_wp ) THEN 
    10281032                     WRITE(ibstr,"(I10.10)") map%ptr(ib)  
    10291033                     CALL ctl_warn('fld_bdy_interp: T depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%') 
    1030                  !   IF(lwp) WRITE(*,*) 'DEPTHT', zh, sum(e3t(zij,zjj,:,nfld_Nnn), mask=tmask(zij,zjj,:)==1),  ht_n(zij,zjj), map%ptr(ib), ib, zij, zjj 
     1034                 !   IF(lwp) WRITE(*,*) 'DEPTHT', zh, sum(e3t(zij,zjj,:,Kmm), mask=tmask(zij,zjj,:)==1),  ht(zij,zjj), map%ptr(ib), ib, zij, zjj 
    10311035                  ENDIF 
    10321036               CASE(2) 
    1033                   IF( ABS( (zh - hu_n(zij,zjj)) * r1_hu_n(zij,zjj)) * umask(zij,zjj,1) > 0.01_wp ) THEN 
     1037                  IF( ABS( (zh - hu(zij,zjj,Kmm)) * r1_hu(zij,zjj,Kmm)) * umask(zij,zjj,1) > 0.01_wp ) THEN 
    10341038                     WRITE(ibstr,"(I10.10)") map%ptr(ib)  
    10351039                     CALL ctl_warn('fld_bdy_interp: U depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%') 
    10361040                  ENDIF 
    10371041               CASE(3) 
    1038                   IF( ABS( (zh - hv_n(zij,zjj)) * r1_hv_n(zij,zjj)) * vmask(zij,zjj,1) > 0.01_wp ) THEN 
     1042                  IF( ABS( (zh - hv(zij,zjj,Kmm)) * r1_hv(zij,zjj,Kmm)) * vmask(zij,zjj,1) > 0.01_wp ) THEN 
    10391043                     WRITE(ibstr,"(I10.10)") map%ptr(ib)  
    10401044                     CALL ctl_warn('fld_bdy_interp: V depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%') 
    … …  
    10441048               SELECT CASE( igrd )                          ! coded for sco - need zco and zps option using min 
    10451049                  CASE(1) 
    1046                      zl =  gdept(zij,zjj,ik,nfld_Nnn)              ! if using in step could use fsdept instead of gdept_n? 
     1050                     zl =  gdept(zij,zjj,ik,Kmm)              ! if using in step could use fsdept instead of gdept_n? 
    10471051                  CASE(2) 
    10481052                     IF(ln_sco) THEN 
    1049                         zl =  ( gdept(zij,zjj,ik,nfld_Nnn) + gdept(zij+1,zjj,ik,nfld_Nnn) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
     1053                        zl =  ( gdept(zij,zjj,ik,Kmm) + gdept(zij+1,zjj,ik,Kmm) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
    10501054                     ELSE 
    1051                         zl =  MIN( gdept(zij,zjj,ik,nfld_Nnn), gdept(zij+1,zjj,ik,nfld_Nnn) ) 
     1055                        zl =  MIN( gdept(zij,zjj,ik,Kmm), gdept(zij+1,zjj,ik,Kmm) ) 
    10521056                     ENDIF 
    10531057                  CASE(3) 
    10541058                     IF(ln_sco) THEN 
    1055                         zl =  ( gdept(zij,zjj,ik,nfld_Nnn) + gdept(zij,zjj+1,ik,nfld_Nnn) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
     1059                        zl =  ( gdept(zij,zjj,ik,Kmm) + gdept(zij,zjj+1,ik,Kmm) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
    10561060                     ELSE 
    1057                         zl =  MIN( gdept(zij,zjj,ik,nfld_Nnn), gdept(zij,zjj+1,ik,nfld_Nnn) ) 
     1061                        zl =  MIN( gdept(zij,zjj,ik,Kmm), gdept(zij,zjj+1,ik,Kmm) ) 
    10581062                     ENDIF 
    10591063               END SELECT 
    … …  
    10631067                  dta(ib,1,ik) =  dta_read(ji,jj,MAXLOC(dta_read_z(ji,jj,:),1)) 
    10641068               ELSE                                                                     ! inbetween : vertical interpolation between ikk & ikk+1 
    1065                   DO ikk = 1, jpkm1_bdy                                                 ! when  gdept(ikk,nfld_Nnn) < zl < gdept(ikk+1,nfld_Nnn) 
     1069                  DO ikk = 1, jpkm1_bdy                                                 ! when  gdept(ikk,Kmm) < zl < gdept(ikk+1,Kmm) 
    10661070                     IF( ( (zl-dta_read_z(ji,jj,ikk)) * (zl-dta_read_z(ji,jj,ikk+1)) <= 0._wp) & 
    10671071                    &    .AND. (dta_read_z(ji,jj,ikk+1) /= fv_alt)) THEN 
    … …  
    10891093               ENDDO 
    10901094               DO ik = 1, ipk                                ! calculate transport on model grid 
    1091                   ztrans_new = ztrans_new + dta(ib,1,ik) * e3u(zij,zjj,ik,nfld_Nnn) * umask(zij,zjj,ik) 
     1095                  ztrans_new = ztrans_new + dta(ib,1,ik) * e3u(zij,zjj,ik,Kmm) * umask(zij,zjj,ik) 
    10921096               ENDDO 
    10931097               DO ik = 1, ipk                                ! make transport correction 
    10941098                  IF(fvl) THEN ! bdy data are total velocity so adjust bt transport term to match input data 
    1095                      dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hu_n(zij,zjj) ) * umask(zij,zjj,ik) 
     1099                     dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hu(zij,zjj,Kmm) ) * umask(zij,zjj,ik) 
    10961100                  ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero 
    1097                      dta(ib,1,ik) = ( dta(ib,1,ik) + ( 0._wp  - ztrans_new ) * r1_hu_n(zij,zjj) ) * umask(zij,zjj,ik) 
     1101                     dta(ib,1,ik) = ( dta(ib,1,ik) + ( 0._wp  - ztrans_new ) * r1_hu(zij,zjj,Kmm) ) * umask(zij,zjj,ik) 
    10981102                  ENDIF 
    10991103               ENDDO 
    … …  
    11141118               ENDDO 
    11151119               DO ik = 1, ipk                                ! calculate transport on model grid 
    1116                   ztrans_new = ztrans_new + dta(ib,1,ik) * e3v(zij,zjj,ik,nfld_Nnn) * vmask(zij,zjj,ik) 
     1120                  ztrans_new = ztrans_new + dta(ib,1,ik) * e3v(zij,zjj,ik,Kmm) * vmask(zij,zjj,ik) 
    11171121               ENDDO 
    11181122               DO ik = 1, ipk                                ! make transport correction 
    11191123                  IF(fvl) THEN ! bdy data are total velocity so adjust bt transport term to match input data 
    1120                      dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hv_n(zij,zjj) ) * vmask(zij,zjj,ik) 
     1124                     dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hv(zij,zjj,Kmm) ) * vmask(zij,zjj,ik) 
    11211125                  ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero 
    1122                      dta(ib,1,ik) = ( dta(ib,1,ik) + ( 0._wp  - ztrans_new ) * r1_hv_n(zij,zjj) ) * vmask(zij,zjj,ik) 
     1126                     dta(ib,1,ik) = ( dta(ib,1,ik) + ( 0._wp  - ztrans_new ) * r1_hv(zij,zjj,Kmm) ) * vmask(zij,zjj,ik) 
    11231127                  ENDIF 
    11241128               ENDDO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/SBC/sbccpl.F90

    r10922 r11053  
    3232   USE cpl_oasis3     ! OASIS3 coupling 
    3333   USE geo2ocean      !  
    34    USE oce     , ONLY : ts, uu, vv, sshn, sshb, fraqsr_1lev 
     34   USE oce     , ONLY : ts, uu, vv, ssh, fraqsr_1lev 
    3535   USE ocealb         !  
    3636   USE eosbn2         !  
    … …  
    20372037    
    20382038    
    2039    SUBROUTINE sbc_cpl_snd( kt, Kmm ) 
     2039   SUBROUTINE sbc_cpl_snd( kt, Kbb, Kmm ) 
    20402040      !!---------------------------------------------------------------------- 
    20412041      !!             ***  ROUTINE sbc_cpl_snd  *** 
    … …  
    20472047      !!---------------------------------------------------------------------- 
    20482048      INTEGER, INTENT(in) ::   kt 
    2049       INTEGER, INTENT(in) ::   Kmm    ! ocean model time level index 
     2049      INTEGER, INTENT(in) ::   Kbb, Kmm    ! ocean model time level index 
    20502050      ! 
    20512051      INTEGER ::   ji, jj, jl   ! dummy loop indices 
    … …  
    24762476         IF( ln_apr_dyn ) THEN   
    24772477            IF( kt /= nit000 ) THEN   
    2478                ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )   
     2478               ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )   
    24792479            ELSE   
    2480                ztmp1(:,:) = sshb(:,:)   
     2480               ztmp1(:,:) = ssh(:,:,Kbb)   
    24812481            ENDIF   
    24822482         ELSE   
    2483             ztmp1(:,:) = sshn(:,:)   
     2483            ztmp1(:,:) = ssh(:,:,Kmm)   
    24842484         ENDIF   
    24852485         CALL cpl_snd( jps_wlev  , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )  
    … …  
    24912491         !                          ! removed inverse barometer ssh when Patm 
    24922492         !                          forcing is used (for sea-ice dynamics) 
    2493          IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    2494          ELSE                    ;   ztmp1(:,:) = sshn(:,:) 
     2493         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     2494         ELSE                    ;   ztmp1(:,:) = ssh(:,:,Kmm) 
    24952495         ENDIF 
    24962496         CALL cpl_snd( jps_ssh   , isec, RESHAPE ( ztmp1            , (/jpi,jpj,1/) ), info ) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/SBC/sbcfwb.F90

    r10570 r11053  
    4848CONTAINS 
    4949 
    50    SUBROUTINE sbc_fwb( kt, kn_fwb, kn_fsbc ) 
     50   SUBROUTINE sbc_fwb( kt, kn_fwb, kn_fsbc, Kmm ) 
    5151      !!--------------------------------------------------------------------- 
    5252      !!                  ***  ROUTINE sbc_fwb  *** 
    … …  
    6565      INTEGER, INTENT( in ) ::   kn_fsbc  !  
    6666      INTEGER, INTENT( in ) ::   kn_fwb   ! ocean time-step index 
     67      INTEGER, INTENT( in ) ::   Kmm      ! ocean time level index 
    6768      ! 
    6869      INTEGER  ::   inum, ikty, iyear     ! local integers 
    … …  
    131132            a_fwb_b = a_fwb                           ! mean sea level taking into account the ice+snow 
    132133                                                      ! sum over the global domain 
    133             a_fwb   = glob_sum( 'sbcfwb', e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rau0 ) ) 
     134            a_fwb   = glob_sum( 'sbcfwb', e1e2t(:,:) * ( ssh(:,:,Kmm) + snwice_mass(:,:) * r1_rau0 ) ) 
    134135            a_fwb   = a_fwb * 1.e+3 / ( area * rday * 365. )     ! convert in Kg/m3/s = mm/s 
    135136!!gm        !                                                      !!bug 365d year  

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/SBC/sbcice_cice.F90

    r10922 r11053  
    147147 
    148148 
    149    SUBROUTINE cice_sbc_init( ksbc ) 
     149   SUBROUTINE cice_sbc_init( ksbc, Kbb, Kmm ) 
    150150      !!--------------------------------------------------------------------- 
    151151      !!                    ***  ROUTINE cice_sbc_init  *** 
    … …  
    154154      !!--------------------------------------------------------------------- 
    155155      INTEGER, INTENT( in  ) ::   ksbc                ! surface forcing type 
     156      INTEGER, INTENT( in  ) ::   Kbb, Kmm            ! time level indices 
    156157      REAL(wp), DIMENSION(jpi,jpj) :: ztmp1, ztmp2 
    157158      REAL(wp) ::   zcoefu, zcoefv, zcoeff            ! local scalar 
    … …  
    227228      IF( .NOT.ln_rstart ) THEN 
    228229         IF( ln_ice_embd ) THEN            ! embedded sea-ice: deplete the initial ssh below sea-ice area 
    229             sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
    230             sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
     230            ssh(:,:,Kmm) = ssh(:,:,Kmm) - snwice_mass(:,:) * r1_rau0 
     231            ssh(:,:,Kbb) = ssh(:,:,Kbb) - snwice_mass(:,:) * r1_rau0 
    231232 
    232233!!gm This should be put elsewhere....   (same remark for limsbc) 
    … …  
    235236               ! 
    236237               DO jk = 1,jpkm1                     ! adjust initial vertical scale factors 
    237                   e3t(:,:,jk,Kmm) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    238                   e3t(:,:,jk,Kbb) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
     238                  e3t(:,:,jk,Kmm) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kmm)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
     239                  e3t(:,:,jk,Kbb) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kbb)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    239240               ENDDO 
    240241               e3t(:,:,:,Krhs) = e3t(:,:,:,Kbb) 
    … …  
    259260               gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 
    260261               gdepw(:,:,1,Kmm) = 0.0_wp 
    261                gde3w(:,:,1)     = gdept(:,:,1,Kmm) - sshn(:,:) 
     262               gde3w(:,:,1)     = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 
    262263               DO jk = 2, jpk 
    263264                  gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk,Kmm) 
    … …  
    10561057   END SUBROUTINE sbc_ice_cice 
    10571058 
    1058    SUBROUTINE cice_sbc_init (ksbc)    ! Dummy routine 
     1059   SUBROUTINE cice_sbc_init (ksbc, Kbb, Kmm)    ! Dummy routine 
    10591060      IMPLICIT NONE 
    10601061      INTEGER, INTENT( in ) :: ksbc 
     1062      INTEGER, INTENT( in ) :: Kbb, Kmm 
    10611063      WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?', ksbc 
    10621064   END SUBROUTINE cice_sbc_init 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/SBC/sbcisf.F90

    r10954 r11053  
    149149         DO jj = 1,jpj 
    150150            DO ji = 1,jpi 
    151                zdep(ji,jj)=gdepw_n(ji,jj,misfkt(ji,jj)) 
     151               zdep(ji,jj)=gdepw(ji,jj,misfkt(ji,jj),Kmm) 
    152152            END DO 
    153153         END DO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/SBC/sbcmod.F90

    r10998 r11053  
    341341                          IF( sbc_ice_alloc() /= 0 )   CALL ctl_stop('STOP', 'sbc_ice_alloc : unable to allocate arrays' ) 
    342342      ELSEIF( nn_ice == 2 ) THEN 
    343                           CALL ice_init( Kbb, Kmm, Kaa )  ! ICE initialization 
     343                          CALL ice_init( Kbb, Kmm, Kaa )         ! ICE initialization 
    344344      ENDIF 
    345345#endif 
    346       IF( nn_ice == 3 )   CALL cice_sbc_init( nsbc )   ! CICE initialization 
    347       ! 
    348       IF( ln_wave     )   CALL sbc_wave_init           ! surface wave initialisation 
     346      IF( nn_ice == 3 )   CALL cice_sbc_init( nsbc, Kbb, Kmm )   ! CICE initialization 
     347      ! 
     348      IF( ln_wave     )   CALL sbc_wave_init                     ! surface wave initialisation 
    349349      ! 
    350350      IF( lwxios ) THEN 
    … …  
    442442      CASE(  1 )   ;         CALL sbc_ice_if   ( kt, Kbb, Kmm )   ! Ice-cover climatology ("Ice-if" model) 
    443443#if defined key_si3 
    444       CASE(  2 )   ;         CALL ice_stp  ( kt, Kbb, nsbc )  ! SI3 ice model 
     444      CASE(  2 )   ;         CALL ice_stp  ( kt, Kbb, Kmm, nsbc ) ! SI3 ice model 
    445445#endif 
    446446      CASE(  3 )   ;         CALL sbc_ice_cice ( kt, nsbc )       ! CICE ice model 
    … …  
    454454      ENDIF 
    455455 
    456       IF( ln_isf         )   CALL sbc_isf( kt, Kmm )              ! compute iceshelves 
    457  
    458       IF( ln_rnf         )   CALL sbc_rnf( kt )                   ! add runoffs to fresh water fluxes 
    459  
    460       IF( ln_ssr         )   CALL sbc_ssr( kt )                   ! add SST/SSS damping term 
    461  
    462       IF( nn_fwb    /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget 
     456      IF( ln_isf         )   CALL sbc_isf( kt, Kmm )                   ! compute iceshelves 
     457 
     458      IF( ln_rnf         )   CALL sbc_rnf( kt )                        ! add runoffs to fresh water fluxes 
     459 
     460      IF( ln_ssr         )   CALL sbc_ssr( kt )                        ! add SST/SSS damping term 
     461 
     462      IF( nn_fwb    /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc, Kmm )  ! control the freshwater budget 
    463463 
    464464      ! Special treatment of freshwater fluxes over closed seas in the model domain 
    … …  
    471471      IF ( ll_wd ) THEN     ! If near WAD point limit the flux for now 
    472472         zthscl = atanh(rn_wd_sbcfra)                     ! taper frac default is .999  
    473          zwdht(:,:) = sshn(:,:) + ht_0(:,:) - rn_wdmin1   ! do this calc of water 
     473         zwdht(:,:) = ssh(:,:,Kmm) + ht_0(:,:) - rn_wdmin1   ! do this calc of water 
    474474                                                     ! depth above wd limit once 
    475475         WHERE( zwdht(:,:) <= 0.0 ) 
    … …  
    557557      ! 
    558558      IF(ln_ctl) THEN         ! print mean trends (used for debugging) 
    559          CALL prt_ctl(tab2d_1=fr_i              , clinfo1=' fr_i    - : ', mask1=tmask ) 
    560          CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf), clinfo1=' emp-rnf - : ', mask1=tmask ) 
    561          CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf), clinfo1=' sfx-rnf - : ', mask1=tmask ) 
    562          CALL prt_ctl(tab2d_1=qns              , clinfo1=' qns      - : ', mask1=tmask ) 
    563          CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr      - : ', mask1=tmask ) 
    564          CALL prt_ctl(tab3d_1=tmask            , clinfo1=' tmask    - : ', mask1=tmask, kdim=jpk ) 
    565          CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' sst      - : ', mask1=tmask, kdim=1   ) 
    566          CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sss      - : ', mask1=tmask, kdim=1   ) 
    567          CALL prt_ctl(tab2d_1=utau             , clinfo1=' utau     - : ', mask1=umask,                      & 
    568             &         tab2d_2=vtau             , clinfo2=' vtau     - : ', mask2=vmask ) 
     559         CALL prt_ctl(tab2d_1=fr_i                , clinfo1=' fr_i    - : ' , mask1=tmask ) 
     560         CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf)  , clinfo1=' emp-rnf - : ' , mask1=tmask ) 
     561         CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf)  , clinfo1=' sfx-rnf - : ' , mask1=tmask ) 
     562         CALL prt_ctl(tab2d_1=qns                 , clinfo1=' qns      - : ', mask1=tmask ) 
     563         CALL prt_ctl(tab2d_1=qsr                 , clinfo1=' qsr      - : ', mask1=tmask ) 
     564         CALL prt_ctl(tab3d_1=tmask               , clinfo1=' tmask    - : ', mask1=tmask, kdim=jpk ) 
     565         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' sst      - : ', mask1=tmask, kdim=1   ) 
     566         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sss      - : ', mask1=tmask, kdim=1   ) 
     567         CALL prt_ctl(tab2d_1=utau                , clinfo1=' utau     - : ', mask1=umask,                      & 
     568            &         tab2d_2=vtau                , clinfo2=' vtau     - : ', mask2=vmask ) 
    569569      ENDIF 
    570570 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/SBC/sbcssm.F90

    r10922 r11053  
    7777         sss_m(:,:) = zts(:,:,jp_sal) 
    7878         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    79          IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    80          ELSE                    ;   ssh_m(:,:) = sshn(:,:) 
     79         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh(:,:,Kmm) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     80         ELSE                    ;   ssh_m(:,:) = ssh(:,:,Kmm) 
    8181         ENDIF 
    8282         ! 
    … …  
    100100            sss_m(:,:) = zcoef * zts(:,:,jp_sal) 
    101101            !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    102             IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
    103             ELSE                    ;   ssh_m(:,:) = zcoef * sshn(:,:) 
     102            IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( ssh(:,:,Kmm) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
     103            ELSE                    ;   ssh_m(:,:) = zcoef *   ssh(:,:,Kmm) 
    104104            ENDIF 
    105105            ! 
    … …  
    128128         sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal) 
    129129         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    130          IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    131          ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) 
     130         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + ssh(:,:,Kmm) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     131         ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + ssh(:,:,Kmm) 
    132132         ENDIF 
    133133         ! 
    … …  
    250250         ENDIF 
    251251         sss_m(:,:) = ts  (:,:,1,jp_sal,Kmm) 
    252          ssh_m(:,:) = sshn(:,:) 
     252         ssh_m(:,:) = ssh(:,:,Kmm) 
    253253         e3t_m(:,:) = e3t (:,:,1,Kmm) 
    254254         frq_m(:,:) = 1._wp 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/TRD/trddyn.F90

    r10946 r11053  
    123123                              z3dx(:,:,:) = 0._wp                  ! U.dxU & V.dyV (approximation) 
    124124                              z3dy(:,:,:) = 0._wp 
    125                               DO jk = 1, jpkm1   ! no mask as un,vn are masked 
     125                              DO jk = 1, jpkm1   ! no mask as uu, vv are masked 
    126126                                 DO jj = 2, jpjm1 
    127127                                    DO ji = 2, jpim1 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/TRD/trdvor.F90

    r10946 r11053  
    189189 
    190190      ! Average except for Beta.V 
    191       zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:) 
    192       zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:) 
     191      zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm) 
     192      zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm) 
    193193    
    194194      ! Curl 
    … …  
    276276         END DO 
    277277         ! Average of the Curl and Surface mask 
    278          vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu_n(:,:) * fmask(:,:,1) 
     278         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu(:,:,Kmm) * fmask(:,:,1) 
    279279      ENDIF 
    280280      ! 
    281281      ! Average  
    282       zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:) 
    283       zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:) 
     282      zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm) 
     283      zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm) 
    284284      ! 
    285285      ! Curl 
    … …  
    342342      END DO 
    343343  
    344       zuu(:,:) = zuu(:,:) * r1_hu_n(:,:) 
    345       zvv(:,:) = zvv(:,:) * r1_hv_n(:,:) 
     344      zuu(:,:) = zuu(:,:) * r1_hu(:,:,Kmm) 
     345      zvv(:,:) = zvv(:,:) * r1_hv(:,:,Kmm) 
    346346 
    347347      ! Curl 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/ZDF/zdfosm.F90

    r10955 r11053  
    489489 
    490490      zhbl_t(:,:) = hbl(:,:) + (zdhdt(:,:) - ww(ji,jj,ibld(ji,jj)))* rn_rdt ! certainly need wb here, so subtract it 
    491       zhbl_t(:,:) = MIN(zhbl_t(:,:), ht_n(:,:)) 
     491      zhbl_t(:,:) = MIN(zhbl_t(:,:), ht(:,:)) 
    492492      zdhdt(:,:) = MIN(zdhdt(:,:), (zhbl_t(:,:) - hbl(:,:))/rn_rdt + ww(ji,jj,ibld(ji,jj))) ! adjustment to represent limiting by ocean bottom 
    493493 
    … …  
    525525 
    526526                     zhbl_s = zhbl_s + MIN( - zwb_ent(ji,jj) / zdb * rn_rdt / FLOAT(ibld(ji,jj)-imld(ji,jj) ), e3w(ji,jj,jk,Kmm) ) 
    527                      zhbl_s = MIN(zhbl_s, ht_n(ji,jj)) 
     527                     zhbl_s = MIN(zhbl_s, ht(ji,jj)) 
    528528 
    529529                     IF ( zhbl_s >= gdepw(ji,jj,jm+1,Kmm) ) jm = jm + 1 
    … …  
    546546                          &          * zwstrl(ji,jj)**3 / hbli(ji,jj) ) / zdb * e3w(ji,jj,jk,Kmm) / zdhdt(ji,jj)  ! ALMG to investigate whether need to include ww here 
    547547 
    548                      zhbl_s = MIN(zhbl_s, ht_n(ji,jj)) 
     548                     zhbl_s = MIN(zhbl_s, ht(ji,jj)) 
    549549                     IF ( zhbl_s >= gdepw(ji,jj,jm,Kmm) ) jm = jm + 1 
    550550                  END DO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/nemogcm.F90

    r10998 r11053  
    137137      !                            !-----------------------! 
    138138#if defined key_agrif 
     139      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    139140      CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM 
    140141      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA  
    … …  
    169170      ! 
    170171      ! Recursive update from highest nested level to lowest: 
     172      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nnn    ! agrif_oce module copies of time level indices 
    171173      CALL Agrif_step_child_adj(Agrif_Update_All) 
    172174      ! 
    … …  
    404406      Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 
    405407 
    406       ! Initialisation of temporary pointers (to be deleted after development finished) 
    407       CALL update_pointers( Nbb, Nnn, Naa ) 
    408408      !                             !-------------------------------! 
    409409      !                             !  NEMO general initialization  ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/oce.F90

    r10919 r11053  
    1717   PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90 
    1818 
    19    !! dynamics and tracer fields  NOTE THAT "TARGET" ATTRIBUTE CAN BE REMOVED AFTER IMMERSE DEVELOPMENT FINISHED                             
     19   !! dynamics and tracer fields 
    2020   !! --------------------------                             
    21    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:),  TARGET ::   uu   ,  vv     !: horizontal velocities        [m/s] 
    22    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:),    TARGET ::   ww             !: vertical velocity            [m/s] 
    23    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)            ::   wi             !: vertical vel. (adaptive-implicit) [m/s] 
    24    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:),    TARGET ::   hdiv           !: horizontal divergence        [s-1] 
    25    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:),TARGET ::   ts             !: 4D T-S fields                  [Celsius,psu]  
    26    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_b,  rab_n          !: thermal/haline expansion coef. [Celsius-1,psu-1] 
    27    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2     [s-2] 
     21   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)  ::   uu   ,  vv     !: horizontal velocities        [m/s] 
     22   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)    ::   ww             !: vertical velocity            [m/s] 
     23   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   wi             !: vertical vel. (adaptive-implicit) [m/s] 
     24   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)    ::   hdiv           !: horizontal divergence        [s-1] 
     25   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   ts             !: 4D T-S fields                  [Celsius,psu]  
     26   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)   ::   rab_b,  rab_n  !: thermal/haline expansion coef. [Celsius-1,psu-1] 
     27   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   rn2b ,  rn2    !: brunt-vaisala frequency**2     [s-2] 
    2828   ! 
    2929   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0  [no units] 
    … …  
    3333   !! free surface                                      !  before  ! now    ! after  ! 
    3434   !! ------------                                      !  fields  ! fields ! fields ! 
    35    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET ::   ssh, uu_b,  vv_b   !: SSH [m] and barotropic velocities [m/s] 
     35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ssh, uu_b,  vv_b   !: SSH [m] and barotropic velocities [m/s] 
    3636 
    3737   !! Arrays at barotropic time step:                   ! befbefore! before !  now   ! after  ! 
    … …  
    6464 
    6565   !! Energy budget of the leads (open water embedded in sea ice) 
    66    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraqsr_1lev        !: fraction of solar net radiation absorbed in the first ocean level [-] 
    67  
    68    !! TEMPORARY POINTERS FOR DEVELOPMENT ONLY 
    69    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:)   ::   ub   ,  un    , ua       !: i-horizontal velocity        [m/s] 
    70    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va       !: j-horizontal velocity        [m/s] 
    71    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:)   ::           wn               !: k-vertical   velocity        [m/s] 
    72    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:)   ::           hdivn            !: horizontal divergence        [s-1] 
    73    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa      !: 4D T-S fields                [Celsius,psu]          
    74    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)     ::   ub_b   ,  un_b  ,  ua_b  !: Barotropic velocities at u-point [m/s] 
    75    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)     ::   vb_b   ,  vn_b  ,  va_b  !: Barotropic velocities at v-point [m/s] 
    76    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)     ::   sshb   ,  sshn  ,  ssha  !: sea surface height at t-point [m] 
    77    !! TEMPORARY POINTERS FOR DEVELOPMENT ONLY 
     66   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraqsr_1lev  !: fraction of solar net radiation absorbed in the first ocean level [-] 
     67   INTEGER, PUBLIC, DIMENSION(2) :: noce_array                             !: unused array but seems to be needed to prevent agrif from creating an empty module 
    7868 
    7969   !!---------------------------------------------------------------------- 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/step.F90

    r11050 r11053  
    4444 
    4545   PUBLIC   stp   ! called by nemogcm.F90 
    46    PUBLIC   update_pointers ! called by nemo_init 
    4746 
    4847   !!---------------------------------------------------------------------- 
    … …  
    253252#endif 
    254253                         CALL tra_adv    ( kstp, Nbb, Nnn, ts, Nrhs )  ! hor. + vert. advection ==> RHS 
    255       IF( ln_zdfosm  )   CALL tra_osm    ( kstp, Nnn     , ts, Nrhs )  ! OSMOSIS non-local tracer fluxes ==> RHS 
     254      IF( ln_zdfosm  )   CALL tra_osm    ( kstp,      Nnn, ts, Nrhs )  ! OSMOSIS non-local tracer fluxes ==> RHS 
    256255      IF( lrst_oce .AND. ln_zdfosm ) & 
    257            &             CALL osm_rst    ( kstp, Nnn, 'WRITE' )        ! write OSMOSIS outputs + ww (so must do here) to restarts 
     256           &             CALL osm_rst    ( kstp,      Nnn, 'WRITE'  )  ! write OSMOSIS outputs + ww (so must do here) to restarts 
    258257                         CALL tra_ldf    ( kstp, Nbb, Nnn, ts, Nrhs )  ! lateral mixing 
    259258 
    260259!!gm : why CALL to dia_ptr has been moved here??? (use trends info?) 
    261       IF( ln_diaptr  )   CALL dia_ptr( Nnn )                 ! Poleward adv/ldf TRansports diagnostics 
     260      IF( ln_diaptr  )   CALL dia_ptr( Nnn )                           ! Poleward adv/ldf TRansports diagnostics 
    262261!!gm 
    263262                         CALL tra_zdf    ( kstp, Nbb, Nnn, Nrhs, ts, Naa  )  ! vert. mixing & after tracer  ==> after 
    … …  
    282281!!jc2: dynnxt must be the latest call. e3t(:,:,:,Nbb) are indeed updated in that routine 
    283282                         CALL tra_nxt       ( kstp, Nbb, Nnn, Nrhs, Naa )  ! finalize (bcs) tracer fields at next time step and swap 
    284                          CALL dyn_atf       ( kstp, Nbb, Nnn, Naa, uu, vv, e3t, e3u, e3v  )  ! time swapping of "now" arrays 
     283                         CALL dyn_atf       ( kstp, Nbb, Nnn, Naa, uu, vv, e3t, e3u, e3v  )  ! time filtering of "now" arrays 
    285284                         CALL ssh_swp       ( kstp, Nbb, Nnn, Naa )  ! swap of sea surface height 
    286285      ! 
    … …  
    291290      Naa = Nrhs 
    292291      ! 
    293       ! Update temporary pointers 
    294       CALL update_pointers( Nbb, Nnn, Naa ) 
    295  
    296292      IF(.NOT.ln_linssh) CALL dom_vvl_sf_swp( kstp, Nbb, Nnn, Naa )  ! swap of vertical scale factors 
    297293      ! 
    … …  
    310306      ! AGRIF 
    311307      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
    312                          CALL Agrif_Integrate_ChildGrids( stp )  ! allows to finish all the Child Grids before updating 
    313  
    314                          IF( Agrif_NbStepint() == 0 ) CALL Agrif_update_all( ) ! Update all components 
     308                         CALL Agrif_Integrate_ChildGrids( stp )       ! allows to finish all the Child Grids before updating 
     309 
     310                         IF( Agrif_NbStepint() == 0 ) THEN 
     311                            Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
     312                            CALL Agrif_update_all( )                  ! Update all components 
     313                         ENDIF 
    315314#endif 
    316315      IF( ln_diaobs  )   CALL dia_obs      ( kstp, Nnn )      ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
    … …  
    331330      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    332331!!gm why lk_oasis and not lk_cpl ???? 
    333       IF( lk_oasis   )   CALL sbc_cpl_snd( kstp, Nnn )     ! coupled mode : field exchanges 
     332      IF( lk_oasis   )   CALL sbc_cpl_snd( kstp, Nbb, Nnn )        ! coupled mode : field exchanges 
    334333      ! 
    335334#if defined key_iomput 
    … …  
    344343      ! 
    345344   END SUBROUTINE stp 
    346     
    347    SUBROUTINE update_pointers( Kbb, Kmm, Kaa ) 
    348       !!---------------------------------------------------------------------- 
    349       !!                     ***  ROUTINE update_pointers  *** 
    350       !! 
    351       !! ** Purpose :   Associate temporary pointer arrays. 
    352       !!                For IMMERSE development phase only - to be deleted 
    353       !! 
    354       !! ** Method  : 
    355       !!---------------------------------------------------------------------- 
    356       INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time level indices 
    357  
    358       ub => uu(:,:,:,Kbb); un => uu(:,:,:,Kmm); ua => uu(:,:,:,Kaa) 
    359       vb => vv(:,:,:,Kbb); vn => vv(:,:,:,Kmm); va => vv(:,:,:,Kaa) 
    360       wn => ww(:,:,:) 
    361       hdivn => hdiv(:,:,:) 
    362  
    363       sshb =>  ssh(:,:,Kbb); sshn =>  ssh(:,:,Kmm); ssha =>  ssh(:,:,Kaa) 
    364       ub_b => uu_b(:,:,Kbb); un_b => uu_b(:,:,Kmm); ua_b => uu_b(:,:,Kaa) 
    365       vb_b => vv_b(:,:,Kbb); vn_b => vv_b(:,:,Kmm); va_b => vv_b(:,:,Kaa) 
    366  
    367       tsb => ts(:,:,:,:,Kbb); tsn => ts(:,:,:,:,Kmm); tsa => ts(:,:,:,:,Kaa) 
    368  
    369       e3t_b => e3t(:,:,:,Kbb); e3t_n => e3t(:,:,:,Kmm); e3t_a => e3t(:,:,:,Kaa) 
    370       e3u_b => e3u(:,:,:,Kbb); e3u_n => e3u(:,:,:,Kmm); e3u_a => e3u(:,:,:,Kaa) 
    371       e3v_b => e3v(:,:,:,Kbb); e3v_n => e3v(:,:,:,Kmm); e3v_a => e3v(:,:,:,Kaa) 
    372  
    373       e3f_n => e3f(:,:,:) 
    374  
    375       e3w_b  => e3w (:,:,:,Kbb); e3w_n  => e3w (:,:,:,Kmm) 
    376       e3uw_b => e3uw(:,:,:,Kbb); e3uw_n => e3uw(:,:,:,Kmm) 
    377       e3vw_b => e3vw(:,:,:,Kbb); e3vw_n => e3vw(:,:,:,Kmm) 
    378  
    379       gdept_b => gdept(:,:,:,Kbb); gdept_n => gdept(:,:,:,Kmm)  
    380       gdepw_b => gdepw(:,:,:,Kbb); gdepw_n => gdepw(:,:,:,Kmm)  
    381       gde3w_n => gde3w(:,:,:) 
    382  
    383       ht_n => ht(:,:) 
    384  
    385       hu_b => hu(:,:,Kbb); hu_n => hu(:,:,Kmm); hu_a => hu(:,:,Kaa) 
    386       hv_b => hv(:,:,Kbb); hv_n => hv(:,:,Kmm); hv_a => hv(:,:,Kaa) 
    387  
    388       r1_hu_b => r1_hu(:,:,Kbb); r1_hu_n => r1_hu(:,:,Kmm); r1_hu_a => r1_hu(:,:,Kaa) 
    389       r1_hv_b => r1_hv(:,:,Kbb); r1_hv_n => r1_hv(:,:,Kmm); r1_hv_a => r1_hv(:,:,Kaa) 
    390  
    391  
    392    END SUBROUTINE update_pointers 
    393  
     345   ! 
    394346   !!====================================================================== 
    395347END MODULE step 
Note: See TracChangeset for help on using the changeset viewer.