1 subroutine ctypes (ilwork) 2 3 parameter (maxseg = 30000) 4 5 include "common.h" 6 include "mpif.h" 7 include "auxmpi.h" 8 9 integer sizeofdouble 10 11 dimension ilwork(nlwork) 12 dimension isbegin(maxseg), lenseg(maxseg), ioffset(maxseg) 13 14 CALL MPI_TYPE_EXTENT (MPI_DOUBLE_PRECISION,sizeofdouble,ierr) 15 lstride = nshg * sizeofdouble 16c 17c.... maxfront is a common variable being set in this routine 18c 19 maxfront = 0 20 numtask = ilwork (1) 21 itkbeg = 1 22 23 if (numtask .gt. maxtask) 24 & call error('ctypes ','numtask ',numtask) 25 26 nshg0 = nshg 27 28 do itask = 1,numtask 29c 30c.... iacc = 0 ==> this task is a send 31c = 1 ==> this task is a recieve 32c 33 iacc = ilwork (itkbeg + 2) 34c 35c.... numseg : number of data segments to be communicated 36c 37 numseg = ilwork (itkbeg + 4) 38c 39c.... adjust the number of the other processor, since processors 40c are numbered here starting from 0, not 1. 41c 42 ilwork (itkbeg + 3) = ilwork (itkbeg + 3) - 1 43 if (numseg .gt. maxseg) 44 & call error('ctypes ','numseg ',numseg ) 45c 46c.... lfront = total number of nodes involved in this task 47c 48 lfront = 0 49 do is = 1,numseg 50c 51c.... isbegin(is): starting node number for each segment 52c 53 isbegin (is) = ilwork (itkbeg + 3 + 2*is) 54c 55c.... lenseg(is): length of each segment (number of nodes) 56c 57 lenseg (is) = ilwork (itkbeg + 4 + 2*is) 58c 59c.... increment the total node counter 60c 61 lfront = lfront + lenseg(is) 62c 63c.... nshg0: number of nodes to be assembled on this processor, 64c i.e. subtract the number of nodes which will be 65c sent to another processor. 66c 67 if (iacc .eq. 0) nshg0 = nshg0 - lenseg(is) 68 enddo 69c 70c.... maxfront: number of nodes which will be communicated, including 71c all segments. Note that after the loop over tasks 72c is complete, maxfront will contain the maximum number 73c of nodes for any of the tasks. 74c 75 maxfront = MAX(maxfront,lfront) 76c 77c.... ioffset: array offset from the first node in the first segment 78c 79 ioffset(1:numseg) = isbegin(1:numseg) - isbegin(1) 80c 81c.... now set up the MPI data types which will be used in commu.f. 82c These data types represent the indexed sets that will be sent 83c and recieved. 84c 85c 86c.... the following call to MPI_TYPE_INDEXED will create a new data 87c type which will represent the blocks of data we wish to transfer 88c for this task. A handle to the new type is returned 89c (sevsegtype(itask,1)). This data type describes the blocks of 90c data to be transferred in terms of segments. 91c Input to this routine: 92c numseg: number of segments in this task 93c lenseg: length of each segment (number of nodes) 94c ioffset: where to begin each block with respect to the 95c first segment 96c MPI_DOUBLE_PRECISION: type to set for each of the blocks 97c 98 call MPI_TYPE_INDEXED (numseg, lenseg, ioffset, 99 & MPI_DOUBLE_PRECISION, sevsegtype(itask,1), ierr) 100c 101c.... now create a new data type for each of the types of arrays we 102c may wish to communicate with. For example ndof will be used when 103c communicating the residual vector. Each one of these is derived 104c from the first data type defined above, sevsegtype(itask,1). 105c 106 call MPI_TYPE_HVECTOR(nsd, 1, lstride, sevsegtype(itask,1), 107 & sevsegtype(itask,2), ierr) 108c 109 call MPI_TYPE_HVECTOR(ndof, 1, lstride, sevsegtype(itask,1), 110 & sevsegtype(itask,3), ierr) 111c 112 call MPI_TYPE_HVECTOR(nflow*nflow,1, lstride, 113 & sevsegtype(itask,1),sevsegtype(itask,4), ierr) 114 call MPI_TYPE_HVECTOR((nflow-1)*nsd,1,lstride, 115 & sevsegtype(itask,1),sevsegtype(itask,5), ierr) 116 call MPI_TYPE_HVECTOR(nflow,1,lstride,sevsegtype(itask,1), 117 & sevsegtype(itask,6), ierr) 118 call MPI_TYPE_HVECTOR(24,1,lstride,sevsegtype(itask,1), 119 & sevsegtype(itask,7), ierr) 120 call MPI_TYPE_HVECTOR(9,1,lstride,sevsegtype(itask,1), 121 & sevsegtype(itask,8), ierr) 122 call MPI_TYPE_HVECTOR(11,1,lstride,sevsegtype(itask,1), 123 & sevsegtype(itask,9), ierr) 124 call MPI_TYPE_HVECTOR(7,1,lstride,sevsegtype(itask,1), 125 & sevsegtype(itask,10), ierr) 126 call MPI_TYPE_HVECTOR(33,1,lstride,sevsegtype(itask,1), 127 & sevsegtype(itask,11), ierr) 128 call MPI_TYPE_HVECTOR(22,1,lstride,sevsegtype(itask,1), 129 & sevsegtype(itask,12), ierr) 130 call MPI_TYPE_HVECTOR(16,1,lstride,sevsegtype(itask,1), 131 & sevsegtype(itask,13), ierr) 132 call MPI_TYPE_HVECTOR(10,1,lstride,sevsegtype(itask,1), 133 & sevsegtype(itask,14), ierr) 134 call MPI_TYPE_HVECTOR(nflow*nsd,1,lstride,sevsegtype(itask,1), 135 & sevsegtype(itask,15), ierr) 136c 137c 138c.... now this must be done to make MPI recognize each of the data 139c types that were just defined 140c 141 do kdof = 1,15 142 call MPI_TYPE_COMMIT (sevsegtype(itask,kdof), ierr) 143 enddo 144c 145c.... set the counter to the index in ilwork where the next task 146c begins 147c 148 149 itkbeg = itkbeg + 4 + 2*numseg 150c 151c.... end loop over tasks 152c 153 enddo 154 155 return 156 end 157 158 subroutine Dctypes(numtask) ! { 159 include "auxmpi.h" 160 integer numtask 161 do itask = 1,numtask 162 do kdof = 1,15 163 call MPI_TYPE_FREE(sevsegtype(itask,kdof), ierr) 164 enddo 165 enddo 166 end !} 167