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 2335 – NEMO

Changeset 2335


Ignore:
Timestamp:
2010-10-29T09:39:51+02:00 (13 years ago)
Author:
gm
Message:

v3.3beta: Suppress obsolete key_mpp_shmem

Location:
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90

    r2287 r2335  
    88   !!   'key_floats'                                     float trajectories 
    99   !!---------------------------------------------------------------------- 
    10  
    11    !!---------------------------------------------------------------------- 
    1210   !!    flotblk     : compute float trajectories with Blanke algorithme 
    1311   !!---------------------------------------------------------------------- 
    14    !! * Modules used 
    1512   USE flo_oce         ! ocean drifting floats 
    1613   USE oce             ! ocean dynamics and tracers 
    … …  
    2320   PRIVATE 
    2421 
    25    !! * Accessibility 
    26    PUBLIC flo_blk      ! routine called by floats.F90 
     22   PUBLIC   flo_blk    ! routine called by floats.F90 
    2723 
    2824   !! * Substitutions 
    … …  
    3127   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3228   !! $Id$  
    33    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    34    !!---------------------------------------------------------------------- 
    35  
     29   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     30   !!---------------------------------------------------------------------- 
    3631CONTAINS 
    3732 
    … …  
    4641      !!      algorithm. We need to know the velocity field, the old positions 
    4742      !!      of the floats and the grid defined on the domain. 
     43      !!---------------------------------------------------------------------- 
     44      INTEGER, INTENT( in  ) ::   kt ! ocean time step 
    4845      !! 
    49       !!---------------------------------------------------------------------- 
    50       !! * arguments 
    51       INTEGER, INTENT( in  ) ::   kt ! ocean time step 
    52  
    53       !! * Local declarations 
    5446      INTEGER :: jfl              ! dummy loop arguments 
    5547      INTEGER :: ind, ifin, iloop 
    … …  
    7870         zsurfz,                    &     ! surface of the face of the mesh  
    7971         zind 
    80       REAL(wp), DIMENSION ( 2 )  ::   & 
    81          zsurfx, zsurfy                   ! surface of the face of the mesh 
     72      REAL(wp), DIMENSION ( 2 )  ::   zsurfx, zsurfy   ! surface of the face of the mesh 
    8273      !!--------------------------------------------------------------------- 
    8374       
    … …  
    111102      iloop = 0 
    112103222   DO jfl = 1, jpnfl 
    113 # if   defined key_mpp_mpi   ||   defined key_mpp_shmem 
     104# if   defined key_mpp_mpi 
    114105         IF( (iil(jfl) >= (mig(nldi)-jpizoom+1)) .AND. (iil(jfl) <= (mig(nlei)-jpizoom+1)) .AND.   & 
    115106             (ijl(jfl) >= (mjg(nldj)-jpjzoom+1)) .AND. (ijl(jfl) <= (mjg(nlej)-jpjzoom+1)) ) THEN 
    … …  
    327318            ! reinitialisation of the age of FLOAT 
    328319            zagefl(jfl) = zagenewfl(jfl) 
    329 # if   defined key_mpp_mpi   ||   defined key_mpp_shmem 
     320# if   defined key_mpp_mpi 
    330321         ELSE 
    331322            ! we put zgifl, zgjfl, zgkfl, zagefl 
    … …  
    413404         GO TO 222 
    414405      ENDIF 
    415  
     406      ! 
    416407   END SUBROUTINE flo_blk 
    417408 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90

    r2287 r2335  
    44   !! Ocean floats :   domain 
    55   !!====================================================================== 
     6   !! History :  OPA  ! 1998-07 (Y.Drillet, CLIPPER)  Original code 
     7   !!---------------------------------------------------------------------- 
    68#if   defined key_floats   ||   defined key_esopa 
    79   !!---------------------------------------------------------------------- 
    … …  
    1214   !!   dstnce         : compute distance between face mesh and floats  
    1315   !!---------------------------------------------------------------------- 
    14    !! * Modules used 
    1516   USE oce             ! ocean dynamics and tracers 
    1617   USE dom_oce         ! ocean space and time domain 
    … …  
    2021 
    2122   IMPLICIT NONE 
    22  
    23    !! * Accessibility 
    24    PRIVATE  dstnce 
    25    PUBLIC flo_dom     ! routine called by floats.F90 
     23   PRIVATE 
     24 
     25   PUBLIC   flo_dom    ! routine called by floats.F90 
    2626 
    2727   !! * Substitutions 
    … …  
    3030   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3131   !! $Id$  
    32    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    33    !!---------------------------------------------------------------------- 
    34  
     32   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     33   !!---------------------------------------------------------------------- 
    3534CONTAINS 
    3635 
    … …  
    4241      !! 
    4342      !!  ** Method  :   We put the floats  in the domain with the latitude, 
    44       !!       the longitude (degree) and the depth (m). 
    45       !! 
     43      !!               the longitude (degree) and the depth (m). 
    4644      !!----------------------------------------------------------------------       
    47       !! * Local declarations 
    48       LOGICAL  :: llinmesh 
    49       INTEGER  :: ji, jj, jk               ! DO loop index on 3 directions 
    50       INTEGER  :: jfl, jfl1                ! number of floats    
    51       INTEGER  :: inum                     ! logical unit for file read 
    52       INTEGER, DIMENSION ( jpnfl    )  ::   & 
    53          iimfl, ijmfl, ikmfl,    &          ! index mesh of floats 
    54          idomfl,  ivtest, ihtest 
    55       REAL(wp) :: zdxab, zdyad 
    56       REAL(wp), DIMENSION ( jpnnewflo+1 )  :: zgifl, zgjfl,  zgkfl 
     45      LOGICAL  ::   llinmesh 
     46      INTEGER  ::   ji, jj, jk   ! DO loop index on 3 directions 
     47      INTEGER  ::   jfl, jfl1    ! number of floats    
     48      INTEGER  ::   inum         ! logical unit for file read 
     49      INTEGER, DIMENSION(jpnfl) ::   iimfl, ijmfl, ikmfl       ! index mesh of floats 
     50      INTEGER, DIMENSION(jpnfl) ::   idomfl,  ivtest, ihtest   !   -             - 
     51      REAL(wp) ::   zdxab, zdyad 
     52      REAL(wp), DIMENSION(jpnnewflo+1)  :: zgifl, zgjfl,  zgkfl 
    5753      !!--------------------------------------------------------------------- 
    5854       
    … …  
    10298               ivtest(jfl) = 0 
    10399               ikmfl(jfl) = 0 
    104 # if   defined key_mpp_mpi   ||   defined key_mpp_shmem 
     100# if   defined key_mpp_mpi 
    105101               DO ji = MAX(nldi,2), nlei 
    106102                  DO jj = MAX(nldj,2), nlej   ! NO vector opt. 
    … …  
    139135             
    140136            ! A zero in the sum of the arrays "ihtest" and "ivtest"              
    141 # if   defined key_mpp_mpi   ||   defined key_mpp_shmem 
     137# if   defined key_mpp_mpi 
    142138            CALL mpp_sum(ihtest,jpnfl) 
    143139            CALL mpp_sum(ivtest,jpnfl) 
    … …  
    233229            ivtest(jfl) = 0 
    234230            ikmfl(jfl) = 0 
    235 # if   defined key_mpp_mpi   ||   defined key_mpp_shmem 
     231# if   defined key_mpp_mpi 
    236232            DO ji = MAX(nldi,2), nlei 
    237233               DO jj = MAX(nldj,2), nlej   ! NO vector opt. 
    … …  
    357353      !! 
    358354      !! ** Method  :  
    359       !! 
    360       !! History : 
    361       !!   8.0  !  98-07 (Y.Drillet)  Original code 
    362355      !!---------------------------------------------------------------------- 
    363       !! * Arguments 
    364356      REAL(wp) ::   & 
    365357         pax, pay, pbx, pby,    &     ! ??? 
    … …  
    368360         ptx, pty                     ! ??? 
    369361      LOGICAL ::  ldinmesh            ! ??? 
    370  
    371       !! * local declarations 
    372       REAL(wp) ::   & 
    373          zabt, zbct, zcdt, zdat, zabpt, zbcpt, zcdpt, zdapt,  & 
    374          psax,psay,psbx,psby,psx,psy 
    375       REAL(wp) ::  fsline                ! Statement function 
    376  
    377       !! * Substitutions 
    378       fsline(psax, psay, psbx, psby, psx, psy) = psy  * ( psbx - psax )   & 
    379                                                - psx  * ( psby - psay )   & 
    380                                                + psax *   psby - psay * psbx 
     362      !! 
     363      REAL(wp) ::   zabt, zbct, zcdt, zdat, zabpt, zbcpt, zcdpt, zdapt 
     364      !!--------------------------------------------------------------------- 
     365      !! Statement function 
     366      REAL(wp) ::   fsline 
     367      REAL(wp) ::   psax, psay, psbx, psby, psx, psy 
     368      fsline( psax, psay, psbx, psby, psx, psy ) = psy  * ( psbx - psax )   & 
     369         &                                       - psx  * ( psby - psay )   & 
     370         &                                       + psax *   psby - psay * psbx 
    381371      !!--------------------------------------------------------------------- 
    382372       
    … …  
    411401         ldinmesh=.FALSE. 
    412402      ENDIF 
    413  
     403      ! 
    414404   END SUBROUTINE findmesh 
    415405 
    … …  
    422412      !!                points 
    423413      !! ** Method  :  
    424       !!          
    425414      !!---------------------------------------------------------------------- 
    426       !! * Arguments 
    427415      REAL(wp), INTENT(in) ::   pla1, phi1, pla2, phi2   ! ??? 
    428  
    429       !! * Local variables 
     416      !! 
    430417      REAL(wp) ::   dly1, dly2, dlx1, dlx2, dlx, dls, dld, dpi 
    431418      REAL(wp) ::   dstnce 
    432419      !!--------------------------------------------------------------------- 
    433        
     420      ! 
    434421      dpi  = 2.* ASIN(1.) 
    435422      dls  = dpi / 180. 
    … …  
    438425      dlx1 = pla1 * dls 
    439426      dlx2 = pla2 * dls 
    440  
     427      ! 
    441428      dlx = SIN(dly1) * SIN(dly2) + COS(dly1) * COS(dly2) * COS(dlx2-dlx1) 
    442   
     429      ! 
    443430      IF( ABS(dlx) > 1.0 ) dlx = 1.0 
    444  
     431      ! 
    445432      dld = ATAN(DSQRT( ( 1-dlx )/( 1+dlx ) )) * 222.24 / dls 
    446433      dstnce = dld * 1000. 
    447  
     434      ! 
    448435   END FUNCTION dstnce 
    449436 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90

    r2287 r2335  
    88   !!   NEMO      1.0  ! 2002-11  (G. Madec, A. Bozec)  F90: Free form and module 
    99   !!---------------------------------------------------------------------- 
    10  
    1110#if   defined key_floats   ||   defined key_esopa 
    1211   !!---------------------------------------------------------------------- 
    … …  
    3433   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3534   !! $Id$  
    36    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    37    !!---------------------------------------------------------------------- 
    38  
     35   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     36   !!---------------------------------------------------------------------- 
    3937CONTAINS 
    4038 
    … …  
    5250      CHARACTER (len=21) ::  clname 
    5351      INTEGER ::   inum   ! temporary logical unit for restart file 
    54       INTEGER ::   iafl, ibfl, icfl, ia1fl, ib1fl, ic1fl, jfl, irecflo,   & 
     52      INTEGER ::   iafl, ibfl, icfl, ia1fl, ib1fl, ic1fl, jfl, irecflo 
    5553      INTEGER ::   iafloc, ibfloc, ia1floc, ib1floc, iafln, ibfln 
    5654      INTEGER  ::    ic, jc , jpn 
    57       INTEGER, DIMENSION ( jpnij )  :: iproc 
    58  
    59       REAL(wp) :: zafl,zbfl,zcfl,zdtj 
    60       REAL(wp) :: zxxu, zxxu_01,zxxu_10, zxxu_11 
    61       REAL(wp), DIMENSION (jpk,jpnfl) :: ztemp, zsal 
     55      INTEGER, DIMENSION ( jpnij )  ::   iproc 
     56      REAL(wp) ::   zafl,zbfl,zcfl,zdtj 
     57      REAL(wp) ::   zxxu, zxxu_01,zxxu_10, zxxu_11 
     58      REAL(wp), DIMENSION (jpk,jpnfl) ::   ztemp, zsal   ! 2D workspace 
    6259      !!--------------------------------------------------------------------- 
    6360       
    … …  
    7471         ! open the file numflo  
    7572         CALL ctl_opn( numflo, 'trajec_float', 'REPLACE', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    76          !      REWIND numflo 
    7773 
    7874         IF( kt == nit000 ) THEN 
    … …  
    8076            IF(lwp) WRITE(numflo)cexper,no,irecflo,jpnfl,nn_writefl 
    8177         ENDIF 
    82          zdtj = rdt / 86400.      !!bug   use of 86400 instead of the phycst parameter 
     78         zdtj = rdt / 86400._wp 
    8379 
    8480         ! translation of index position in geographical position 
    … …  
    195191      !         iafln=NINT(tpifl(jfl)) 
    196192      !         ibfln=NINT(tpjfl(jfl)) 
    197       !# if defined key_mpp_mpi   ||   defined key_mpp_shmem 
     193      !# if defined key_mpp_mpi    
    198194      !        IF ( (iafl >= (mig(nldi)-jpizoom+1)) .AND. 
    199195      !     $       (iafl <= (mig(nlei)-jpizoom+1)) .AND. 
    … …  
    214210      !         ztemp(jfl)=tn(iafloc,ibfloc,jk) 
    215211      !         zsal(jfl)=sn(iaflo!,ibfloc,jk) 
    216       !# if defined key_mpp_mpi   ||   defined key_mpp_shmem 
     212      !# if defined key_mpp_mpi    
    217213      !        ELSE 
    218214      !         ztemp(jfl) = 0. 
    … …  
    298294 
    299295      IF( kt == nitend )   CLOSE( numflo )  
    300      
     296      ! 
    301297   END SUBROUTINE flo_wri 
    302298 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBC/obc_vectopt_loop_substitute.h90

    r2287 r2335  
    55   !!      to allow unrolling of do-loop using CPP macro. 
    66   !!---------------------------------------------------------------------- 
    7    !!---------------------------------------------------------------------- 
    8    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    9    !! $Id$  
    10    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    11    !!---------------------------------------------------------------------- 
    12 #if defined key_vectopt_loop && defined key_obc && ! defined key_mpp_mpi && ! defined key_mpp_shmem 
     7#if defined key_vectopt_loop && defined key_obc && ! defined key_mpp_mpi 
    138#  define fs_niw0  jpiwob  
    149#  define fs_niw1  jpiwob 
    … …  
    2924#  define fs_njs1  njs1 
    3025#endif 
     26   !!---------------------------------------------------------------------- 
     27   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     28   !! $Id$  
     29   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     30   !!---------------------------------------------------------------------- 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS/mpp_map.F90

    r2287 r2335  
    44   !! NEMOVAR: MPP global grid point mapping to processors 
    55   !!====================================================================== 
     6   !! History :  2.0  ! 2007-08  (K. Mogensen)  Original code 
     7   !!---------------------------------------------------------------------- 
    68 
    79   !!---------------------------------------------------------------------- 
    8    !! mppmap      : Global array which maps i,j to area number. 
    9    !! mppmap_init : Initialize mppmap. 
     10   !!  mppmap_init : Initialize mppmap. 
    1011   !!---------------------------------------------------------------------- 
    11    !! * Modules used    
    12    USE par_kind, ONLY : &   ! Precision variables 
    13       & wp 
    14    USE par_oce, ONLY : &    ! Ocean parameters 
    15       & jpi,   & 
    16       & jpj 
    17    USE dom_oce, ONLY : &    ! Ocean space and time domain variables 
    18       & mig,   & 
    19       & mjg,   &   
    20       & nldi,  & 
    21       & nlei,  & 
    22       & nldj,  & 
    23       & nlej,  & 
    24       & narea  
     12   USE par_kind, ONLY :   wp            ! Precision variables 
     13   USE par_oce , ONLY :   jpi, jpj      ! Ocean parameters 
     14   USE dom_oce , ONLY :   mig, mjg, nldi, nlei, nldj, nlej, narea   ! Ocean space and time domain variables 
    2515#if defined key_mpp_mpi 
    26    USE lib_mpp, ONLY : &    ! MPP library 
    27       & mpi_comm_opa 
     16   USE lib_mpp, ONLY :   mpi_comm_opa   ! MPP library 
    2817#endif 
    29    USE in_out_manager 
     18   USE in_out_manager   ! I/O manager 
    3019 
    3120   IMPLICIT NONE 
    32  
    33    !! * Routine accessibility 
    3421   PRIVATE 
    3522 
    36    PUBLIC & 
    37       & mppmap_init,        & 
    38       & mppmap 
     23   PUBLIC ::   mppmap_init, mppmap   !: ??? 
    3924 
    40    !! * Module variables 
    41  
    42    INTEGER, DIMENSION(:,:), ALLOCATABLE :: & 
    43       & mppmap 
     25   INTEGER, DIMENSION(:,:), ALLOCATABLE ::   mppmap   ! ??? 
    4426 
    4527   !!---------------------------------------------------------------------- 
    4628   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4729   !! $Id$ 
    48    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     30   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4931   !!---------------------------------------------------------------------- 
    50  
    5132CONTAINS 
    5233 
    … …  
    6041      !! 
    6142      !! ** Action  : This does only work for MPI.  
    62       !!              It does not work for SHMEM. 
    6343      !! 
    6444      !! References : http://www.mpi-forum.org 
    65       !! 
    66       !! History : 
    67       !!        !  07-08  (K. Mogensen)  Original code 
    6845      !!---------------------------------------------------------------------- 
    69  
    70       !! * Arguments 
    71       INTEGER, DIMENSION(:,:), ALLOCATABLE :: imppmap 
     46      INTEGER, DIMENSION(:,:), ALLOCATABLE ::   imppmap   ! 
    7247#if defined key_mpp_mpi 
    73       !! * Local declarations 
    7448      INTEGER :: ierr 
    7549INCLUDE 'mpif.h' 
    7650#endif 
     51      !!---------------------------------------------------------------------- 
    7752 
    7853      ALLOCATE( & 
    … …  
    9570 
    9671      ! Call the MPI library to find the max across processors 
    97  
    98       CALL mpi_allreduce( imppmap, mppmap, jpiglo*jpjglo, mpi_integer, & 
     72      CALL mpi_allreduce( imppmap, mppmap, jpiglo*jpjglo, mpi_integer,   & 
    9973         &                mpi_max, mpi_comm_opa, ierr ) 
    100 #elif defined key_mpp_shmem 
    101 #error "Only MPI support for MPP in NEMOVAR" 
    10274#else       
    10375       
    104       ! Just copy the data 
    105  
     76      ! No MPP: Just copy the data 
    10677      mppmap(:,:) = imppmap(:,:) 
    107  
    10878#endif 
    109  
     79      ! 
    11080   END SUBROUTINE mppmap_init 
    11181 
     82   !!====================================================================== 
    11283END MODULE mpp_map 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90

    r2287 r2335  
    1 #if defined key_mpp_mpi 
    2 #if defined key_sp 
    3 #define mpivar mpi_real 
    4 #else 
    5 #define mpivar mpi_double_precision 
    6 #endif 
    7 #endif 
    81MODULE obs_mpp 
    92   !!====================================================================== 
    … …  
    114   !! Observation diagnostics: Various MPP support routines 
    125   !!====================================================================== 
    13  
     6   !! History :  2.0  ! 2006-03  (K. Mogensen)  Original code 
     7   !!             -   ! 2006-05  (K. Mogensen)  Reformatted 
     8   !!             -   ! 2008-01  (K. Mogensen)  add mpp_global_max 
    149   !!---------------------------------------------------------------------- 
    15    !! obs_mpp_bcast_integer : Broadcast an integer array from a processor  
    16    !!                         to all processors 
    17    !! obs_mpp_max_integer   : Find maximum on all processors of each 
    18    !!                         value in an integer on all processors 
     10#if defined key_mpp_mpi 
     11# if defined key_sp 
     12#  define mpivar mpi_real 
     13# else 
     14#  define mpivar mpi_double_precision 
     15# endif 
     16#endif 
     17   !!---------------------------------------------------------------------- 
     18   !! obs_mpp_bcast_integer : Broadcast an integer array from a processor to all processors 
     19   !! obs_mpp_max_integer   : Find maximum on all processors of each value in an integer on all processors 
    1920   !! obs_mpp_find_obs_proc : Find processors which should hold the observations 
    2021   !! obs_mpp_sum_integers  : Sum an integer array from all processors 
    2122   !! obs_mpp_sum_integer   : Sum an integer from all processors 
    2223   !!---------------------------------------------------------------------- 
    23    !! * Modules used    
    24    USE dom_oce, ONLY : &    ! Ocean space and time domain variables 
    25       & nproc, & 
    26       & mig,mjg 
    27    USE mpp_map, ONLY : & 
    28       & mppmap 
     24   USE dom_oce, ONLY :   nproc, mig, mjg   ! Ocean space and time domain variables 
     25   USE mpp_map, ONLY :   mppmap 
    2926   USE in_out_manager 
    3027#if defined key_mpp_mpi 
    31    USE lib_mpp, ONLY : &    ! MPP library 
    32       & mpi_comm_opa 
     28   USE lib_mpp, ONLY :   mpi_comm_opa      ! MPP library 
    3329#endif 
    3430   IMPLICIT NONE 
    35  
    36    !! * Routine accessibility 
    3731   PRIVATE 
    3832 
    39    PUBLIC obs_mpp_bcast_integer, & ! Broadcast an integer array from a proc to all procs 
    40       &   obs_mpp_max_integer,   & ! Find maximum across processors in an integer array 
    41       &   obs_mpp_find_obs_proc, & ! Find processors which should hold the observations 
    42       &   obs_mpp_sum_integers,  & ! Sum an integer array from all processors 
    43       &   obs_mpp_sum_integer,   & ! Sum an integer from all processors 
     33   PUBLIC obs_mpp_bcast_integer, & !: Broadcast an integer array from a proc to all procs 
     34      &   obs_mpp_max_integer,   & !: Find maximum across processors in an integer array 
     35      &   obs_mpp_find_obs_proc, & !: Find processors which should hold the observations 
     36      &   obs_mpp_sum_integers,  & !: Sum an integer array from all processors 
     37      &   obs_mpp_sum_integer,   & !: Sum an integer from all processors 
    4438      &   mpp_alltoall_int,      & 
    4539      &   mpp_alltoallv_int,     & 
    … …  
    5044   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5145   !! $Id$ 
    52    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     46   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5347   !!---------------------------------------------------------------------- 
    54  
    5548CONTAINS 
    5649 
    57    SUBROUTINE obs_mpp_bcast_integer(kvals,kno,kroot) 
     50   SUBROUTINE obs_mpp_bcast_integer( kvals, kno, kroot ) 
    5851      !!---------------------------------------------------------------------- 
    5952      !!               ***  ROUTINE obs_mpp_bcast_integer *** 
    … …  
    6457      !! 
    6558      !! ** Action  : This does only work for MPI.  
    66       !!              It does not work for SHMEM. 
    6759      !!              MPI_COMM_OPA needs to be replace for OASIS4.! 
    6860      !! 
    6961      !! References : http://www.mpi-forum.org 
    70       !! 
    71       !! History : 
    72       !!        !  06-03  (K. Mogensen)  Original code 
    73       !!        !  06-05  (K. Mogensen)  Reformatted 
    74       !!---------------------------------------------------------------------- 
    75  
    76       !! * Arguments 
    77       INTEGER, INTENT(IN) :: kno       ! Number of elements in array 
    78       INTEGER, INTENT(IN) :: kroot      ! Processor to send data 
    79       INTEGER, DIMENSION(kno), INTENT(INOUT) :: & 
    80          & kvals         ! Array to send on kroot, receive for non-kroot 
     62      !!---------------------------------------------------------------------- 
     63      INTEGER                , INTENT(in   ) ::   kno     ! Number of elements in array 
     64      INTEGER                , INTENT(in   ) ::   kroot   ! Processor to send data 
     65      INTEGER, DIMENSION(kno), INTENT(inout) ::   kvals   ! Array to send on kroot, receive for non-kroot 
     66      !! 
     67#if defined key_mpp_mpi 
     68      INTEGER :: ierr 
     69INCLUDE 'mpif.h' 
     70      !!---------------------------------------------------------------------- 
     71 
     72      ! Call the MPI library to broadcast data 
     73      CALL mpi_bcast( kvals, kno, mpi_integer,  & 
     74         &            kroot, mpi_comm_opa, ierr ) 
     75#else 
     76      ! no MPI: empty routine 
     77#endif 
     78      ! 
     79   END SUBROUTINE obs_mpp_bcast_integer 
     80 
    8181   
    82 #if defined key_mpp_mpi 
    83       !! * Local declarations 
    84       INTEGER :: ierr 
    85 INCLUDE 'mpif.h' 
    86  
    87       !----------------------------------------------------------------------- 
    88       ! Call the MPI library to broadcast data 
    89       !----------------------------------------------------------------------- 
    90       CALL mpi_bcast( kvals, kno, mpi_integer, & 
    91          &            kroot, mpi_comm_opa, ierr ) 
    92 #elif defined key_mpp_shmem 
    93 error "Only MPI support for MPP in NEMOVAR" 
    94 #endif 
    95  
    96    END SUBROUTINE obs_mpp_bcast_integer 
    97      
    9882   SUBROUTINE obs_mpp_max_integer( kvals, kno ) 
    9983      !!---------------------------------------------------------------------- 
    … …  
    10993      !! 
    11094      !! References : http://www.mpi-forum.org 
    111       !! 
    112       !! History : 
    113       !!        !  06-03  (K. Mogensen)  Original code 
    114       !!        !  06-05  (K. Mogensen)  Reformatted 
    115       !!---------------------------------------------------------------------- 
    116  
    117       !! * Arguments 
    118       INTEGER, INTENT(IN) ::kno       ! Number of elements in array 
    119       INTEGER, DIMENSION(kno), INTENT(INOUT) :: & 
    120          & kvals     ! Array to send on kroot, receive for non-kroot   
    121  
    122 #if defined key_mpp_mpi 
    123       !! * Local declarations 
    124       INTEGER :: ierr 
    125       INTEGER, DIMENSION(kno) :: & 
    126          & ivals 
    127 INCLUDE 'mpif.h' 
    128  
    129       !----------------------------------------------------------------------- 
     95      !!---------------------------------------------------------------------- 
     96      INTEGER                , INTENT(in   ) ::   kno     ! Number of elements in array 
     97      INTEGER, DIMENSION(kno), INTENT(inout) ::   kvals   ! Array to send on kroot, receive for non-kroot   
     98      !! 
     99#if defined key_mpp_mpi 
     100      INTEGER :: ierr 
     101      INTEGER, DIMENSION(kno) ::   ivals 
     102INCLUDE 'mpif.h' 
     103      !!---------------------------------------------------------------------- 
     104 
    130105      ! Call the MPI library to find the maximum across processors 
    131       !----------------------------------------------------------------------- 
    132       CALL mpi_allreduce( kvals, ivals, kno, mpi_integer, & 
     106      CALL mpi_allreduce( kvals, ivals, kno, mpi_integer,   & 
    133107         &                mpi_max, mpi_comm_opa, ierr ) 
    134108      kvals(:) = ivals(:) 
    135 #elif defined key_mpp_shmem 
    136 error "Only MPI support for MPP in NEMOVAR" 
     109#else 
     110      ! no MPI: empty routine 
    137111#endif 
    138112   END SUBROUTINE obs_mpp_max_integer 
    139113 
    140    SUBROUTINE obs_mpp_find_obs_proc(kobsp,kobsi,kobsj,kno) 
     114 
     115   SUBROUTINE obs_mpp_find_obs_proc( kobsp, kobsi, kobsj, kno ) 
    141116      !!---------------------------------------------------------------------- 
    142117      !!               ***  ROUTINE obs_mpp_find_obs_proc *** 
    … …  
    155130      !! 
    156131      !! References : http://www.mpi-forum.org 
    157       !! 
    158       !! History : 
    159       !!        !  06-07  (K. Mogensen)  Original code 
    160       !!---------------------------------------------------------------------- 
    161  
    162       !! * Arguments 
    163       INTEGER, INTENT(IN) :: kno 
    164       INTEGER, DIMENSION(kno), INTENT(IN) :: & 
    165          & kobsi, & 
    166          & kobsj 
    167       INTEGER, DIMENSION(kno), INTENT(INOUT) :: & 
    168          & kobsp 
    169  
    170 #if defined key_mpp_mpi 
    171       !! * Local declarations 
     132      !!---------------------------------------------------------------------- 
     133      INTEGER                , INTENT(in   ) ::   kno 
     134      INTEGER, DIMENSION(kno), INTENT(in   ) ::   kobsi, kobsj 
     135      INTEGER, DIMENSION(kno), INTENT(inout) ::   kobsp 
     136      !! 
     137#if defined key_mpp_mpi 
    172138      INTEGER :: ji 
    173139      INTEGER :: jj 
    … …  
    177143      INTEGER :: iobsjp 
    178144      INTEGER :: num_sus_obs 
    179       INTEGER, DIMENSION(kno) :: & 
    180          & iobsig, & 
    181          & iobsjg 
    182       INTEGER, ALLOCATABLE, DIMENSION(:,:) :: & 
    183          & iobsp, iobsi, iobsj 
    184  
    185 INCLUDE 'mpif.h' 
     145      INTEGER, DIMENSION(kno) ::   iobsig, iobsjg 
     146      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iobsp, iobsi, iobsj 
     147      !! 
     148INCLUDE 'mpif.h' 
     149      !!---------------------------------------------------------------------- 
    186150 
    187151      !----------------------------------------------------------------------- 
    … …  
    258222      DEALLOCATE( iobsi ) 
    259223      DEALLOCATE( iobsp ) 
    260 #elif defined key_mpp_shmem 
    261 error "Only MPI support for MPP in NEMOVAR" 
    262 #endif 
    263  
     224#else 
     225      ! no MPI: empty routine 
     226#endif 
     227      ! 
    264228   END SUBROUTINE obs_mpp_find_obs_proc 
    265229 
     230 
    266231   SUBROUTINE obs_mpp_sum_integers( kvalsin, kvalsout, kno ) 
    267232      !!---------------------------------------------------------------------- 
    … …  
    276241      !! 
    277242      !! References : http://www.mpi-forum.org 
    278       !! 
    279       !! History : 
    280       !!        !  06-07  (K. Mogensen)  Original code 
    281       !!---------------------------------------------------------------------- 
    282  
    283       !! * Arguments 
    284       INTEGER, INTENT(IN) :: kno 
    285       INTEGER, DIMENSION(kno), INTENT(IN) :: & 
    286          & kvalsin 
    287       INTEGER, DIMENSION(kno), INTENT(OUT) :: & 
    288          & kvalsout 
    289  
    290 #if defined key_mpp_mpi 
    291       !! * Local declarations 
    292       INTEGER :: ierr 
    293 INCLUDE 'mpif.h' 
    294   
     243      !!---------------------------------------------------------------------- 
     244      INTEGER                , INTENT(in   ) :: kno 
     245      INTEGER, DIMENSION(kno), INTENT(in   ) ::   kvalsin 
     246      INTEGER, DIMENSION(kno), INTENT(  out) ::   kvalsout 
     247      !! 
     248#if defined key_mpp_mpi 
     249      INTEGER :: ierr 
     250      !! 
     251INCLUDE 'mpif.h' 
     252      !!---------------------------------------------------------------------- 
     253      ! 
    295254      !----------------------------------------------------------------------- 
    296255      ! Call the MPI library to find the sum across processors 
    … …  
    298257      CALL mpi_allreduce( kvalsin, kvalsout, kno, mpi_integer, & 
    299258         &                mpi_sum, mpi_comm_opa, ierr ) 
    300 #elif defined key_mpp_shmem 
    301 error "Only MPI support for MPP in NEMOVAR" 
    302 #else 
    303  
     259#else 
    304260      !----------------------------------------------------------------------- 
    305261      ! For no-MPP just return input values 
    … …  
    307263      kvalsout(:) = kvalsin(:) 
    308264#endif 
    309  
     265      ! 
    310266   END SUBROUTINE obs_mpp_sum_integers 
    311267 
     268 
    312269   SUBROUTINE obs_mpp_sum_integer( kvalin, kvalout ) 
    313270      !!---------------------------------------------------------------------- 
    … …  
    322279      !! 
    323280      !! References : http://www.mpi-forum.org 
    324       !! 
    325       !! History : 
    326       !!        !  06-07  (K. Mogensen)  Original code 
    327       !!---------------------------------------------------------------------- 
    328  
    329       !! * Arguments 
    330       INTEGER, INTENT(IN) :: kvalin 
    331       INTEGER, INTENT(OUT) :: kvalout 
    332  
    333 #if defined key_mpp_mpi 
    334       !! * Local declarations 
    335       INTEGER :: ierr 
    336 INCLUDE 'mpif.h' 
    337  
     281      !!---------------------------------------------------------------------- 
     282      INTEGER, INTENT(in   ) ::   kvalin 
     283      INTEGER, INTENT(  out) ::   kvalout 
     284      !! 
     285#if defined key_mpp_mpi 
     286      INTEGER :: ierr 
     287      !! 
     288INCLUDE 'mpif.h' 
     289      !!---------------------------------------------------------------------- 
     290      ! 
    338291      !----------------------------------------------------------------------- 
    339292      ! Call the MPI library to find the sum across processors 
    340293      !----------------------------------------------------------------------- 
    341       CALL mpi_allreduce( kvalin, kvalout, 1, mpi_integer, & 
     294      CALL mpi_allreduce( kvalin, kvalout, 1, mpi_integer,   & 
    342295         &                mpi_sum, mpi_comm_opa, ierr ) 
    343 #elif defined key_mpp_shmem 
    344 error "Only MPI support for MPP in NEMOVAR" 
    345 #else 
    346  
     296#else 
    347297      !----------------------------------------------------------------------- 
    348298      ! For no-MPP just return input values 
    … …  
    350300      kvalout = kvalin 
    351301#endif 
     302      ! 
    352303   END SUBROUTINE obs_mpp_sum_integer 
     304 
    353305 
    354306   SUBROUTINE mpp_global_max( pval ) 
    … …  
    365317      !! 
    366318      !! References : http://www.mpi-forum.org 
    367       !! 
    368       !! History : 
    369       !!        !  08-01  (K. Mogensen)  Original code 
    370       !!---------------------------------------------------------------------- 
    371  
    372       !! * Arguments 
    373       REAL(KIND=wp), DIMENSION(jpiglo,jpjglo), INTENT(INOUT) :: & 
    374          & pval 
    375       !! * Local declarations 
    376       INTEGER :: ierr 
    377 #if defined key_mpp_mpi 
    378 INCLUDE 'mpif.h' 
    379       REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: & 
    380          & zcp 
     319      !!---------------------------------------------------------------------- 
     320      REAL(KIND=wp), DIMENSION(jpiglo,jpjglo), INTENT(inout) ::   pval 
     321      !! 
     322      INTEGER :: ierr 
     323#if defined key_mpp_mpi 
     324INCLUDE 'mpif.h' 
     325      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE ::   zcp 
     326      !!---------------------------------------------------------------------- 
    381327 
    382328      ! Copy data for input to MPI 
    … …  
    396342         & ) 
    397343 
    398 #elif defined key_mpp_shmem 
    399 error "Only MPI support for MPP in NEMOVAR" 
    400 #endif 
    401        
     344#else 
     345      ! no MPI: empty routine 
     346#endif 
     347      ! 
    402348   END SUBROUTINE mpp_global_max 
    403349 
     350 
    404351   SUBROUTINE mpp_alltoall_int( kno, kvalsin, kvalsout ) 
    405352      !!---------------------------------------------------------------------- 
    … …  
    414361      !! 
    415362      !! References : http://www.mpi-forum.org 
    416       !! 
    417       !! History : 
    418       !!        !  06-09  (K. Mogensen)  Original code 
    419       !!---------------------------------------------------------------------- 
    420  
    421       !! * Arguments 
    422       INTEGER, INTENT(IN) :: kno 
    423       INTEGER, DIMENSION(kno*jpnij), INTENT(IN) :: & 
    424          & kvalsin 
    425       INTEGER, DIMENSION(kno*jpnij), INTENT(OUT) :: & 
    426          & kvalsout 
    427       !! * Local declarations 
     363      !!---------------------------------------------------------------------- 
     364      INTEGER                      , INTENT(in   ) ::   kno 
     365      INTEGER, DIMENSION(kno*jpnij), INTENT(in   ) ::   kvalsin 
     366      INTEGER, DIMENSION(kno*jpnij), INTENT(  out) ::   kvalsout 
     367      !! 
    428368      INTEGER :: ierr 
    429369#if defined key_mpp_mpi 
    … …  
    435375         &               kvalsout, kno, mpi_integer, & 
    436376         &               mpi_comm_opa, ierr ) 
    437 #elif defined key_mpp_shmem 
    438 error "Only MPI support for MPP in NEMOVAR" 
    439377#else 
    440378      !----------------------------------------------------------------------- 
    … …  
    443381      kvalsout = kvalsin 
    444382#endif 
    445        
     383      ! 
    446384   END SUBROUTINE mpp_alltoall_int 
    447385 
    448    SUBROUTINE mpp_alltoallv_int( kvalsin, knoin, kinv, kvalsout, & 
    449       &                              knoout, koutv ) 
     386 
     387   SUBROUTINE mpp_alltoallv_int( kvalsin, knoin , kinv , kvalsout,   & 
     388      &                                   knoout, koutv ) 
    450389      !!---------------------------------------------------------------------- 
    451390      !!               ***  ROUTINE mpp_alltoallv_int *** 
    … …  
    459398      !! 
    460399      !! References : http://www.mpi-forum.org 
    461       !! 
    462       !! History : 
    463       !!        !  06-09  (K. Mogensen)  Original code 
    464       !!---------------------------------------------------------------------- 
    465  
    466       !! * Arguments 
    467       INTEGER, INTENT(IN) :: knoin 
    468       INTEGER, INTENT(IN) :: knoout 
    469       INTEGER, DIMENSION(jpnij) :: & 
    470          & kinv, & 
    471          & koutv 
    472       INTEGER, DIMENSION(knoin), INTENT(IN) :: & 
    473          & kvalsin 
    474       INTEGER, DIMENSION(knoout), INTENT(OUT) :: & 
    475          & kvalsout 
    476       !! * Local declarations 
     400      !!---------------------------------------------------------------------- 
     401      INTEGER                   , INTENT(in) :: knoin 
     402      INTEGER                   , INTENT(in) :: knoout 
     403      INTEGER, DIMENSION(jpnij)                 ::   kinv, koutv 
     404      INTEGER, DIMENSION(knoin) , INTENT(in   ) ::   kvalsin 
     405      INTEGER, DIMENSION(knoout), INTENT(  out) ::   kvalsout 
     406      !! 
    477407      INTEGER :: ierr 
    478408      INTEGER :: jproc 
    479409#if defined key_mpp_mpi 
    480410INCLUDE 'mpif.h' 
    481       INTEGER, DIMENSION(jpnij) :: & 
    482          & irdsp, & 
    483          & isdsp 
     411      INTEGER, DIMENSION(jpnij) ::   irdsp, isdsp 
    484412      !----------------------------------------------------------------------- 
    485413      ! Compute displacements 
    … …  
    497425         &                kvalsout, koutv, irdsp, mpi_integer, & 
    498426         &                mpi_comm_opa, ierr ) 
    499 #elif defined key_mpp_shmem 
    500 error "Only MPI support for MPP in NEMOVAR" 
    501427#else 
    502428      !----------------------------------------------------------------------- 
    … …  
    505431      kvalsout = kvalsin 
    506432#endif 
    507        
     433      ! 
    508434   END SUBROUTINE mpp_alltoallv_int 
    509435 
    510    SUBROUTINE mpp_alltoallv_real( pvalsin, knoin, kinv, pvalsout, & 
    511       &                               knoout, koutv ) 
     436 
     437   SUBROUTINE mpp_alltoallv_real( pvalsin, knoin , kinv , pvalsout,   & 
     438      &                                    knoout, koutv ) 
    512439      !!---------------------------------------------------------------------- 
    513440      !!               ***  ROUTINE mpp_alltoallv_real *** 
    … …  
    521448      !! 
    522449      !! References : http://www.mpi-forum.org 
    523       !! 
    524       !! History : 
    525       !!        !  06-09  (K. Mogensen)  Original code 
    526       !!---------------------------------------------------------------------- 
    527  
    528       !! * Arguments 
    529       INTEGER, INTENT(IN) :: knoin 
    530       INTEGER, INTENT(IN) :: knoout 
    531       INTEGER, DIMENSION(jpnij) :: & 
    532          & kinv, & 
    533          & koutv 
    534       REAL(KIND=wp), DIMENSION(knoin), INTENT(IN) :: & 
    535          & pvalsin 
    536       REAL(KIND=wp), DIMENSION(knoout), INTENT(OUT) :: & 
    537          & pvalsout 
    538       !! * Local declarations 
     450      !!---------------------------------------------------------------------- 
     451      INTEGER                    , INTENT(in   ) :: knoin 
     452      INTEGER                    , INTENT(in   ) :: knoout 
     453      INTEGER , DIMENSION(jpnij)                 ::   kinv, koutv 
     454      REAL(wp), DIMENSION(knoin) , INTENT(in   ) ::   pvalsin 
     455      REAL(wp), DIMENSION(knoout), INTENT(  out) ::   pvalsout 
     456      !! 
    539457      INTEGER :: ierr 
    540458      INTEGER :: jproc 
    541459#if defined key_mpp_mpi 
    542460INCLUDE 'mpif.h' 
    543       INTEGER, DIMENSION(jpnij) :: & 
    544          & irdsp, & 
    545          & isdsp 
     461      INTEGER, DIMENSION(jpnij) ::   irdsp, isdsp 
     462      !!---------------------------------------------------------------------- 
     463      ! 
    546464      !----------------------------------------------------------------------- 
    547465      ! Compute displacements 
    … …  
    559477         &                pvalsout, koutv, irdsp, mpivar, & 
    560478         &                mpi_comm_opa, ierr ) 
    561 #elif defined key_mpp_shmem 
    562 error "Only MPI support for MPP in NEMOVAR" 
    563479#else 
    564480      !----------------------------------------------------------------------- 
    … …  
    567483      pvalsout = pvalsin 
    568484#endif 
    569        
     485      ! 
    570486   END SUBROUTINE mpp_alltoallv_real 
    571487 
     488   !!====================================================================== 
    572489END MODULE obs_mpp 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/lbclnk.F90

    r2287 r2335  
    44   !! Ocean        : lateral boundary conditions 
    55   !!===================================================================== 
     6   !! History :  OPA  ! 1997-06  (G. Madec)     Original code 
     7   !!   NEMO     1.0  ! 2002-09  (G. Madec)     F90: Free form and module 
     8   !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment   
     9   !!---------------------------------------------------------------------- 
     10#if   defined key_mpp_mpi 
     11   !!---------------------------------------------------------------------- 
     12   !!   'key_mpp_mpi'             MPI massively parallel processing library 
     13   !!---------------------------------------------------------------------- 
     14   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp 
     15   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp 
     16   !!---------------------------------------------------------------------- 
     17   USE lib_mpp          ! distributed memory computing library 
     18 
     19   INTERFACE lbc_lnk 
     20      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d 
     21   END INTERFACE 
     22 
     23   INTERFACE lbc_lnk_e 
     24      MODULE PROCEDURE mpp_lnk_2d_e 
     25   END INTERFACE 
     26 
     27   PUBLIC lbc_lnk       ! ocean lateral boundary conditions 
     28   PUBLIC lbc_lnk_e 
     29 
     30   !!---------------------------------------------------------------------- 
    631   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    732   !! $Id$ 
    8    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    9    !!---------------------------------------------------------------------- 
    10 #if   defined key_mpp_mpi   ||   defined key_mpp_shmem 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_mpp_mpi'     OR      MPI massively parallel processing library 
    13    !!   'key_mpp_shmem'         SHMEM massively parallel processing library 
    14    !!---------------------------------------------------------------------- 
    15    !!---------------------------------------------------------------------- 
    16    !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d 
    17    !!                  routines defined in lib_mpp 
    18    !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e 
    19    !!                   routinee defined in lib_mpp 
    20    !!---------------------------------------------------------------------- 
    21    !! * Modules used 
    22    USE lib_mpp          ! distributed memory computing library 
    23  
    24    INTERFACE lbc_lnk 
    25       MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d 
    26    END INTERFACE 
    27  
    28    INTERFACE lbc_lnk_e 
    29       MODULE PROCEDURE mpp_lnk_2d_e 
    30    END INTERFACE 
    31  
    32    PUBLIC lbc_lnk       ! ocean lateral boundary conditions 
    33    PUBLIC lbc_lnk_e 
     33   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3434   !!---------------------------------------------------------------------- 
    3535 
    … …  
    3939   !!---------------------------------------------------------------------- 
    4040   !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d 
    41    !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable 
    42    !!                  on OPA ocean mesh 
    43    !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable 
    44    !!                  on OPA ocean mesh 
    45    !!---------------------------------------------------------------------- 
    46    !! * Modules used 
     41   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable on ocean mesh 
     42   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable on ocean mesh 
     43   !!---------------------------------------------------------------------- 
    4744   USE oce             ! ocean dynamics and tracers    
    4845   USE dom_oce         ! ocean space and time domain  
    … …  
    6158   END INTERFACE 
    6259 
    63    PUBLIC lbc_lnk       ! ocean/ice  lateral boundary conditions 
    64    PUBLIC  lbc_lnk_e  
    65    !!---------------------------------------------------------------------- 
    66  
     60   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions 
     61   PUBLIC   lbc_lnk_e  
     62    
     63   !!---------------------------------------------------------------------- 
     64   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     65   !! $Id$ 
     66   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     67   !!---------------------------------------------------------------------- 
    6768CONTAINS 
    6869 
    … …  
    7172      !!                  ***  ROUTINE lbc_lnk_3d_gather  *** 
    7273      !! 
    73       !! ** Purpose :   set lateral boundary conditions (non mpp case) 
    74       !! 
    75       !! ** Method  : 
    76       !! 
    77       !! History : 
    78       !!        !  97-06  (G. Madec)     Original code 
    79       !!   8.5  !  02-09  (G. Madec)     F90: Free form and module 
    80       !!        !  09-03  (R. Benshila)  External north fold treatment   
    81       !!---------------------------------------------------------------------- 
    82       !! * Arguments 
    83       CHARACTER(len=1), INTENT( in ) ::   & 
    84          cd_type1, cd_type2       ! nature of pt3d grid-points 
    85       !             !   = T ,  U , V , F or W  gridpoints 
    86       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   & 
    87          pt3d1, pt3d2          ! 3D array on which the boundary condition is applied 
    88       REAL(wp), INTENT( in ) ::   & 
    89          psgn          ! control of the sign change 
    90       !             !   =-1 , the sign is changed if north fold boundary 
    91       !             !   = 1 , no sign change 
    92       !             !   = 0 , no sign change and > 0 required (use the inner 
    93       !             !         row/column if closed boundary) 
    94  
     74      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (non mpp case) 
     75      !! 
     76      !! ** Method  :   psign = -1 :    change the sign across the north fold 
     77      !!                      =  1 : no change of the sign across the north fold 
     78      !!                      =  0 : no change of the sign across the north fold and 
     79      !!                             strict positivity preserved: use inner row/column 
     80      !!                             for closed boundaries. 
     81      !!---------------------------------------------------------------------- 
     82      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points 
     83      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied 
     84      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign  
     85      !!---------------------------------------------------------------------- 
     86      ! 
    9587      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn) 
    9688      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn) 
    97  
     89      ! 
    9890   END SUBROUTINE lbc_lnk_3d_gather 
    9991 
    … …  
    10395      !!                  ***  ROUTINE lbc_lnk_3d  *** 
    10496      !! 
    105       !! ** Purpose :   set lateral boundary conditions (non mpp case) 
    106       !! 
    107       !! ** Method  : 
    108       !! 
    109       !! History : 
    110       !!        !  97-06  (G. Madec)  Original code 
    111       !!   8.5  !  02-09  (G. Madec)  F90: Free form and module 
    112       !!        !  09-03  (R. Benshila)  External north fold treatment   
    113       !!---------------------------------------------------------------------- 
    114       !! * Arguments 
    115       CHARACTER(len=1), INTENT( in ) ::   & 
    116          cd_type       ! nature of pt3d grid-points 
    117       !             !   = T ,  U , V , F or W  gridpoints 
    118       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   & 
    119          pt3d          ! 3D array on which the boundary condition is applied 
    120       REAL(wp), INTENT( in ) ::   & 
    121          psgn          ! control of the sign change 
    122       !             !   =-1 , the sign is changed if north fold boundary 
    123       !             !   = 1 , no sign change 
    124       !             !   = 0 , no sign change and > 0 required (use the inner 
    125       !             !         row/column if closed boundary) 
    126       CHARACTER(len=3), INTENT( in ), OPTIONAL ::    & 
    127          cd_mpp        ! fill the overlap area only (here do nothing) 
    128       REAL(wp)        , INTENT(in   ), OPTIONAL           ::   pval      ! background value (used at closed boundaries) 
    129  
    130       !! * Local declarations 
     97      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case) 
     98      !! 
     99      !! ** Method  :   psign = -1 :    change the sign across the north fold 
     100      !!                      =  1 : no change of the sign across the north fold 
     101      !!                      =  0 : no change of the sign across the north fold and 
     102      !!                             strict positivity preserved: use inner row/column 
     103      !!                             for closed boundaries. 
     104      !!---------------------------------------------------------------------- 
     105      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
     106      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
     107      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign  
     108      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
     109      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
     110      !! 
    131111      REAL(wp) ::   zland 
    132  
    133       IF( PRESENT( pval ) ) THEN      ! set land value (zero by default) 
    134          zland = pval 
    135       ELSE 
    136          zland = 0.e0 
     112      !!---------------------------------------------------------------------- 
     113 
     114      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default) 
     115      ELSE                         ;   zland = 0.e0 
    137116      ENDIF 
    138117 
    … …  
    142121         ! this is in mpp case. In this module, just do nothing 
    143122      ELSE 
    144  
     123         ! 
    145124         !                                     !  East-West boundaries 
    146125         !                                     ! ====================== 
    … …  
    161140            ! 
    162141         END SELECT 
    163  
     142         ! 
    164143         !                                     ! North-South boundaries 
    165144         !                                     ! ====================== 
    … …  
    196175            ! 
    197176         END SELECT 
    198  
    199       ENDIF 
    200  
     177         ! 
     178      ENDIF 
     179      ! 
    201180   END SUBROUTINE lbc_lnk_3d 
    202181 
    … …  
    206185      !!                 ***  ROUTINE lbc_lnk_2d  *** 
    207186      !! 
    208       !! ** Purpose :   set lateral boundary conditions (non mpp case) 
    209       !! 
    210       !! ** Method  : 
    211       !! 
    212       !! History : 
    213       !!        !  97-06  (G. Madec)  Original code 
    214       !!        !  01-05  (E. Durand)  correction 
    215       !!   8.5  !  02-09  (G. Madec)  F90: Free form and module 
    216       !!        !  09-03  (R. Benshila)  External north fold treatment   
    217       !!---------------------------------------------------------------------- 
    218       !! * Arguments 
    219       CHARACTER(len=1), INTENT( in ) ::   & 
    220          cd_type       ! nature of pt2d grid-point 
    221          !             !   = T , U , V , F or W  gridpoints 
    222          !             !   = I sea-ice U-V gridpoint (= F ocean grid point with indice shift) 
    223       REAL(wp), INTENT( in ) ::   & 
    224          psgn          ! control of the sign change 
    225          !             !   =-1 , the sign is modified following the type of b.c. used 
    226          !             !   = 1 , no sign change 
    227       REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   & 
    228          pt2d          ! 2D array on which the boundary condition is applied 
    229       CHARACTER(len=3), INTENT( in ), OPTIONAL ::    & 
    230          cd_mpp        ! fill the overlap area only (here do nothing) 
    231       REAL(wp)        , INTENT(in   ), OPTIONAL           ::   pval      ! background value (used at closed boundaries) 
    232  
    233       !! * Local declarations 
     187      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case) 
     188      !! 
     189      !! ** Method  :   psign = -1 :    change the sign across the north fold 
     190      !!                      =  1 : no change of the sign across the north fold 
     191      !!                      =  0 : no change of the sign across the north fold and 
     192      !!                             strict positivity preserved: use inner row/column 
     193      !!                             for closed boundaries. 
     194      !!---------------------------------------------------------------------- 
     195      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
     196      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt3d      ! 2D array on which the lbc is applied 
     197      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign  
     198      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
     199      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
     200      !! 
    234201      REAL(wp) ::   zland 
    235  
    236       IF( PRESENT( pval ) ) THEN      ! set land value (zero by default) 
    237          zland = pval 
    238       ELSE 
    239          zland = 0.e0 
     202      !!---------------------------------------------------------------------- 
     203 
     204      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default) 
     205      ELSE                         ;   zland = 0.e0 
    240206      ENDIF 
    241207 
    … …  
    244210         ! this is in mpp case. In this module, just do nothing 
    245211      ELSE       
    246        
     212         ! 
    247213         !                                     ! East-West boundaries 
    248214         !                                     ! ==================== 
    … …  
    263229            ! 
    264230         END SELECT 
    265   
     231         ! 
    266232         !                                     ! North-South boundaries 
    267233         !                                     ! ====================== 
    … …  
    299265            ! 
    300266         END SELECT 
    301  
    302       ENDIF 
    303        
     267         ! 
     268      ENDIF 
     269      !     
    304270   END SUBROUTINE lbc_lnk_2d 
    305271 
Note: See TracChangeset for help on using the changeset viewer.