SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/gather_and_write_mpi

Go to the documentation of this file.
00001 MODULE MODI_GATHER_AND_WRITE_MPI_K4
00002 !
00003 INTERFACE GATHER_AND_WRITE_MPI_K4
00004 !
00005 SUBROUTINE GATHER_AND_WRITE_MPI_X1D0(PWORK,PWORK2,KMASK)
00006 !
00007 REAL, DIMENSION(:), INTENT(IN) :: PWORK
00008 REAL, DIMENSION(:), INTENT(OUT) :: PWORK2
00009 !
00010 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
00011 !
00012 END SUBROUTINE GATHER_AND_WRITE_MPI_X1D0
00013 !
00014 SUBROUTINE GATHER_AND_WRITE_MPI_X2D0(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 GATHER_AND_WRITE_MPI_X2D0
00022 !
00023 END INTERFACE
00024 !
00025 END MODULE MODI_GATHER_AND_WRITE_MPI_K4
00026 !
00027 !**************************************************************************
00028 !
00029 SUBROUTINE GATHER_AND_WRITE_MPI_X1D0(PWORK,PWORK2,KMASK)
00030 !
00031 USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
00032                             XTIME_COMM_WRITE, XTIME_CALC_WRITE, &
00033                             XTIME_OMP_BARR, IDX_W, WLOG_MPI
00034 USE MODD_SURFEX_OMP, ONLY : NINDX1, NINDX2, XWORK
00035 !
00036 USE MODI_UNPACK_SAME_RANK
00037 !
00038 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00039 USE PARKIND1  ,ONLY : JPRB
00040 !
00041 IMPLICIT NONE
00042 !
00043 #ifndef NOMPI
00044 INCLUDE "mpif.h"
00045 #endif
00046 !
00047 REAL, DIMENSION(:), INTENT(IN) :: PWORK
00048 REAL, DIMENSION(:), INTENT(OUT) :: PWORK2
00049 !
00050 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
00051 !
00052 REAL, DIMENSION(NSIZE) :: ZINTER
00053 DOUBLE PRECISION   :: XTIME0
00054 !
00055 #ifndef NOMPI
00056 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
00057 #endif
00058 INTEGER :: ICPT
00059 INTEGER :: I,J
00060 INTEGER :: INFOMPI
00061 !
00062 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00063 !
00064 !
00065 IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X1D0',0,ZHOOK_HANDLE)
00066 !
00067 XWORK(NINDX1:NINDX2) = 0.
00068 !
00069 #ifndef NOMPI
00070 XTIME0 = MPI_WTIME()
00071 #endif
00072 !
00073 IF (PRESENT(KMASK)) THEN
00074   CALL UNPACK_SAME_RANK(KMASK,PWORK,XWORK(NINDX1:NINDX2))
00075 ELSE
00076   XWORK(NINDX1:NINDX2) = PWORK(:)
00077 ENDIF
00078 !
00079 #ifndef NOMPI
00080 XTIME_CALC_WRITE = XTIME_CALC_WRITE + (MPI_WTIME() - XTIME0)
00081 !
00082 XTIME0 = MPI_WTIME()
00083 #endif
00084 !
00085 !$OMP BARRIER
00086 !
00087 #ifndef NOMPI
00088 XTIME_OMP_BARR = XTIME_OMP_BARR + (MPI_WTIME() - XTIME0)
00089 #endif
00090 !
00091 IF (NRANK/=NPIO) THEN
00092   !
00093 !$OMP SINGLE
00094   ! 
00095   IDX_W = IDX_W + 1
00096   !
00097 #ifndef NOMPI
00098   XTIME0 = MPI_WTIME()
00099   CALL MPI_SEND(XWORK,SIZE(XWORK)*KIND(XWORK)/4,MPI_REAL,NPIO,IDX_W,NCOMM,INFOMPI)
00100   XTIME_COMM_WRITE = XTIME_COMM_WRITE + (MPI_WTIME() - XTIME0)
00101 #endif
00102   !
00103 !$OMP END SINGLE
00104   !
00105 ELSE
00106   !
00107 !$OMP SINGLE
00108   !  
00109   IDX_W = IDX_W + 1
00110   !
00111   DO I=1,NPROC
00112     !
00113 #ifndef NOMPI   
00114     XTIME0 = MPI_WTIME()
00115 #endif    
00116     !
00117     IF (I<NPROC) THEN
00118 #ifndef NOMPI
00119       CALL MPI_RECV(ZINTER,SIZE(ZINTER)*KIND(ZINTER)/4,MPI_REAL,I,IDX_W,NCOMM,ISTATUS,INFOMPI)
00120 #endif
00121     ELSE
00122       ZINTER(1:SIZE(XWORK)) = XWORK(:)
00123     ENDIF
00124     !
00125 #ifndef NOMPI    
00126     XTIME_COMM_WRITE = XTIME_COMM_WRITE + (MPI_WTIME() - XTIME0)
00127     !
00128     XTIME0 = MPI_WTIME()
00129 #endif     
00130     !    
00131     ICPT = 0
00132     !
00133     DO J=1,SIZE(NINDEX)
00134       !
00135       IF ( NINDEX(J)==MOD(I,NPROC) ) THEN
00136         ICPT = ICPT + 1
00137         PWORK2(J) = ZINTER(ICPT)
00138       ENDIF
00139       !
00140     ENDDO
00141     !
00142 #ifndef NOMPI    
00143     XTIME_CALC_WRITE = XTIME_CALC_WRITE + (MPI_WTIME() - XTIME0)
00144 #endif      
00145     !
00146   ENDDO
00147   !
00148 !$OMP END SINGLE COPYPRIVATE(PWORK2)
00149   !
00150 ENDIF
00151 !
00152 IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X1D0',1,ZHOOK_HANDLE)
00153 !
00154 END SUBROUTINE GATHER_AND_WRITE_MPI_X1D0
00155 !
00156 !**************************************************************************
00157 !
00158 SUBROUTINE GATHER_AND_WRITE_MPI_X2D0(PWORK,PWORK2,KMASK)
00159 !
00160 USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
00161                             XTIME_COMM_WRITE, XTIME_OMP_BARR,  &
00162                             XTIME_CALC_WRITE, IDX_W, WLOG_MPI
00163 USE MODD_SURFEX_OMP, ONLY : NINDX1, NINDX2, XWORK2
00164 !
00165 USE MODI_UNPACK_SAME_RANK
00166 !
00167 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00168 USE PARKIND1  ,ONLY : JPRB
00169 !
00170 IMPLICIT NONE
00171 !
00172 #ifndef NOMPI
00173 INCLUDE "mpif.h"
00174 #endif
00175 !
00176 REAL, DIMENSION(:,:), INTENT(IN) :: PWORK
00177 REAL, DIMENSION(:,:), INTENT(OUT) :: PWORK2
00178 !
00179 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
00180 !
00181 REAL, DIMENSION(NSIZE,SIZE(PWORK,2)) :: ZINTER
00182 DOUBLE PRECISION   :: XTIME0
00183 !
00184 #ifndef NOMPI
00185 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
00186 #endif
00187 INTEGER :: ICPT, IS2
00188 INTEGER :: I,J
00189 INTEGER :: INFOMPI
00190 !
00191 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00192 !
00193 !
00194 IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X2D0',0,ZHOOK_HANDLE)
00195 !
00196 IS2 = SIZE(PWORK,2)
00197 !
00198 !$OMP SINGLE
00199 !
00200 IF (IS2>SIZE(XWORK2,2)) THEN
00201   DEALLOCATE(XWORK2)
00202   ALLOCATE(XWORK2(NSIZE,IS2))
00203 ENDIF
00204 !
00205 !$OMP END SINGLE
00206 !
00207 XWORK2(NINDX1:NINDX2,1:IS2) = 0.
00208 !
00209 #ifndef NOMPI
00210 XTIME0 = MPI_WTIME()
00211 #endif
00212 !
00213 IF (PRESENT(KMASK)) THEN
00214   CALL UNPACK_SAME_RANK(KMASK,PWORK,XWORK2(NINDX1:NINDX2,1:IS2))
00215 ELSE
00216   XWORK2(NINDX1:NINDX2,1:IS2) = PWORK(:,:)
00217 ENDIF
00218 !
00219 #ifndef NOMPI
00220 XTIME_CALC_WRITE = XTIME_CALC_WRITE + (MPI_WTIME() - XTIME0)
00221 !
00222 XTIME0 = MPI_WTIME()
00223 #endif
00224 !
00225 !$OMP BARRIER
00226 !
00227 #ifndef NOMPI
00228 XTIME_OMP_BARR = XTIME_OMP_BARR + (MPI_WTIME() - XTIME0)
00229 #endif
00230 !
00231 IF (NRANK/=NPIO) THEN
00232   !
00233 !$OMP SINGLE
00234   !  
00235   IDX_W = IDX_W + 1
00236   !
00237 #ifndef NOMPI
00238   XTIME0 = MPI_WTIME()
00239   CALL MPI_SEND(XWORK2(:,1:IS2),NSIZE*IS2*KIND(XWORK2)/4,MPI_REAL,NPIO,IDX_W,NCOMM,INFOMPI)
00240   XTIME_COMM_WRITE = XTIME_COMM_WRITE + (MPI_WTIME() - XTIME0)
00241 #endif
00242   !
00243 !$OMP END SINGLE
00244   !
00245 ELSE
00246   !
00247 !$OMP SINGLE
00248   !
00249   IDX_W = IDX_W + 1
00250   !
00251   DO I=1,NPROC
00252     !
00253     !
00254 #ifndef NOMPI   
00255     XTIME0 = MPI_WTIME()
00256 #endif    
00257 !    !    
00258     IF (I<NPROC) THEN
00259 #ifndef NOMPI
00260       CALL MPI_RECV(ZINTER,SIZE(ZINTER)*KIND(ZINTER)/4,MPI_REAL,I,IDX_W,NCOMM,ISTATUS,INFOMPI)
00261 #endif
00262     ELSE
00263       ZINTER(:,:) = XWORK2(:,1:IS2)
00264     ENDIF
00265 !    !
00266 #ifndef NOMPI    
00267     XTIME_COMM_WRITE = XTIME_COMM_WRITE + (MPI_WTIME() - XTIME0)
00268     !
00269     XTIME0 = MPI_WTIME()
00270 #endif     
00271     !    
00272     ICPT = 0
00273     !    
00274     DO J=1,SIZE(NINDEX)
00275       !
00276       IF ( NINDEX(J)==MOD(I,NPROC) ) THEN
00277         ICPT = ICPT + 1
00278         PWORK2(J,:) = ZINTER(ICPT,:)
00279       ENDIF
00280       !
00281     ENDDO
00282 !    !
00283 #ifndef NOMPI    
00284     XTIME_CALC_WRITE = XTIME_CALC_WRITE + (MPI_WTIME() - XTIME0)
00285 #endif      
00286 !    !    
00287   ENDDO
00288   !
00289 !$OMP END SINGLE COPYPRIVATE(PWORK2)
00290   !
00291 ENDIF
00292 !
00293 IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X2D0',1,ZHOOK_HANDLE)
00294 !
00295 !
00296 END SUBROUTINE GATHER_AND_WRITE_MPI_X2D0
00297 !
00298 !**************************************************************************