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 10701 for NEMO/branches/2019/fix_ticket2238_solution1/src/OCE/ICB/icbutl.F90 – NEMO

Ignore:
Timestamp:
2019-02-19T20:15:53+01:00 (5 years ago)
Author:
mathiot
Message:

update branch to head of the trunk (ticket #2238)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/fix_ticket2238_solution1/src/OCE/ICB/icbutl.F90

    r10696 r10701  
    120120      !!             is half the off shore value, wile the normal-to-the-coast value is zero. 
    121121      !!             This is OK as a starting point. 
     122      !!       !!pm  HARD CODED: - rho_air now computed in sbcblk (what are the effect ?) 
     123      !!                         - drag coefficient (should it be namelist parameter ?) 
    122124      !! 
    123125      !!---------------------------------------------------------------------- 
     
    131133      !!---------------------------------------------------------------------- 
    132134 
    133       pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj )     ! scale factors 
     135      pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj )      ! scale factors 
    134136      pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 
    135137      ! 
    136       puo  = icb_utl_bilin_h( uo_e, pi, pj, 'U' )             ! ocean velocities 
    137       pvo  = icb_utl_bilin_h( vo_e, pi, pj, 'V' ) 
    138       psst = icb_utl_bilin_h( tt_e, pi, pj, 'T' )             ! SST 
    139       pcn  = icb_utl_bilin_h( fr_e , pi, pj, 'T' )            ! ice concentration 
    140       pff  = icb_utl_bilin_h( ff_e , pi, pj, 'F' )            ! Coriolis parameter 
    141       ! 
    142       pua  = icb_utl_bilin_h( ua_e , pi, pj, 'U' )            ! 10m wind 
    143       pva  = icb_utl_bilin_h( va_e , pi, pj, 'V' )            ! here (ua,va) are stress => rough conversion from stress to speed 
    144       zcd  = 1.22_wp * 1.5e-3_wp                              ! air density * drag coefficient 
     138      puo  = icb_utl_bilin_h( uo_e, pi, pj, 'U', .false.  )    ! ocean velocities 
     139      pvo  = icb_utl_bilin_h( vo_e, pi, pj, 'V', .false. ) 
     140      psst = icb_utl_bilin_h( tt_e, pi, pj, 'T', .true.   )    ! SST 
     141      pcn  = icb_utl_bilin_h( fr_e, pi, pj, 'T', .true.   )    ! ice concentration 
     142      pff  = icb_utl_bilin_h( ff_e, pi, pj, 'F', .false.  )    ! Coriolis parameter 
     143      ! 
     144      pua  = icb_utl_bilin_h( ua_e, pi, pj, 'U', .true.   )    ! 10m wind 
     145      pva  = icb_utl_bilin_h( va_e, pi, pj, 'V', .true.   )    ! here (ua,va) are stress => rough conversion from stress to speed 
     146      zcd  = 1.22_wp * 1.5e-3_wp                               ! air density * drag coefficient  
    145147      zmod = 1._wp / MAX(  1.e-20, SQRT(  zcd * SQRT( pua*pua + pva*pva)  )  ) 
    146148      pua  = pua * zmod                                       ! note: stress module=0 necessarly implies ua=va=0 
     
    148150 
    149151#if defined key_si3 
    150       pui = icb_utl_bilin_h( ui_e , pi, pj, 'U' )              ! sea-ice velocities 
    151       pvi = icb_utl_bilin_h( vi_e , pi, pj, 'V' ) 
    152       phi = icb_utl_bilin_h( hi_e , pi, pj, 'T' )              ! ice thickness 
     152      pui = icb_utl_bilin_h( ui_e , pi, pj, 'U', .false. )    ! sea-ice velocities 
     153      pvi = icb_utl_bilin_h( vi_e , pi, pj, 'V', .false. ) 
     154      phi = icb_utl_bilin_h( hi_e , pi, pj, 'T', .true.  )    ! ice thickness 
    153155#else 
    154156      pui = 0._wp 
     
    158160 
    159161      ! Estimate SSH gradient in i- and j-direction (centred evaluation) 
    160       pssh_i = ( icb_utl_bilin_h( ssh_e, pi+0.1_wp, pj, 'T' ) -   & 
    161          &       icb_utl_bilin_h( ssh_e, pi-0.1_wp, pj, 'T' )  ) / ( 0.2_wp * pe1 ) 
    162       pssh_j = ( icb_utl_bilin_h( ssh_e, pi, pj+0.1_wp, 'T' ) -   & 
    163          &       icb_utl_bilin_h( ssh_e, pi, pj-0.1_wp, 'T' )  ) / ( 0.2_wp * pe2 ) 
     162      pssh_i = ( icb_utl_bilin_h( ssh_e, pi+0.1_wp, pj, 'T', .true. ) -   & 
     163         &       icb_utl_bilin_h( ssh_e, pi-0.1_wp, pj, 'T', .true. )  ) / ( 0.2_wp * pe1 ) 
     164      pssh_j = ( icb_utl_bilin_h( ssh_e, pi, pj+0.1_wp, 'T', .true. ) -   & 
     165         &       icb_utl_bilin_h( ssh_e, pi, pj-0.1_wp, 'T', .true. )  ) / ( 0.2_wp * pe2 ) 
    164166      ! 
    165167   END SUBROUTINE icb_utl_interp 
    166168 
    167169 
    168    REAL(wp) FUNCTION icb_utl_bilin_h( pfld, pi, pj, cd_type ) 
     170   REAL(wp) FUNCTION icb_utl_bilin_h( pfld, pi, pj, cd_type, plmask ) 
    169171      !!---------------------------------------------------------------------- 
    170172      !!                  ***  FUNCTION icb_utl_bilin  *** 
     
    180182      REAL(wp)                            , INTENT(in) ::   pi, pj    ! targeted coordinates in (i,j) referential 
    181183      CHARACTER(len=1)                    , INTENT(in) ::   cd_type   ! type of pfld array grid-points: = T , U , V or F points 
     184      LOGICAL                             , INTENT(in) ::   plmask    ! special treatment of mask point 
    182185      ! 
    183186      INTEGER  ::   ii, ij   ! local integer 
    184187      REAL(wp) ::   zi, zj   ! local real 
     188      REAL(wp) :: zw1, zw2, zw3, zw4 
     189      REAL(wp), DIMENSION(4) :: zmask 
    185190      !!---------------------------------------------------------------------- 
    186191      ! 
     
    223228      ENDIF 
    224229      ! 
    225       ! 
    226       icb_utl_bilin_h = ( pfld(ii,ij  ) * (1._wp-zi) + pfld(ii+1,ij  ) * zi ) * (1._wp-zj)   & 
    227          &            + ( pfld(ii,ij+1) * (1._wp-zi) + pfld(ii+1,ij+1) * zi ) *        zj 
     230      ! define mask array  
     231      IF (plmask) THEN 
     232         ! land value is not used in the interpolation 
     233         SELECT CASE ( cd_type ) 
     234         CASE ( 'T' ) 
     235            zmask = (/tmask_e(ii,ij), tmask_e(ii+1,ij), tmask_e(ii,ij+1), tmask_e(ii+1,ij+1)/) 
     236         CASE ( 'U' ) 
     237            zmask = (/umask_e(ii,ij), umask_e(ii+1,ij), umask_e(ii,ij+1), umask_e(ii+1,ij+1)/) 
     238         CASE ( 'V' ) 
     239            zmask = (/vmask_e(ii,ij), vmask_e(ii+1,ij), vmask_e(ii,ij+1), vmask_e(ii+1,ij+1)/) 
     240         CASE ( 'F' ) 
     241            ! F case only used for coriolis, ff_f is not mask so zmask = 1 
     242            zmask = 1. 
     243         END SELECT 
     244      ELSE 
     245         ! land value is used during interpolation 
     246         zmask = 1. 
     247      END iF 
     248      ! 
     249      ! compute weight 
     250      zw1 = zmask(1) * (1._wp-zi) * (1._wp-zj) 
     251      zw2 = zmask(2) *        zi  * (1._wp-zj) 
     252      zw3 = zmask(3) * (1._wp-zi) *        zj 
     253      zw4 = zmask(4) *        zi  *        zj 
     254      ! 
     255      ! compute interpolated value 
     256      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)  
    228257      ! 
    229258   END FUNCTION icb_utl_bilin_h 
Note: See TracChangeset for help on using the changeset viewer.