SURFEX v7.3
General documentation of Surfex
 All Classes Files Functions Variables Typedefs
/home/dasprezs/EXPORT_v7_3/src/SURFEX/read_and_send_mpi.F90
Go to the documentation of this file.
00001 MODULE MODI_READ_AND_SEND_MPI
00002 !
00003 INTERFACE READ_AND_SEND_MPI
00004 !
00005 SUBROUTINE READ_AND_SEND_MPI_N1D(KWORK,KWORK2,KMASK)
00006 !
00007 INTEGER, DIMENSION(:), INTENT(IN) :: KWORK
00008 INTEGER, DIMENSION(:), INTENT(OUT) :: KWORK2
00009 !
00010 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
00011 !
00012 END SUBROUTINE READ_AND_SEND_MPI_N1D
00013 !
00014 SUBROUTINE READ_AND_SEND_MPI_X1D(PWORK,PWORK2,KMASK)
00015 !
00016 REAL, DIMENSION(:), INTENT(IN) :: PWORK
00017 REAL, DIMENSION(:), INTENT(OUT) :: PWORK2
00018 !
00019 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
00020 !
00021 END SUBROUTINE READ_AND_SEND_MPI_X1D
00022 !
00023 SUBROUTINE READ_AND_SEND_MPI_X2D(PWORK,PWORK2,KMASK)
00024 !
00025 REAL, DIMENSION(:,:), INTENT(IN) :: PWORK
00026 REAL, DIMENSION(:,:), INTENT(OUT) :: PWORK2
00027 !
00028 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
00029 !
00030 END SUBROUTINE READ_AND_SEND_MPI_X2D
00031 !
00032 SUBROUTINE READ_AND_SEND_MPI_X3D(PWORK,PWORK2,KMASK)
00033 !
00034 REAL, DIMENSION(:,:,:), INTENT(IN) :: PWORK
00035 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWORK2
00036 !
00037 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
00038 !
00039 END SUBROUTINE READ_AND_SEND_MPI_X3D
00040 !
00041 END INTERFACE
00042 !
00043 END MODULE MODI_READ_AND_SEND_MPI
00044 !
00045 SUBROUTINE READ_AND_SEND_MPI_N1D(KWORK,KWORK2,KMASK)
00046 !
00047 USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
00048                             XTIME_NPIO_READ, XTIME_COMM_READ, IDX_R, WLOG_MPI
00049 USE MODD_SURFEX_OMP, ONLY : NINDX1, NINDX2
00050 !
00051 USE MODI_PACK_SAME_RANK
00052 !
00053 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00054 USE PARKIND1  ,ONLY : JPRB
00055 !
00056 IMPLICIT NONE
00057 !
00058 #ifndef NOMPI
00059 INCLUDE "mpif.h"
00060 #endif
00061 !
00062 INTEGER, DIMENSION(:), INTENT(IN) :: KWORK
00063 INTEGER, DIMENSION(:), INTENT(OUT) :: KWORK2
00064 !
00065 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
00066 !
00067 INTEGER, DIMENSION(NSIZE) :: IINTER
00068 !
00069 #ifndef NOMPI
00070 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
00071 #endif
00072 INTEGER :: ICPT
00073 INTEGER :: I,J
00074 INTEGER :: INFOMPI
00075 DOUBLE PRECISION :: XTIME0
00076 !
00077 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00078 !
00079 IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N1D',0,ZHOOK_HANDLE)
00080 !
00081 IF (NRANK==NPIO) THEN
00082   !
00083 !$OMP SINGLE 
00084   !
00085   IDX_R = IDX_R + 1
00086   !
00087   DO I=1,NPROC-1
00088     !
00089 #ifndef NOMPI    
00090     XTIME0 = MPI_WTIME()
00091 #endif
00092     !
00093     ICPT = 0
00094     !
00095     IINTER(:) = 0
00096     !
00097     DO J=1,SIZE(NINDEX)
00098       !
00099       IF ( NINDEX(J)==MOD(I,NPROC) ) THEN
00100         ICPT = ICPT + 1
00101         IINTER(ICPT) = KWORK(J)
00102       ENDIF
00103       !
00104     ENDDO
00105     !
00106 #ifndef NOMPI    
00107     XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
00108     !  
00109     IF (I<NPROC) THEN
00110       XTIME0 = MPI_WTIME()
00111       CALL MPI_SEND(IINTER,SIZE(IINTER)*KIND(IINTER)/4,MPI_INTEGER,I,IDX_R,NCOMM,INFOMPI)
00112       XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
00113     ENDIF
00114 #endif
00115     !
00116   ENDDO
00117   !
00118 !$OMP END SINGLE COPYPRIVATE(IINTER)
00119   ! 
00120 ELSE
00121   !
00122 !$OMP SINGLE
00123   ! 
00124   IDX_R = IDX_R + 1
00125   !  
00126 #ifndef NOMPI
00127   IINTER(:) = 0
00128   !  
00129   XTIME0 = MPI_WTIME()
00130   CALL MPI_RECV(IINTER,SIZE(IINTER)*KIND(IINTER)/4,MPI_INTEGER,NPIO,IDX_R,NCOMM,ISTATUS,INFOMPI)
00131   XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
00132 #endif
00133   !
00134 !$OMP END SINGLE COPYPRIVATE(IINTER)
00135   !  
00136 ENDIF
00137 !
00138 IF (PRESENT(KMASK)) THEN
00139   CALL PACK_SAME_RANK(KMASK,IINTER(NINDX1:NINDX2),KWORK2)
00140 ELSE
00141   KWORK2(:) = IINTER(NINDX1:NINDX2)
00142 ENDIF
00143 !
00144 IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_N1D',1,ZHOOK_HANDLE)
00145 !
00146 !
00147 END SUBROUTINE READ_AND_SEND_MPI_N1D
00148 !
00149 !**************************************************************************
00150 !
00151 SUBROUTINE READ_AND_SEND_MPI_X1D(PWORK,PWORK2,KMASK)
00152 !
00153 USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
00154                             XTIME_NPIO_READ, XTIME_COMM_READ, WLOG_MPI, IDX_R
00155 USE MODD_SURFEX_OMP, ONLY : NINDX1, NINDX2                 
00156 !
00157 USE MODI_PACK_SAME_RANK
00158 !
00159 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00160 USE PARKIND1  ,ONLY : JPRB
00161 !
00162 IMPLICIT NONE
00163 !
00164 #ifndef NOMPI
00165 INCLUDE "mpif.h"
00166 #endif
00167 !
00168 REAL, DIMENSION(:), INTENT(IN) :: PWORK
00169 REAL, DIMENSION(:), INTENT(OUT) :: PWORK2
00170 !
00171 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
00172 !
00173 REAL, DIMENSION(NSIZE) :: ZINTER
00174 !
00175 #ifndef NOMPI
00176 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
00177 #endif
00178 INTEGER :: ICPT
00179 INTEGER :: I,J
00180 INTEGER :: INFOMPI
00181 DOUBLE PRECISION   :: XTIME0
00182 !
00183 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00184 !
00185 IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X1D',0,ZHOOK_HANDLE)
00186 !
00187 IF (NRANK==NPIO) THEN
00188   !
00189 !$OMP SINGLE
00190   !
00191   IDX_R = IDX_R + 1
00192   !
00193   DO I=1,NPROC
00194     !
00195 #ifndef NOMPI
00196     XTIME0 = MPI_WTIME()
00197 #endif
00198     !
00199     ICPT = 0
00200     !
00201     ZINTER(:) = 0
00202     !
00203     DO J=1,SIZE(NINDEX)
00204       !
00205       IF ( NINDEX(J)==MOD(I,NPROC) ) THEN
00206         ICPT = ICPT + 1
00207         ZINTER(ICPT) = PWORK(J)
00208       ENDIF
00209       !
00210     ENDDO
00211     !
00212 #ifndef NOMPI    
00213     XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
00214     !
00215     IF (I<NPROC) THEN
00216       XTIME0 = MPI_WTIME()
00217       CALL MPI_SEND(ZINTER,SIZE(ZINTER)*KIND(ZINTER)/4,MPI_REAL,I,IDX_R,NCOMM,INFOMPI)
00218       XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
00219     ENDIF
00220 #endif
00221     !
00222   ENDDO
00223   !
00224 !$OMP END SINGLE COPYPRIVATE(ZINTER)
00225   !   
00226 ELSE
00227   !
00228 !$OMP SINGLE
00229   !  
00230   IDX_R = IDX_R + 1
00231   !
00232 #ifndef NOMPI
00233   ZINTER(:) = 0
00234   !
00235   XTIME0 = MPI_WTIME()
00236   CALL MPI_RECV(ZINTER,SIZE(ZINTER)*KIND(ZINTER)/4,MPI_REAL,NPIO,IDX_R,NCOMM,ISTATUS,INFOMPI)
00237   XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
00238 #endif
00239   !
00240 !$OMP END SINGLE COPYPRIVATE(ZINTER)
00241   !  
00242 ENDIF
00243 !
00244 IF (PRESENT(KMASK)) THEN
00245   CALL PACK_SAME_RANK(KMASK,ZINTER(NINDX1:NINDX2),PWORK2)
00246 ELSE
00247   PWORK2(:) = ZINTER(NINDX1:NINDX2)
00248 ENDIF
00249 !
00250 IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X1D',1,ZHOOK_HANDLE)
00251 !
00252 !
00253 END SUBROUTINE READ_AND_SEND_MPI_X1D
00254 !
00255 !**************************************************************************
00256 !
00257 SUBROUTINE READ_AND_SEND_MPI_X2D(PWORK,PWORK2,KMASK)
00258 !
00259 USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
00260                             XTIME_NPIO_READ, XTIME_COMM_READ, WLOG_MPI, IDX_R
00261 USE MODD_SURFEX_OMP, ONLY : NINDX1, NINDX2
00262 !
00263 USE MODI_PACK_SAME_RANK
00264 !
00265 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00266 USE PARKIND1  ,ONLY : JPRB
00267 !
00268 IMPLICIT NONE
00269 !
00270 #ifndef NOMPI
00271 INCLUDE "mpif.h"
00272 #endif
00273 !
00274 REAL, DIMENSION(:,:), INTENT(IN) :: PWORK
00275 REAL, DIMENSION(:,:), INTENT(OUT) :: PWORK2
00276 !
00277 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
00278 !
00279 REAL, DIMENSION(NSIZE,SIZE(PWORK2,2)) :: ZINTER
00280 !
00281 #ifndef NOMPI
00282 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
00283 #endif
00284 INTEGER :: ICPT
00285 INTEGER :: I,J, K
00286 INTEGER :: INFOMPI
00287 DOUBLE PRECISION   :: XTIME0
00288 !
00289 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00290 !
00291 !
00292 IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X2D',0,ZHOOK_HANDLE)
00293 !
00294 IF (NRANK==NPIO) THEN
00295   !
00296 !$OMP SINGLE
00297   !  
00298   IDX_R = IDX_R + 1
00299   !
00300   DO I=1,NPROC
00301     !
00302 #ifndef NOMPI    
00303     XTIME0 = MPI_WTIME()
00304 #endif    
00305     !
00306     ICPT = 0
00307     !    
00308     ZINTER(:,:) = 0
00309     !
00310     DO J=1,SIZE(NINDEX)
00311       !
00312       IF ( NINDEX(J)==MOD(I,NPROC) ) THEN
00313         ICPT = ICPT + 1
00314         ZINTER(ICPT,:) = PWORK(J,:)
00315       ENDIF
00316       !
00317     ENDDO
00318     !
00319 #ifndef NOMPI    
00320     XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
00321     !
00322     IF (I<NPROC) THEN
00323       XTIME0 = MPI_WTIME()
00324       CALL MPI_SEND(ZINTER,SIZE(ZINTER)*KIND(ZINTER)/4,MPI_REAL,I,IDX_R,NCOMM,INFOMPI)
00325       XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
00326     ENDIF
00327 #endif
00328     !
00329   ENDDO
00330   !
00331 !$OMP END SINGLE COPYPRIVATE(ZINTER)
00332   !  
00333 ELSE
00334   !
00335 !$OMP SINGLE
00336   !
00337   IDX_R = IDX_R + 1
00338   !
00339 #ifndef NOMPI
00340   ZINTER(:,:) = 0
00341   !
00342   XTIME0 = MPI_WTIME()
00343   CALL MPI_RECV(ZINTER,SIZE(ZINTER)*KIND(ZINTER)/4,MPI_REAL,NPIO,IDX_R,NCOMM,ISTATUS,INFOMPI)
00344   XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
00345 #endif
00346   !
00347 !$OMP END SINGLE COPYPRIVATE(ZINTER)
00348   !  
00349 ENDIF
00350 !
00351 IF (PRESENT(KMASK)) THEN
00352   CALL PACK_SAME_RANK(KMASK,ZINTER(NINDX1:NINDX2,:),PWORK2)
00353 ELSE
00354   PWORK2(:,:) = ZINTER(NINDX1:NINDX2,:)
00355 ENDIF
00356 !
00357 IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X2D',1,ZHOOK_HANDLE)
00358 !
00359 !
00360 END SUBROUTINE READ_AND_SEND_MPI_X2D
00361 !**************************************************************************
00362 !
00363 SUBROUTINE READ_AND_SEND_MPI_X3D(PWORK,PWORK2,KMASK)
00364 !
00365 USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
00366                             XTIME_NPIO_READ, XTIME_COMM_READ, IDX_R, WLOG_MPI
00367 USE MODD_SURFEX_OMP, ONLY : NINDX1, NINDX2
00368 !
00369 USE MODI_PACK_SAME_RANK
00370 !
00371 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00372 USE PARKIND1  ,ONLY : JPRB
00373 !
00374 IMPLICIT NONE
00375 !
00376 #ifndef NOMPI
00377 INCLUDE "mpif.h"
00378 #endif
00379 !
00380 REAL, DIMENSION(:,:,:), INTENT(IN) :: PWORK
00381 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWORK2
00382 !
00383 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
00384 !
00385 REAL, DIMENSION(NSIZE,SIZE(PWORK2,2),SIZE(PWORK2,3)) :: ZINTER
00386 !
00387 #ifndef NOMPI
00388 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
00389 #endif
00390 INTEGER :: ICPT
00391 INTEGER :: I,J
00392 INTEGER :: INFOMPI
00393 DOUBLE PRECISION   :: XTIME0
00394 !
00395 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00396 !
00397 !
00398 IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X3D',0,ZHOOK_HANDLE)
00399 !
00400 IF (NRANK==NPIO) THEN
00401   !
00402 !$OMP SINGLE
00403   !  
00404   IDX_R = IDX_R + 1
00405   !  
00406   DO I=1,NPROC
00407     !
00408 #ifndef NOMPI    
00409     XTIME0 = MPI_WTIME()
00410 #endif    
00411     ! 
00412     ICPT = 0
00413     !
00414     ZINTER(:,:,:) = 0.
00415     !
00416     DO J=1,SIZE(NINDEX)
00417       !
00418       IF ( NINDEX(J)==MOD(I,NPROC) ) THEN
00419         ICPT = ICPT + 1
00420         ZINTER(ICPT,:,:) = PWORK(J,:,:)
00421       ENDIF
00422       !
00423     ENDDO
00424     !
00425 #ifndef NOMPI    
00426     XTIME_NPIO_READ = XTIME_NPIO_READ + (MPI_WTIME() - XTIME0)
00427     !    
00428     IF (I<NPROC) THEN
00429       XTIME0 = MPI_WTIME()
00430       CALL MPI_SEND(ZINTER,SIZE(ZINTER)*KIND(ZINTER)/4,MPI_REAL,I,IDX_R,NCOMM,INFOMPI)
00431       XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
00432     ENDIF
00433 #endif
00434     !
00435   ENDDO
00436   !
00437 !$OMP END SINGLE COPYPRIVATE(ZINTER)
00438   !  
00439 ELSE
00440   !
00441 !$OMP SINGLE
00442   !  
00443   IDX_R = IDX_R + 1
00444   !
00445 #ifndef NOMPI
00446   ZINTER(:,:,:) = 0.
00447   !
00448   XTIME0 = MPI_WTIME()  
00449   CALL MPI_RECV(ZINTER,SIZE(ZINTER)*KIND(ZINTER)/4,MPI_REAL,NPIO,IDX_R,NCOMM,ISTATUS,INFOMPI)
00450   XTIME_COMM_READ = XTIME_COMM_READ + (MPI_WTIME() - XTIME0)
00451 #endif
00452   !
00453 !$OMP END SINGLE COPYPRIVATE(ZINTER)
00454   !  
00455 ENDIF
00456 !
00457 IF (PRESENT(KMASK)) THEN
00458   CALL PACK_SAME_RANK(KMASK,ZINTER(NINDX1:NINDX2,:,:),PWORK2)
00459 ELSE
00460   PWORK2(:,:,:) = ZINTER(NINDX1:NINDX2,:,:)
00461 ENDIF
00462 !
00463 IF (LHOOK) CALL DR_HOOK('READ_AND_SEND_MPI_X3D',1,ZHOOK_HANDLE)
00464 !
00465 !
00466 END SUBROUTINE READ_AND_SEND_MPI_X3D