Changeset 10170 for NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/mpp_lnk_generic.h90

Timestamp:

2018-10-03T16:49:50+02:00 (6 years ago)

Author:

smasson

Message:

dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 2a: add report calls of lbc_lnk, see #2133

File:

• NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/mpp_lnk_generic.h90 (modified) (3 diffs)

NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/mpp_lnk_generic.h90

@@ -46 +46 @@
 
 #if defined MULTI
-   SUBROUTINE ROUTINE_LNK( ptab, cd_nat, psgn, kfld, cd_mpp, pval )
+   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, cd_mpp, pval )
       INTEGER                     , INTENT(in   ) ::   kfld        ! number of pt3d arrays
 #else
-   SUBROUTINE ROUTINE_LNK( ptab, cd_nat, psgn      , cd_mpp, pval )
+   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , cd_mpp, pval )
 #endif
       ARRAY_TYPE(:,:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=*)            , INTENT(in   ) ::   cdname      ! name of the calling subroutine
       CHARACTER(len=1)            , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
       REAL(wp)                    , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
@@ -61 +62 @@
       INTEGER  ::   imigr, iihom, ijhom          ! local integers
       INTEGER  ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend
+      INTEGER  ::   ierr
       REAL(wp) ::   zland
       INTEGER , DIMENSION(MPI_STATUS_SIZE)      ::   ml_stat        ! for key_mpi_isend
@@ -150 +152 @@
       imigr = nn_hls * jpj * ipk * ipl * ipf
       !
+      IF( narea == 1 ) THEN
+         IF ( ncom_stp == nit000 ) THEN
+            IF( .NOT. ALLOCATED( ncomm_sequence) ) THEN
+               ALLOCATE( ncomm_sequence(1000,2), STAT=ierr )
+               IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'lnk_generic, cannot allocate ncomm_sequence' )
+               ALLOCATE( crname(1000), STAT=ierr )
+               IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'lnk_generic, cannot allocate crname' )
+            ENDIF
+            n_sequence = n_sequence + 1
+            IF( n_sequence > 1000 ) CALL ctl_stop( 'STOP', 'lnk_generic, increase ncomm_sequence first dimension' )
+            ncomm_sequence(n_sequence,1) = ipk*ipl   ! size of 3rd and 4th dimensions
+            ncomm_sequence(n_sequence,2) = ipf       ! number of arrays to be treated (multi)
+            crname(n_sequence) = cdname              ! keep the name of the calling routine
+         ELSE IF ( ncom_stp == (nit000+1) ) THEN
+            IF ( .NOT. l_comm_report_done ) THEN
+               WRITE(numout,*) ' '
+               WRITE(numout,*) ' -----------------------------------------------'
+               WRITE(numout,*) ' Communication pattern report (first time step):'
+               WRITE(numout,*) ' -----------------------------------------------'
+               WRITE(numout,*) ' '
+               WRITE(numout,'(A,I3)') ' Exchanged halos : ', n_sequence
+               jj = 0; jk = 0; jf = 0; jh = 0
+               DO ji = 1, n_sequence
+                  IF ( ncomm_sequence(ji,1) .GT. 1 ) jk = jk + 1
+                  IF ( ncomm_sequence(ji,2) .GT. 1 ) jf = jf + 1
+                  IF ( ncomm_sequence(ji,1) .GT. 1 .AND. ncomm_sequence(ji,2) .GT. 1 ) jj = jj + 1
+                  jh = MAX (jh, ncomm_sequence(ji,1)*ncomm_sequence(ji,2))
+               END DO
+               WRITE(numout,'(A,I3)') ' 3D Exchanged halos : ', jk
+               WRITE(numout,'(A,I3)') ' Multi arrays exchanged halos : ', jf
+               WRITE(numout,'(A,I3)') '   from which 3D : ', jj
+               WRITE(numout,'(A,I10)') ' Array max size : ', jh*jpi*jpj
+               WRITE(numout,*) ' '
+               WRITE(numout,*) ' lbc_lnk called'
+               jj = 1
+               DO ji = 2, n_sequence
+                  IF( crname(ji-1) /= crname(ji) ) THEN
+                    WRITE(numout,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname(ji-1))
+                    jj = 0
+                  END IF
+                  jj = jj + 1 
+               END DO
+               WRITE(numout,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname(n_sequence))
+               WRITE(numout,*) ' '
+               WRITE(numout,*) ' -----------------------------------------------'
+               WRITE(numout,*) ' '
+               DEALLOCATE(ncomm_sequence)
+               DEALLOCATE(crname)
+               l_comm_report_done = .TRUE.
+            ENDIF
+         ENDIF
+      ENDIF
+      !
       SELECT CASE ( nbondi )
       CASE ( -1 )