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 14789 for NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ICB/icbutl.F90 – NEMO

Ignore:
Timestamp:
2021-05-05T13:18:04+02:00 (3 years ago)
Author:
mcastril
Message:

[2021/HPC-11_mcastril_HPDAonline_DiagGPU] Update externals

Location:
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
         5^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8^/vendors/PPR@HEAD            ext/PPR 
        89 
        910# SETTE 
        10 ^/utils/CI/sette@13559        sette 
         11^/utils/CI/sette@14244        sette 
  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ICB/icbutl.F90

    r13281 r14789  
    88   !!            -    !                            Removal of mapping from another grid 
    99   !!            -    !  2011-04  (Alderson)       Split into separate modules 
     10   !!           4.2   !  2020-07  (P. Mathiot)     simplification of interpolation routine 
     11   !!                 !                            and add Nacho Merino work 
    1012   !!---------------------------------------------------------------------- 
    1113 
    1214   !!---------------------------------------------------------------------- 
    1315   !!   icb_utl_interp   : 
    14    !!   icb_utl_bilin    : 
    15    !!   icb_utl_bilin_e  : 
     16   !!   icb_utl_pos      : compute bottom left corner indice, weight and mask 
     17   !!   icb_utl_bilin_h  : interpolation field to icb position 
     18   !!   icb_utl_bilin_e  : interpolation of scale factor to icb position 
    1619   !!---------------------------------------------------------------------- 
    1720   USE par_oce                             ! ocean parameters 
     21   USE oce,    ONLY: ts, uu, vv 
    1822   USE dom_oce                             ! ocean domain 
    1923   USE in_out_manager                      ! IO parameters 
     
    3135   PRIVATE 
    3236 
     37   INTERFACE icb_utl_bilin_h 
     38      MODULE PROCEDURE icb_utl_bilin_2d_h, icb_utl_bilin_3d_h 
     39   END INTERFACE 
     40 
    3341   PUBLIC   icb_utl_copy          ! routine called in icbstp module 
     42   PUBLIC   icb_utl_getkb         ! routine called in icbdyn and icbthm modules 
     43   PUBLIC   test_icb_utl_getkb    ! routine called in icbdyn and icbthm modules 
     44   PUBLIC   icb_utl_zavg          ! routine called in icbdyn and icbthm modules 
    3445   PUBLIC   icb_utl_interp        ! routine called in icbdyn, icbthm modules 
    35    PUBLIC   icb_utl_bilin         ! routine called in icbini, icbdyn modules 
    36    PUBLIC   icb_utl_bilin_x       ! routine called in icbdyn module 
     46   PUBLIC   icb_utl_bilin_h       ! routine called in icbdyn module 
    3747   PUBLIC   icb_utl_add           ! routine called in icbini.F90, icbclv, icblbc and icbrst modules 
    3848   PUBLIC   icb_utl_delete        ! routine called in icblbc, icbthm modules 
     
    4757   PUBLIC   icb_utl_heat          ! routine called in icbdia module 
    4858 
     59   !! * Substitutions 
     60#  include "domzgr_substitute.h90" 
    4961   !!---------------------------------------------------------------------- 
    5062   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    5466CONTAINS 
    5567 
    56    SUBROUTINE icb_utl_copy() 
     68   SUBROUTINE icb_utl_copy( Kmm ) 
    5769      !!---------------------------------------------------------------------- 
    5870      !!                  ***  ROUTINE icb_utl_copy  *** 
     
    6274      !! ** Method  : - blah blah 
    6375      !!---------------------------------------------------------------------- 
     76      REAL(wp), DIMENSION(0:jpi+1,0:jpj+1) :: ztmp 
    6477#if defined key_si3 
    6578      REAL(wp), DIMENSION(jpi,jpj) :: zssh_lead_m    !    ocean surface (ssh_m) if ice is not embedded 
    6679      !                                              !    ocean surface in leads if ice is embedded    
    6780#endif 
     81      INTEGER :: jk   ! vertical loop index 
     82      INTEGER :: Kmm  ! ocean time levelindex 
     83      ! 
    6884      ! copy nemo forcing arrays into iceberg versions with extra halo 
    6985      ! only necessary for variables not on T points 
    7086      ! and ssh which is used to calculate gradients 
    71  
    72       uo_e(1:jpi,1:jpj) = ssu_m(:,:) * umask(:,:,1) 
    73       vo_e(1:jpi,1:jpj) = ssv_m(:,:) * vmask(:,:,1) 
     87      ! 
     88      ! surface forcing 
     89      ! 
     90      ssu_e(1:jpi,1:jpj) = ssu_m(:,:) * umask(:,:,1) 
     91      ssv_e(1:jpi,1:jpj) = ssv_m(:,:) * vmask(:,:,1) 
     92      sst_e(1:jpi,1:jpj) = sst_m(:,:) 
     93      sss_e(1:jpi,1:jpj) = sss_m(:,:) 
     94      fr_e (1:jpi,1:jpj) = fr_i (:,:) 
     95      ua_e (1:jpi,1:jpj) = utau (:,:) * umask(:,:,1) ! maybe mask useless because mask applied in sbcblk 
     96      va_e (1:jpi,1:jpj) = vtau (:,:) * vmask(:,:,1) ! maybe mask useless because mask applied in sbcblk 
    7497      ff_e(1:jpi,1:jpj) = ff_f (:,:)  
    75       tt_e(1:jpi,1:jpj) = sst_m(:,:) 
    76       ss_e(1:jpi,1:jpj) = sss_m(:,:) 
    77       fr_e(1:jpi,1:jpj) = fr_i (:,:) 
    78       ua_e(1:jpi,1:jpj) = utau (:,:) * umask(:,:,1) ! maybe mask useless because mask applied in sbcblk 
    79       va_e(1:jpi,1:jpj) = vtau (:,:) * vmask(:,:,1) ! maybe mask useless because mask applied in sbcblk 
    80       ! 
    81       CALL lbc_lnk_icb( 'icbutl', uo_e, 'U', -1._wp, 1, 1 ) 
    82       CALL lbc_lnk_icb( 'icbutl', vo_e, 'V', -1._wp, 1, 1 ) 
    83       CALL lbc_lnk_icb( 'icbutl', ff_e, 'F', +1._wp, 1, 1 ) 
    84       CALL lbc_lnk_icb( 'icbutl', ua_e, 'U', -1._wp, 1, 1 ) 
    85       CALL lbc_lnk_icb( 'icbutl', va_e, 'V', -1._wp, 1, 1 ) 
    86       CALL lbc_lnk_icb( 'icbutl', fr_e, 'T', +1._wp, 1, 1 ) 
    87       CALL lbc_lnk_icb( 'icbutl', tt_e, 'T', +1._wp, 1, 1 ) 
    88       CALL lbc_lnk_icb( 'icbutl', ss_e, 'T', +1._wp, 1, 1 ) 
     98      ! 
     99      CALL lbc_lnk_icb( 'icbutl', ssu_e, 'U', -1._wp, 1, 1 ) 
     100      CALL lbc_lnk_icb( 'icbutl', ssv_e, 'V', -1._wp, 1, 1 ) 
     101      CALL lbc_lnk_icb( 'icbutl', ua_e , 'U', -1._wp, 1, 1 ) 
     102      CALL lbc_lnk_icb( 'icbutl', va_e , 'V', -1._wp, 1, 1 ) 
    89103#if defined key_si3 
    90104      hi_e(1:jpi, 1:jpj) = hm_i (:,:)   
     
    96110      ssh_e(1:jpi, 1:jpj) = zssh_lead_m(:,:) * tmask(:,:,1) 
    97111      ! 
    98       CALL lbc_lnk_icb( 'icbutl', hi_e , 'T', +1._wp, 1, 1 ) 
    99112      CALL lbc_lnk_icb( 'icbutl', ui_e , 'U', -1._wp, 1, 1 ) 
    100113      CALL lbc_lnk_icb( 'icbutl', vi_e , 'V', -1._wp, 1, 1 ) 
    101114#else 
    102       ssh_e(1:jpi, 1:jpj) = ssh_m(:,:) * tmask(:,:,1) 
     115      ssh_e(1:jpi, 1:jpj) = ssh_m(:,:) * tmask(:,:,1)          
    103116#endif 
    104       CALL lbc_lnk_icb( 'icbutl', ssh_e, 'T', +1._wp, 1, 1 ) 
     117      ! 
     118      ! (PM) could be improve with a 3d lbclnk gathering both variables 
     119      ! should be done once extra haloe generalised 
     120      IF ( ln_M2016 ) THEN 
     121         DO jk = 1,jpk 
     122            ! uoce 
     123            ztmp(1:jpi,1:jpj) = uu(:,:,jk,Kmm) 
     124            CALL lbc_lnk_icb( 'icbutl', ztmp, 'U', -1._wp, 1, 1 ) 
     125            uoce_e(:,:,jk) = ztmp(:,:) 
     126            ! 
     127            ! voce 
     128            ztmp(1:jpi,1:jpj) = vv(:,:,jk,Kmm) 
     129            CALL lbc_lnk_icb( 'icbutl', ztmp, 'V', -1._wp, 1, 1 ) 
     130            voce_e(:,:,jk) = ztmp(:,:) 
     131            ! 
     132            e3t_e(1:jpi,1:jpj,jk) = e3t(:,:,jk,Kmm) 
     133         END DO 
     134         toce_e(1:jpi,1:jpj,:) = ts(:,:,:,1,Kmm) 
     135      END IF 
    105136      ! 
    106137   END SUBROUTINE icb_utl_copy 
    107138 
    108139 
    109    SUBROUTINE icb_utl_interp( pi, pe1, puo, pui, pua, pssh_i,   & 
    110       &                       pj, pe2, pvo, pvi, pva, pssh_j,   & 
    111       &                       psst, pcn, phi, pff, psss        ) 
     140   SUBROUTINE icb_utl_interp( pi, pj, pe1 , pssu, pui, pua, pssh_i,         & 
     141      &                               pe2 , pssv, pvi, pva, pssh_j,         & 
     142      &                               psst, psss, pcn, phi, pff   ,         & 
     143      &                               plon, plat, ptoce, puoce, pvoce, pe3t ) 
    112144      !!---------------------------------------------------------------------- 
    113145      !!                  ***  ROUTINE icb_utl_interp  *** 
     
    127159      !!---------------------------------------------------------------------- 
    128160      REAL(wp), INTENT(in   ) ::   pi , pj                        ! position in (i,j) referential 
    129       REAL(wp), INTENT(  out) ::   pe1, pe2                       ! i- and j scale factors 
    130       REAL(wp), INTENT(  out) ::   puo, pvo, pui, pvi, pua, pva   ! ocean, ice and wind speeds 
    131       REAL(wp), INTENT(  out) ::   pssh_i, pssh_j                 ! ssh i- & j-gradients 
    132       REAL(wp), INTENT(  out) ::   psst, pcn, phi, pff, psss      ! SST, ice concentration, ice thickness, Coriolis, SSS 
    133       ! 
     161      REAL(wp), INTENT(  out), OPTIONAL ::   pe1, pe2                       ! i- and j scale factors 
     162      REAL(wp), INTENT(  out), OPTIONAL ::   pssu, pssv, pui, pvi, pua, pva ! ocean, ice and wind speeds 
     163      REAL(wp), INTENT(  out), OPTIONAL ::   pssh_i, pssh_j                 ! ssh i- & j-gradients 
     164      REAL(wp), INTENT(  out), OPTIONAL ::   psst, psss, pcn, phi, pff      ! SST, SSS, ice concentration, ice thickness, Coriolis 
     165      REAL(wp), INTENT(  out), OPTIONAL ::   plat, plon                     ! position 
     166      REAL(wp), DIMENSION(jpk), INTENT(  out), OPTIONAL ::   ptoce, puoce, pvoce, pe3t   ! 3D variables 
     167      ! 
     168      REAL(wp), DIMENSION(4) :: zwT  , zwU  , zwV  , zwF   ! interpolation weight 
     169      REAL(wp), DIMENSION(4) :: zmskF, zmskU, zmskV, zmskT ! mask 
     170      REAL(wp), DIMENSION(4) :: zwTp, zmskTp, zwTm, zmskTm 
     171      REAL(wp), DIMENSION(4,jpk) :: zw1d 
     172      INTEGER                :: iiT, iiU, iiV, iiF, ijT, ijU, ijV, ijF ! bottom left corner 
     173      INTEGER                :: iiTp, iiTm, ijTp, ijTm 
    134174      REAL(wp) ::   zcd, zmod       ! local scalars 
    135175      !!---------------------------------------------------------------------- 
    136  
    137       pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj )      ! scale factors 
    138       pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 
    139       ! 
    140       puo  = icb_utl_bilin_h( uo_e, pi, pj, 'U', .false.  )    ! ocean velocities 
    141       pvo  = icb_utl_bilin_h( vo_e, pi, pj, 'V', .false.  ) 
    142       psst = icb_utl_bilin_h( tt_e, pi, pj, 'T', .true.   )    ! SST 
    143       psss = icb_utl_bilin_h( ss_e, pi, pj, 'T', .true.   )    ! SSS 
    144       pcn  = icb_utl_bilin_h( fr_e, pi, pj, 'T', .true.   )    ! ice concentration 
    145       pff  = icb_utl_bilin_h( ff_e, pi, pj, 'F', .false.  )    ! Coriolis parameter 
    146       ! 
    147       pua  = icb_utl_bilin_h( ua_e, pi, pj, 'U', .true.   )    ! 10m wind 
    148       pva  = icb_utl_bilin_h( va_e, pi, pj, 'V', .true.   )    ! here (ua,va) are stress => rough conversion from stress to speed 
    149       zcd  = 1.22_wp * 1.5e-3_wp                               ! air density * drag coefficient  
    150       zmod = 1._wp / MAX(  1.e-20, SQRT(  zcd * SQRT( pua*pua + pva*pva)  )  ) 
    151       pua  = pua * zmod                                       ! note: stress module=0 necessarly implies ua=va=0 
    152       pva  = pva * zmod 
    153  
     176      ! 
     177      ! get position, weight and mask  
     178      CALL icb_utl_pos( pi, pj, 'T', iiT, ijT, zwT, zmskT ) 
     179      CALL icb_utl_pos( pi, pj, 'U', iiU, ijU, zwU, zmskU ) 
     180      CALL icb_utl_pos( pi, pj, 'V', iiV, ijV, zwV, zmskV ) 
     181      CALL icb_utl_pos( pi, pj, 'F', iiF, ijF, zwF, zmskF ) 
     182      ! 
     183      ! metrics and coordinates 
     184      IF ( PRESENT(pe1 ) ) pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj )      ! scale factors 
     185      IF ( PRESENT(pe2 ) ) pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 
     186      IF ( PRESENT(plon) ) plon= icb_utl_bilin_h( rlon_e, iiT, ijT, zwT, .true.  ) 
     187      IF ( PRESENT(plat) ) plat= icb_utl_bilin_h( rlat_e, iiT, ijT, zwT, .false. ) 
     188      ! 
     189      IF ( PRESENT(pssu) ) pssu = icb_utl_bilin_h( ssu_e, iiU, ijU, zwU        , .false. ) ! ocean velocities 
     190      IF ( PRESENT(pssv) ) pssv = icb_utl_bilin_h( ssv_e, iiV, ijV, zwV        , .false. ) ! 
     191      IF ( PRESENT(psst) ) psst = icb_utl_bilin_h( sst_e, iiT, ijT, zwT * zmskT, .false. ) ! sst 
     192      IF ( PRESENT(psss) ) psss = icb_utl_bilin_h( sss_e, iiT, ijT, zwT * zmskT, .false. ) ! sss 
     193      IF ( PRESENT(pcn ) ) pcn  = icb_utl_bilin_h( fr_e , iiT, ijT, zwT * zmskT, .false. ) ! ice concentration 
     194      IF ( PRESENT(pff ) ) pff  = icb_utl_bilin_h( ff_e , iiF, ijF, zwF        , .false. ) ! Coriolis parameter 
     195      ! 
     196      IF ( PRESENT(pua) .AND. PRESENT(pva) ) THEN 
     197         pua  = icb_utl_bilin_h( ua_e, iiU, ijU, zwU * zmskU, .false. ) ! 10m wind 
     198         pva  = icb_utl_bilin_h( va_e, iiV, ijV, zwV * zmskV, .false. ) ! here (ua,va) are stress => rough conversion from stress to speed 
     199         zcd  = 1.22_wp * 1.5e-3_wp                               ! air density * drag coefficient  
     200         zmod = 1._wp / MAX(  1.e-20, SQRT(  zcd * SQRT( pua*pua + pva*pva)  )  ) 
     201         pua  = pua * zmod                                       ! note: stress module=0 necessarly implies ua=va=0 
     202         pva  = pva * zmod 
     203      END IF 
     204      ! 
    154205#if defined key_si3 
    155       pui = icb_utl_bilin_h( ui_e , pi, pj, 'U', .false. )    ! sea-ice velocities 
    156       pvi = icb_utl_bilin_h( vi_e , pi, pj, 'V', .false. ) 
    157       phi = icb_utl_bilin_h( hi_e , pi, pj, 'T', .true.  )    ! ice thickness 
     206      IF ( PRESENT(pui) ) pui = icb_utl_bilin_h( ui_e , iiU, ijU, zwU        , .false. ) ! sea-ice velocities 
     207      IF ( PRESENT(pvi) ) pvi = icb_utl_bilin_h( vi_e , iiV, ijV, zwV        , .false. ) 
     208      IF ( PRESENT(phi) ) phi = icb_utl_bilin_h( hi_e , iiT, ijT, zwT * zmskT, .false. ) ! ice thickness 
    158209#else 
    159       pui = 0._wp 
    160       pvi = 0._wp 
    161       phi = 0._wp 
     210      IF ( PRESENT(pui) ) pui = 0._wp 
     211      IF ( PRESENT(pvi) ) pvi = 0._wp 
     212      IF ( PRESENT(phi) ) phi = 0._wp 
    162213#endif 
    163  
     214      ! 
    164215      ! Estimate SSH gradient in i- and j-direction (centred evaluation) 
    165       pssh_i = ( icb_utl_bilin_h( ssh_e, pi+0.1_wp, pj, 'T', .true. ) -   & 
    166          &       icb_utl_bilin_h( ssh_e, pi-0.1_wp, pj, 'T', .true. )  ) / ( 0.2_wp * pe1 ) 
    167       pssh_j = ( icb_utl_bilin_h( ssh_e, pi, pj+0.1_wp, 'T', .true. ) -   & 
    168          &       icb_utl_bilin_h( ssh_e, pi, pj-0.1_wp, 'T', .true. )  ) / ( 0.2_wp * pe2 ) 
     216      IF ( PRESENT(pssh_i) .AND. PRESENT(pssh_j) ) THEN 
     217         CALL icb_utl_pos( pi+0.1, pj    , 'T', iiTp, ijTp, zwTp, zmskTp ) 
     218         CALL icb_utl_pos( pi-0.1, pj    , 'T', iiTm, ijTm, zwTm, zmskTm ) 
     219         ! 
     220         IF ( .NOT. PRESENT(pe1) ) pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj ) 
     221         pssh_i = ( icb_utl_bilin_h( ssh_e, iiTp, ijTp, zwTp*zmskTp, .false. ) -   & 
     222            &       icb_utl_bilin_h( ssh_e, iiTm, ijTm, zwTm*zmskTm, .false. )  ) / ( 0.2_wp * pe1 ) 
     223         ! 
     224         CALL icb_utl_pos( pi    , pj+0.1, 'T', iiTp, ijTp, zwTp, zmskTp ) 
     225         CALL icb_utl_pos( pi    , pj-0.1, 'T', iiTm, ijTm, zwTm, zmskTm ) 
     226         ! 
     227         IF ( .NOT. PRESENT(pe2) ) pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 
     228         pssh_j = ( icb_utl_bilin_h( ssh_e, iiTp, ijTp, zwTp*zmskTp, .false. ) -   & 
     229            &       icb_utl_bilin_h( ssh_e, iiTm, ijTm, zwTm*zmskTm, .false. )  ) / ( 0.2_wp * pe2 ) 
     230      END IF 
     231      ! 
     232      ! 3d interpolation 
     233      IF ( PRESENT(puoce) .AND. PRESENT(pvoce) ) THEN 
     234         ! no need to mask as 0 is a valid data for land 
     235         zw1d(1,:) = zwU(1) ; zw1d(2,:) = zwU(2) ; zw1d(3,:) = zwU(3) ; zw1d(4,:) = zwU(4) ; 
     236         puoce(:) = icb_utl_bilin_h( uoce_e , iiU, ijU, zw1d ) 
     237 
     238         zw1d(1,:) = zwV(1) ; zw1d(2,:) = zwV(2) ; zw1d(3,:) = zwV(3) ; zw1d(4,:) = zwV(4) ; 
     239         pvoce(:) = icb_utl_bilin_h( voce_e , iiV, ijV, zw1d ) 
     240      END IF 
     241 
     242      IF ( PRESENT(ptoce) ) THEN 
     243         ! for temperature we need to mask the weight properly 
     244         ! no need of extra halo as it is a T point variable 
     245         zw1d(1,:) = tmask(iiT  ,ijT  ,:) * zwT(1) * zmskT(1) 
     246         zw1d(2,:) = tmask(iiT+1,ijT  ,:) * zwT(2) * zmskT(2) 
     247         zw1d(3,:) = tmask(iiT  ,ijT+1,:) * zwT(3) * zmskT(3) 
     248         zw1d(4,:) = tmask(iiT+1,ijT+1,:) * zwT(4) * zmskT(4) 
     249         ptoce(:) = icb_utl_bilin_h( toce_e , iiT, ijT, zw1d ) 
     250      END IF 
     251      ! 
     252      IF ( PRESENT(pe3t)  ) pe3t(:)  = e3t_e(iiT,ijT,:)    ! as in Nacho tarball need to be fix once we are able to reproduce Nacho results 
    169253      ! 
    170254   END SUBROUTINE icb_utl_interp 
    171255 
    172  
    173    REAL(wp) FUNCTION icb_utl_bilin_h( pfld, pi, pj, cd_type, plmask ) 
     256   SUBROUTINE icb_utl_pos( pi, pj, cd_type, kii, kij, pw, pmsk ) 
    174257      !!---------------------------------------------------------------------- 
    175258      !!                  ***  FUNCTION icb_utl_bilin  *** 
     
    182265      !! 
    183266      !!---------------------------------------------------------------------- 
    184       REAL(wp), DIMENSION(0:jpi+1,0:jpj+1), INTENT(in) ::   pfld      ! field to be interpolated 
    185       REAL(wp)                            , INTENT(in) ::   pi, pj    ! targeted coordinates in (i,j) referential 
    186       CHARACTER(len=1)                    , INTENT(in) ::   cd_type   ! type of pfld array grid-points: = T , U , V or F points 
    187       LOGICAL                             , INTENT(in) ::   plmask    ! special treatment of mask point 
    188       ! 
    189       INTEGER  ::   ii, ij   ! local integer 
    190       REAL(wp) ::   zi, zj   ! local real 
    191       REAL(wp) :: zw1, zw2, zw3, zw4 
    192       REAL(wp), DIMENSION(4) :: zmask 
     267      REAL(wp)              , INTENT(IN)  ::   pi, pj    ! targeted coordinates in (i,j) referential 
     268      CHARACTER(len=1)      , INTENT(IN)  ::   cd_type   ! point type 
     269      REAL(wp), DIMENSION(4), INTENT(OUT) ::   pw, pmsk  ! weight and mask 
     270      INTEGER ,               INTENT(OUT) ::   kii, kij  ! bottom left corner position in local domain 
     271      ! 
     272      REAL(wp) :: zwi, zwj ! distance to bottom left corner 
     273      INTEGER  :: ierr  
     274      ! 
    193275      !!---------------------------------------------------------------------- 
    194276      ! 
     
    198280         ! since we're looking for four T points containing quadrant we're in of  
    199281         ! current T cell 
    200          ii = MAX(0, INT( pi     )) 
    201          ij = MAX(0, INT( pj     ))    ! T-point 
    202          zi = pi - REAL(ii,wp) 
    203          zj = pj - REAL(ij,wp) 
     282         kii = MAX(0, INT( pi        )) 
     283         kij = MAX(0, INT( pj        ))    ! T-point 
     284         zwi = pi - REAL(kii,wp) 
     285         zwj = pj - REAL(kij,wp) 
    204286      CASE ( 'U' ) 
    205          ii = MAX(0, INT( pi-0.5_wp )) 
    206          ij = MAX(0, INT( pj     ))    ! U-point 
    207          zi = pi - 0.5_wp - REAL(ii,wp) 
    208          zj = pj - REAL(ij,wp) 
     287         kii = MAX(0, INT( pi-0.5_wp )) 
     288         kij = MAX(0, INT( pj        ))    ! U-point 
     289         zwi = pi - 0.5_wp - REAL(kii,wp) 
     290         zwj = pj - REAL(kij,wp) 
    209291      CASE ( 'V' ) 
    210          ii = MAX(0, INT( pi     )) 
    211          ij = MAX(0, INT( pj-0.5_wp ))    ! V-point 
    212          zi = pi - REAL(ii,wp) 
    213          zj = pj - 0.5_wp - REAL(ij,wp) 
     292         kii = MAX(0, INT( pi        )) 
     293         kij = MAX(0, INT( pj-0.5_wp ))    ! V-point 
     294         zwi = pi - REAL(kii,wp) 
     295         zwj = pj - 0.5_wp - REAL(kij,wp) 
    214296      CASE ( 'F' ) 
    215          ii = MAX(0, INT( pi-0.5_wp )) 
    216          ij = MAX(0, INT( pj-0.5_wp ))    ! F-point 
    217          zi = pi - 0.5_wp - REAL(ii,wp) 
    218          zj = pj - 0.5_wp - REAL(ij,wp) 
     297         kii = MAX(0, INT( pi-0.5_wp )) 
     298         kij = MAX(0, INT( pj-0.5_wp ))    ! F-point 
     299         zwi = pi - 0.5_wp - REAL(kii,wp) 
     300         zwj = pj - 0.5_wp - REAL(kij,wp) 
    219301      END SELECT 
     302      ! 
     303      ! compute weight 
     304      pw(1) = (1._wp-zwi) * (1._wp-zwj) 
     305      pw(2) =        zwi  * (1._wp-zwj) 
     306      pw(3) = (1._wp-zwi) *        zwj 
     307      pw(4) =        zwi  *        zwj 
     308      ! 
     309      ! find position in this processor. Prevent near edge problems (see #1389) 
     310      ! 
     311      IF (TRIM(cd_type) == 'T' ) THEN 
     312         ierr = 0 
     313         IF    ( kii <  mig( 1 ) ) THEN   ;  ierr = ierr + 1 
     314         ELSEIF( kii >= mig(jpi) ) THEN   ;  ierr = ierr + 1 
     315         ENDIF 
     316         ! 
     317         IF    ( kij <  mjg( 1 ) ) THEN   ;   ierr = ierr + 1 
     318         ELSEIF( kij >= mjg(jpj) ) THEN   ;   ierr = ierr + 1 
     319         ENDIF 
     320         ! 
     321         IF ( ierr > 0 ) THEN 
     322            WRITE(numicb,*) 'bottom left corner T point out of bound' 
     323            WRITE(numicb,*) pi, kii, mig( 1 ), mig(jpi) 
     324            WRITE(numicb,*) pj, kij, mjg( 1 ), mjg(jpj) 
     325            WRITE(numicb,*) pmsk 
     326            CALL FLUSH(numicb) 
     327            CALL ctl_stop('STOP','icb_utl_bilin_e: an icebergs coordinates is out of valid range (out of bound error).'       , & 
     328                 &                                'This can be fixed using rn_speed_limit=0.4 in &namberg.'                   , & 
     329                 &                                'More details in the corresponding iceberg.stat file (nn_verbose_level > 0).' ) 
     330         END IF 
     331      END IF 
    220332      ! 
    221333      ! find position in this processor. Prevent near edge problems (see #1389) 
    222334      ! (PM) will be useless if extra halo is used in NEMO 
    223335      ! 
    224       IF    ( ii <= mig(1)-1 ) THEN   ;   ii = 0 
    225       ELSEIF( ii  > mig(jpi) ) THEN   ;   ii = jpi 
    226       ELSE                            ;   ii = mi1(ii) 
     336      IF    ( kii <= mig(1)-1 ) THEN   ;   kii = 0 
     337      ELSEIF( kii  > mig(jpi) ) THEN   ;   kii = jpi 
     338      ELSE                             ;   kii = mi1(kii) 
    227339      ENDIF 
    228       IF    ( ij <= mjg(1)-1 ) THEN   ;   ij = 0 
    229       ELSEIF( ij  > mjg(jpj) ) THEN   ;   ij = jpj 
    230       ELSE                            ;   ij = mj1(ij) 
     340      IF    ( kij <= mjg(1)-1 ) THEN   ;   kij = 0 
     341      ELSEIF( kij  > mjg(jpj) ) THEN   ;   kij = jpj 
     342      ELSE                             ;   kij = mj1(kij) 
    231343      ENDIF 
    232344      ! 
    233345      ! define mask array  
    234       IF (plmask) THEN 
    235          ! land value is not used in the interpolation 
    236          SELECT CASE ( cd_type ) 
    237          CASE ( 'T' ) 
    238             zmask = (/tmask_e(ii,ij), tmask_e(ii+1,ij), tmask_e(ii,ij+1), tmask_e(ii+1,ij+1)/) 
    239          CASE ( 'U' ) 
    240             zmask = (/umask_e(ii,ij), umask_e(ii+1,ij), umask_e(ii,ij+1), umask_e(ii+1,ij+1)/) 
    241          CASE ( 'V' ) 
    242             zmask = (/vmask_e(ii,ij), vmask_e(ii+1,ij), vmask_e(ii,ij+1), vmask_e(ii+1,ij+1)/) 
    243          CASE ( 'F' ) 
    244             ! F case only used for coriolis, ff_f is not mask so zmask = 1 
    245             zmask = 1. 
    246          END SELECT 
    247       ELSE 
    248          ! land value is used during interpolation 
    249          zmask = 1. 
    250       END iF 
    251       ! 
    252       ! compute weight 
    253       zw1 = zmask(1) * (1._wp-zi) * (1._wp-zj) 
    254       zw2 = zmask(2) *        zi  * (1._wp-zj) 
    255       zw3 = zmask(3) * (1._wp-zi) *        zj 
    256       zw4 = zmask(4) *        zi  *        zj 
    257       ! 
    258       ! compute interpolated value 
    259       icb_utl_bilin_h = ( pfld(ii,ij)*zw1 + pfld(ii+1,ij)*zw2 + pfld(ii,ij+1)*zw3 + pfld(ii+1,ij+1)*zw4 ) / MAX(1.e-20, zw1+zw2+zw3+zw4)  
    260       ! 
    261    END FUNCTION icb_utl_bilin_h 
    262  
    263  
    264    REAL(wp) FUNCTION icb_utl_bilin( pfld, pi, pj, cd_type ) 
     346      ! land value is not used in the interpolation 
     347      SELECT CASE ( cd_type ) 
     348      CASE ( 'T' ) 
     349         pmsk = (/tmask_e(kii,kij), tmask_e(kii+1,kij), tmask_e(kii,kij+1), tmask_e(kii+1,kij+1)/) 
     350      CASE ( 'U' ) 
     351         pmsk = (/umask_e(kii,kij), umask_e(kii+1,kij), umask_e(kii,kij+1), umask_e(kii+1,kij+1)/) 
     352      CASE ( 'V' ) 
     353         pmsk = (/vmask_e(kii,kij), vmask_e(kii+1,kij), vmask_e(kii,kij+1), vmask_e(kii+1,kij+1)/) 
     354      CASE ( 'F' ) 
     355         ! F case only used for coriolis, ff_f is not mask so zmask = 1 
     356         pmsk = 1. 
     357      END SELECT 
     358   END SUBROUTINE icb_utl_pos 
     359 
     360   REAL(wp) FUNCTION icb_utl_bilin_2d_h( pfld, pii, pij, pw, pllon ) 
    265361      !!---------------------------------------------------------------------- 
    266362      !!                  ***  FUNCTION icb_utl_bilin  *** 
    267363      !! 
    268364      !! ** Purpose :   bilinear interpolation at berg location depending on the grid-point type 
     365      !!                this version deals with extra halo points 
    269366      !! 
    270367      !!       !!gm  CAUTION an optional argument should be added to handle 
     
    272369      !! 
    273370      !!---------------------------------------------------------------------- 
    274       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pfld      ! field to be interpolated 
    275       REAL(wp)                    , INTENT(in) ::   pi, pj    ! targeted coordinates in (i,j) referential 
    276       CHARACTER(len=1)            , INTENT(in) ::   cd_type   ! type of pfld array grid-points: = T , U , V or F points 
    277       ! 
    278       INTEGER  ::   ii, ij   ! local integer 
    279       REAL(wp) ::   zi, zj   ! local real 
    280       !!---------------------------------------------------------------------- 
    281       ! 
    282       SELECT CASE ( cd_type ) 
    283          CASE ( 'T' ) 
    284             ! note that here there is no +0.5 added 
    285             ! since we're looking for four T points containing quadrant we're in of  
    286             ! current T cell 
    287             ii = MAX(1, INT( pi     )) 
    288             ij = MAX(1, INT( pj     ))    ! T-point 
    289             zi = pi - REAL(ii,wp) 
    290             zj = pj - REAL(ij,wp) 
    291          CASE ( 'U' ) 
    292             ii = MAX(1, INT( pi-0.5 )) 
    293             ij = MAX(1, INT( pj     ))    ! U-point 
    294             zi = pi - 0.5 - REAL(ii,wp) 
    295             zj = pj - REAL(ij,wp) 
    296          CASE ( 'V' ) 
    297             ii = MAX(1, INT( pi     )) 
    298             ij = MAX(1, INT( pj-0.5 ))    ! V-point 
    299             zi = pi - REAL(ii,wp) 
    300             zj = pj - 0.5 - REAL(ij,wp) 
    301          CASE ( 'F' ) 
    302             ii = MAX(1, INT( pi-0.5 )) 
    303             ij = MAX(1, INT( pj-0.5 ))    ! F-point 
    304             zi = pi - 0.5 - REAL(ii,wp) 
    305             zj = pj - 0.5 - REAL(ij,wp) 
    306       END SELECT 
    307       ! 
    308       ! find position in this processor. Prevent near edge problems (see #1389) 
    309       IF    ( ii < mig( 1 ) ) THEN   ;   ii = 1 
    310       ELSEIF( ii > mig(jpi) ) THEN   ;   ii = jpi 
    311       ELSE                           ;   ii = mi1(ii) 
     371      REAL(wp), DIMENSION(0:jpi+1,0:jpj+1), INTENT(in) ::   pfld      ! field to be interpolated 
     372      REAL(wp), DIMENSION(4)              , INTENT(in) ::   pw        ! weight 
     373      LOGICAL                             , INTENT(in) ::   pllon     ! input data is a longitude 
     374      INTEGER ,                             INTENT(in) ::   pii, pij  ! bottom left corner 
     375      ! 
     376      REAL(wp), DIMENSION(4) :: zdat ! input data 
     377      !!---------------------------------------------------------------------- 
     378      ! 
     379      ! data 
     380      zdat(1) = pfld(pii  ,pij  ) 
     381      zdat(2) = pfld(pii+1,pij  ) 
     382      zdat(3) = pfld(pii  ,pij+1) 
     383      zdat(4) = pfld(pii+1,pij+1) 
     384      ! 
     385      IF( pllon .AND. MAXVAL(zdat) - MINVAL(zdat) > 90._wp ) THEN 
     386         WHERE( zdat < 0._wp ) zdat = zdat + 360._wp 
    312387      ENDIF 
    313       IF    ( ij < mjg( 1 ) ) THEN   ;   ij = 1 
    314       ELSEIF( ij > mjg(jpj) ) THEN   ;   ij = jpj 
    315       ELSE                           ;   ij  = mj1(ij) 
    316       ENDIF 
    317       ! 
    318       IF( ii == jpi )   ii = ii-1       
    319       IF( ij == jpj )   ij = ij-1 
    320       ! 
    321       icb_utl_bilin = ( pfld(ii,ij  ) * (1.-zi) + pfld(ii+1,ij  ) * zi ) * (1.-zj)   & 
    322          &          + ( pfld(ii,ij+1) * (1.-zi) + pfld(ii+1,ij+1) * zi ) *     zj 
    323       ! 
    324    END FUNCTION icb_utl_bilin 
    325  
    326  
    327    REAL(wp) FUNCTION icb_utl_bilin_x( pfld, pi, pj ) 
    328       !!---------------------------------------------------------------------- 
    329       !!                  ***  FUNCTION icb_utl_bilin_x  *** 
     388      ! 
     389      ! compute interpolated value 
     390      icb_utl_bilin_2d_h = ( zdat(1)*pw(1) + zdat(2)*pw(2) + zdat(3)*pw(3) + zdat(4)*pw(4) ) / MAX(1.e-20, pw(1)+pw(2)+pw(3)+pw(4))  
     391      ! 
     392      IF( pllon .AND. icb_utl_bilin_2d_h > 180._wp ) icb_utl_bilin_2d_h = icb_utl_bilin_2d_h - 360._wp 
     393      ! 
     394   END FUNCTION icb_utl_bilin_2d_h 
     395 
     396   FUNCTION icb_utl_bilin_3d_h( pfld, pii, pij, pw ) 
     397      !!---------------------------------------------------------------------- 
     398      !!                  ***  FUNCTION icb_utl_bilin  *** 
    330399      !! 
    331400      !! ** Purpose :   bilinear interpolation at berg location depending on the grid-point type 
    332       !!                Special case for interpolating longitude 
     401      !!                this version deals with extra halo points 
    333402      !! 
    334403      !!       !!gm  CAUTION an optional argument should be added to handle 
     
    336405      !! 
    337406      !!---------------------------------------------------------------------- 
    338       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pfld      ! field to be interpolated 
    339       REAL(wp)                    , INTENT(in) ::   pi, pj    ! targeted coordinates in (i,j) referential 
    340       ! 
    341       INTEGER                                  ::   ii, ij   ! local integer 
    342       REAL(wp)                                 ::   zi, zj   ! local real 
    343       REAL(wp)                                 ::   zret     ! local real 
    344       REAL(wp), DIMENSION(4)                   ::   z4 
    345       !!---------------------------------------------------------------------- 
    346       ! 
    347       ! note that here there is no +0.5 added 
    348       ! since we're looking for four T points containing quadrant we're in of  
    349       ! current T cell 
    350       ii = MAX(1, INT( pi     )) 
    351       ij = MAX(1, INT( pj     ))    ! T-point 
    352       zi = pi - REAL(ii,wp) 
    353       zj = pj - REAL(ij,wp) 
    354       ! 
    355       ! find position in this processor. Prevent near edge problems (see #1389) 
    356       IF    ( ii < mig( 1 ) ) THEN   ;   ii = 1 
    357       ELSEIF( ii > mig(jpi) ) THEN   ;   ii = jpi 
    358       ELSE                           ;   ii = mi1(ii) 
    359       ENDIF 
    360       IF    ( ij < mjg( 1 ) ) THEN   ;   ij = 1 
    361       ELSEIF( ij > mjg(jpj) ) THEN   ;   ij = jpj 
    362       ELSE                           ;   ij  = mj1(ij) 
    363       ENDIF 
    364       ! 
    365       IF( ii == jpi )   ii = ii-1       
    366       IF( ij == jpj )   ij = ij-1 
    367       ! 
    368       z4(1) = pfld(ii  ,ij  ) 
    369       z4(2) = pfld(ii+1,ij  ) 
    370       z4(3) = pfld(ii  ,ij+1) 
    371       z4(4) = pfld(ii+1,ij+1) 
    372       IF( MAXVAL(z4) - MINVAL(z4) > 90._wp ) THEN 
    373          WHERE( z4 < 0._wp ) z4 = z4 + 360._wp 
    374       ENDIF 
    375       ! 
    376       zret = (z4(1) * (1.-zi) + z4(2) * zi) * (1.-zj) + (z4(3) * (1.-zi) + z4(4) * zi) * zj 
    377       IF( zret > 180._wp ) zret = zret - 360._wp 
    378       icb_utl_bilin_x = zret 
    379       ! 
    380    END FUNCTION icb_utl_bilin_x 
    381  
     407      REAL(wp), DIMENSION(0:jpi+1,0:jpj+1, jpk), INTENT(in) ::   pfld      ! field to be interpolated 
     408      REAL(wp), DIMENSION(4,jpk)               , INTENT(in) ::   pw        ! weight 
     409      INTEGER ,                                  INTENT(in) ::   pii, pij  ! bottom left corner 
     410      REAL(wp), DIMENSION(jpk) :: icb_utl_bilin_3d_h 
     411      ! 
     412      REAL(wp), DIMENSION(4,jpk) :: zdat ! input data 
     413      INTEGER :: jk 
     414      !!---------------------------------------------------------------------- 
     415      ! 
     416      ! data 
     417      zdat(1,:) = pfld(pii  ,pij  ,:) 
     418      zdat(2,:) = pfld(pii+1,pij  ,:) 
     419      zdat(3,:) = pfld(pii  ,pij+1,:) 
     420      zdat(4,:) = pfld(pii+1,pij+1,:) 
     421      ! 
     422      ! compute interpolated value 
     423      DO jk=1,jpk 
     424         icb_utl_bilin_3d_h(jk) =   ( zdat(1,jk)*pw(1,jk) + zdat(2,jk)*pw(2,jk) + zdat(3,jk)*pw(3,jk) + zdat(4,jk)*pw(4,jk) ) & 
     425            &                     /   MAX(1.e-20, pw(1,jk)+pw(2,jk)+pw(3,jk)+pw(4,jk))  
     426      END DO 
     427      ! 
     428   END FUNCTION icb_utl_bilin_3d_h 
    382429 
    383430   REAL(wp) FUNCTION icb_utl_bilin_e( pet, peu, pev, pef, pi, pj ) 
     
    390437      !!---------------------------------------------------------------------- 
    391438      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pet, peu, pev, pef   ! horizontal scale factor to be interpolated at t-,u-,v- & f-pts 
    392       REAL(wp)                , INTENT(in) ::   pi, pj               ! targeted coordinates in (i,j) referential 
    393       ! 
    394       INTEGER  ::   ii, ij, icase, ierr   ! local integer 
     439      REAL(wp)                , INTENT(IN) ::   pi , pj              ! iceberg position 
    395440      ! 
    396441      ! weights corresponding to corner points of a T cell quadrant 
    397442      REAL(wp) ::   zi, zj          ! local real 
     443      INTEGER  ::   ii, ij          ! bottom left corner coordinate in local domain 
    398444      ! 
    399445      ! values at corner points of a T cell quadrant 
     
    402448      !!---------------------------------------------------------------------- 
    403449      ! 
     450      ! cannot used iiT because need ii/ij reltaive to global indices not local one 
    404451      ii = MAX(1, INT( pi ))   ;   ij = MAX(1, INT( pj ))            ! left bottom T-point (i,j) indices 
    405  
     452      !  
    406453      ! fractional box spacing 
    407454      ! 0   <= zi < 0.5, 0   <= zj < 0.5   -->  NW quadrant of current T cell 
     
    413460      zj = pj - REAL(ij,wp) 
    414461 
    415       ! find position in this processor. Prevent near edge problems (see #1389) 
    416       ! 
    417       ierr = 0 
    418       IF    ( ii < mig( 1 ) ) THEN   ;   ii = 1       ; ierr = ierr + 1 
    419       ELSEIF( ii > mig(jpi) ) THEN   ;   ii = jpi     ; ierr = ierr + 1 
    420       ELSE                           ;   ii = mi1(ii) 
    421       ENDIF 
    422       IF    ( ij < mjg( 1 ) ) THEN   ;   ij = 1       ; ierr = ierr + 1 
    423       ELSEIF( ij > mjg(jpj) ) THEN   ;   ij = jpj     ; ierr = ierr + 1 
    424       ELSE                           ;   ij  = mj1(ij) 
    425       ENDIF 
    426       ! 
    427       IF( ii == jpi ) THEN ; ii = ii-1 ; ierr = ierr + 1 ; END IF      
    428       IF( ij == jpj ) THEN ; ij = ij-1 ; ierr = ierr + 1 ; END IF 
    429       ! 
    430       IF ( ierr > 0 ) CALL ctl_stop('STOP','icb_utl_bilin_e: an icebergs coordinates is out of valid range (out of bound error)') 
     462      ! conversion to local domain (no need to do a sanity check already done in icbpos) 
     463      ii = mi1(ii) 
     464      ij = mj1(ij) 
    431465      ! 
    432466      IF(    0.0_wp <= zi .AND. zi < 0.5_wp   ) THEN 
     
    465499   END FUNCTION icb_utl_bilin_e 
    466500 
     501   SUBROUTINE icb_utl_getkb( kb, pe3, pD ) 
     502      !!---------------------------------------------------------------------- 
     503      !!                ***  ROUTINE icb_utl_getkb         *** 
     504      !! 
     505      !! ** Purpose :   compute the latest level affected by icb 
     506      !! 
     507      !!---------------------------------------------------------------------- 
     508      INTEGER,                INTENT(out):: kb 
     509      REAL(wp), DIMENSION(:), INTENT(in) :: pe3 
     510      REAL(wp),               INTENT(in) :: pD 
     511      !! 
     512      INTEGER  :: jk 
     513      REAL(wp) :: zdepw 
     514      !!---------------------------------------------------------------------- 
     515      !! 
     516      zdepw = pe3(1) ; kb = 2 
     517      DO WHILE ( zdepw <  pD) 
     518         zdepw = zdepw + pe3(kb) 
     519         kb = kb + 1 
     520      END DO 
     521      kb = MIN(kb - 1,jpk) 
     522   END SUBROUTINE 
     523 
     524   SUBROUTINE icb_utl_zavg(pzavg, pdat, pe3, pD, kb ) 
     525      !!---------------------------------------------------------------------- 
     526      !!                ***  ROUTINE icb_utl_getkb         *** 
     527      !! 
     528      !! ** Purpose :   compute the vertical average of ocean properties affected by icb 
     529      !! 
     530      !!---------------------------------------------------------------------- 
     531      INTEGER,                INTENT(in ) :: kb        ! deepest level affected by icb 
     532      REAL(wp), DIMENSION(:), INTENT(in ) :: pe3, pdat ! vertical profile 
     533      REAL(wp),               INTENT(in ) :: pD        ! draft 
     534      REAL(wp),               INTENT(out) :: pzavg     ! z average 
     535      !!---------------------------------------------------------------------- 
     536      INTEGER  :: jk 
     537      REAL(wp) :: zdep 
     538      !!---------------------------------------------------------------------- 
     539      pzavg = 0.0 ; zdep = 0.0 
     540      DO jk = 1,kb-1 
     541         pzavg = pzavg + pe3(jk)*pdat(jk) 
     542         zdep  = zdep  + pe3(jk) 
     543      END DO 
     544      ! if kb is limited by mbkt  => bottom value is used between bathy and icb tail 
     545      ! if kb not limited by mbkt => ocean value over mask is used (ie 0.0 for u, v) 
     546      pzavg = ( pzavg + (pD - zdep)*pdat(kb)) / pD 
     547   END SUBROUTINE 
    467548 
    468549   SUBROUTINE icb_utl_add( bergvals, ptvals ) 
     
    653734      WRITE(numicb, 9200) kt, berg%number(1), & 
    654735                   pt%xi, pt%yj, pt%lon, pt%lat, pt%uvel, pt%vvel,  & 
    655                    pt%uo, pt%vo, pt%ua, pt%va, pt%ui, pt%vi 
     736                   pt%ssu, pt%ssv, pt%ua, pt%va, pt%ui, pt%vi 
    656737      CALL flush( numicb ) 
    657738 9200 FORMAT(5x,i5,2x,i10,6(2x,2f10.4)) 
     
    679760         WRITE(numicb,'(a," pe=(",i3,")")' ) cd_label, narea 
    680761         WRITE(numicb,'(a8,4x,a6,12x,a5,15x,a7,19x,a3,17x,a5,17x,a5,17x,a5)' )   & 
    681             &         'timestep', 'number', 'xi,yj','lon,lat','u,v','uo,vo','ua,va','ui,vi' 
     762            &         'timestep', 'number', 'xi,yj','lon,lat','u,v','ssu,ssv','ua,va','ui,vi' 
    682763      ENDIF 
    683764      DO WHILE( ASSOCIATED(this) ) 
     
    823904   END FUNCTION icb_utl_heat 
    824905 
     906   SUBROUTINE test_icb_utl_getkb 
     907      !!---------------------------------------------------------------------- 
     908      !!                 ***  FUNCTION test_icb_utl_getkb  *** 
     909      !! 
     910      !! ** Purpose : Test routine icb_utl_getkb, icb_utl_zavg 
     911      !! ** Methode : Call each subroutine with specific input data 
     912      !!              What should be the output is easy to determined and check  
     913      !!              if NEMO return the correct answer. 
     914      !! ** Comments : not called, if needed a CALL test_icb_utl_getkb need to be added in icb_step 
     915      !!---------------------------------------------------------------------- 
     916      INTEGER :: ikb 
     917      REAL(wp) :: zD, zout 
     918      REAL(wp), DIMENSION(jpk) :: ze3, zin 
     919      WRITE(numout,*) 'Test icb_utl_getkb : ' 
     920      zD = 0.0 ; ze3= 20.0 
     921      WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 
     922      CALL icb_utl_getkb(ikb, ze3, zD) 
     923      WRITE(numout,*) 'OUTPUT : kb = ',ikb 
     924 
     925      zD = 8000000.0 ; ze3= 20.0 
     926      WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 
     927      CALL icb_utl_getkb(ikb, ze3, zD) 
     928      WRITE(numout,*) 'OUTPUT : kb = ',ikb 
     929 
     930      zD = 80.0 ; ze3= 20.0 
     931      WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 
     932      CALL icb_utl_getkb(ikb, ze3, zD) 
     933      WRITE(numout,*) 'OUTPUT : kb = ',ikb 
     934 
     935      zD = 85.0 ; ze3= 20.0 
     936      WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 
     937      CALL icb_utl_getkb(ikb, ze3, zD) 
     938      WRITE(numout,*) 'OUTPUT : kb = ',ikb 
     939 
     940      zD = 75.0 ; ze3= 20.0 
     941      WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 
     942      CALL icb_utl_getkb(ikb, ze3, zD) 
     943      WRITE(numout,*) 'OUTPUT : kb = ',ikb 
     944 
     945      WRITE(numout,*) '==================================' 
     946      WRITE(numout,*) 'Test icb_utl_zavg' 
     947      zD = 0.0 ; ze3= 20.0 ; zin=1.0 
     948      CALL icb_utl_getkb(ikb, ze3, zD) 
     949      CALL icb_utl_zavg(zout, zin, ze3, zD, ikb) 
     950      WRITE(numout,*) 'INPUT  : zD = ',zD,' ze3 = ',ze3(1),' zin = ', zin, ' ikb = ',ikb 
     951      WRITE(numout,*) 'OUTPUT : zout = ',zout 
     952 
     953      zD = 50.0 ; ze3= 20.0 ; zin=1.0; zin(3:jpk) = 0.0 
     954      CALL icb_utl_getkb(ikb, ze3, zD) 
     955      CALL icb_utl_zavg(zout, zin, ze3, zD, ikb) 
     956      WRITE(numout,*) 'INPUT  : zD = ',zD,' ze3 = ',ze3(1),' zin = ', zin, ' ikb = ',ikb 
     957      WRITE(numout,*) 'OUTPUT : zout = ',zout 
     958      CALL FLUSH(numout) 
     959 
     960      zD = 80.0 ; ze3= 20.0 ; zin=1.0; zin(3:jpk) = 0.0 
     961      CALL icb_utl_getkb(ikb, ze3, zD) 
     962      CALL icb_utl_zavg(zout, zin, ze3, zD, ikb) 
     963      WRITE(numout,*) 'INPUT  : zD = ',zD,' ze3 = ',ze3(1),' zin = ', zin, ' ikb = ',ikb 
     964      WRITE(numout,*) 'OUTPUT : zout = ',zout 
     965 
     966      zD = 80 ; ze3= 20.0 ; zin=1.0 ; zin(3:jpk) = 0.0 
     967      CALL icb_utl_getkb(ikb, ze3, zD) 
     968      ikb = 2 
     969      CALL icb_utl_zavg(zout, zin, ze3, zD, ikb) 
     970      WRITE(numout,*) 'INPUT  : zD = ',zD,' ze3 = ',ze3(1),' zin = ', zin, ' ikb = ',ikb 
     971      WRITE(numout,*) 'OUTPUT : zout = ',zout 
     972 
     973      CALL FLUSH(numout) 
     974 
     975   END SUBROUTINE test_icb_utl_getkb 
     976 
    825977   !!====================================================================== 
    826978END MODULE icbutl 
Note: See TracChangeset for help on using the changeset viewer.