Ignore:
Timestamp:
2018-11-15T17:27:18+01:00 (23 months ago)
Author:
smasson
Message:

dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 2: add generic glob_min/max/sum and locmin/max, complete timing and report (including bdy and icb), see #2133

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/mpp_lnk_generic.h90

    r10297 r10314  
    6363      INTEGER  ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend 
    6464      INTEGER  ::   ierr 
    65       INTEGER  ::   icom_freq 
    6665      REAL(wp) ::   zland 
    6766      INTEGER , DIMENSION(MPI_STATUS_SIZE)      ::   ml_stat        ! for key_mpi_isend 
     
    7372      ipl = L_SIZE(ptab)   ! 4th    - 
    7473      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers) 
     74      ! 
     75      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. ) 
    7576      ! 
    7677      ALLOCATE( zt3ns(jpi,nn_hls,ipk,ipl,ipf,2), zt3sn(jpi,nn_hls,ipk,ipl,ipf,2),   & 
     
    151152      ! 
    152153      !                           ! Migrations 
    153       imigr = nn_hls * jpj * ipk * ipl * ipf 
    154       ! 
    155       IF( narea == 1 ) THEN 
    156  
    157          ! find the smallest common frequency: default = frequency product, if multiple, choose the larger of the 2 frequency 
    158          icom_freq = ncom_fsbc * ncom_dttrc 
    159          IF( MOD( MAX(ncom_fsbc,ncom_dttrc), MIN(ncom_fsbc,ncom_dttrc) ) == 0 ) icom_freq = MAX(ncom_fsbc,ncom_dttrc) 
    160           
    161          IF ( ncom_stp == nit000+icom_freq ) THEN   ! avoid to count extra communications in potential initializations at nit000 
    162             IF( .NOT. ALLOCATED( ncomm_sequence) ) THEN 
    163                ALLOCATE( ncomm_sequence(2000,2), STAT=ierr ) 
    164                IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'lnk_generic, cannot allocate ncomm_sequence' ) 
    165                ALLOCATE( crname_lbc(2000), STAT=ierr ) 
    166                IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'lnk_generic, cannot allocate crname' ) 
    167             ENDIF 
    168             n_sequence_lbc = n_sequence_lbc + 1 
    169             IF( n_sequence_lbc > 2000 ) CALL ctl_stop( 'STOP', 'lnk_generic, increase ncomm_sequence first dimension' ) 
    170             ncomm_sequence(n_sequence_lbc,1) = ipk*ipl   ! size of 3rd and 4th dimensions 
    171             ncomm_sequence(n_sequence_lbc,2) = ipf       ! number of arrays to be treated (multi) 
    172             crname_lbc    (n_sequence_lbc)   = cdname    ! keep the name of the calling routine 
    173          ELSE IF ( ncom_stp == (nit000+2*icom_freq) ) THEN 
    174             IF ( numcom == -1 ) THEN 
    175                CALL ctl_opn( numcom, 'communication_report.txt', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 
    176                WRITE(numcom,*) ' ' 
    177                WRITE(numcom,*) ' ------------------------------------------------------------' 
    178                WRITE(numcom,*) ' Communication pattern report (second oce+sbc+top time step):' 
    179                WRITE(numcom,*) ' ------------------------------------------------------------' 
    180                WRITE(numcom,*) ' ' 
    181                WRITE(numcom,'(A,I4)') ' Exchanged halos : ', n_sequence_lbc 
    182                jj = 0; jk = 0; jf = 0; jh = 0 
    183                DO ji = 1, n_sequence_lbc 
    184                   IF ( ncomm_sequence(ji,1) .GT. 1 ) jk = jk + 1 
    185                   IF ( ncomm_sequence(ji,2) .GT. 1 ) jf = jf + 1 
    186                   IF ( ncomm_sequence(ji,1) .GT. 1 .AND. ncomm_sequence(ji,2) .GT. 1 ) jj = jj + 1 
    187                   jh = MAX (jh, ncomm_sequence(ji,1)*ncomm_sequence(ji,2)) 
    188                END DO 
    189                WRITE(numcom,'(A,I3)') ' 3D Exchanged halos : ', jk 
    190                WRITE(numcom,'(A,I3)') ' Multi arrays exchanged halos : ', jf 
    191                WRITE(numcom,'(A,I3)') '   from which 3D : ', jj 
    192                WRITE(numcom,'(A,I10)') ' Array max size : ', jh*jpi*jpj 
    193                WRITE(numcom,*) ' ' 
    194                WRITE(numcom,*) ' lbc_lnk called' 
    195                jj = 1 
    196                DO ji = 2, n_sequence_lbc 
    197                   IF( crname_lbc(ji-1) /= crname_lbc(ji) ) THEN 
    198                     WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_lbc(ji-1)) 
    199                     jj = 0 
    200                   END IF 
    201                   jj = jj + 1  
    202                END DO 
    203                WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_lbc(n_sequence_lbc)) 
    204                WRITE(numcom,*) ' ' 
    205                IF ( n_sequence_glb > 0 ) THEN 
    206                   WRITE(numcom,'(A,I4)') ' Global communications : ', n_sequence_glb 
    207                   jj = 1 
    208                   DO ji = 2, n_sequence_glb 
    209                      IF( crname_glb(ji-1) /= crname_glb(ji) ) THEN 
    210                        WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_glb(ji-1)) 
    211                        jj = 0 
    212                      END IF 
    213                      jj = jj + 1  
    214                   END DO 
    215                   WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_glb(n_sequence_glb)) 
    216                   DEALLOCATE(crname_glb) 
    217                ELSE 
    218                   WRITE(numcom,*) ' No MPI global communication ' 
    219                ENDIF 
    220                WRITE(numcom,*) ' ' 
    221                WRITE(numcom,*) ' -----------------------------------------------' 
    222                WRITE(numcom,*) ' ' 
    223                DEALLOCATE(ncomm_sequence) 
    224                DEALLOCATE(crname_lbc) 
    225             ENDIF 
    226          ENDIF 
    227       ENDIF 
     154      imigr = nn_hls * jpj * ipk * ipl * ipf       
    228155      ! 
    229156      IF( ln_timing ) CALL tic_tac(.TRUE.) 
Note: See TracChangeset for help on using the changeset viewer.