Changeset 14072 for NEMO/trunk/src/OCE/LBC/lib_mpp.F90

Timestamp:

2020-12-04T08:48:38+01:00 (3 years ago)

Author:

laurent

Message:

Merging branch "2020/dev_r13648_ASINTER-04_laurent_bulk_ice", ticket #2369

File:

• NEMO/trunk/src/OCE/LBC/lib_mpp.F90 (modified) (30 diffs)

NEMO/trunk/src/OCE/LBC/lib_mpp.F90

@@ -20 +20 @@
    !!            4.0  !  2011  (G. Madec)  move ctl_ routines from in_out_manager
    !!            3.5  !  2012  (S.Mocavero, I. Epicoco) Add mpp_lnk_bdy_3d/2d routines to optimize the BDY comm.
-   !!            3.5  !  2013  (C. Ethe, G. Madec)  message passing arrays as local variables 
+   !!            3.5  !  2013  (C. Ethe, G. Madec)  message passing arrays as local variables
    !!            3.5  !  2013  (S.Mocavero, I.Epicoco - CMCC) north fold optimizations
    !!            3.6  !  2015  (O. Tintó and M. Castrillo - BSC) Added '_multiple' case for 2D lbc and max
@@ -77 +77 @@
    PUBLIC MPI_Wtime
 #endif
-   
+
    !! * Interfaces
    !! define generic interface for these routine as they are called sometimes
@@ -115 +115 @@
 !$AGRIF_END_DO_NOT_TREAT
    LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.    !: mpp flag
-#else   
+#else
    INTEGER, PUBLIC, PARAMETER ::   MPI_STATUS_SIZE = 1
    INTEGER, PUBLIC, PARAMETER ::   MPI_REAL = 4
@@ -183 +183 @@
    REAL(dp), DIMENSION(2), PUBLIC ::  waiting_time = 0._dp
    REAL(dp)              , PUBLIC ::  compute_time = 0._dp, elapsed_time = 0._dp
-   
+
    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   tampon   ! buffer in case of bsend
 
    LOGICAL, PUBLIC ::   ln_nnogather                !: namelist control of northfold comms
    LOGICAL, PUBLIC ::   l_north_nogather = .FALSE.  !: internal control of northfold comms
-   
+
    !! * Substitutions
 #  include "do_loop_substitute.h90"
@@ -223 +223 @@
          IF( ierr /= MPI_SUCCESS ) CALL ctl_stop( 'STOP', ' lib_mpp: Error in routine mpi_init' )
       ENDIF
-       
+
       IF( PRESENT(localComm) ) THEN
          IF( Agrif_Root() ) THEN
@@ -473 +473 @@
    END SUBROUTINE mppscatter
 
-   
+
    SUBROUTINE mpp_delay_sum( cdname, cdelay, y_in, pout, ldlast, kcom )
      !!----------------------------------------------------------------------
@@ -498 +498 @@
 
       isz = SIZE(y_in)
-      
+
       IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_dlg = .TRUE. )
 
@@ -519 +519 @@
          END IF
       ENDIF
-      
+
       IF( ndelayid(idvar) == -1 ) THEN         ! first call without restart: define %y1d and %z1d from y_in with blocking allreduce
          !                                       --------------------------
@@ -547 +547 @@
    END SUBROUTINE mpp_delay_sum
 
-   
+
    SUBROUTINE mpp_delay_max( cdname, cdelay, p_in, pout, ldlast, kcom )
       !!----------------------------------------------------------------------
@@ -557 +557 @@
       CHARACTER(len=*), INTENT(in   )                 ::   cdname  ! name of the calling subroutine
       CHARACTER(len=*), INTENT(in   )                 ::   cdelay  ! name (used as id) of the delayed operation
-      REAL(wp),         INTENT(in   ), DIMENSION(:)   ::   p_in    ! 
-      REAL(wp),         INTENT(  out), DIMENSION(:)   ::   pout    ! 
+      REAL(wp),         INTENT(in   ), DIMENSION(:)   ::   p_in    !
+      REAL(wp),         INTENT(  out), DIMENSION(:)   ::   pout    !
       LOGICAL,          INTENT(in   )                 ::   ldlast  ! true if this is the last time we call this routine
       INTEGER,          INTENT(in   ), OPTIONAL       ::   kcom
@@ -567 +567 @@
       INTEGER ::   MPI_TYPE
       !!----------------------------------------------------------------------
-      
+
 #if defined key_mpp_mpi
       if( wp == dp ) then
@@ -575 +575 @@
       else
         CALL ctl_stop( "Error defining type, wp is neither dp nor sp" )
-   
+
       end if
 
@@ -629 +629 @@
    END SUBROUTINE mpp_delay_max
 
-   
+
    SUBROUTINE mpp_delay_rcv( kid )
       !!----------------------------------------------------------------------
       !!                   ***  routine mpp_delay_rcv  ***
       !!
-      !! ** Purpose :  force barrier for delayed mpp (needed for restart) 
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER,INTENT(in   )      ::  kid 
+      !! ** Purpose :  force barrier for delayed mpp (needed for restart)
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,INTENT(in   )      ::  kid
       INTEGER ::   ierr
       !!----------------------------------------------------------------------
@@ -674 +674 @@
    END SUBROUTINE mpp_bcast_nml
 
-   
+
    !!----------------------------------------------------------------------
    !!    ***  mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real  ***
-   !!   
+   !!
    !!----------------------------------------------------------------------
    !!
@@ -729 +729 @@
    !!----------------------------------------------------------------------
    !!    ***  mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real  ***
-   !!   
+   !!
    !!----------------------------------------------------------------------
    !!
@@ -781 +781 @@
    !!----------------------------------------------------------------------
    !!    ***  mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real  ***
-   !!   
+   !!
    !!   Global sum of 1D array or a variable (integer, real or complex)
    !!----------------------------------------------------------------------
@@ -855 +855 @@
    !!----------------------------------------------------------------------
    !!    ***  mpp_minloc2d, mpp_minloc3d, mpp_maxloc2d, mpp_maxloc3d
-   !!   
+   !!
    !!----------------------------------------------------------------------
    !!
@@ -935 +935 @@
 
 
-   SUBROUTINE mppstop( ld_abort ) 
+   SUBROUTINE mppstop( ld_abort )
       !!----------------------------------------------------------------------
       !!                  ***  routine mppstop  ***
@@ -1080 +1080 @@
       !!                collectives
       !!
-      !! ** Method  : - Create graph communicators starting from the processes   
+      !! ** Method  : - Create graph communicators starting from the processes
       !!                distribution along i and j directions
       !
@@ -1411 +1411 @@
                   jj = 0
                END IF
-               jj = jj + 1 
+               jj = jj + 1
             END DO
             WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_glb(n_sequence_glb))
@@ -1427 +1427 @@
                   jj = 0
                END IF
-               jj = jj + 1 
+               jj = jj + 1
             END DO
             WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_dlg(n_sequence_dlg))
@@ -1443 +1443 @@
    END SUBROUTINE mpp_report
 
-   
+
    SUBROUTINE tic_tac (ld_tic, ld_global)
 
@@ -1459 +1459 @@
        IF( ld_global ) ii = 2
     END IF
-    
+
     IF ( ld_tic ) THEN
        tic_wt(ii) = MPI_Wtime()                                                    ! start count tic->tac (waiting time)
@@ -1468 +1468 @@
     ENDIF
 #endif
-    
+
    END SUBROUTINE tic_tac
 
@@ -1478 +1478 @@
    END SUBROUTINE mpi_wait
 
-   
+
    FUNCTION MPI_Wtime()
       REAL(wp) ::  MPI_Wtime
@@ -1540 +1540 @@
       !
       IF( cd1 == 'STOP' ) THEN
-         WRITE(numout,*)  
+         WRITE(numout,*)
          WRITE(numout,*)  'huge E-R-R-O-R : immediate stop'
-         WRITE(numout,*)  
+         WRITE(numout,*)
          CALL FLUSH(numout)
          CALL SLEEP(60)   ! make sure that all output and abort files are written by all cores. 60s should be enough...
@@ -1639 +1639 @@
       ENDIF
       IF( iost /= 0 .AND. TRIM(clfile) == '/dev/null' ) &   ! for windows
-         &  OPEN(UNIT=knum,FILE='NUL', FORM=cdform, ACCESS=cdacce, STATUS=cdstat                      , ERR=100, IOSTAT=iost )   
+         &  OPEN(UNIT=knum,FILE='NUL', FORM=cdform, ACCESS=cdacce, STATUS=cdstat                      , ERR=100, IOSTAT=iost )
       IF( iost == 0 ) THEN
          IF(ldwp .AND. kout > 0) THEN
@@ -1681 +1681 @@
       !
       WRITE (clios, '(I5.0)')   kios
-      IF( kios < 0 ) THEN         
+      IF( kios < 0 ) THEN
          CALL ctl_warn( 'end of record or file while reading namelist '   &
             &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
@@ -1727 +1727 @@
       !csp = NEW_LINE('A')
       ! a new line character is the best seperator but some systems (e.g.Cray)
-      ! seem to terminate namelist reads from internal files early if they 
+      ! seem to terminate namelist reads from internal files early if they
       ! encounter new-lines. Use a single space for safety.
       csp = ' '
@@ -1746 +1746 @@
          iltc = LEN_TRIM(chline)
          IF ( iltc.GT.0 ) THEN
-          inl = INDEX(chline, '!') 
+          inl = INDEX(chline, '!')
           IF( inl.eq.0 ) THEN
            itot = itot + iltc + 1                                ! +1 for the newline character