subroutine ctypes (ilwork) parameter (maxseg = 30000) include "common.h" include "mpif.h" include "auxmpi.h" integer sizeofdouble,sizeofInt64 dimension ilwork(nlwork) dimension isbegin(maxseg), lenseg(maxseg), ioffset(maxseg) CALL MPI_TYPE_EXTENT (MPI_DOUBLE_PRECISION,sizeofdouble,ierr) lstride = nshg * sizeofdouble c c you would need the next two lines if you commu-ed vectors of integers c c CALL MPI_TYPE_EXTENT (MPI_LONG_LONG,sizeofInt64,ierr) c lstrideInt = nshg * sizeofInt64 c c.... maxfront is a common variable being set in this routine c maxfront = 0 numtask = ilwork (1) itkbeg = 1 if (numtask .gt. maxtask) & call error('ctypes ','numtask ',numtask) nshg0 = nshg do itask = 1,numtask c c.... iacc = 0 ==> this task is a send c = 1 ==> this task is a recieve c iacc = ilwork (itkbeg + 2) c c.... numseg : number of data segments to be communicated c numseg = ilwork (itkbeg + 4) c c.... adjust the number of the other processor, since processors c are numbered here starting from 0, not 1. c ilwork (itkbeg + 3) = ilwork (itkbeg + 3) - 1 if (numseg .gt. maxseg) & call error('ctypes ','numseg ',numseg ) c c.... lfront = total number of nodes involved in this task c lfront = 0 do is = 1,numseg c c.... isbegin(is): starting node number for each segment c isbegin (is) = ilwork (itkbeg + 3 + 2*is) c c.... lenseg(is): length of each segment (number of nodes) c lenseg (is) = ilwork (itkbeg + 4 + 2*is) c c.... increment the total node counter c lfront = lfront + lenseg(is) c c.... nshg0: number of nodes to be assembled on this processor, c i.e. subtract the number of nodes which will be c sent to another processor. c if (iacc .eq. 0) nshg0 = nshg0 - lenseg(is) enddo c c.... maxfront: number of nodes which will be communicated, including c all segments. Note that after the loop over tasks c is complete, maxfront will contain the maximum number c of nodes for any of the tasks. c maxfront = MAX(maxfront,lfront) c c.... ioffset: array offset from the first node in the first segment c ioffset(1:numseg) = isbegin(1:numseg) - isbegin(1) c c.... now set up the MPI data types which will be used in commu.f. c These data types represent the indexed sets that will be sent c and recieved. c c c.... the following call to MPI_TYPE_INDEXED will create a new data c type which will represent the blocks of data we wish to transfer c for this task. A handle to the new type is returned c (sevsegtype(itask,1)). This data type describes the blocks of c data to be transferred in terms of segments. c Input to this routine: c numseg: number of segments in this task c lenseg: length of each segment (number of nodes) c ioffset: where to begin each block with respect to the c first segment c MPI_DOUBLE_PRECISION: type to set for each of the blocks c call MPI_TYPE_INDEXED (numseg, lenseg, ioffset, & MPI_LONG_LONG_INT, sevsegtype(itask,16), ierr) call MPI_TYPE_INDEXED (numseg, lenseg, ioffset, & MPI_DOUBLE_PRECISION, sevsegtype(itask,1), ierr) c c.... now create a new data type for each of the types of arrays we c may wish to communicate with. For example ndof will be used when c communicating the residual vector. Each one of these is derived c from the first data type defined above, sevsegtype(itask,1). c call MPI_TYPE_HVECTOR(nsd, 1, lstride, sevsegtype(itask,1), & sevsegtype(itask,2), ierr) c call MPI_TYPE_HVECTOR(ndof, 1, lstride, sevsegtype(itask,1), & sevsegtype(itask,3), ierr) c call MPI_TYPE_HVECTOR(nflow*nflow,1, lstride, & sevsegtype(itask,1),sevsegtype(itask,4), ierr) call MPI_TYPE_HVECTOR((nflow-1)*nsd,1,lstride, & sevsegtype(itask,1),sevsegtype(itask,5), ierr) call MPI_TYPE_HVECTOR(nflow,1,lstride,sevsegtype(itask,1), & sevsegtype(itask,6), ierr) call MPI_TYPE_HVECTOR(24,1,lstride,sevsegtype(itask,1), & sevsegtype(itask,7), ierr) call MPI_TYPE_HVECTOR(9,1,lstride,sevsegtype(itask,1), & sevsegtype(itask,8), ierr) call MPI_TYPE_HVECTOR(11,1,lstride,sevsegtype(itask,1), & sevsegtype(itask,9), ierr) call MPI_TYPE_HVECTOR(7,1,lstride,sevsegtype(itask,1), & sevsegtype(itask,10), ierr) call MPI_TYPE_HVECTOR(33,1,lstride,sevsegtype(itask,1), & sevsegtype(itask,11), ierr) call MPI_TYPE_HVECTOR(22,1,lstride,sevsegtype(itask,1), & sevsegtype(itask,12), ierr) call MPI_TYPE_HVECTOR(16,1,lstride,sevsegtype(itask,1), & sevsegtype(itask,13), ierr) call MPI_TYPE_HVECTOR(10,1,lstride,sevsegtype(itask,1), & sevsegtype(itask,14), ierr) call MPI_TYPE_HVECTOR(nflow*nsd,1,lstride,sevsegtype(itask,1), & sevsegtype(itask,15), ierr) c c c.... now this must be done to make MPI recognize each of the data c types that were just defined c do kdof = 1,16 call MPI_TYPE_COMMIT (sevsegtype(itask,kdof), ierr) enddo c c.... set the counter to the index in ilwork where the next task c begins c itkbeg = itkbeg + 4 + 2*numseg c c.... end loop over tasks c enddo return end subroutine Dctypes(numtask) ! { include "auxmpi.h" integer numtask do itask = 1,numtask do kdof = 1,16 call MPI_TYPE_FREE(sevsegtype(itask,kdof), ierr) enddo enddo end !}