Changeset 10314 for NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/mpp_lnk_generic.h90
- Timestamp:
- 2018-11-15T17:27:18+01:00 (5 years ago)
- 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 63 63 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 64 64 INTEGER :: ierr 65 INTEGER :: icom_freq66 65 REAL(wp) :: zland 67 66 INTEGER , DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend … … 73 72 ipl = L_SIZE(ptab) ! 4th - 74 73 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. ) 75 76 ! 76 77 ALLOCATE( zt3ns(jpi,nn_hls,ipk,ipl,ipf,2), zt3sn(jpi,nn_hls,ipk,ipl,ipf,2), & … … 151 152 ! 152 153 ! ! 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 228 155 ! 229 156 IF( ln_timing ) CALL tic_tac(.TRUE.)
Note: See TracChangeset
for help on using the changeset viewer.