Ignore:
Timestamp:
2014-12-15T17:42:49+01:00 (6 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.

Location:
trunk/NEMOGCM/NEMO/OPA_SRC/ICB
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90

    r4153 r4990  
    4444 
    4545INTEGER, PUBLIC, PARAMETER ::   nclasses = 10   !: Number of icebergs classes    
    46 !!INTEGER, PUBLIC & 
    47 !!#if !defined key_agrif  
    48 !!           , PARAMETER & 
    49 !!#endif 
    50 !!     :: & 
    51 !!     nclasses = 10   !: Number of icebergs classes 
    5246   INTEGER, PUBLIC, PARAMETER ::   nkounts  =  3   !: Number of integers combined for unique naming 
    5347 
     
    9387   ! particularly for MPP when iceberg can lie inside T grid but outside U, V, or f grid 
    9488   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   uo_e, vo_e 
    95    REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ff_e 
     89   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ff_e, tt_e, fr_e, hicth 
    9690   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ua_e, va_e 
    9791   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ssh_e 
    98 #if defined key_lim2 || defined key_lim3 
     92#if defined key_lim2 || defined key_lim3 || defined key_cice 
    9993   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ui_e, vi_e 
    10094#endif 
     
    144138   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbflddest                      !: nfold destination proc 
    145139   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldproc                      !: nfold destination proc 
     140   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldnsend                     !: nfold number of bergs to send to nfold neighbour 
     141   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldexpect                    !: nfold expected number of bergs 
     142   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldreq                       !: nfold message handle (immediate send) 
    146143 
    147144   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: griddata                           !: work array for icbrst 
     
    162159      ! 
    163160      icb_alloc = 0 
     161      ALLOCATE( berg_grid, STAT=ill ) 
     162      icb_alloc = icb_alloc + ill 
    164163      ALLOCATE( berg_grid%calving    (jpi,jpj) , berg_grid%calving_hflx (jpi,jpj)          ,   & 
    165164         &      berg_grid%stored_heat(jpi,jpj) , berg_grid%floating_melt(jpi,jpj)          ,   & 
     
    171170      ALLOCATE( uo_e(0:jpi+1,0:jpj+1) , ua_e(0:jpi+1,0:jpj+1) ,   & 
    172171         &      vo_e(0:jpi+1,0:jpj+1) , va_e(0:jpi+1,0:jpj+1) ,   & 
    173 #if defined key_lim2 || defined key_lim3 
     172#if defined key_lim2 || defined key_lim3 || defined key_cice 
    174173         &      ui_e(0:jpi+1,0:jpj+1) ,                            & 
    175174         &      vi_e(0:jpi+1,0:jpj+1) ,                            & 
    176175#endif 
    177          &      ff_e(0:jpi+1,0:jpj+1) , ssh_e(0:jpi+1,0:jpj+1) ,   & 
     176         &      ff_e(0:jpi+1,0:jpj+1) , fr_e(0:jpi+1,0:jpj+1)  ,   & 
     177         &      tt_e(0:jpi+1,0:jpj+1) , ssh_e(0:jpi+1,0:jpj+1) ,   & 
     178         &      hicth(0:jpi+1,0:jpj+1),                            & 
    178179         &      first_width(nclasses) , first_length(nclasses) ,   & 
    179180         &      src_calving (jpi,jpj) ,                            & 
     
    181182      icb_alloc = icb_alloc + ill 
    182183 
    183       ALLOCATE( nicbfldpts(jpi) , nicbflddest(jpi) , nicbfldproc(jpni) , STAT=ill) 
     184      ALLOCATE( nicbfldpts(jpi) , nicbflddest(jpi) , nicbfldproc(jpni) , & 
     185         &      nicbfldnsend(jpni), nicbfldexpect(jpni) , nicbfldreq(jpni), STAT=ill) 
    184186      icb_alloc = icb_alloc + ill 
    185187 
  • trunk/NEMOGCM/NEMO/OPA_SRC/ICB/icbdyn.F90

    r3614 r4990  
    3333CONTAINS 
    3434 
    35    SUBROUTINE icb_dyn() 
     35   SUBROUTINE icb_dyn( kt ) 
    3636      !!---------------------------------------------------------------------- 
    3737      !!                  ***  ROUTINE icb_dyn  *** 
     
    5050      TYPE(iceberg), POINTER          ::   berg 
    5151      TYPE(point)  , POINTER          ::   pt 
     52      INTEGER                         ::   kt 
    5253      !!---------------------------------------------------------------------- 
    5354 
  • trunk/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90

    r4624 r4990  
    172172         DO ji = nicbdi, nicbei 
    173173            ii = nicbflddest(ji) 
    174             DO jn = 1, jpni 
    175                ! work along array until we find an empty slot 
    176                IF( nicbfldproc(jn) == -1 ) THEN 
    177                   nicbfldproc(jn) = ii 
    178                   EXIT                             !!gm EXIT should be avoided: use DO WHILE expression instead 
    179                ENDIF 
    180                ! before we find an empty slot, we may find processor number is already here so we exit 
    181                IF( nicbfldproc(jn) == ii ) EXIT 
    182             END DO 
     174            IF( ii .GT. 0 ) THEN     ! Needed because land suppression can mean 
     175                                     ! that unused points are not set in edge haloes 
     176               DO jn = 1, jpni 
     177                  ! work along array until we find an empty slot 
     178                  IF( nicbfldproc(jn) == -1 ) THEN 
     179                     nicbfldproc(jn) = ii 
     180                     EXIT                             !!gm EXIT should be avoided: use DO WHILE expression instead 
     181                  ENDIF 
     182                  ! before we find an empty slot, we may find processor number is already here so we exit 
     183                  IF( nicbfldproc(jn) == ii ) EXIT 
     184               END DO 
     185            ENDIF 
    183186         END DO 
    184187      ENDIF 
     
    210213            WRITE(numicb,*) 'north fold destination procs  ' 
    211214            WRITE(numicb,*) nicbflddest 
     215            WRITE(numicb,*) 'north fold destination proclist  ' 
     216            WRITE(numicb,*) nicbfldproc 
    212217         ENDIF 
    213218         CALL flush(numicb) 
     
    397402      ENDIF 
    398403 
    399       IF( lk_lim3 .AND. ln_icebergs ) THEN 
    400          CALL ctl_stop( 'icb_nam: the use of ICB with LIM3 not allowed. ice thickness missing in ICB' ) 
    401       ENDIF 
     404!     IF( lk_lim3 .AND. ln_icebergs ) THEN 
     405!        CALL ctl_stop( 'icb_nam: the use of ICB with LIM3 not allowed. ice thickness missing in ICB' ) 
     406!     ENDIF 
    402407 
    403408      IF(lwp) THEN                  ! control print 
  • trunk/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90

    r3614 r4990  
    280280         zwebergs(1) = ibergs_to_send_e 
    281281         CALL mppsend( 12, zwebergs(1), 1, ipe_E, iml_req1) 
    282          CALL mpprecv( 11, zewbergs(2), 1 ) 
     282         CALL mpprecv( 11, zewbergs(2), 1, ipe_E ) 
    283283         IF( l_isend ) CALL mpi_wait( iml_req1, iml_stat, iml_err ) 
    284284         ibergs_rcvd_from_e = INT( zewbergs(2) ) 
     
    288288         CALL mppsend( 11, zewbergs(1), 1, ipe_W, iml_req2) 
    289289         CALL mppsend( 12, zwebergs(1), 1, ipe_E, iml_req3) 
    290          CALL mpprecv( 11, zewbergs(2), 1 ) 
    291          CALL mpprecv( 12, zwebergs(2), 1 ) 
     290         CALL mpprecv( 11, zewbergs(2), 1, ipe_E ) 
     291         CALL mpprecv( 12, zwebergs(2), 1, ipe_W ) 
    292292         IF( l_isend ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) 
    293293         IF( l_isend ) CALL mpi_wait( iml_req3, iml_stat, iml_err ) 
     
    297297         zewbergs(1) = ibergs_to_send_w 
    298298         CALL mppsend( 11, zewbergs(1), 1, ipe_W, iml_req4) 
    299          CALL mpprecv( 12, zwebergs(2), 1 ) 
     299         CALL mpprecv( 12, zwebergs(2), 1, ipe_W ) 
    300300         IF( l_isend ) CALL mpi_wait( iml_req4, iml_stat, iml_err ) 
    301301         ibergs_rcvd_from_w = INT( zwebergs(2) ) 
     
    411411         zsnbergs(1) = ibergs_to_send_n 
    412412         CALL mppsend( 16, zsnbergs(1), 1, ipe_N, iml_req1) 
    413          CALL mpprecv( 15, znsbergs(2), 1 ) 
     413         CALL mpprecv( 15, znsbergs(2), 1, ipe_N ) 
    414414         IF( l_isend ) CALL mpi_wait( iml_req1, iml_stat, iml_err ) 
    415415         ibergs_rcvd_from_n = INT( znsbergs(2) ) 
     
    419419         CALL mppsend( 15, znsbergs(1), 1, ipe_S, iml_req2) 
    420420         CALL mppsend( 16, zsnbergs(1), 1, ipe_N, iml_req3) 
    421          CALL mpprecv( 15, znsbergs(2), 1 ) 
    422          CALL mpprecv( 16, zsnbergs(2), 1 ) 
     421         CALL mpprecv( 15, znsbergs(2), 1, ipe_N ) 
     422         CALL mpprecv( 16, zsnbergs(2), 1, ipe_S ) 
    423423         IF( l_isend ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) 
    424424         IF( l_isend ) CALL mpi_wait( iml_req3, iml_stat, iml_err ) 
     
    428428         znsbergs(1) = ibergs_to_send_s 
    429429         CALL mppsend( 15, znsbergs(1), 1, ipe_S, iml_req4) 
    430          CALL mpprecv( 16, zsnbergs(2), 1 ) 
     430         CALL mpprecv( 16, zsnbergs(2), 1, ipe_S ) 
    431431         IF( l_isend ) CALL mpi_wait( iml_req4, iml_stat, iml_err ) 
    432432         ibergs_rcvd_from_s = INT( zsnbergs(2) ) 
     
    581581      INTEGER                             :: ifldproc, iproc, ipts 
    582582      INTEGER                             :: iine, ijne 
    583       REAL(wp), DIMENSION(2)              :: zsbergs, znbergs 
     583      INTEGER                             :: jjn 
     584      REAL(wp), DIMENSION(0:3)            :: zsbergs, znbergs 
    584585      INTEGER                             :: iml_req1, iml_req2, iml_err 
    585586      INTEGER, DIMENSION(MPI_STATUS_SIZE) :: iml_stat 
     
    591592      ! its of fixed size, the first -1 marks end of list of processors 
    592593      ! 
     594      nicbfldnsend(:) = 0 
     595      nicbfldexpect(:) = 0 
     596      nicbfldreq(:) = 0 
     597      ! 
     598      ! Since each processor may be communicating with more than one northern 
     599      ! neighbour, cycle through the sends so that the receive order can be 
     600      ! controlled. 
     601      ! 
     602      ! First compute how many icebergs each active neighbour should expect 
     603      DO jn = 1, jpni 
     604         IF( nicbfldproc(jn) /= -1 ) THEN 
     605            ifldproc = nicbfldproc(jn) 
     606            nicbfldnsend(jn) = 0 
     607 
     608            ! Find number of bergs that need to be exchanged 
     609            ! Pick out exchanges with processor ifldproc 
     610            ! if ifldproc is this processor then don't send 
     611            ! 
     612            IF( ASSOCIATED(first_berg) ) THEN 
     613               this => first_berg 
     614               DO WHILE (ASSOCIATED(this)) 
     615                  pt => this%current_point 
     616                  iine = INT( pt%xi + 0.5 ) 
     617                  ijne = INT( pt%yj + 0.5 ) 
     618                  iproc = nicbflddest(mi1(iine)) 
     619                  IF( ijne .GT. mjg(nicbej) ) THEN 
     620                     IF( iproc == ifldproc ) THEN 
     621                        ! 
     622                        IF( iproc /= narea ) THEN 
     623                           tmpberg => this 
     624                           nicbfldnsend(jn) = nicbfldnsend(jn) + 1 
     625                        ENDIF 
     626                        ! 
     627                     ENDIF 
     628                  ENDIF 
     629                  this => this%next 
     630               END DO 
     631            ENDIF 
     632            ! 
     633         ENDIF 
     634         ! 
     635      END DO 
     636      ! 
     637      ! Now tell each active neighbour how many icebergs to expect 
     638      DO jn = 1, jpni 
     639         IF( nicbfldproc(jn) /= -1 ) THEN 
     640            ifldproc = nicbfldproc(jn) 
     641            IF( ifldproc == narea ) CYCLE 
     642    
     643            zsbergs(0) = narea 
     644            zsbergs(1) = nicbfldnsend(jn) 
     645            !IF ( nicbfldnsend(jn) .GT. 0) write(numicb,*) 'ICB sending ',nicbfldnsend(jn),' to ', ifldproc 
     646            CALL mppsend( 21, zsbergs(0:1), 2, ifldproc-1, nicbfldreq(jn)) 
     647         ENDIF 
     648         ! 
     649      END DO 
     650      ! 
     651      ! and receive the heads-up from active neighbours preparing to send 
     652      DO jn = 1, jpni 
     653         IF( nicbfldproc(jn) /= -1 ) THEN 
     654            ifldproc = nicbfldproc(jn) 
     655            IF( ifldproc == narea ) CYCLE 
     656 
     657            CALL mpprecv( 21, znbergs(1:2), 2 ) 
     658            DO jjn = 1,jpni 
     659             IF( nicbfldproc(jjn) .eq. INT(znbergs(1)) ) EXIT 
     660            END DO 
     661            IF( jjn .GT. jpni ) write(numicb,*) 'ICB ERROR' 
     662            nicbfldexpect(jjn) = INT( znbergs(2) ) 
     663            !IF ( nicbfldexpect(jjn) .GT. 0) write(numicb,*) 'ICB expecting ',nicbfldexpect(jjn),' from ', nicbfldproc(jjn) 
     664            !CALL FLUSH(numicb) 
     665         ENDIF 
     666         ! 
     667      END DO 
     668      ! 
     669      ! post the mpi waits if using immediate send protocol 
     670      DO jn = 1, jpni 
     671         IF( nicbfldproc(jn) /= -1 ) THEN 
     672            ifldproc = nicbfldproc(jn) 
     673            IF( ifldproc == narea ) CYCLE 
     674 
     675            IF( l_isend ) CALL mpi_wait( nicbfldreq(jn), iml_stat, iml_err ) 
     676         ENDIF 
     677         ! 
     678      END DO 
     679    
     680         ! 
     681         ! Cycle through the icebergs again, this time packing and sending any 
     682         ! going through the north fold. They will be expected. 
    593683      DO jn = 1, jpni 
    594684         IF( nicbfldproc(jn) /= -1 ) THEN 
     
    646736            IF( ifldproc == narea ) CYCLE 
    647737    
    648             zsbergs(1) = ibergs_to_send 
    649             CALL mppsend( 21, zsbergs(1), 1, ifldproc-1, iml_req1) 
    650             CALL mpprecv( 21, znbergs(2), 1 ) 
    651             IF( l_isend ) CALL mpi_wait( iml_req1, iml_stat, iml_err ) 
    652             ibergs_to_rcv = INT( znbergs(2) ) 
    653     
    654738            ! send bergs 
    655739    
    656740            IF( ibergs_to_send > 0 )  & 
    657                 CALL mppsend( 12, obuffer_f%data, ibergs_to_send*jp_buffer_width, ifldproc-1, iml_req2 ) 
     741                CALL mppsend( 12, obuffer_f%data, ibergs_to_send*jp_buffer_width, ifldproc-1, nicbfldreq(jn) ) 
     742            ! 
     743         ENDIF 
     744         ! 
     745      END DO 
     746      ! 
     747      ! Now receive the expected number of bergs from the active neighbours 
     748      DO jn = 1, jpni 
     749         IF( nicbfldproc(jn) /= -1 ) THEN 
     750            ifldproc = nicbfldproc(jn) 
     751            IF( ifldproc == narea ) CYCLE 
     752            ibergs_to_rcv = nicbfldexpect(jn) 
     753 
    658754            IF( ibergs_to_rcv  > 0 ) THEN 
    659755               CALL icb_increase_ibuffer(ibuffer_f, ibergs_to_rcv) 
    660                CALL mpprecv( 12, ibuffer_f%data, ibergs_to_rcv*jp_buffer_width ) 
    661             ENDIF 
    662             IF( ibergs_to_send > 0 .AND. l_isend ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) 
     756               CALL mpprecv( 12, ibuffer_f%data, ibergs_to_rcv*jp_buffer_width, ifldproc-1 ) 
     757            ENDIF 
     758            ! 
    663759            DO jk = 1, ibergs_to_rcv 
    664760               IF( nn_verbose_level >= 4 ) THEN 
     
    668764               CALL icb_unpack_from_buffer(first_berg, ibuffer_f, jk ) 
    669765            END DO 
    670             ! 
     766         ENDIF 
     767         ! 
     768      END DO 
     769      ! 
     770      ! Finally post the mpi waits if using immediate send protocol 
     771      DO jn = 1, jpni 
     772         IF( nicbfldproc(jn) /= -1 ) THEN 
     773            ifldproc = nicbfldproc(jn) 
     774            IF( ifldproc == narea ) CYCLE 
     775 
     776            IF( l_isend ) CALL mpi_wait( nicbfldreq(jn), iml_stat, iml_err ) 
    671777         ENDIF 
    672778         ! 
  • trunk/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90

    r3614 r4990  
    6464                                                                                            ! start and count arrays 
    6565      LOGICAL                      ::   ll_found_restart 
    66       CHARACTER(len=80)            ::   cl_filename 
     66      CHARACTER(len=256)           ::   cl_filename 
    6767      CHARACTER(len=NF90_MAX_NAME) ::   cl_dname 
    6868      TYPE(iceberg)                ::   localberg ! NOT a pointer but an actual local variable 
     
    228228      INTEGER ::   jn   ! dummy loop index 
    229229      INTEGER ::   ix_dim, iy_dim, ik_dim, in_dim 
    230       CHARACTER(len=80)      :: cl_filename 
     230      CHARACTER(len=256)     :: cl_filename 
    231231      TYPE(iceberg), POINTER :: this 
    232232      TYPE(point)  , POINTER :: pt 
     
    256256      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_def_dim k failed') 
    257257 
     258      ! global attributes 
     259      IF( lk_mpp ) THEN 
     260         ! Set domain parameters (assume jpdom_local_full) 
     261         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ) 
     262         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number'         , narea-1            ) 
     263         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/1     , 2     /) ) 
     264         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_global'    , (/jpiglo, jpjglo/) ) 
     265         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_local'     , (/jpi   , jpj   /) ) 
     266         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_first' , (/nimpp , njmpp /) ) 
     267         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_last'  , (/nimpp + jpi - 1 , njmpp + jpj - 1  /) ) 
     268         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/nldi - 1        , nldj - 1         /) ) 
     269         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , (/jpi - nlei      , jpj - nlej       /) ) 
     270         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'              ) 
     271      ENDIF 
     272       
    258273      IF (associated(first_berg)) then 
    259274         nret = NF90_DEF_DIM(ncid, 'n', NF90_UNLIMITED, in_dim) 
  • trunk/NEMOGCM/NEMO/OPA_SRC/ICB/icbstp.F90

    r4153 r4990  
    105105!                               !==  For each berg, evolve  ==! 
    106106      ! 
    107       IF( ASSOCIATED(first_berg) )   CALL icb_dyn()           ! ice berg dynamics 
     107      IF( ASSOCIATED(first_berg) )   CALL icb_dyn( kt )       ! ice berg dynamics 
    108108 
    109109      IF( lk_mpp ) THEN          ;   CALL icb_lbc_mpp()       ! Send bergs to other PEs 
  • 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.