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 3598 for trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90 – NEMO

Ignore:
Timestamp:
2012-11-19T14:35:09+01:00 (12 years ago)
Author:
rblod
Message:

Change of some variable range for TAM in 3.4 - Ticket #1004

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r3435 r3598  
    1717   !!             -   !  2008  (R. Benshila) add mpp_ini_ice 
    1818   !!            3.2  !  2009  (R. Benshila) SHMEM suppression, north fold in lbc_nfd 
    19    !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl  
     19   !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl 
    2020   !!            4.0  !  2011  (G. Madec)  move ctl_ routines from in_out_manager 
    2121   !!---------------------------------------------------------------------- 
     
    2727   !!   get_unit    : give the index of an unused logical unit 
    2828   !!---------------------------------------------------------------------- 
    29 #if   defined key_mpp_mpi   
     29#if   defined key_mpp_mpi 
    3030   !!---------------------------------------------------------------------- 
    3131   !!   'key_mpp_mpi'             MPI massively parallel processing library 
     
    5252   !!   mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo 
    5353   !!---------------------------------------------------------------------- 
    54    USE dom_oce        ! ocean space and time domain  
     54   USE dom_oce        ! ocean space and time domain 
    5555   USE lbcnfd         ! north fold treatment 
    5656   USE in_out_manager ! I/O manager 
     
    5858   IMPLICIT NONE 
    5959   PRIVATE 
    60     
     60 
    6161   PUBLIC   ctl_stop, ctl_warn, get_unit, ctl_opn 
    6262   PUBLIC   mynode, mppstop, mppsync, mpp_comm_free 
     
    6767   PUBLIC   mppobc, mpp_ini_ice, mpp_ini_znl 
    6868   PUBLIC   mppsize 
    69    PUBLIC   lib_mpp_alloc   ! Called in nemogcm.F90 
     69   PUBLIC   lib_mpp_alloc    ! Called in nemogcm.F90 
     70   PUBLIC   mppsend, mpprecv ! (PUBLIC for TAM) 
    7071 
    7172   !! * Interfaces 
     
    8485   END INTERFACE 
    8586   INTERFACE mpp_lbc_north 
    86       MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d  
     87      MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d 
    8788   END INTERFACE 
    8889   INTERFACE mpp_minloc 
     
    9293      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d 
    9394   END INTERFACE 
    94     
     95 
    9596   !! ========================= !! 
    9697   !!  MPI  variable definition !! 
     
    99100   INCLUDE 'mpif.h' 
    100101!$AGRIF_END_DO_NOT_TREAT 
    101     
     102 
    102103   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.    !: mpp flag 
    103104 
    104105   INTEGER, PARAMETER         ::   nprocmax = 2**10   ! maximun dimension (required to be a power of 2) 
    105     
     106 
    106107   INTEGER ::   mppsize        ! number of process 
    107108   INTEGER ::   mpprank        ! process number  [ 0 - size-1 ] 
     
    126127   INTEGER ::   ndim_rank_znl   ! number of processors on the same zonal average 
    127128   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain 
    128     
     129 
    129130   ! North fold condition in mpp_mpi with jpni > 1 
    130131   INTEGER ::   ngrp_world        ! group ID for the world processors 
     
    140141   CHARACTER(len=1) ::   cn_mpi_send = 'S'    ! type od mpi send/recieve (S=standard, B=bsend, I=isend) 
    141142   LOGICAL          ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I') 
    142    INTEGER          ::   nn_buffer = 0       ! size of the buffer in case of mpi_bsend  
    143        
     143   INTEGER          ::   nn_buffer = 0       ! size of the buffer in case of mpi_bsend 
     144 
    144145   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon  ! buffer in case of bsend 
    145146 
     
    173174   ! North fold arrays used to minimise the use of allgather operations. Set in nemo_northcomms (nemogcm) so need to be public 
    174175   INTEGER, PUBLIC,  PARAMETER :: jpmaxngh = 8                 ! Assumed maximum number of active neighbours 
    175    INTEGER, PUBLIC,  PARAMETER :: jptyps   = 5                 ! Number of different neighbour lists to be used for northfold exchanges  
     176   INTEGER, PUBLIC,  PARAMETER :: jptyps   = 5                 ! Number of different neighbour lists to be used for northfold exchanges 
    176177   INTEGER, PUBLIC,  DIMENSION (jpmaxngh,jptyps)    ::   isendto 
    177178   INTEGER, PUBLIC,  DIMENSION (jptyps)             ::   nsndto 
     
    229230      !!---------------------------------------------------------------------- 
    230231      !!                  ***  routine mynode  *** 
    231       !!                     
     232      !! 
    232233      !! ** Purpose :   Find processor unit 
    233234      !!---------------------------------------------------------------------- 
    234       CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt  
    235       INTEGER                      , INTENT(in   ) ::   kumnam       ! namelist logical unit  
    236       INTEGER                      , INTENT(inout) ::   kstop        ! stop indicator  
     235      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
     236      INTEGER                      , INTENT(in   ) ::   kumnam       ! namelist logical unit 
     237      INTEGER                      , INTENT(inout) ::   kstop        ! stop indicator 
    237238      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm 
    238239      ! 
     
    258259#if defined key_agrif 
    259260      IF( .NOT. Agrif_Root() ) THEN 
    260          jpni  = Agrif_Parent(jpni )  
     261         jpni  = Agrif_Parent(jpni ) 
    261262         jpnj  = Agrif_Parent(jpnj ) 
    262263         jpnij = Agrif_Parent(jpnij) 
     
    282283      CALL mpi_initialized ( mpi_was_called, code ) 
    283284      IF( code /= MPI_SUCCESS ) THEN 
    284          DO ji = 1, SIZE(ldtxt)  
     285         DO ji = 1, SIZE(ldtxt) 
    285286            IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode 
    286          END DO          
     287         END DO 
    287288         WRITE(*, cform_err) 
    288289         WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 
     
    297298         CASE ( 'B' )                ! Buffer mpi send (blocking) 
    298299            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'                      ;   ii = ii + 1 
    299             IF( Agrif_Root() )   CALL mpi_init_opa( ldtxt, ii, ierr )  
     300            IF( Agrif_Root() )   CALL mpi_init_opa( ldtxt, ii, ierr ) 
    300301         CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    301302            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'                   ;   ii = ii + 1 
     
    330331      ENDIF 
    331332 
    332       IF( PRESENT(localComm) ) THEN  
     333      IF( PRESENT(localComm) ) THEN 
    333334         IF( Agrif_Root() ) THEN 
    334335            mpi_comm_opa = localComm 
     
    337338         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 
    338339         IF( code /= MPI_SUCCESS ) THEN 
    339             DO ji = 1, SIZE(ldtxt)  
     340            DO ji = 1, SIZE(ldtxt) 
    340341               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode 
    341342            END DO 
     
    344345            CALL mpi_abort( mpi_comm_world, code, ierr ) 
    345346         ENDIF 
    346       ENDIF  
     347      ENDIF 
    347348 
    348349      CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr ) 
    349350      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr ) 
    350351      mynode = mpprank 
    351       !  
     352      ! 
    352353      CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr) 
    353354      ! 
     
    361362      !! ** Purpose :   Message passing manadgement 
    362363      !! 
    363       !! ** Method  :   Use mppsend and mpprecv function for passing mask  
     364      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    364365      !!      between processors following neighboring subdomains. 
    365366      !!            domain parameters 
     
    368369      !!                    nbondi : mark for "east-west local boundary" 
    369370      !!                    nbondj : mark for "north-south local boundary" 
    370       !!                    noea   : number for local neighboring processors  
     371      !!                    noea   : number for local neighboring processors 
    371372      !!                    nowe   : number for local neighboring processors 
    372373      !!                    noso   : number for local neighboring processors 
     
    381382      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    382383      !                                                             ! =  1. , the sign is kept 
    383       CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only  
     384      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
    384385      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    385386      !! 
     
    402403         DO jk = 1, jpk 
    403404            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
    404                ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk)    
     405               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk) 
    405406               ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk) 
    406407               ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk) 
     
    413414         END DO 
    414415         ! 
    415       ELSE                              ! standard close or cyclic treatment  
     416      ELSE                              ! standard close or cyclic treatment 
    416417         ! 
    417418         !                                   ! East-West boundaries 
     
    432433      ! 2. East and west directions exchange 
    433434      ! ------------------------------------ 
    434       ! we play with the neigbours AND the row number because of the periodicity  
     435      ! we play with the neigbours AND the row number because of the periodicity 
    435436      ! 
    436437      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     
    441442            t3we(:,jl,:,1) = ptab(iihom +jl,:,:) 
    442443         END DO 
    443       END SELECT   
     444      END SELECT 
    444445      ! 
    445446      !                           ! Migrations 
    446447      imigr = jpreci * jpj * jpk 
    447448      ! 
    448       SELECT CASE ( nbondi )  
     449      SELECT CASE ( nbondi ) 
    449450      CASE ( -1 ) 
    450451         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 ) 
     
    472473            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2) 
    473474         END DO 
    474       CASE ( 0 )  
     475      CASE ( 0 ) 
    475476         DO jl = 1, jpreci 
    476477            ptab(jl      ,:,:) = t3we(:,jl,:,2) 
     
    499500      imigr = jprecj * jpi * jpk 
    500501      ! 
    501       SELECT CASE ( nbondj )      
     502      SELECT CASE ( nbondj ) 
    502503      CASE ( -1 ) 
    503504         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 ) 
     
    511512         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    512513         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    513       CASE ( 1 )  
     514      CASE ( 1 ) 
    514515         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 ) 
    515516         CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso ) 
     
    525526            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2) 
    526527         END DO 
    527       CASE ( 0 )  
     528      CASE ( 0 ) 
    528529         DO jl = 1, jprecj 
    529530            ptab(:,jl      ,:) = t3sn(:,jl,:,2) 
     
    555556      !!---------------------------------------------------------------------- 
    556557      !!                  ***  routine mpp_lnk_2d  *** 
    557       !!                   
     558      !! 
    558559      !! ** Purpose :   Message passing manadgement for 2d array 
    559560      !! 
    560       !! ** Method  :   Use mppsend and mpprecv function for passing mask  
     561      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    561562      !!      between processors following neighboring subdomains. 
    562563      !!            domain parameters 
     
    565566      !!                    nbondi : mark for "east-west local boundary" 
    566567      !!                    nbondj : mark for "north-south local boundary" 
    567       !!                    noea   : number for local neighboring processors  
     568      !!                    noea   : number for local neighboring processors 
    568569      !!                    nowe   : number for local neighboring processors 
    569570      !!                    noso   : number for local neighboring processors 
     
    576577      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    577578      !                                                         ! =  1. , the sign is kept 
    578       CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only  
     579      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
    579580      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    580581      !! 
     
    597598         ! WARNING pt2d is defined only between nld and nle 
    598599         DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
    599             pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej)    
     600            pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej) 
    600601            pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej) 
    601602            pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej) 
     
    607608         END DO 
    608609         ! 
    609       ELSE                              ! standard close or cyclic treatment  
     610      ELSE                              ! standard close or cyclic treatment 
    610611         ! 
    611612         !                                   ! East-West boundaries 
     
    626627      ! 2. East and west directions exchange 
    627628      ! ------------------------------------ 
    628       ! we play with the neigbours AND the row number because of the periodicity  
     629      ! we play with the neigbours AND the row number because of the periodicity 
    629630      ! 
    630631      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     
    724725            pt2d(:,ijhom+jl) = t2ns(:,jl,2) 
    725726         END DO 
    726       CASE ( 1 )  
     727      CASE ( 1 ) 
    727728         DO jl = 1, jprecj 
    728729            pt2d(:,jl      ) = t2sn(:,jl,2) 
     
    752753      !! ** Purpose :   Message passing manadgement for two 3D arrays 
    753754      !! 
    754       !! ** Method  :   Use mppsend and mpprecv function for passing mask  
     755      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    755756      !!      between processors following neighboring subdomains. 
    756757      !!            domain parameters 
     
    759760      !!                    nbondi : mark for "east-west local boundary" 
    760761      !!                    nbondj : mark for "north-south local boundary" 
    761       !!                    noea   : number for local neighboring processors  
     762      !!                    noea   : number for local neighboring processors 
    762763      !!                    nowe   : number for local neighboring processors 
    763764      !!                    noso   : number for local neighboring processors 
     
    767768      !! 
    768769      !!---------------------------------------------------------------------- 
    769       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab1     ! first and second 3D array on which  
     770      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab1     ! first and second 3D array on which 
    770771      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab2     ! the boundary condition is applied 
    771       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1  ! nature of ptab1 and ptab2 arrays  
     772      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1  ! nature of ptab1 and ptab2 arrays 
    772773      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type2  ! i.e. grid-points = T , U , V , F or W points 
    773774      REAL(wp)                        , INTENT(in   ) ::   psgn      ! =-1 the sign change across the north fold boundary 
     
    795796      ENDIF 
    796797 
    797        
     798 
    798799      !                                      ! North-South boundaries 
    799800      IF( .NOT. cd_type1 == 'F' )   ptab1(:,     1       :jprecj,:) = 0.e0    ! south except at F-point 
     
    805806      ! 2. East and west directions exchange 
    806807      ! ------------------------------------ 
    807       ! we play with the neigbours AND the row number because of the periodicity  
     808      ! we play with the neigbours AND the row number because of the periodicity 
    808809      ! 
    809810      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     
    821822      imigr = jpreci * jpj * jpk *2 
    822823      ! 
    823       SELECT CASE ( nbondi )  
     824      SELECT CASE ( nbondi ) 
    824825      CASE ( -1 ) 
    825826         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 ) 
     
    848849            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2) 
    849850         END DO 
    850       CASE ( 0 )  
     851      CASE ( 0 ) 
    851852         DO jl = 1, jpreci 
    852853            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2) 
     
    880881      imigr = jprecj * jpi * jpk * 2 
    881882      ! 
    882       SELECT CASE ( nbondj )      
     883      SELECT CASE ( nbondj ) 
    883884      CASE ( -1 ) 
    884885         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req1 ) 
     
    892893         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    893894         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    894       CASE ( 1 )  
     895      CASE ( 1 ) 
    895896         CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 
    896897         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr, noso ) 
     
    907908            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2) 
    908909         END DO 
    909       CASE ( 0 )  
     910      CASE ( 0 ) 
    910911         DO jl = 1, jprecj 
    911912            ptab1(:,jl      ,:) = t4sn(:,jl,:,1,2) 
     
    927928         ! 
    928929         SELECT CASE ( jpni ) 
    929          CASE ( 1 )                                            
     930         CASE ( 1 ) 
    930931            CALL lbc_nfd      ( ptab1, cd_type1, psgn )   ! only for northern procs. 
    931932            CALL lbc_nfd      ( ptab2, cd_type2, psgn ) 
     
    933934            CALL mpp_lbc_north( ptab1, cd_type1, psgn )   ! for all northern procs. 
    934935            CALL mpp_lbc_north (ptab2, cd_type2, psgn) 
    935          END SELECT  
     936         END SELECT 
    936937         ! 
    937938      ENDIF 
     
    943944      !!---------------------------------------------------------------------- 
    944945      !!                  ***  routine mpp_lnk_2d_e  *** 
    945       !!                   
     946      !! 
    946947      !! ** Purpose :   Message passing manadgement for 2d array (with halo) 
    947948      !! 
    948       !! ** Method  :   Use mppsend and mpprecv function for passing mask  
     949      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    949950      !!      between processors following neighboring subdomains. 
    950951      !!            domain parameters 
     
    955956      !!                    nbondi : mark for "east-west local boundary" 
    956957      !!                    nbondj : mark for "north-south local boundary" 
    957       !!                    noea   : number for local neighboring processors  
     958      !!                    noea   : number for local neighboring processors 
    958959      !!                    nowe   : number for local neighboring processors 
    959960      !!                    noso   : number for local neighboring processors 
     
    984985      IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jpr2dj   :  jprecj  ) = 0.e0    ! south except at F-point 
    985986                                   pt2d(:,nlcj-jprecj+1:jpj+jpr2dj) = 0.e0    ! north 
    986                                  
     987 
    987988      !                                      ! East-West boundaries 
    988989      !                                           !* Cyclic east-west 
     
    10041005         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jpr2dj), cd_type, psgn, pr2dj=jpr2dj ) 
    10051006         CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                    , cd_type, psgn               ) 
    1006          END SELECT  
     1007         END SELECT 
    10071008         ! 
    10081009      ENDIF 
     
    10101011      ! 2. East and west directions exchange 
    10111012      ! ------------------------------------ 
    1012       ! we play with the neigbours AND the row number because of the periodicity  
     1013      ! we play with the neigbours AND the row number because of the periodicity 
    10131014      ! 
    10141015      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     
    10961097      ! 
    10971098      !                           ! Write Dirichlet lateral conditions 
    1098       ijhom = nlcj - jprecj   
     1099      ijhom = nlcj - jprecj 
    10991100      ! 
    11001101      SELECT CASE ( nbondj ) 
     
    11081109            pt2d(:,ijhom+jl ) = tr2ns(:,jl,2) 
    11091110         END DO 
    1110       CASE ( 1 )  
     1111      CASE ( 1 ) 
    11111112         DO jl = 1, iprecj 
    11121113            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2) 
     
    11201121      !!---------------------------------------------------------------------- 
    11211122      !!                  ***  routine mppsend  *** 
    1122       !!                    
     1123      !! 
    11231124      !! ** Purpose :   Send messag passing array 
    11241125      !! 
     
    11561157      INTEGER , INTENT(in   ) ::   kbytes     ! suze of the array pmess 
    11571158      INTEGER , INTENT(in   ) ::   ktyp       ! Tag of the recevied message 
    1158       INTEGER, OPTIONAL, INTENT(in) :: ksource    ! source process number  
     1159      INTEGER, OPTIONAL, INTENT(in) :: ksource    ! source process number 
    11591160      !! 
    11601161      INTEGER :: istatus(mpi_status_size) 
     
    11641165      ! 
    11651166 
    1166       ! If a specific process number has been passed to the receive call,  
     1167      ! If a specific process number has been passed to the receive call, 
    11671168      ! use that one. Default is to use mpi_any_source 
    11681169      use_source=mpi_any_source 
     
    11791180      !!---------------------------------------------------------------------- 
    11801181      !!                   ***  routine mppgather  *** 
    1181       !!                    
    1182       !! ** Purpose :   Transfert between a local subdomain array and a work  
     1182      !! 
     1183      !! ** Purpose :   Transfert between a local subdomain array and a work 
    11831184      !!     array which is distributed following the vertical level. 
    11841185      !! 
     
    11931194      itaille = jpi * jpj 
    11941195      CALL mpi_gather( ptab, itaille, mpi_double_precision, pio, itaille     ,   & 
    1195          &                            mpi_double_precision, kp , mpi_comm_opa, ierror )  
     1196         &                            mpi_double_precision, kp , mpi_comm_opa, ierror ) 
    11961197      ! 
    11971198   END SUBROUTINE mppgather 
     
    12021203      !!                  ***  routine mppscatter  *** 
    12031204      !! 
    1204       !! ** Purpose :   Transfert between awork array which is distributed  
     1205      !! ** Purpose :   Transfert between awork array which is distributed 
    12051206      !!      following the vertical level and the local subdomain array. 
    12061207      !! 
     
    12241225      !!---------------------------------------------------------------------- 
    12251226      !!                  ***  routine mppmax_a_int  *** 
    1226       !!  
     1227      !! 
    12271228      !! ** Purpose :   Find maximum value in an integer layout array 
    12281229      !! 
     
    12301231      INTEGER , INTENT(in   )                  ::   kdim   ! size of array 
    12311232      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab   ! input array 
    1232       INTEGER , INTENT(in   ), OPTIONAL        ::   kcom   !  
     1233      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom   ! 
    12331234      !! 
    12341235      INTEGER :: ierror, localcomm   ! temporary integer 
     
    12551256      INTEGER, INTENT(inout)           ::   ktab      ! ??? 
    12561257      INTEGER, INTENT(in   ), OPTIONAL ::   kcom      ! ??? 
    1257       !!  
     1258      !! 
    12581259      INTEGER ::   ierror, iwork, localcomm   ! temporary integer 
    12591260      !!---------------------------------------------------------------------- 
    12601261      ! 
    1261       localcomm = mpi_comm_opa  
     1262      localcomm = mpi_comm_opa 
    12621263      IF( PRESENT(kcom) )   localcomm = kcom 
    12631264      ! 
     
    12721273      !!---------------------------------------------------------------------- 
    12731274      !!                  ***  routine mppmin_a_int  *** 
    1274       !!  
     1275      !! 
    12751276      !! ** Purpose :   Find minimum value in an integer layout array 
    12761277      !! 
     
    13201321      !!---------------------------------------------------------------------- 
    13211322      !!                  ***  routine mppsum_a_int  *** 
    1322       !!                     
     1323      !! 
    13231324      !! ** Purpose :   Global integer sum, 1D array case 
    13241325      !! 
     
    13411342      !!---------------------------------------------------------------------- 
    13421343      !!                 ***  routine mppsum_int  *** 
    1343       !!                   
     1344      !! 
    13441345      !! ** Purpose :   Global integer sum 
    13451346      !! 
    13461347      !!---------------------------------------------------------------------- 
    13471348      INTEGER, INTENT(inout) ::   ktab 
    1348       !!  
     1349      !! 
    13491350      INTEGER :: ierror, iwork 
    13501351      !!---------------------------------------------------------------------- 
     
    13601361      !!---------------------------------------------------------------------- 
    13611362      !!                 ***  routine mppmax_a_real  *** 
    1362       !!                   
     1363      !! 
    13631364      !! ** Purpose :   Maximum 
    13641365      !! 
     
    13841385      !!---------------------------------------------------------------------- 
    13851386      !!                  ***  routine mppmax_real  *** 
    1386       !!                     
     1387      !! 
    13871388      !! ** Purpose :   Maximum 
    13881389      !! 
     
    13951396      !!---------------------------------------------------------------------- 
    13961397      ! 
    1397       localcomm = mpi_comm_opa  
     1398      localcomm = mpi_comm_opa 
    13981399      IF( PRESENT(kcom) )   localcomm = kcom 
    13991400      ! 
     
    14071408      !!---------------------------------------------------------------------- 
    14081409      !!                 ***  routine mppmin_a_real  *** 
    1409       !!                   
     1410      !! 
    14101411      !! ** Purpose :   Minimum of REAL, array case 
    14111412      !! 
     
    14191420      !!----------------------------------------------------------------------- 
    14201421      ! 
    1421       localcomm = mpi_comm_opa  
     1422      localcomm = mpi_comm_opa 
    14221423      IF( PRESENT(kcom) ) localcomm = kcom 
    14231424      ! 
     
    14311432      !!---------------------------------------------------------------------- 
    14321433      !!                  ***  routine mppmin_real  *** 
    1433       !!  
     1434      !! 
    14341435      !! ** Purpose :   minimum of REAL, scalar case 
    14351436      !! 
    14361437      !!----------------------------------------------------------------------- 
    1437       REAL(wp), INTENT(inout)           ::   ptab        !  
     1438      REAL(wp), INTENT(inout)           ::   ptab        ! 
    14381439      INTEGER , INTENT(in   ), OPTIONAL :: kcom 
    14391440      !! 
     
    14431444      !!----------------------------------------------------------------------- 
    14441445      ! 
    1445       localcomm = mpi_comm_opa  
     1446      localcomm = mpi_comm_opa 
    14461447      IF( PRESENT(kcom) )   localcomm = kcom 
    14471448      ! 
     
    14551456      !!---------------------------------------------------------------------- 
    14561457      !!                  ***  routine mppsum_a_real  *** 
    1457       !!  
     1458      !! 
    14581459      !! ** Purpose :   global sum, REAL ARRAY argument case 
    14591460      !! 
     
    14641465      !! 
    14651466      INTEGER                   ::   ierror    ! temporary integer 
    1466       INTEGER                   ::   localcomm  
    1467       REAL(wp), DIMENSION(kdim) ::   zwork     ! temporary workspace  
     1467      INTEGER                   ::   localcomm 
     1468      REAL(wp), DIMENSION(kdim) ::   zwork     ! temporary workspace 
    14681469      !!----------------------------------------------------------------------- 
    14691470      ! 
    1470       localcomm = mpi_comm_opa  
     1471      localcomm = mpi_comm_opa 
    14711472      IF( PRESENT(kcom) )   localcomm = kcom 
    14721473      ! 
     
    14801481      !!---------------------------------------------------------------------- 
    14811482      !!                  ***  routine mppsum_real  *** 
    1482       !!               
     1483      !! 
    14831484      !! ** Purpose :   global sum, SCALAR argument case 
    14841485      !! 
     
    14871488      INTEGER , INTENT(in   ), OPTIONAL ::   kcom 
    14881489      !! 
    1489       INTEGER  ::   ierror, localcomm  
     1490      INTEGER  ::   ierror, localcomm 
    14901491      REAL(wp) ::   zwork 
    14911492      !!----------------------------------------------------------------------- 
    14921493      ! 
    1493       localcomm = mpi_comm_opa  
     1494      localcomm = mpi_comm_opa 
    14941495      IF( PRESENT(kcom) ) localcomm = kcom 
    14951496      ! 
     
    15241525 
    15251526   END SUBROUTINE mppsum_realdd 
    1526    
    1527    
     1527 
     1528 
    15281529   SUBROUTINE mppsum_a_realdd( ytab, kdim, kcom ) 
    15291530      !!---------------------------------------------------------------------- 
     
    15511552 
    15521553   END SUBROUTINE mppsum_a_realdd 
    1553     
     1554 
    15541555   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki,kj ) 
    15551556      !!------------------------------------------------------------------------ 
     
    16461647      REAL(wp)                     , INTENT(  out) ::   pmax     ! Global maximum of ptab 
    16471648      INTEGER                      , INTENT(  out) ::   ki, kj   ! index of maximum in global frame 
    1648       !!   
     1649      !! 
    16491650      INTEGER  :: ierror 
    16501651      INTEGER, DIMENSION (2)   ::   ilocs 
     
    16851686      REAL(wp)                         , INTENT(  out) ::   pmax         ! Global maximum of ptab 
    16861687      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of maximum in global frame 
    1687       !!    
     1688      !! 
    16881689      REAL(wp) :: zmax   ! local maximum 
    16891690      REAL(wp), DIMENSION(2,1) ::   zain, zaout 
     
    17151716      !!---------------------------------------------------------------------- 
    17161717      !!                  ***  routine mppsync  *** 
    1717       !!                    
     1718      !! 
    17181719      !! ** Purpose :   Massively parallel processors, synchroneous 
    17191720      !! 
     
    17301731      !!---------------------------------------------------------------------- 
    17311732      !!                  ***  routine mppstop  *** 
    1732       !!                    
     1733      !! 
    17331734      !! ** purpose :   Stop massively parallel processors method 
    17341735      !! 
     
    17461747      !!---------------------------------------------------------------------- 
    17471748      !!                  ***  routine mppobc  *** 
    1748       !!  
     1749      !! 
    17491750      !! ** Purpose :   Message passing manadgement for open boundary 
    17501751      !!     conditions array 
     
    17571758      !!                    nbondi : mark for "east-west local boundary" 
    17581759      !!                    nbondj : mark for "north-south local boundary" 
    1759       !!                    noea   : number for local neighboring processors  
     1760      !!                    noea   : number for local neighboring processors 
    17601761      !!                    nowe   : number for local neighboring processors 
    17611762      !!                    noso   : number for local neighboring processors 
     
    18061807         CALL mppstop 
    18071808      ENDIF 
    1808        
     1809 
    18091810      ! Communication level by level 
    18101811      ! ---------------------------- 
     
    19211922            DO jj = ijpt0, ijpt1            ! north/south boundaries 
    19221923               DO ji = iipt0,ilpt1 
    1923                   ptab(ji,jk) = ztab(ji,jj)   
     1924                  ptab(ji,jk) = ztab(ji,jj) 
    19241925               END DO 
    19251926            END DO 
     
    19271928            DO jj = ijpt0, ilpt1            ! east/west boundaries 
    19281929               DO ji = iipt0,iipt1 
    1929                   ptab(jj,jk) = ztab(ji,jj)  
     1930                  ptab(jj,jk) = ztab(ji,jj) 
    19301931               END DO 
    19311932            END DO 
     
    19371938      ! 
    19381939   END SUBROUTINE mppobc 
    1939     
     1940 
    19401941 
    19411942   SUBROUTINE mpp_comm_free( kcom ) 
     
    19961997      kice = 0 
    19971998      DO jjproc = 1, jpnij 
    1998          IF( jjproc == narea .AND. pindic .GT. 0 )   kice(jjproc) = 1     
     1999         IF( jjproc == narea .AND. pindic .GT. 0 )   kice(jjproc) = 1 
    19992000      END DO 
    20002001      ! 
    20012002      zwork = 0 
    20022003      CALL MPI_ALLREDUCE( kice, zwork, jpnij, mpi_integer, mpi_sum, mpi_comm_opa, ierr ) 
    2003       ndim_rank_ice = SUM( zwork )           
     2004      ndim_rank_ice = SUM( zwork ) 
    20042005 
    20052006      ! Allocate the right size to nrank_north 
     
    20072008      ALLOCATE( nrank_ice(ndim_rank_ice) ) 
    20082009      ! 
    2009       ii = 0      
     2010      ii = 0 
    20102011      nrank_ice = 0 
    20112012      DO jjproc = 1, jpnij 
    20122013         IF( zwork(jjproc) == 1) THEN 
    20132014            ii = ii + 1 
    2014             nrank_ice(ii) = jjproc -1  
     2015            nrank_ice(ii) = jjproc -1 
    20152016         ENDIF 
    20162017      END DO 
     
    20942095         IF (ALLOCATED (nrank_znl)) DEALLOCATE(nrank_znl) 
    20952096         ALLOCATE(nrank_znl(ndim_rank_znl)) 
    2096          ii = 0      
     2097         ii = 0 
    20972098         nrank_znl (:) = 0 
    20982099         DO jproc=1,jpnij 
    20992100            IF ( kwork(jproc) == njmpp) THEN 
    21002101               ii = ii + 1 
    2101                nrank_znl(ii) = jproc -1  
     2102               nrank_znl(ii) = jproc -1 
    21022103            ENDIF 
    21032104         END DO 
     
    21232124 
    21242125      ! Determines if processor if the first (starting from i=1) on the row 
    2125       IF ( jpni == 1 ) THEN  
     2126      IF ( jpni == 1 ) THEN 
    21262127         l_znl_root = .TRUE. 
    21272128      ELSE 
     
    21412142      !!               ***  routine mpp_ini_north  *** 
    21422143      !! 
    2143       !! ** Purpose :   Initialize special communicator for north folding  
     2144      !! ** Purpose :   Initialize special communicator for north folding 
    21442145      !!      condition together with global variables needed in the mpp folding 
    21452146      !! 
     
    22022203      !!                   ***  routine mpp_lbc_north_3d  *** 
    22032204      !! 
    2204       !! ** Purpose :   Ensure proper north fold horizontal bondary condition  
     2205      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
    22052206      !!              in mpp configuration in case of jpn1 > 1 
    22062207      !! 
    22072208      !! ** Method  :   North fold condition and mpp with more than one proc 
    2208       !!              in i-direction require a specific treatment. We gather  
     2209      !!              in i-direction require a specific treatment. We gather 
    22092210      !!              the 4 northern lines of the global domain on 1 processor 
    22102211      !!              and apply lbc north-fold on this sub array. Then we 
     
    22152216      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
    22162217      !                                                              !   = T ,  U , V , F or W  gridpoints 
    2217       REAL(wp)                        , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold  
     2218      REAL(wp)                        , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
    22182219      !!                                                             ! =  1. , the sign is kept 
    22192220      INTEGER ::   ji, jj, jr 
     
    22242225      INTEGER, DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat            ! for mpi_isend when avoiding mpi_allgather 
    22252226      !!---------------------------------------------------------------------- 
    2226       !    
     2227      ! 
    22272228      ijpj   = 4 
    22282229      ityp = -1 
     
    22392240      IF ( l_north_nogather ) THEN 
    22402241         ! 
    2241          ! Avoid the use of mpi_allgather by exchanging only with the processes already identified  
     2242         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 
    22422243         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange 
    22432244         ! 
     
    22642265               ityp = 5 
    22652266            CASE DEFAULT 
    2266                ityp = -1                    ! Set a default value for unsupported types which  
     2267               ityp = -1                    ! Set a default value for unsupported types which 
    22672268                                            ! will cause a fallback to the mpi_allgather method 
    22682269         END SELECT 
     
    23132314      ! The ztab array has been either: 
    23142315      !  a. Fully populated by the mpi_allgather operation or 
    2315       !  b. Had the active points for this domain and northern neighbours populated  
     2316      !  b. Had the active points for this domain and northern neighbours populated 
    23162317      !     by peer to peer exchanges 
    2317       ! Either way the array may be folded by lbc_nfd and the result for the span of  
     2318      ! Either way the array may be folded by lbc_nfd and the result for the span of 
    23182319      ! this domain will be identical. 
    23192320      ! 
     
    23342335      !!                   ***  routine mpp_lbc_north_2d  *** 
    23352336      !! 
    2336       !! ** Purpose :   Ensure proper north fold horizontal bondary condition  
     2337      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
    23372338      !!              in mpp configuration in case of jpn1 > 1 (for 2d array ) 
    23382339      !! 
    23392340      !! ** Method  :   North fold condition and mpp with more than one proc 
    2340       !!              in i-direction require a specific treatment. We gather  
     2341      !!              in i-direction require a specific treatment. We gather 
    23412342      !!              the 4 northern lines of the global domain on 1 processor 
    23422343      !!              and apply lbc north-fold on this sub array. Then we 
     
    23472348      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
    23482349      !                                                          !   = T ,  U , V , F or W  gridpoints 
    2349       REAL(wp)                    , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold  
     2350      REAL(wp)                    , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
    23502351      !!                                                             ! =  1. , the sign is kept 
    23512352      INTEGER ::   ji, jj, jr 
     
    23712372      IF ( l_north_nogather ) THEN 
    23722373         ! 
    2373          ! Avoid the use of mpi_allgather by exchanging only with the processes already identified  
     2374         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 
    23742375         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange 
    23752376         ! 
     
    23962397               ityp = 5 
    23972398            CASE DEFAULT 
    2398                ityp = -1                    ! Set a default value for unsupported types which  
     2399               ityp = -1                    ! Set a default value for unsupported types which 
    23992400                                            ! will cause a fallback to the mpi_allgather method 
    24002401         END SELECT 
     
    24462447      ! The ztab array has been either: 
    24472448      !  a. Fully populated by the mpi_allgather operation or 
    2448       !  b. Had the active points for this domain and northern neighbours populated  
     2449      !  b. Had the active points for this domain and northern neighbours populated 
    24492450      !     by peer to peer exchanges 
    2450       ! Either way the array may be folded by lbc_nfd and the result for the span of  
     2451      ! Either way the array may be folded by lbc_nfd and the result for the span of 
    24512452      ! this domain will be identical. 
    24522453      ! 
     
    24682469      !!                   ***  routine mpp_lbc_north_2d  *** 
    24692470      !! 
    2470       !! ** Purpose :   Ensure proper north fold horizontal bondary condition  
    2471       !!              in mpp configuration in case of jpn1 > 1 and for 2d  
     2471      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
     2472      !!              in mpp configuration in case of jpn1 > 1 and for 2d 
    24722473      !!              array with outer extra halo 
    24732474      !! 
    24742475      !! ** Method  :   North fold condition and mpp with more than one proc 
    2475       !!              in i-direction require a specific treatment. We gather  
    2476       !!              the 4+2*jpr2dj northern lines of the global domain on 1  
    2477       !!              processor and apply lbc north-fold on this sub array.  
     2476      !!              in i-direction require a specific treatment. We gather 
     2477      !!              the 4+2*jpr2dj northern lines of the global domain on 1 
     2478      !!              processor and apply lbc north-fold on this sub array. 
    24782479      !!              Then we scatter the north fold array back to the processors. 
    24792480      !! 
     
    24822483      CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of pt3d grid-points 
    24832484      !                                                                                         !   = T ,  U , V , F or W -points 
    2484       REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! = -1. the sign change across the   
     2485      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! = -1. the sign change across the 
    24852486      !!                                                                                        ! north fold, =  1. otherwise 
    24862487      INTEGER ::   ji, jj, jr 
     
    25252526      !! Scatter back to pt2d 
    25262527      DO jj = nlcj - ijpj + 1 , nlcj +jpr2dj 
    2527       ij  = ij +1  
     2528      ij  = ij +1 
    25282529         DO ji= 1, nlci 
    25292530            pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij) 
     
    25422543      !! ** Method  :: define buffer size in namelist, if 0 no buffer attachment 
    25432544      !!            but classical mpi_init 
    2544       !!  
    2545       !! History :: 01/11 :: IDRIS initial version for IBM only   
     2545      !! 
     2546      !! History :: 01/11 :: IDRIS initial version for IBM only 
    25462547      !!            08/04 :: R. Benshila, generalisation 
    25472548      !!--------------------------------------------------------------------- 
    2548       CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt  
     2549      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
    25492550      INTEGER                      , INTENT(inout) ::   ksft 
    25502551      INTEGER                      , INTENT(  out) ::   code 
     
    25552556      CALL mpi_initialized( mpi_was_called, code )      ! MPI initialization 
    25562557      IF ( code /= MPI_SUCCESS ) THEN 
    2557          DO ji = 1, SIZE(ldtxt)  
     2558         DO ji = 1, SIZE(ldtxt) 
    25582559            IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode 
    2559          END DO          
     2560         END DO 
    25602561         WRITE(*, cform_err) 
    25612562         WRITE(*, *) ' lib_mpp: Error in routine mpi_initialized' 
     
    25672568         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code ) 
    25682569         IF ( code /= MPI_SUCCESS ) THEN 
    2569             DO ji = 1, SIZE(ldtxt)  
     2570            DO ji = 1, SIZE(ldtxt) 
    25702571               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode 
    25712572            END DO 
     
    25802581         ! Buffer allocation and attachment 
    25812582         ALLOCATE( tampon(nn_buffer), stat = ierr ) 
    2582          IF( ierr /= 0 ) THEN  
    2583             DO ji = 1, SIZE(ldtxt)  
     2583         IF( ierr /= 0 ) THEN 
     2584            DO ji = 1, SIZE(ldtxt) 
    25842585               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode 
    25852586            END DO 
     
    26602661   FUNCTION mynode( ldtxt, kumnam, kstop, localComm ) RESULT (function_value) 
    26612662      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm 
    2662       CHARACTER(len=*),DIMENSION(:) ::   ldtxt  
     2663      CHARACTER(len=*),DIMENSION(:) ::   ldtxt 
    26632664      INTEGER ::   kumnam, kstop 
    26642665      IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) )   function_value = 0 
     
    26722673      REAL   , DIMENSION(:) :: parr 
    26732674      INTEGER               :: kdim 
    2674       INTEGER, OPTIONAL     :: kcom  
     2675      INTEGER, OPTIONAL     :: kcom 
    26752676      WRITE(*,*) 'mpp_sum_as: You should not have seen this print! error?', kdim, parr(1), kcom 
    26762677   END SUBROUTINE mpp_sum_as 
     
    26792680      REAL   , DIMENSION(:,:) :: parr 
    26802681      INTEGER               :: kdim 
    2681       INTEGER, OPTIONAL     :: kcom  
     2682      INTEGER, OPTIONAL     :: kcom 
    26822683      WRITE(*,*) 'mpp_sum_a2s: You should not have seen this print! error?', kdim, parr(1,1), kcom 
    26832684   END SUBROUTINE mpp_sum_a2s 
     
    26862687      INTEGER, DIMENSION(:) :: karr 
    26872688      INTEGER               :: kdim 
    2688       INTEGER, OPTIONAL     :: kcom  
     2689      INTEGER, OPTIONAL     :: kcom 
    26892690      WRITE(*,*) 'mpp_sum_ai: You should not have seen this print! error?', kdim, karr(1), kcom 
    26902691   END SUBROUTINE mpp_sum_ai 
     
    26922693   SUBROUTINE mpp_sum_s( psca, kcom )            ! Dummy routine 
    26932694      REAL                  :: psca 
    2694       INTEGER, OPTIONAL     :: kcom  
     2695      INTEGER, OPTIONAL     :: kcom 
    26952696      WRITE(*,*) 'mpp_sum_s: You should not have seen this print! error?', psca, kcom 
    26962697   END SUBROUTINE mpp_sum_s 
     
    26982699   SUBROUTINE mpp_sum_i( kint, kcom )            ! Dummy routine 
    26992700      integer               :: kint 
    2700       INTEGER, OPTIONAL     :: kcom  
     2701      INTEGER, OPTIONAL     :: kcom 
    27012702      WRITE(*,*) 'mpp_sum_i: You should not have seen this print! error?', kint, kcom 
    27022703   END SUBROUTINE mpp_sum_i 
     
    27072708      WRITE(*,*) 'mppsum_realdd: You should not have seen this print! error?', ytab 
    27082709   END SUBROUTINE mppsum_realdd 
    2709   
     2710 
    27102711   SUBROUTINE mppsum_a_realdd( ytab, kdim, kcom ) 
    27112712      INTEGER , INTENT( in )                        ::   kdim      ! size of ytab 
     
    27182719      REAL   , DIMENSION(:) :: parr 
    27192720      INTEGER               :: kdim 
    2720       INTEGER, OPTIONAL     :: kcom  
     2721      INTEGER, OPTIONAL     :: kcom 
    27212722      WRITE(*,*) 'mppmax_a_real: You should not have seen this print! error?', kdim, parr(1), kcom 
    27222723   END SUBROUTINE mppmax_a_real 
     
    27242725   SUBROUTINE mppmax_real( psca, kcom ) 
    27252726      REAL                  :: psca 
    2726       INTEGER, OPTIONAL     :: kcom  
     2727      INTEGER, OPTIONAL     :: kcom 
    27272728      WRITE(*,*) 'mppmax_real: You should not have seen this print! error?', psca, kcom 
    27282729   END SUBROUTINE mppmax_real 
     
    27312732      REAL   , DIMENSION(:) :: parr 
    27322733      INTEGER               :: kdim 
    2733       INTEGER, OPTIONAL     :: kcom  
     2734      INTEGER, OPTIONAL     :: kcom 
    27342735      WRITE(*,*) 'mppmin_a_real: You should not have seen this print! error?', kdim, parr(1), kcom 
    27352736   END SUBROUTINE mppmin_a_real 
     
    27372738   SUBROUTINE mppmin_real( psca, kcom ) 
    27382739      REAL                  :: psca 
    2739       INTEGER, OPTIONAL     :: kcom  
     2740      INTEGER, OPTIONAL     :: kcom 
    27402741      WRITE(*,*) 'mppmin_real: You should not have seen this print! error?', psca, kcom 
    27412742   END SUBROUTINE mppmin_real 
     
    27442745      INTEGER, DIMENSION(:) :: karr 
    27452746      INTEGER               :: kdim 
    2746       INTEGER, OPTIONAL     :: kcom  
     2747      INTEGER, OPTIONAL     :: kcom 
    27472748      WRITE(*,*) 'mppmax_a_int: You should not have seen this print! error?', kdim, karr(1), kcom 
    27482749   END SUBROUTINE mppmax_a_int 
     
    27502751   SUBROUTINE mppmax_int( kint, kcom) 
    27512752      INTEGER               :: kint 
    2752       INTEGER, OPTIONAL     :: kcom  
     2753      INTEGER, OPTIONAL     :: kcom 
    27532754      WRITE(*,*) 'mppmax_int: You should not have seen this print! error?', kint, kcom 
    27542755   END SUBROUTINE mppmax_int 
     
    27572758      INTEGER, DIMENSION(:) :: karr 
    27582759      INTEGER               :: kdim 
    2759       INTEGER, OPTIONAL     :: kcom  
     2760      INTEGER, OPTIONAL     :: kcom 
    27602761      WRITE(*,*) 'mppmin_a_int: You should not have seen this print! error?', kdim, karr(1), kcom 
    27612762   END SUBROUTINE mppmin_a_int 
     
    27632764   SUBROUTINE mppmin_int( kint, kcom ) 
    27642765      INTEGER               :: kint 
    2765       INTEGER, OPTIONAL     :: kcom  
     2766      INTEGER, OPTIONAL     :: kcom 
    27662767      WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint, kcom 
    27672768   END SUBROUTINE mppmin_int 
     
    28502851      !!                  ***  ROUTINE  stop_opa  *** 
    28512852      !! 
    2852       !! ** Purpose :   print in ocean.outpput file a error message and  
     2853      !! ** Purpose :   print in ocean.outpput file a error message and 
    28532854      !!                increment the error number (nstop) by one. 
    28542855      !!---------------------------------------------------------------------- 
     
    28572858      !!---------------------------------------------------------------------- 
    28582859      ! 
    2859       nstop = nstop + 1  
     2860      nstop = nstop + 1 
    28602861      IF(lwp) THEN 
    28612862         WRITE(numout,cform_err) 
     
    28892890      !!                  ***  ROUTINE  stop_warn  *** 
    28902891      !! 
    2891       !! ** Purpose :   print in ocean.outpput file a error message and  
     2892      !! ** Purpose :   print in ocean.outpput file a error message and 
    28922893      !!                increment the warning number (nwarn) by one. 
    28932894      !!---------------------------------------------------------------------- 
     
    28952896      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10 
    28962897      !!---------------------------------------------------------------------- 
    2897       !  
    2898       nwarn = nwarn + 1  
     2898      ! 
     2899      nwarn = nwarn + 1 
    28992900      IF(lwp) THEN 
    29002901         WRITE(numout,cform_war) 
     
    29822983         STOP 'ctl_opn bad opening' 
    29832984      ENDIF 
    2984        
     2985 
    29852986   END SUBROUTINE ctl_opn 
    29862987 
     
    29922993      !! ** Purpose :   return the index of an unused logical unit 
    29932994      !!---------------------------------------------------------------------- 
    2994       LOGICAL :: llopn  
     2995      LOGICAL :: llopn 
    29952996      !!---------------------------------------------------------------------- 
    29962997      ! 
Note: See TracChangeset for help on using the changeset viewer.