1! This software is Copyright (c) 2012-2015 The Regents of the 2! University of California. All Rights Reserved. 3! 4! Permission to copy and modify this software and its documentation 5! for educational, research and non-profit purposes, without fee, 6! and without a written agreement is hereby granted, provided that 7! the above copyright notice, this paragraph and the following three 8! paragraphs appear in all copies. 9! 10! Permission to make commercial use of this software may be obtained 11! by contacting: 12! 13! Technology Transfer Office 14! 9500 Gilman Drive, Mail Code 0910 15! University of California 16! La Jolla, CA 92093-0910 17! (858) 534-5815 18! invent@ucsd.edu 19! 20! This software program and documentation are copyrighted by The 21! Regents of the University of California. The software program and 22! documentation are supplied "as is", without any accompanying 23! services from The Regents. The Regents does not warrant that the 24! operation of the program will be uninterrupted or error-free. The 25! end-user understands that the program was developed for research 26! purposes and is advised not to rely exclusively on the program for 27! any reason. 28! 29! IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY 30! PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL 31! DAMAGES, INCLUDING LOST PROFITS, ARISING OUT OF THE USE OF THIS 32! SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF 33! CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 34! THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY 35! WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 36! OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE 37! SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND THE 38! UNIVERSITY OF CALIFORNIA HAS NO OBLIGATIONS TO PROVIDE 39! MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. 40 41 SUBROUTINE COMMUV(dof, nNo, commu, cS, R) 42 43 INCLUDE "svLS_STD.h" 44 45 INTEGER, INTENT(IN) :: dof, nNo 46 TYPE(svLS_commuType), INTENT(IN) :: commu 47 TYPE(svLS_cSType), INTENT(IN) :: cS(commu%nTasks) 48 REAL*8, INTENT(INOUT) :: R(dof,nNo) 49 50 INTEGER i, j, k, s, e, ierr, nTasks, tF, stat(MPI_STATUS_SIZE) 51 INTEGER comm 52 REAL*8, ALLOCATABLE :: rTmp(:,:) 53 54 IF (commu%nTasks .EQ. 1) RETURN 55 56 nTasks = commu%nTasks 57 tF = commu%tF 58 comm = commu%comm 59 60 IF (tF .NE. 1) THEN 61 i = tF - 1 62 i = cS(i)%ptr + cS(i)%n - 1 63 ALLOCATE(rTmp(dof,i)) 64 END IF 65 66 DO i=1, nTasks 67 IF (cS(i)%tag .NE. 0) THEN 68 s = cS(i)%ptr 69 e = s + cS(i)%n - 1 70 IF (i .LT. tF) THEN 71 CALL MPI_IRECV(rTmp(:,s:e), cS(i)%n*dof, mpreal, i-1, 72 2 cS(i)%tag, comm, cS(i)%req, ierr) 73 ELSE 74 CALL MPI_ISEND(R(:,s:e), cS(i)%n*dof, mpreal, i-1, 75 2 cS(i)%tag, comm, cS(i)%req, ierr) 76 END IF 77 END IF 78 END DO 79 80 k = 1 81 DO i=1, tF - 1 82 IF (cS(i)%tag .NE. 0) THEN 83 CALL MPI_WAIT(cS(i)%req, stat, ierr) 84 DO j=1, cS(i)%nBl 85 s = cS(i)%blPtr(j) 86 e = s + cS(i)%blN(j) - 1 87 R(:,s:e) = R(:,s:e) + rTmp(:,k:k+e-s) 88 k = k + cS(i)%blN(j) 89 END DO 90 END IF 91 END DO 92 93 k = 1 94 DO i=1, tF - 1 95 DO j=1, cS(i)%nBl 96 s = cS(i)%blPtr(j) 97 e = s + cS(i)%blN(j) - 1 98 rTmp(:,k:k+e-s) = R(:,s:e) 99 k = k + cS(i)%blN(j) 100 END DO 101 END DO 102 103 DO i=1, nTasks 104 IF (cS(i)%tag .NE. 0) THEN 105 s = cS(i)%ptr 106 e = s + cS(i)%n - 1 107 IF (i .GT. tF) THEN 108 CALL MPI_WAIT(cS(i)%req, stat, ierr) 109 CALL MPI_IRECV(R(:,s:e), cS(i)%n*dof, mpreal, i-1, 110 2 cS(i)%tag, comm, cS(i)%req, ierr) 111 ELSE 112 CALL MPI_ISEND(rTmp(:,s:e), cS(i)%n*dof, mpreal, i-1, 113 2 cS(i)%tag, comm, cS(i)%req, ierr) 114 END IF 115 END IF 116 END DO 117 118 DO i=1, nTasks 119 IF (cS(i)%tag .NE. 0) THEN 120 CALL MPI_WAIT(cS(i)%req, stat, ierr) 121 END IF 122 END DO 123 124 RETURN 125 END SUBROUTINE COMMUV 126 127!==================================================================== 128 129 SUBROUTINE COMMUS(nNo, commu, cS, R) 130 131 INCLUDE "svLS_STD.h" 132 133 INTEGER, INTENT(IN) :: nNo 134 TYPE(svLS_commuType), INTENT(IN) :: commu 135 TYPE(svLS_cSType), INTENT(IN) :: cS(commu%nTasks) 136 REAL*8, INTENT(INOUT) :: R(nNo) 137 138 INTEGER i, j, k, s, e, ierr, nTasks, tF, stat(MPI_STATUS_SIZE) 139 INTEGER comm 140 REAL*8, ALLOCATABLE :: rTmp(:) 141 142 IF (commu%nTasks .EQ. 1) RETURN 143 144 nTasks = commu%nTasks 145 tF = commu%tF 146 comm = commu%comm 147 148 IF (tF .NE. 1) THEN 149 i = tF - 1 150 i = cS(i)%ptr + cS(i)%n - 1 151 ALLOCATE(rTmp(i)) 152 END IF 153 154 DO i=1, nTasks 155 IF (cS(i)%tag .NE. 0) THEN 156 s = cS(i)%ptr 157 e = s + cS(i)%n - 1 158 IF (i .LT. tF) THEN 159 CALL MPI_IRECV(rTmp(s:e), cS(i)%n, mpreal, i-1, 160 2 cS(i)%tag, comm, cS(i)%req, ierr) 161 ELSE 162 CALL MPI_ISEND(R(s:e), cS(i)%n, mpreal, i-1, 163 2 cS(i)%tag, comm, cS(i)%req, ierr) 164 END IF 165 END IF 166 END DO 167 168 k = 1 169 DO i=1, tF - 1 170 IF (cS(i)%tag .NE. 0) THEN 171 CALL MPI_WAIT(cS(i)%req, stat, ierr) 172 DO j=1, cS(i)%nBl 173 s = cS(i)%blPtr(j) 174 e = s + cS(i)%blN(j) - 1 175 R(s:e) = R(s:e) + rTmp(k:k+e-s) 176 k = k + cS(i)%blN(j) 177 END DO 178 END IF 179 END DO 180 181 k = 1 182 DO i=1, tF - 1 183 DO j=1, cS(i)%nBl 184 s = cS(i)%blPtr(j) 185 e = s + cS(i)%blN(j) - 1 186 rTmp(k:k+e-s) = R(s:e) 187 k = k + cS(i)%blN(j) 188 END DO 189 END DO 190 191 DO i=1, nTasks 192 IF (cS(i)%tag .NE. 0) THEN 193 s = cS(i)%ptr 194 e = s + cS(i)%n - 1 195 IF (i .GT. tF) THEN 196 CALL MPI_WAIT(cS(i)%req, stat, ierr) 197 CALL MPI_IRECV(R(s:e), cS(i)%n, mpreal, i-1, 198 2 cS(i)%tag, comm, cS(i)%req, ierr) 199 ELSE 200 CALL MPI_ISEND(rTmp(s:e), cS(i)%n, mpreal, i-1, 201 2 cS(i)%tag, comm, cS(i)%req, ierr) 202 END IF 203 END IF 204 END DO 205 206 DO i=1, nTasks 207 IF (cS(i)%tag .NE. 0) THEN 208 CALL MPI_WAIT(cS(i)%req, stat, ierr) 209 END IF 210 END DO 211 212 RETURN 213 END SUBROUTINE COMMUS 214 215