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 4328 for branches/2013/dev_MERGE_2013/NEMOGCM/NEMO – NEMO

Ignore:
Timestamp:
2013-12-06T11:25:13+01:00 (10 years ago)
Author:
davestorkey
Message:

Remove OBC module at NEMO 3.6. See ticket #1189.

Location:
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC
Files:
1 deleted
16 edited

Legend:

Unmodified
Added
Removed
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r4234 r4328  
    1919   USE lib_mpp         ! distributed memory computing library 
    2020   USE trabbc          ! bottom boundary condition 
    21    USE obc_par         ! (for lk_obc) 
    2221   USE bdy_par         ! (for lk_bdy) 
    2322   USE timing          ! preformance summary 
     
    263262         ! ----------------------------------------------- ! 
    264263         IF(lwp) WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 
    265          IF( lk_obc .or. lk_bdy ) THEN 
     264         IF( lk_bdy ) THEN 
    266265            CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' )          
    267266         ENDIF 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r4147 r4328  
    115115      !!      even IF nperio is not zero. 
    116116      !! 
    117       !!      In case of open boundaries (lk_obc=T): 
     117      !!      In case of open boundaries (lk_bdy=T): 
    118118      !!        - tmask is set to 1 on the points to be computed bay the open 
    119119      !!          boundaries routines. 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90

    r4147 r4328  
    2424   USE oce              ! ocean dynamics and tracers 
    2525   USE dom_oce          ! ocean space and time domain 
    26    USE obc_oce          ! ocean lateral open boundary condition 
    2726   USE in_out_manager   ! I/O manager 
    2827   USE lib_mpp          ! distributed memory computing 
     
    419418         END DO 
    420419 
    421 #if defined key_obc 
    422          IF( Agrif_Root() ) THEN 
    423             ! open boundaries (div must be zero behind the open boundary) 
    424             !  mpp remark: The zeroing of zhdivnep can probably be extended to 1->jpi/jpj for the correct row/column 
    425             IF( lp_obc_east  )  zhdivnep(nie0p1:nie1p1,nje0  :nje1  ,jk) = 0.0_wp      ! east 
    426             IF( lp_obc_west  )  zhdivnep(niw0  :niw1  ,njw0  :njw1  ,jk) = 0.0_wp      ! west 
    427             IF( lp_obc_north )  zhdivnep(nin0  :nin1  ,njn0p1:njn1p1,jk) = 0.0_wp      ! north 
    428             IF( lp_obc_south )  zhdivnep(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.0_wp      ! south 
    429          ENDIF 
    430 #endif 
    431420         IF( .NOT. AGRIF_Root() ) THEN 
    432421            IF ((nbondi ==  1).OR.(nbondi == 2))  zhdivnep(nlci-1 , :     ,jk) = 0.0_wp   ! east 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r4312 r4328  
    3030   USE dynadv          ! dynamics: vector invariant versus flux form 
    3131   USE domvvl          ! variable volume 
    32    USE obc_oce         ! ocean open boundary conditions 
    33    USE obcdyn          ! open boundary condition for momentum (obc_dyn routine) 
    34    USE obcdyn_bt       ! 2D open boundary condition for momentum (obc_dyn_bt routine) 
    35    USE obcvol          ! ocean open boundary condition (obc_vol routines) 
    3632   USE bdy_oce         ! ocean open boundary conditions 
    3733   USE bdydta          ! ocean open boundary conditions 
     
    8379      !!              * Apply lateral boundary conditions on after velocity  
    8480      !!             at the local domain boundaries through lbc_lnk call, 
    85       !!             at the one-way open boundaries (lk_obc=T), 
     81      !!             at the one-way open boundaries (lk_bdy=T), 
    8682      !!             at the AGRIF zoom     boundaries (lk_agrif=T) 
    8783      !! 
     
    204200      CALL lbc_lnk( va, 'V', -1. )  
    205201      ! 
    206 # if defined key_obc 
    207       !                                !* OBC open boundaries 
    208       IF( lk_obc ) CALL obc_dyn( kt ) 
    209       ! 
    210       IF( .NOT. lk_dynspg_flt ) THEN 
    211          ! Flather boundary condition : - Update sea surface height on each open boundary 
    212          !                                       sshn   (= after ssh   ) for explicit case (lk_dynspg_exp=T) 
    213          !                                       sshn_b (= after ssha_b) for time-splitting case (lk_dynspg_ts=T) 
    214          !                              - Correct the barotropic velocities 
    215          IF( lk_obc ) CALL obc_dyn_bt( kt ) 
    216          ! 
    217 !!gm ERROR - potential BUG: sshn should not be modified at this stage !!   ssh_nxt not alrady called 
    218          CALL lbc_lnk( sshn, 'T', 1. )         ! Boundary conditions on sshn 
    219          ! 
    220          IF( lk_obc .AND. ln_vol_cst )   CALL obc_vol( kt ) 
    221          ! 
    222          IF(ln_ctl)   CALL prt_ctl( tab2d_1=sshn, clinfo1=' ssh      : ', mask1=tmask ) 
    223       ENDIF 
    224       ! 
    225 # elif defined key_bdy 
     202# if defined key_bdy 
    226203      !                                !* BDY open boundaries 
    227204      IF( lk_bdy .AND. lk_dynspg_exp ) CALL bdy_dyn( kt ) 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90

    r4292 r4328  
    1818   USE dom_oce         ! ocean space and time domain  
    1919   USE sbc_oce         ! surface boundary condition: ocean 
    20    USE obc_oce         ! Lateral open boundary condition 
    2120   USE phycst          ! physical constants 
    22    USE obc_par         ! open boundary condition parameters 
    23    USE obcdta          ! open boundary condition data     (bdy_dta_bt routine) 
    2421   USE in_out_manager  ! I/O manager 
    2522   USE lib_mpp         ! distributed memory computing library 
     
    7976      ENDIF 
    8077 
    81  
    82 !!gm bug ??  Rachid we have to discuss of the call below. I don't understand why it is here and not in ssh_wzv 
    83       IF( lk_obc )   CALL obc_dta_bt( kt, 0 )      ! OBC: read or estimate ssh and vertically integrated velocities 
    84 !!gm 
    85  
    8678      IF( .NOT. lk_vvl ) THEN          !* fixed volume : add the surface pressure gradient trend 
    8779         ! 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r4153 r4328  
    2525   USE zdf_oce         ! ocean vertical physics 
    2626   USE sbc_oce         ! surface boundary condition: ocean 
    27    USE obc_oce         ! Lateral open boundary condition 
    2827   USE bdy_oce         ! Lateral open boundary condition 
    2928   USE sol_oce         ! ocean elliptic solver 
     
    3433   USE solpcg          ! preconditionned conjugate gradient solver 
    3534   USE solsor          ! Successive Over-relaxation solver 
    36    USE obcdyn          ! ocean open boundary condition on dynamics 
    37    USE obcvol          ! ocean open boundary condition (obc_vol routine) 
    3835   USE bdydyn          ! ocean open boundary condition on dynamics 
    3936   USE bdyvol          ! ocean open boundary condition (bdy_vol routine) 
     
    184181      ENDIF 
    185182 
    186 #if defined key_obc 
    187       IF( lk_obc ) CALL obc_dyn( kt )   ! Update velocities on each open boundary with the radiation algorithm 
    188       IF( lk_obc ) CALL obc_vol( kt )   ! Correction of the barotropic componant velocity to control the volume of the system 
    189 #endif 
    190183#if defined key_bdy 
    191184      IF( lk_bdy ) CALL bdy_dyn( kt )   ! Update velocities on each open boundary 
     
    304297            ztdgv = z2dtg * (gcx(ji  ,jj+1) - gcx(ji,jj) ) / e2v(ji,jj) 
    305298            ! multiplied by z2dt 
    306 #if defined key_obc 
    307             IF(lk_obc) THEN 
    308             ! caution : grad D = 0 along open boundaries 
    309             ! Remark: The filtering force could be reduced here in the FRS zone 
    310             !         by multiplying spgu/spgv by (1-alpha) ??   
    311                spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj) 
    312                spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj) 
    313             ELSE 
    314                spgu(ji,jj) = z2dt * ztdgu 
    315                spgv(ji,jj) = z2dt * ztdgv 
    316             ENDIF 
    317 #elif defined key_bdy 
     299#if defined key_bdy 
    318300            IF(lk_bdy) THEN 
    319301            ! caution : grad D = 0 along open boundaries 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r4327 r4328  
    2828   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    2929   USE lib_mpp         ! MPP library 
    30    USE obc_par         ! open boundary cond. parameter 
    31    USE obc_oce 
    3230   USE bdy_oce 
    3331   USE bdy_par          
     
    120118      CALL agrif_ssh( kt ) 
    121119#endif 
    122 #if defined key_obc 
    123       IF( Agrif_Root() ) THEN  
    124          ssha(:,:) = ssha(:,:) * obctmsk(:,:) 
    125          CALL lbc_lnk( ssha, 'T', 1. )                 ! absolutly compulsory !! (jmm) 
    126       ENDIF 
    127 #endif 
    128120#if defined key_bdy 
    129121      ! bg jchanut tschanges 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90

    r3294 r4328  
    1414   USE dom_oce         ! ocean space and time domain 
    1515   USE phycst          ! physical constants 
    16    USE obc_par         ! open boundary condition parameters 
    1716   USE in_out_manager  ! I/O manager 
    1817   USE lib_mpp         ! distribued memory computing library 
     
    345344      IF( lk_mpp )   CALL mpp_sum( ijl   , jpnfl ) 
    346345       
    347       ! in the case of open boundaries we need to test if the floats don't 
    348       ! go out of the domain. If it goes out, the float is put at the  
    349       ! middle of the mesh in the domain but the trajectory isn't compute  
    350       ! more time.       
    351 # if defined key_obc 
    352       DO jfl = 1, jpnfl 
    353          IF( lp_obc_east ) THEN 
    354             IF( jped <=  zgjfl(jfl) .AND. zgjfl(jfl) <= jpef .AND. nieob-1 <=  zgifl(jfl) ) THEN 
    355                zgifl (jfl) = INT(zgifl(jfl)) + 0.5 
    356                zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 
    357                zagefl(jfl) = rdt 
    358             END IF 
    359          END IF 
    360          IF( lp_obc_west ) THEN 
    361             IF( jpwd <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpwf .AND. niwob >=  zgifl(jfl) ) THEN 
    362                zgifl (jfl) = INT(zgifl(jfl)) + 0.5 
    363                zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 
    364                zagefl(jfl) = rdt 
    365             END IF 
    366          END IF 
    367          IF( lp_obc_north ) THEN 
    368             IF( jpnd <=  zgifl(jfl) .AND. zgifl(jfl) <= jpnf .AND. njnob-1 >=  zgjfl(jfl) ) THEN 
    369                zgifl (jfl) = INT(zgifl(jfl)) + 0.5 
    370                zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 
    371                zagefl(jfl) = rdt 
    372             END IF 
    373          END IF 
    374          IF( lp_obc_south ) THEN 
    375             IF( jpsd <=  zgifl(jfl) .AND. zgifl(jfl) <= jpsf .AND.  njsob >= zgjfl(jfl) ) THEN 
    376                zgifl (jfl) = INT(zgifl(jfl)) + 0.5 
    377                zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5 
    378                zagefl(jfl) = rdt 
    379             END IF 
    380          END IF 
    381       END DO 
    382 #endif 
    383  
    384346      ! Test to know if a  float hasn't integrated enought time 
    385347      IF( ln_argo ) THEN 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    r4153 r4328  
    1919   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp 
    2020   !!   lbc_bdy_lnk  : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp 
    21    !!   lbc_obc_lnk  : generic interface for mpp_lnk_obc_2d and mpp_lnk_obc_3d routines defined in lib_mpp 
    2221   !!---------------------------------------------------------------------- 
    2322   USE lib_mpp          ! distributed memory computing library 
     
    2928   INTERFACE lbc_bdy_lnk 
    3029      MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 
    31    END INTERFACE 
    32    INTERFACE lbc_obc_lnk 
    33       MODULE PROCEDURE mpp_lnk_obc_2d, mpp_lnk_obc_3d 
    3430   END INTERFACE 
    3531 
     
    4137   PUBLIC lbc_lnk_e 
    4238   PUBLIC lbc_bdy_lnk   ! ocean lateral BDY boundary conditions 
    43    PUBLIC lbc_obc_lnk   ! ocean lateral BDY boundary conditions 
    4439 
    4540   !!---------------------------------------------------------------------- 
     
    5752   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable on ocean mesh 
    5853   !!   lbc_bdy_lnk  : set the lateral BDY boundary condition 
    59    !!   lbc_obc_lnk  : set the lateral OBC boundary condition 
    6054   !!---------------------------------------------------------------------- 
    6155   USE oce             ! ocean dynamics and tracers    
     
    7872      MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d 
    7973   END INTERFACE 
    80    INTERFACE lbc_obc_lnk 
    81       MODULE PROCEDURE lbc_lnk_2d, lbc_lnk_3d 
    82    END INTERFACE 
    8374 
    8475   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions 
    8576   PUBLIC   lbc_lnk_e  
    8677   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions 
    87    PUBLIC   lbc_obc_lnk   ! ocean lateral OBC boundary conditions 
    8878    
    8979   !!---------------------------------------------------------------------- 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r4314 r4328  
    5353   !!   mppsync       : 
    5454   !!   mppstop       : 
    55    !!   mppobc        : variant of mpp_lnk for open boundary condition 
    5655   !!   mpp_ini_north : initialisation of north fold 
    5756   !!   mpp_lbc_north : north fold processors gathering 
     
    7170   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 
    7271   PUBLIC   mppscatter, mppgather 
    73    PUBLIC   mppobc, mpp_ini_ice, mpp_ini_znl 
     72   PUBLIC   mpp_ini_ice, mpp_ini_znl 
    7473   PUBLIC   mppsize 
    7574   PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines 
    7675   PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 
    77    PUBLIC   mpp_lnk_obc_2d, mpp_lnk_obc_3d 
    7876 
    7977   !! * Interfaces 
     
    300298   END FUNCTION mynode 
    301299 
    302    SUBROUTINE mpp_lnk_obc_3d( ptab, cd_type, psgn ) 
    303       !!---------------------------------------------------------------------- 
    304       !!                  ***  routine mpp_lnk_obc_3d  *** 
     300   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval ) 
     301      !!---------------------------------------------------------------------- 
     302      !!                  ***  routine mpp_lnk_3d  *** 
    305303      !! 
    306304      !! ** Purpose :   Message passing manadgement 
    307305      !! 
    308       !! ** Method  :   Use mppsend and mpprecv function for passing OBC boundaries  
     306      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    309307      !!      between processors following neighboring subdomains. 
    310308      !!            domain parameters 
     
    313311      !!                    nbondi : mark for "east-west local boundary" 
    314312      !!                    nbondj : mark for "north-south local boundary" 
    315       !!                    noea   : number for local neighboring processors  
     313      !!                    noea   : number for local neighboring processors 
    316314      !!                    nowe   : number for local neighboring processors 
    317315      !!                    noso   : number for local neighboring processors 
     
    326324      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    327325      !                                                             ! =  1. , the sign is kept 
     326      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
     327      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    328328      !! 
    329329      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices 
     
    337337 
    338338      !!---------------------------------------------------------------------- 
    339  
     339       
    340340      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   & 
    341341         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  ) 
    342342 
    343       zland = 0.e0      ! zero by default 
     343      ! 
     344      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
     345      ELSE                         ;   zland = 0.e0      ! zero by default 
     346      ENDIF 
    344347 
    345348      ! 1. standard boundary treatment 
    346349      ! ------------------------------ 
    347       IF( nbondi == 2) THEN 
    348         IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN 
    349           ptab( 1 ,:,:) = ptab(jpim1,:,:) 
    350           ptab(jpi,:,:) = ptab(  2  ,:,:) 
    351         ELSE 
    352           IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
    353           ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
    354         ENDIF 
    355       ELSEIF(nbondi == -1) THEN 
    356         IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
    357       ELSEIF(nbondi == 1) THEN 
    358         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
    359       ENDIF                                     !* closed 
    360  
    361       IF (nbondj == 2 .OR. nbondj == -1) THEN 
    362         IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point 
    363       ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN 
    364         ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north 
     350      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
     351         ! 
     352         ! WARNING ptab is defined only between nld and nle 
     353         DO jk = 1, jpk 
     354            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
     355               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk) 
     356               ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk) 
     357               ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk) 
     358            END DO 
     359            DO ji = nlci+1, jpi                 ! added column(s) (full) 
     360               ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk) 
     361               ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk) 
     362               ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk) 
     363            END DO 
     364         END DO 
     365         ! 
     366      ELSE                              ! standard close or cyclic treatment 
     367         ! 
     368         !                                   ! East-West boundaries 
     369         !                                        !* Cyclic east-west 
     370         IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
     371            ptab( 1 ,:,:) = ptab(jpim1,:,:) 
     372            ptab(jpi,:,:) = ptab(  2  ,:,:) 
     373         ELSE                                     !* closed 
     374            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
     375                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
     376         ENDIF 
     377         !                                   ! North-South boundaries (always closed) 
     378         IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point 
     379                                      ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north 
     380         ! 
    365381      ENDIF 
    366382 
    367383      ! 2. East and west directions exchange 
    368384      ! ------------------------------------ 
    369       ! we play with the neigbours AND the row number because of the periodicity  
    370       ! 
    371       IF(nbondj .ne. 0) THEN 
     385      ! we play with the neigbours AND the row number because of the periodicity 
     386      ! 
    372387      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    373388      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
     
    377392            zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 
    378393         END DO 
    379       END SELECT   
     394      END SELECT 
    380395      ! 
    381396      !                           ! Migrations 
    382397      imigr = jpreci * jpj * jpk 
    383398      ! 
    384       SELECT CASE ( nbondi )  
     399      SELECT CASE ( nbondi ) 
    385400      CASE ( -1 ) 
    386401         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) 
     
    418433         END DO 
    419434      END SELECT 
    420       ENDIF 
    421435 
    422436 
     
    425439      ! always closed : we play only with the neigbours 
    426440      ! 
    427       IF(nbondi .ne. 0) THEN 
    428441      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    429442         ijhom = nlcj-nrecj 
     
    437450      imigr = jprecj * jpi * jpk 
    438451      ! 
    439       SELECT CASE ( nbondj )      
     452      SELECT CASE ( nbondj ) 
    440453      CASE ( -1 ) 
    441454         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 
     
    449462         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    450463         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    451       CASE ( 1 )  
     464      CASE ( 1 ) 
    452465         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 
    453466         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 
     
    473486         END DO 
    474487      END SELECT 
    475       ENDIF 
    476488 
    477489 
     
    479491      ! ----------------------- 
    480492      ! 
    481       IF( npolj /= 0 ) THEN 
     493      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 
    482494         ! 
    483495         SELECT CASE ( jpni ) 
     
    490502      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 
    491503      ! 
    492    END SUBROUTINE mpp_lnk_obc_3d 
    493  
    494  
    495    SUBROUTINE mpp_lnk_obc_2d( pt2d, cd_type, psgn ) 
    496       !!---------------------------------------------------------------------- 
    497       !!                  ***  routine mpp_lnk_obc_2d  *** 
    498       !!                   
     504   END SUBROUTINE mpp_lnk_3d 
     505 
     506 
     507   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
     508      !!---------------------------------------------------------------------- 
     509      !!                  ***  routine mpp_lnk_2d  *** 
     510      !! 
    499511      !! ** Purpose :   Message passing manadgement for 2d array 
    500512      !! 
    501       !! ** Method  :   Use mppsend and mpprecv function for passing OBC boundaries  
     513      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    502514      !!      between processors following neighboring subdomains. 
    503515      !!            domain parameters 
     
    506518      !!                    nbondi : mark for "east-west local boundary" 
    507519      !!                    nbondj : mark for "north-south local boundary" 
    508       !!                    noea   : number for local neighboring processors  
     520      !!                    noea   : number for local neighboring processors 
    509521      !!                    nowe   : number for local neighboring processors 
    510522      !!                    noso   : number for local neighboring processors 
     
    517529      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    518530      !                                                         ! =  1. , the sign is kept 
     531      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
     532      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    519533      !! 
    520534      INTEGER  ::   ji, jj, jl   ! dummy loop indices 
     
    532546         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   ) 
    533547 
    534       zland = 0.e0      ! zero by default 
     548      ! 
     549      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
     550      ELSE                         ;   zland = 0.e0      ! zero by default 
     551      ENDIF 
    535552 
    536553      ! 1. standard boundary treatment 
    537554      ! ------------------------------ 
    538555      ! 
    539       IF( nbondi == 2) THEN 
    540         IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN 
    541           pt2d( 1 ,:) = pt2d(jpim1,:) 
    542           pt2d(jpi,:) = pt2d(  2  ,:) 
    543         ELSE 
    544           IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point 
    545           pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north 
    546         ENDIF 
    547       ELSEIF(nbondi == -1) THEN 
    548         IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point 
    549       ELSEIF(nbondi == 1) THEN 
    550         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north 
    551       ENDIF                                     !* closed 
    552  
    553       IF (nbondj == 2 .OR. nbondj == -1) THEN 
    554         IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland       ! south except F-point 
    555       ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN 
    556         pt2d(:,nlcj-jprecj+1:jpj) = zland       ! north 
     556      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
     557         ! 
     558         ! WARNING pt2d is defined only between nld and nle 
     559         DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
     560            pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej) 
     561            pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej) 
     562            pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej) 
     563         END DO 
     564         DO ji = nlci+1, jpi                 ! added column(s) (full) 
     565            pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej) 
     566            pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     ) 
     567            pt2d(ji           ,nlej+1:jpj   ) = pt2d(     nlei,     nlej) 
     568         END DO 
     569         ! 
     570      ELSE                              ! standard close or cyclic treatment 
     571         ! 
     572         !                                   ! East-West boundaries 
     573         IF( nbondi == 2 .AND.   &                ! Cyclic east-west 
     574            &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
     575            pt2d( 1 ,:) = pt2d(jpim1,:)                                    ! west 
     576            pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east 
     577         ELSE                                     ! closed 
     578            IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point 
     579                                         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north 
     580         ENDIF 
     581         !                                   ! North-South boundaries (always closed) 
     582            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point 
     583                                         pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north 
     584         ! 
    557585      ENDIF 
    558586 
    559587      ! 2. East and west directions exchange 
    560588      ! ------------------------------------ 
    561       ! we play with the neigbours AND the row number because of the periodicity  
     589      ! we play with the neigbours AND the row number because of the periodicity 
    562590      ! 
    563591      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     
    657685            pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 
    658686         END DO 
    659       CASE ( 1 )  
    660          DO jl = 1, jprecj 
    661             pt2d(:,jl      ) = zt2sn(:,jl,2) 
    662          END DO 
    663       END SELECT 
    664  
    665  
    666       ! 4. north fold treatment 
    667       ! ----------------------- 
    668       ! 
    669       IF( npolj /= 0 ) THEN 
    670          ! 
    671          SELECT CASE ( jpni ) 
    672          CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp 
    673          CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs. 
    674          END SELECT 
    675          ! 
    676       ENDIF 
    677       ! 
    678       DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 
    679       ! 
    680    END SUBROUTINE mpp_lnk_obc_2d 
    681  
    682    SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval ) 
    683       !!---------------------------------------------------------------------- 
    684       !!                  ***  routine mpp_lnk_3d  *** 
    685       !! 
    686       !! ** Purpose :   Message passing manadgement 
    687       !! 
    688       !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    689       !!      between processors following neighboring subdomains. 
    690       !!            domain parameters 
    691       !!                    nlci   : first dimension of the local subdomain 
    692       !!                    nlcj   : second dimension of the local subdomain 
    693       !!                    nbondi : mark for "east-west local boundary" 
    694       !!                    nbondj : mark for "north-south local boundary" 
    695       !!                    noea   : number for local neighboring processors 
    696       !!                    nowe   : number for local neighboring processors 
    697       !!                    noso   : number for local neighboring processors 
    698       !!                    nono   : number for local neighboring processors 
    699       !! 
    700       !! ** Action  :   ptab with update value at its periphery 
    701       !! 
    702       !!---------------------------------------------------------------------- 
    703       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied 
    704       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
    705       !                                                             ! = T , U , V , F , W points 
    706       REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    707       !                                                             ! =  1. , the sign is kept 
    708       CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
    709       REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    710       !! 
    711       INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices 
    712       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
    713       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    714       REAL(wp) ::   zland 
    715       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
    716       ! 
    717       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north 
    718       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east 
    719  
    720       !!---------------------------------------------------------------------- 
    721        
    722       ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   & 
    723          &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  ) 
    724  
    725       ! 
    726       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
    727       ELSE                         ;   zland = 0.e0      ! zero by default 
    728       ENDIF 
    729  
    730       ! 1. standard boundary treatment 
    731       ! ------------------------------ 
    732       IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
    733          ! 
    734          ! WARNING ptab is defined only between nld and nle 
    735          DO jk = 1, jpk 
    736             DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
    737                ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk) 
    738                ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk) 
    739                ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk) 
    740             END DO 
    741             DO ji = nlci+1, jpi                 ! added column(s) (full) 
    742                ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk) 
    743                ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk) 
    744                ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk) 
    745             END DO 
    746          END DO 
    747          ! 
    748       ELSE                              ! standard close or cyclic treatment 
    749          ! 
    750          !                                   ! East-West boundaries 
    751          !                                        !* Cyclic east-west 
    752          IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    753             ptab( 1 ,:,:) = ptab(jpim1,:,:) 
    754             ptab(jpi,:,:) = ptab(  2  ,:,:) 
    755          ELSE                                     !* closed 
    756             IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
    757                                          ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
    758          ENDIF 
    759          !                                   ! North-South boundaries (always closed) 
    760          IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point 
    761                                       ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north 
    762          ! 
    763       ENDIF 
    764  
    765       ! 2. East and west directions exchange 
    766       ! ------------------------------------ 
    767       ! we play with the neigbours AND the row number because of the periodicity 
    768       ! 
    769       SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    770       CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    771          iihom = nlci-nreci 
    772          DO jl = 1, jpreci 
    773             zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 
    774             zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 
    775          END DO 
    776       END SELECT 
    777       ! 
    778       !                           ! Migrations 
    779       imigr = jpreci * jpj * jpk 
    780       ! 
    781       SELECT CASE ( nbondi ) 
    782       CASE ( -1 ) 
    783          CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) 
    784          CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 
    785          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    786       CASE ( 0 ) 
    787          CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
    788          CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 ) 
    789          CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 
    790          CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 
    791          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    792          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    793       CASE ( 1 ) 
    794          CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
    795          CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 
    796          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    797       END SELECT 
    798       ! 
    799       !                           ! Write Dirichlet lateral conditions 
    800       iihom = nlci-jpreci 
    801       ! 
    802       SELECT CASE ( nbondi ) 
    803       CASE ( -1 ) 
    804          DO jl = 1, jpreci 
    805             ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 
    806          END DO 
    807       CASE ( 0 ) 
    808          DO jl = 1, jpreci 
    809             ptab(jl      ,:,:) = zt3we(:,jl,:,2) 
    810             ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 
    811          END DO 
    812       CASE ( 1 ) 
    813          DO jl = 1, jpreci 
    814             ptab(jl      ,:,:) = zt3we(:,jl,:,2) 
    815          END DO 
    816       END SELECT 
    817  
    818  
    819       ! 3. North and south directions 
    820       ! ----------------------------- 
    821       ! always closed : we play only with the neigbours 
    822       ! 
    823       IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    824          ijhom = nlcj-nrecj 
    825          DO jl = 1, jprecj 
    826             zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 
    827             zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 
    828          END DO 
    829       ENDIF 
    830       ! 
    831       !                           ! Migrations 
    832       imigr = jprecj * jpi * jpk 
    833       ! 
    834       SELECT CASE ( nbondj ) 
    835       CASE ( -1 ) 
    836          CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 
    837          CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 
    838          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    839       CASE ( 0 ) 
    840          CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 
    841          CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 ) 
    842          CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 
    843          CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 
    844          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    845          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    846       CASE ( 1 ) 
    847          CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 
    848          CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 
    849          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    850       END SELECT 
    851       ! 
    852       !                           ! Write Dirichlet lateral conditions 
    853       ijhom = nlcj-jprecj 
    854       ! 
    855       SELECT CASE ( nbondj ) 
    856       CASE ( -1 ) 
    857          DO jl = 1, jprecj 
    858             ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 
    859          END DO 
    860       CASE ( 0 ) 
    861          DO jl = 1, jprecj 
    862             ptab(:,jl      ,:) = zt3sn(:,jl,:,2) 
    863             ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 
    864          END DO 
    865       CASE ( 1 ) 
    866          DO jl = 1, jprecj 
    867             ptab(:,jl,:) = zt3sn(:,jl,:,2) 
    868          END DO 
    869       END SELECT 
    870  
    871  
    872       ! 4. north fold treatment 
    873       ! ----------------------- 
    874       ! 
    875       IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 
    876          ! 
    877          SELECT CASE ( jpni ) 
    878          CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp 
    879          CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs. 
    880          END SELECT 
    881          ! 
    882       ENDIF 
    883       ! 
    884       DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 
    885       ! 
    886    END SUBROUTINE mpp_lnk_3d 
    887  
    888  
    889    SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
    890       !!---------------------------------------------------------------------- 
    891       !!                  ***  routine mpp_lnk_2d  *** 
    892       !! 
    893       !! ** Purpose :   Message passing manadgement for 2d array 
    894       !! 
    895       !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    896       !!      between processors following neighboring subdomains. 
    897       !!            domain parameters 
    898       !!                    nlci   : first dimension of the local subdomain 
    899       !!                    nlcj   : second dimension of the local subdomain 
    900       !!                    nbondi : mark for "east-west local boundary" 
    901       !!                    nbondj : mark for "north-south local boundary" 
    902       !!                    noea   : number for local neighboring processors 
    903       !!                    nowe   : number for local neighboring processors 
    904       !!                    noso   : number for local neighboring processors 
    905       !!                    nono   : number for local neighboring processors 
    906       !! 
    907       !!---------------------------------------------------------------------- 
    908       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied 
    909       CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
    910       !                                                         ! = T , U , V , F , W and I points 
    911       REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    912       !                                                         ! =  1. , the sign is kept 
    913       CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
    914       REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    915       !! 
    916       INTEGER  ::   ji, jj, jl   ! dummy loop indices 
    917       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
    918       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    919       REAL(wp) ::   zland 
    920       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
    921       ! 
    922       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north 
    923       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east 
    924  
    925       !!---------------------------------------------------------------------- 
    926  
    927       ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  & 
    928          &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   ) 
    929  
    930       ! 
    931       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
    932       ELSE                         ;   zland = 0.e0      ! zero by default 
    933       ENDIF 
    934  
    935       ! 1. standard boundary treatment 
    936       ! ------------------------------ 
    937       ! 
    938       IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
    939          ! 
    940          ! WARNING pt2d is defined only between nld and nle 
    941          DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
    942             pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej) 
    943             pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej) 
    944             pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej) 
    945          END DO 
    946          DO ji = nlci+1, jpi                 ! added column(s) (full) 
    947             pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej) 
    948             pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     ) 
    949             pt2d(ji           ,nlej+1:jpj   ) = pt2d(     nlei,     nlej) 
    950          END DO 
    951          ! 
    952       ELSE                              ! standard close or cyclic treatment 
    953          ! 
    954          !                                   ! East-West boundaries 
    955          IF( nbondi == 2 .AND.   &                ! Cyclic east-west 
    956             &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    957             pt2d( 1 ,:) = pt2d(jpim1,:)                                    ! west 
    958             pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east 
    959          ELSE                                     ! closed 
    960             IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point 
    961                                          pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north 
    962          ENDIF 
    963          !                                   ! North-South boundaries (always closed) 
    964             IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point 
    965                                          pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north 
    966          ! 
    967       ENDIF 
    968  
    969       ! 2. East and west directions exchange 
    970       ! ------------------------------------ 
    971       ! we play with the neigbours AND the row number because of the periodicity 
    972       ! 
    973       SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    974       CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    975          iihom = nlci-nreci 
    976          DO jl = 1, jpreci 
    977             zt2ew(:,jl,1) = pt2d(jpreci+jl,:) 
    978             zt2we(:,jl,1) = pt2d(iihom +jl,:) 
    979          END DO 
    980       END SELECT 
    981       ! 
    982       !                           ! Migrations 
    983       imigr = jpreci * jpj 
    984       ! 
    985       SELECT CASE ( nbondi ) 
    986       CASE ( -1 ) 
    987          CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 
    988          CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 
    989          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    990       CASE ( 0 ) 
    991          CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 
    992          CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 
    993          CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 
    994          CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 
    995          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    996          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    997       CASE ( 1 ) 
    998          CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 
    999          CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 
    1000          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    1001       END SELECT 
    1002       ! 
    1003       !                           ! Write Dirichlet lateral conditions 
    1004       iihom = nlci - jpreci 
    1005       ! 
    1006       SELECT CASE ( nbondi ) 
    1007       CASE ( -1 ) 
    1008          DO jl = 1, jpreci 
    1009             pt2d(iihom+jl,:) = zt2ew(:,jl,2) 
    1010          END DO 
    1011       CASE ( 0 ) 
    1012          DO jl = 1, jpreci 
    1013             pt2d(jl      ,:) = zt2we(:,jl,2) 
    1014             pt2d(iihom+jl,:) = zt2ew(:,jl,2) 
    1015          END DO 
    1016       CASE ( 1 ) 
    1017          DO jl = 1, jpreci 
    1018             pt2d(jl      ,:) = zt2we(:,jl,2) 
    1019          END DO 
    1020       END SELECT 
    1021  
    1022  
    1023       ! 3. North and south directions 
    1024       ! ----------------------------- 
    1025       ! always closed : we play only with the neigbours 
    1026       ! 
    1027       IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    1028          ijhom = nlcj-nrecj 
    1029          DO jl = 1, jprecj 
    1030             zt2sn(:,jl,1) = pt2d(:,ijhom +jl) 
    1031             zt2ns(:,jl,1) = pt2d(:,jprecj+jl) 
    1032          END DO 
    1033       ENDIF 
    1034       ! 
    1035       !                           ! Migrations 
    1036       imigr = jprecj * jpi 
    1037       ! 
    1038       SELECT CASE ( nbondj ) 
    1039       CASE ( -1 ) 
    1040          CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 
    1041          CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 
    1042          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    1043       CASE ( 0 ) 
    1044          CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 
    1045          CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 
    1046          CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 
    1047          CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 
    1048          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    1049          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    1050       CASE ( 1 ) 
    1051          CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 
    1052          CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 
    1053          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    1054       END SELECT 
    1055       ! 
    1056       !                           ! Write Dirichlet lateral conditions 
    1057       ijhom = nlcj - jprecj 
    1058       ! 
    1059       SELECT CASE ( nbondj ) 
    1060       CASE ( -1 ) 
    1061          DO jl = 1, jprecj 
    1062             pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 
    1063          END DO 
    1064       CASE ( 0 ) 
    1065          DO jl = 1, jprecj 
    1066             pt2d(:,jl      ) = zt2sn(:,jl,2) 
    1067             pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 
    1068          END DO 
    1069687      CASE ( 1 ) 
    1070688         DO jl = 1, jprecj 
     
    21021720      ! 
    21031721   END SUBROUTINE mppstop 
    2104  
    2105  
    2106    SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij , kumout) 
    2107       !!---------------------------------------------------------------------- 
    2108       !!                  ***  routine mppobc  *** 
    2109       !! 
    2110       !! ** Purpose :   Message passing manadgement for open boundary 
    2111       !!     conditions array 
    2112       !! 
    2113       !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    2114       !!       between processors following neighboring subdomains. 
    2115       !!       domain parameters 
    2116       !!                    nlci   : first dimension of the local subdomain 
    2117       !!                    nlcj   : second dimension of the local subdomain 
    2118       !!                    nbondi : mark for "east-west local boundary" 
    2119       !!                    nbondj : mark for "north-south local boundary" 
    2120       !!                    noea   : number for local neighboring processors 
    2121       !!                    nowe   : number for local neighboring processors 
    2122       !!                    noso   : number for local neighboring processors 
    2123       !!                    nono   : number for local neighboring processors 
    2124       !! 
    2125       !!---------------------------------------------------------------------- 
    2126       USE wrk_nemo        ! Memory allocation 
    2127       ! 
    2128       INTEGER , INTENT(in   )                     ::   kd1, kd2   ! starting and ending indices 
    2129       INTEGER , INTENT(in   )                     ::   kl         ! index of open boundary 
    2130       INTEGER , INTENT(in   )                     ::   kk         ! vertical dimension 
    2131       INTEGER , INTENT(in   )                     ::   ktype      ! define north/south or east/west cdt 
    2132       !                                                           !  = 1  north/south  ;  = 2  east/west 
    2133       INTEGER , INTENT(in   )                     ::   kij        ! horizontal dimension 
    2134       INTEGER , INTENT(in   )                     ::   kumout     ! ocean.output logical unit 
    2135       REAL(wp), INTENT(inout), DIMENSION(kij,kk)  ::   ptab       ! variable array 
    2136       ! 
    2137       INTEGER ::   ji, jj, jk, jl        ! dummy loop indices 
    2138       INTEGER ::   iipt0, iipt1, ilpt1   ! local integers 
    2139       INTEGER ::   ijpt0, ijpt1          !   -       - 
    2140       INTEGER ::   imigr, iihom, ijhom   !   -       - 
    2141       INTEGER ::   ml_req1, ml_req2, ml_err    ! for key_mpi_isend 
    2142       INTEGER ::   ml_stat(MPI_STATUS_SIZE)    ! for key_mpi_isend 
    2143       REAL(wp), POINTER, DIMENSION(:,:) ::   ztab   ! temporary workspace 
    2144       ! 
    2145       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north 
    2146       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east 
    2147       LOGICAL :: lmigr ! is true for those processors that have to migrate the OB 
    2148  
    2149       !!---------------------------------------------------------------------- 
    2150  
    2151       ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),   & 
    2152          &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   ) 
    2153  
    2154       CALL wrk_alloc( jpi,jpj, ztab ) 
    2155  
    2156       ! boundary condition initialization 
    2157       ! --------------------------------- 
    2158       ztab(:,:) = 0.e0 
    2159       ! 
    2160       IF( ktype==1 ) THEN                                  ! north/south boundaries 
    2161          iipt0 = MAX( 1, MIN(kd1 - nimpp+1, nlci     ) ) 
    2162          iipt1 = MAX( 0, MIN(kd2 - nimpp+1, nlci - 1 ) ) 
    2163          ilpt1 = MAX( 1, MIN(kd2 - nimpp+1, nlci     ) ) 
    2164          ijpt0 = MAX( 1, MIN(kl  - njmpp+1, nlcj     ) ) 
    2165          ijpt1 = MAX( 0, MIN(kl  - njmpp+1, nlcj - 1 ) ) 
    2166       ELSEIF( ktype==2 ) THEN                              ! east/west boundaries 
    2167          iipt0 = MAX( 1, MIN(kl  - nimpp+1, nlci     ) ) 
    2168          iipt1 = MAX( 0, MIN(kl  - nimpp+1, nlci - 1 ) ) 
    2169          ijpt0 = MAX( 1, MIN(kd1 - njmpp+1, nlcj     ) ) 
    2170          ijpt1 = MAX( 0, MIN(kd2 - njmpp+1, nlcj - 1 ) ) 
    2171          ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj     ) ) 
    2172       ELSE 
    2173          WRITE(kumout, cform_err) 
    2174          WRITE(kumout,*) 'mppobc : bad ktype' 
    2175          CALL mppstop 
    2176       ENDIF 
    2177  
    2178       ! Communication level by level 
    2179       ! ---------------------------- 
    2180 !!gm Remark : this is very time consumming!!! 
    2181       !                                         ! ------------------------ ! 
    2182         IF(((nbondi .ne. 0) .AND. (ktype .eq. 2)) .OR. ((nbondj .ne. 0) .AND. (ktype .eq. 1))) THEN 
    2183             ! there is nothing to be migrated 
    2184               lmigr = .TRUE. 
    2185             ELSE 
    2186               lmigr = .FALSE. 
    2187             ENDIF 
    2188  
    2189       IF( lmigr ) THEN 
    2190  
    2191       DO jk = 1, kk                             !   Loop over the levels   ! 
    2192          !                                      ! ------------------------ ! 
    2193          ! 
    2194          IF( ktype == 1 ) THEN                               ! north/south boundaries 
    2195             DO jj = ijpt0, ijpt1 
    2196                DO ji = iipt0, iipt1 
    2197                   ztab(ji,jj) = ptab(ji,jk) 
    2198                END DO 
    2199             END DO 
    2200          ELSEIF( ktype == 2 ) THEN                           ! east/west boundaries 
    2201             DO jj = ijpt0, ijpt1 
    2202                DO ji = iipt0, iipt1 
    2203                   ztab(ji,jj) = ptab(jj,jk) 
    2204                END DO 
    2205             END DO 
    2206          ENDIF 
    2207  
    2208  
    2209          ! 1. East and west directions 
    2210          ! --------------------------- 
    2211          ! 
    2212        IF( ktype == 1 ) THEN 
    2213  
    2214          IF( nbondi /= 2 ) THEN         ! Read Dirichlet lateral conditions 
    2215             iihom = nlci-nreci 
    2216             zt2ew(1:jpreci,1,1) = ztab(jpreci+1:nreci, ijpt0) 
    2217             zt2we(1:jpreci,1,1) = ztab(iihom+1:iihom+jpreci, ijpt0) 
    2218          ENDIF 
    2219          ! 
    2220          !                              ! Migrations 
    2221          imigr = jpreci 
    2222          ! 
    2223          IF( nbondi == -1 ) THEN 
    2224             CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 
    2225             CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 
    2226             IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    2227          ELSEIF( nbondi == 0 ) THEN 
    2228             CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 
    2229             CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 
    2230             CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 
    2231             CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 
    2232             IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    2233             IF(l_isend)   CALL mpi_wait( ml_req2, ml_stat, ml_err ) 
    2234          ELSEIF( nbondi == 1 ) THEN 
    2235             CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 
    2236             CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 
    2237             IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    2238          ENDIF 
    2239          ! 
    2240          !                              ! Write Dirichlet lateral conditions 
    2241          iihom = nlci-jpreci 
    2242          ! 
    2243          IF( nbondi == 0 .OR. nbondi == 1 ) THEN 
    2244             ztab(1:jpreci, ijpt0) = zt2we(1:jpreci,1,2) 
    2245          ENDIF 
    2246          IF( nbondi == -1 .OR. nbondi == 0 ) THEN 
    2247             ztab(iihom+1:iihom+jpreci, ijpt0) = zt2ew(1:jpreci,1,2) 
    2248          ENDIF 
    2249        ENDIF  ! (ktype == 1) 
    2250  
    2251          ! 2. North and south directions 
    2252          ! ----------------------------- 
    2253          ! 
    2254        IF(ktype == 2 ) THEN 
    2255          IF( nbondj /= 2 ) THEN         ! Read Dirichlet lateral conditions 
    2256             ijhom = nlcj-nrecj 
    2257             zt2sn(1:jprecj,1,1) = ztab(iipt0, ijhom+1:ijhom+jprecj) 
    2258             zt2ns(1:jprecj,1,1) = ztab(iipt0, jprecj+1:nrecj) 
    2259          ENDIF 
    2260          ! 
    2261          !                              ! Migrations 
    2262          imigr = jprecj 
    2263          ! 
    2264          IF( nbondj == -1 ) THEN 
    2265             CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 
    2266             CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 
    2267             IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    2268          ELSEIF( nbondj == 0 ) THEN 
    2269             CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 
    2270             CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 
    2271             CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 
    2272             CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 
    2273             IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    2274             IF( l_isend )   CALL mpi_wait( ml_req2, ml_stat, ml_err ) 
    2275          ELSEIF( nbondj == 1 ) THEN 
    2276             CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 
    2277             CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso) 
    2278             IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err ) 
    2279          ENDIF 
    2280          ! 
    2281          !                              ! Write Dirichlet lateral conditions 
    2282          ijhom = nlcj - jprecj 
    2283          IF( nbondj == 0 .OR. nbondj == 1 ) THEN 
    2284             ztab(iipt0,1:jprecj) = zt2sn(1:jprecj,1,2) 
    2285          ENDIF 
    2286          IF( nbondj == 0 .OR. nbondj == -1 ) THEN 
    2287             ztab(iipt0, ijhom+1:ijhom+jprecj) = zt2ns(1:jprecj,1,2) 
    2288          ENDIF 
    2289          ENDIF    ! (ktype == 2) 
    2290          IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN 
    2291             DO jj = ijpt0, ijpt1            ! north/south boundaries 
    2292                DO ji = iipt0,ilpt1 
    2293                   ptab(ji,jk) = ztab(ji,jj) 
    2294                END DO 
    2295             END DO 
    2296          ELSEIF( ktype==2 .AND. kd1 <= jpj+njmpp-1 .AND. njmpp <= kd2 ) THEN 
    2297             DO jj = ijpt0, ilpt1            ! east/west boundaries 
    2298                DO ji = iipt0,iipt1 
    2299                   ptab(jj,jk) = ztab(ji,jj) 
    2300                END DO 
    2301             END DO 
    2302          ENDIF 
    2303          ! 
    2304       END DO 
    2305       ! 
    2306       ENDIF ! ( lmigr ) 
    2307       ! 
    2308       DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 
    2309       CALL wrk_dealloc( jpi,jpj, ztab ) 
    2310       ! 
    2311    END SUBROUTINE mppobc 
    23121722 
    23131723 
     
    34902900      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real 
    34912901   END INTERFACE 
    3492    INTERFACE mppobc 
    3493       MODULE PROCEDURE mppobc_1d, mppobc_2d, mppobc_3d, mppobc_4d 
    3494    END INTERFACE 
    34952902   INTERFACE mpp_minloc 
    34962903      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d 
     
    36193026      WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint, kcom 
    36203027   END SUBROUTINE mppmin_int 
    3621  
    3622    SUBROUTINE mppobc_1d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 
    3623       INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum 
    3624       REAL, DIMENSION(:) ::   parr           ! variable array 
    3625       WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1), kd1, kd2, kl, kk, ktype, kij, knum 
    3626    END SUBROUTINE mppobc_1d 
    3627  
    3628    SUBROUTINE mppobc_2d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 
    3629       INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum 
    3630       REAL, DIMENSION(:,:) ::   parr           ! variable array 
    3631       WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1), kd1, kd2, kl, kk, ktype, kij, knum 
    3632    END SUBROUTINE mppobc_2d 
    3633  
    3634    SUBROUTINE mppobc_3d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 
    3635       INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum 
    3636       REAL, DIMENSION(:,:,:) ::   parr           ! variable array 
    3637       WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1), kd1, kd2, kl, kk, ktype, kij, knum 
    3638    END SUBROUTINE mppobc_3d 
    3639  
    3640    SUBROUTINE mppobc_4d( parr, kd1, kd2, kl, kk, ktype, kij, knum ) 
    3641       INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum 
    3642       REAL, DIMENSION(:,:,:,:) ::   parr           ! variable array 
    3643       WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1,1), kd1, kd2, kl, kk, ktype, kij, knum 
    3644    END SUBROUTINE mppobc_4d 
    36453028 
    36463029   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki, kj ) 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90

    r4230 r4328  
    1010   !!   sbc_apr        : read atmospheric pressure in netcdf files  
    1111   !!---------------------------------------------------------------------- 
    12    USE obc_par         ! open boundary condition parameters 
    1312   USE dom_oce         ! ocean space and time domain 
    1413   USE sbc_oce         ! surface boundary condition 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90

    r4153 r4328  
    2626   USE sol_oce         ! ocean solver 
    2727   USE phycst          ! physical constants 
    28    USE obc_oce         ! ocean open boundary conditions 
    2928   USE bdy_oce         ! unstructured open boundary conditions 
    3029   USE lbclnk          ! lateral boudary conditions 
     
    8685 
    8786#if defined key_dynspg_flt && ! defined key_bdy 
    88 #   if ! defined key_obc 
    8987 
    9088      DO jj = 2, jpjm1                      ! matrix of free surface elliptic system 
     
    103101         END DO 
    104102      END DO 
    105 #   else 
    106     IF ( Agrif_Root() ) THEN 
    107       DO jj = 2, jpjm1                      ! matrix of free surface elliptic system with open boundaries 
    108          DO ji = 2, jpim1 
    109             zcoef = z2dt * z2dt * grav * bmask(ji,jj) 
    110             !                                    ! south coefficient 
    111             IF( lp_obc_south .AND. ( jj == njs0p1 ) ) THEN 
    112                zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)*(1.-vsmsk(ji,1)) 
    113             ELSE 
    114                zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1) 
    115             END IF 
    116             gcp(ji,jj,1) = zcoefs 
    117             ! 
    118             !                                    ! west coefficient 
    119             IF( lp_obc_west  .AND. ( ji == niw0p1 ) ) THEN 
    120                zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)*(1.-uwmsk(jj,1)) 
    121             ELSE 
    122                zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj) 
    123             END IF 
    124             gcp(ji,jj,2) = zcoefw 
    125             ! 
    126             !                                    ! east coefficient 
    127             IF( lp_obc_east  .AND. ( ji == nie0 ) ) THEN 
    128                zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)*(1.-uemsk(jj,1)) 
    129             ELSE 
    130                zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj) 
    131             END IF 
    132             gcp(ji,jj,3) = zcoefe 
    133             ! 
    134             !                                    ! north coefficient 
    135             IF( lp_obc_north .AND. ( jj == njn0 ) ) THEN 
    136                zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)*(1.-vnmsk(ji,1)) 
    137             ELSE 
    138                zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj) 
    139             END IF 
    140             gcp(ji,jj,4) = zcoefn 
    141             ! 
    142             !                                    ! diagonal coefficient 
    143             gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj)   & 
    144                &            - zcoefs -zcoefw -zcoefe -zcoefn 
    145          END DO 
    146       END DO 
    147     ELSE 
    148       DO jj = 2, jpjm1                      ! matrix of free surface elliptic system 
    149          DO ji = 2, jpim1 
    150             zcoef = z2dt * z2dt * grav * bmask(ji,jj) 
    151             zcoefs = -zcoef * hv(ji  ,jj-1) * e1v(ji  ,jj-1) / e2v(ji  ,jj-1)    ! south coefficient 
    152             zcoefw = -zcoef * hu(ji-1,jj  ) * e2u(ji-1,jj  ) / e1u(ji-1,jj  )    ! west coefficient 
    153             zcoefe = -zcoef * hu(ji  ,jj  ) * e2u(ji  ,jj  ) / e1u(ji  ,jj  )    ! east coefficient 
    154             zcoefn = -zcoef * hv(ji  ,jj  ) * e1v(ji  ,jj  ) / e2v(ji  ,jj  )    ! north coefficient 
    155             gcp(ji,jj,1) = zcoefs 
    156             gcp(ji,jj,2) = zcoefw 
    157             gcp(ji,jj,3) = zcoefe 
    158             gcp(ji,jj,4) = zcoefn 
    159             gcdmat(ji,jj) = e1t(ji,jj) * e2t(ji,jj) * bmask(ji,jj)    &          ! diagonal coefficient 
    160                &          - zcoefs -zcoefw -zcoefe -zcoefn 
    161          END DO 
    162       END DO 
    163     ENDIF 
    164 #   endif 
    165103 
    166104#  elif defined key_dynspg_flt && defined key_bdy  
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r4230 r4328  
    3434   USE trdtra          ! ocean active tracers trends  
    3535   USE phycst 
    36    USE obc_oce 
    37    USE obctra          ! open boundary condition (obc_tra routine) 
    3836   USE bdy_oce 
    3937   USE bdytra          ! open boundary condition (bdy_tra routine) 
     
    8179      !!              - Apply lateral boundary conditions on (ta,sa)  
    8280      !!             at the local domain   boundaries through lbc_lnk call,  
    83       !!             at the one-way open boundaries (lk_obc=T),  
     81      !!             at the one-way open boundaries (lk_bdy=T),  
    8482      !!             at the AGRIF zoom     boundaries (lk_agrif=T) 
    8583      !! 
     
    112110      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp ) 
    113111      ! 
    114 #if defined key_obc  
    115       IF( lk_obc )   CALL obc_tra( kt )  ! OBC open boundaries 
    116 #endif 
    117112#if defined key_bdy  
    118113      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r4319 r4328  
    5151#endif 
    5252   USE tideini         ! tidal components initialization   (tide_ini routine) 
    53    USE obcini          ! open boundary cond. initialization (obc_ini routine) 
    5453   USE bdyini          ! open boundary cond. initialization (bdy_init routine) 
    5554   USE bdydta          ! open boundary cond. initialization (bdy_dta_init routine) 
     
    381380 
    382381      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
    383  
    384       IF( lk_obc        )   CALL     obc_init   ! Open boundaries 
    385382 
    386383                            CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/step.F90

    r4313 r4328  
    9696      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    9797      IF( lk_tide    )   CALL sbc_tide( kstp ) 
    98       IF( lk_obc     )   CALL obc_dta ( kstp )        ! update dynamic and tracer data at open boundaries 
    99       IF( lk_obc     )   CALL obc_rad ( kstp )        ! compute phase velocities at open boundaries 
    10098      IF( lk_bdy     )   CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries 
    10199 
     
    315313      ENDIF 
    316314      IF( lrst_oce         )   CALL rst_write    ( kstp )   ! write output ocean restart file 
    317       IF( lk_obc           )   CALL obc_rst_write( kstp )   ! write open boundary restart file 
    318315 
    319316      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r4292 r4328  
    5353 
    5454   USE dynnxt           ! time-stepping                    (dyn_nxt routine) 
    55  
    56    USE obc_par          ! open boundary condition variables 
    57    USE obcdta           ! open boundary condition data     (obc_dta routine) 
    58    USE obcrst           ! open boundary cond. restart      (obc_rst routine) 
    59    USE obcrad           ! open boundary cond. radiation    (obc_rad routine) 
    6055 
    6156   USE bdy_par          ! for lk_bdy 
Note: See TracChangeset for help on using the changeset viewer.