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

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