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 4990 for trunk/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90 – NEMO

Ignore:
Timestamp:
2014-12-15T17:42:49+01:00 (9 years ago)
Author:
timgraham
Message:

Merged branches/2014/dev_MERGE_2014 back onto the trunk as follows:

In the working copy of branch ran:
svn merge ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
1 conflict in LIM_SRC_3/limdiahsb.F90
Resolved by keeping the version from dev_MERGE_2014 branch
and commited at r4989

In working copy run:
svn switch ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2014/dev_MERGE_2014
to merge the branch into the trunk - no conflicts at this stage.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90

    r3821 r4990  
    7070      ! and ssh which is used to calculate gradients 
    7171 
    72       uo_e(:,:) = 0._wp ;   uo_e(1:jpi, 1:jpj) = ssu_m(:,:) 
    73       vo_e(:,:) = 0._wp ;   vo_e(1:jpi, 1:jpj) = ssv_m(:,:) 
    74       ff_e(:,:) = 0._wp ;   ff_e(1:jpi, 1:jpj) = ff   (:,:) 
    75       ua_e(:,:) = 0._wp ;   ua_e(1:jpi, 1:jpj) = utau (:,:) 
    76       va_e(:,:) = 0._wp ;   va_e(1:jpi, 1:jpj) = vtau (:,:) 
    77  
    78       CALL lbc_lnk_e( uo_e, 'U', -1._wp, 1, 1 ) 
    79       CALL lbc_lnk_e( vo_e, 'V', -1._wp, 1, 1 ) 
    80       CALL lbc_lnk_e( ff_e, 'F', +1._wp, 1, 1 ) 
    81       CALL lbc_lnk_e( ua_e, 'U', -1._wp, 1, 1 ) 
    82       CALL lbc_lnk_e( va_e, 'V', -1._wp, 1, 1 ) 
     72      uo_e(:,:) = 0._wp ;   uo_e(1:jpi, 1:jpj) = ssu_m(:,:) * umask(:,:,1) 
     73      vo_e(:,:) = 0._wp ;   vo_e(1:jpi, 1:jpj) = ssv_m(:,:) * vmask(:,:,1) 
     74      ff_e(:,:) = 0._wp ;   ff_e(1:jpi, 1:jpj) = ff   (:,:)  
     75      tt_e(:,:) = 0._wp ;   tt_e(1:jpi, 1:jpj) = sst_m(:,:) 
     76      fr_e(:,:) = 0._wp ;   fr_e(1:jpi, 1:jpj) = fr_i (:,:) 
     77      ua_e(:,:) = 0._wp ;   ua_e(1:jpi, 1:jpj) = utau (:,:) * umask(:,:,1) ! maybe mask useless because mask applied in sbcblk 
     78      va_e(:,:) = 0._wp ;   va_e(1:jpi, 1:jpj) = vtau (:,:) * vmask(:,:,1) ! maybe mask useless because mask applied in sbcblk 
     79 
     80      CALL lbc_lnk_icb( uo_e, 'U', -1._wp, 1, 1 ) 
     81      CALL lbc_lnk_icb( vo_e, 'V', -1._wp, 1, 1 ) 
     82      CALL lbc_lnk_icb( ff_e, 'F', +1._wp, 1, 1 ) 
     83      CALL lbc_lnk_icb( ua_e, 'U', -1._wp, 1, 1 ) 
     84      CALL lbc_lnk_icb( va_e, 'V', -1._wp, 1, 1 ) 
     85      CALL lbc_lnk_icb( fr_e, 'T', +1._wp, 1, 1 ) 
     86      CALL lbc_lnk_icb( tt_e, 'T', +1._wp, 1, 1 ) 
     87#if defined key_lim2 
     88      hicth(:,:) = 0._wp ;  hicth(1:jpi,1:jpj) = hicif(:,:)   
     89      CALL lbc_lnk_icb(hicth, 'T', +1._wp, 1, 1 )   
     90#endif 
    8391 
    8492#if defined key_lim2 || defined key_lim3 
    … …  
    8694      vi_e(:,:) = 0._wp ;   vi_e(1:jpi, 1:jpj) = v_ice(:,:) 
    8795 
    88       CALL lbc_lnk_e( ui_e, 'U', -1._wp, 1, 1 ) 
    89       CALL lbc_lnk_e( vi_e, 'V', -1._wp, 1, 1 ) 
     96      CALL lbc_lnk_icb( ui_e, 'U', -1._wp, 1, 1 ) 
     97      CALL lbc_lnk_icb( vi_e, 'V', -1._wp, 1, 1 ) 
    9098#endif 
    9199 
    … …  
    93101      !! so fudge some numbers all the way around the boundary 
    94102 
    95       ssh_e(:,:) = 0._wp ;   ssh_e(1:jpi, 1:jpj) = ssh_m(:,:) 
     103      ssh_e(:,:) = 0._wp ;   ssh_e(1:jpi, 1:jpj) = ssh_m(:,:) * tmask(:,:,1) 
    96104      ssh_e(0    ,    :) = ssh_e(1  ,  :) 
    97105      ssh_e(jpi+1,    :) = ssh_e(jpi,  :) 
    … …  
    102110      ssh_e(0,jpj+1)     = ssh_e(1,jpj) 
    103111      ssh_e(jpi+1,jpj+1) = ssh_e(jpi,jpj) 
    104       CALL lbc_lnk_e( ssh_e, 'T', +1._wp, 1, 1 ) 
     112      CALL lbc_lnk_icb( ssh_e, 'T', +1._wp, 1, 1 ) 
    105113      ! 
    106114   END SUBROUTINE icb_utl_copy 
    … …  
    133141      !!---------------------------------------------------------------------- 
    134142 
    135       pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj )         ! scale factors 
     143      pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj )     ! scale factors 
    136144      pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 
    137145      ! 
    138146      puo  = icb_utl_bilin_h( uo_e, pi, pj, 'U' )             ! ocean velocities 
    139147      pvo  = icb_utl_bilin_h( vo_e, pi, pj, 'V' ) 
    140       psst = icb_utl_bilin( sst_m, pi, pj, 'T' )              ! SST 
    141       pcn  = icb_utl_bilin( fr_i , pi, pj, 'T' )              ! ice concentration 
     148      psst = icb_utl_bilin_h( tt_e, pi, pj, 'T' )             ! SST 
     149      pcn  = icb_utl_bilin_h( fr_e , pi, pj, 'T' )            ! ice concentration 
    142150      pff  = icb_utl_bilin_h( ff_e , pi, pj, 'F' )            ! Coriolis parameter 
    143151      ! 
    144152      pua  = icb_utl_bilin_h( ua_e , pi, pj, 'U' )            ! 10m wind 
    145153      pva  = icb_utl_bilin_h( va_e , pi, pj, 'V' )            ! here (ua,va) are stress => rough conversion from stress to speed 
    146       zcd  = 1.22_wp * 1.5e-3_wp                                  ! air density * drag coefficient 
     154      zcd  = 1.22_wp * 1.5e-3_wp                              ! air density * drag coefficient 
    147155      zmod = 1._wp / MAX(  1.e-20, SQRT(  zcd * SQRT( pua*pua + pva*pva)  )  ) 
    148       pua  = pua * zmod                                           ! note: stress module=0 necessarly implies ua=va=0 
     156      pua  = pua * zmod                                       ! note: stress module=0 necessarly implies ua=va=0 
    149157      pva  = pva * zmod 
    150158 
    … …  
    155163      phi = 0._wp                                             ! LIM-3 case (to do) 
    156164# else 
    157       phi = icb_utl_bilin(hicif, pi, pj, 'T' )                ! ice thickness 
     165      phi = icb_utl_bilin_h(hicth, pi, pj, 'T' )              ! ice thickness 
    158166# endif 
    159167#else 
    … …  
    217225      END SELECT 
    218226      ! 
    219       ! find position in this processor 
    220       ii = mi1( ii ) 
    221       ij = mj1( ij ) 
     227      ! find position in this processor. Prevent near edge problems (see #1389) 
     228 
     229      if (ii.lt.mig(1)) then 
     230        ii = 1 
     231      else if (ii.gt.mig(jpi)) then 
     232        ii = jpi 
     233      else 
     234        ii  = mi1( ii  ) 
     235      end if 
     236 
     237      if (ij.lt.mjg(1)) then 
     238        ij = 1 
     239      else if (ij.gt.mjg(jpj)) then 
     240        ij = jpj 
     241      else 
     242        ij  = mj1( ij  ) 
     243      end if 
     244 
     245      if (ij.eq.jpj) ij=ij-1 
     246      if (ii.eq.jpi) ii=ii-1       
     247 
    222248      ! 
    223249      icb_utl_bilin_h = ( pfld(ii,ij  ) * (1.-zi) + pfld(ii+1,ij  ) * zi ) * (1.-zj)   & 
    … …  
    271297      END SELECT 
    272298      ! 
    273       ! find position in this processor 
    274       ii = mi1( ii ) 
    275       ij = mj1( ij ) 
    276       ! 
     299      ! find position in this processor. Prevent near edge problems (see #1389) 
     300 
     301      if (ii.lt.mig(1)) then 
     302        ii = 1 
     303      else if (ii.gt.mig(jpi)) then 
     304        ii = jpi 
     305      else 
     306        ii  = mi1( ii  ) 
     307      end if 
     308 
     309      if (ij.lt.mjg(1)) then 
     310        ij = 1 
     311      else if (ij.gt.mjg(jpj)) then 
     312        ij = jpj 
     313      else 
     314        ij  = mj1( ij  ) 
     315      end if 
     316 
     317      if (ij.eq.jpj) ij=ij-1 
     318      if (ii.eq.jpi) ii=ii-1 
     319 
    277320      icb_utl_bilin = ( pfld(ii,ij  ) * (1.-zi) + pfld(ii+1,ij  ) * zi ) * (1.-zj)   & 
    278321         &          + ( pfld(ii,ij+1) * (1.-zi) + pfld(ii+1,ij+1) * zi ) *     zj 
    … …  
    309352      zj = pj - REAL(ij,wp) 
    310353      ! 
    311       ! find position in this processor          !!gm use here mig, mjg arrays 
    312       ii = mi1( ii ) 
    313       ij = mj1( ij ) 
     354      ! find position in this processor. Prevent near edge problems (see #1389) 
     355 
     356      if (ii.lt.mig(1)) then 
     357        ii = 1 
     358      else if (ii.gt.mig(jpi)) then 
     359        ii = jpi 
     360      else 
     361        ii  = mi1( ii  ) 
     362      end if 
     363 
     364      if (ij.lt.mjg(1)) then 
     365        ij = 1 
     366      else if (ij.gt.mjg(jpj)) then 
     367        ij = jpj 
     368      else 
     369        ij  = mj1( ij  ) 
     370      end if 
     371 
     372      if (ij.eq.jpj) ij=ij-1 
     373      if (ii.eq.jpi) ii=ii-1 
     374 
    314375      z4(1) = pfld(ii  ,ij  ) 
    315376      z4(2) = pfld(ii+1,ij  ) 
    … …  
    359420      zj = pj - REAL(ij,wp) 
    360421 
    361       ! find position in this processor 
    362       ii = mi1( ii ) 
    363       ij = mj1( ij ) 
     422      ! find position in this processor. Prevent near edge problems (see #1389) 
     423 
     424      if (ii.lt.mig(1)) then 
     425        ii = 1 
     426      else if (ii.gt.mig(jpi)) then 
     427        ii = jpi 
     428      else 
     429        ii  = mi1( ii  ) 
     430      end if 
     431 
     432      if (ij.lt.mjg(1)) then 
     433        ij = 1 
     434      else if (ij.gt.mjg(jpj)) then 
     435        ij = jpj 
     436      else 
     437        ij  = mj1( ij  ) 
     438      end if 
     439 
     440      if (ij.eq.jpj) ij=ij-1 
     441      if (ii.eq.jpi) ii=ii-1 
    364442 
    365443      IF(    0.0_wp <= zi .AND. zi < 0.5_wp   ) THEN 
Note: See TracChangeset for help on using the changeset viewer.