Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
createK.f90
Go to the documentation of this file.
1 !*********************************************************************
2 !* Illinois Open Source License *
3 !* *
4 !* University of Illinois/NCSA *
5 !* Open Source License *
6 !* *
7 !* Copyright@2008, University of Illinois. All rights reserved. *
8 !* *
9 !* Developed by: *
10 !* *
11 !* Center for Simulation of Advanced Rockets *
12 !* *
13 !* University of Illinois *
14 !* *
15 !* www.csar.uiuc.edu *
16 !* *
17 !* Permission is hereby granted, free of charge, to any person *
18 !* obtaining a copy of this software and associated documentation *
19 !* files (the "Software"), to deal with the Software without *
20 !* restriction, including without limitation the rights to use, *
21 !* copy, modify, merge, publish, distribute, sublicense, and/or *
22 !* sell copies of the Software, and to permit persons to whom the *
23 !* Software is furnished to do so, subject to the following *
24 !* conditions: *
25 !* *
26 !* *
27 !* @ Redistributions of source code must retain the above copyright *
28 !* notice, this list of conditions and the following disclaimers. *
29 !* *
30 !* @ Redistributions in binary form must reproduce the above *
31 !* copyright notice, this list of conditions and the following *
32 !* disclaimers in the documentation and/or other materials *
33 !* provided with the distribution. *
34 !* *
35 !* @ Neither the names of the Center for Simulation of Advanced *
36 !* Rockets, the University of Illinois, nor the names of its *
37 !* contributors may be used to endorse or promote products derived *
38 !* from this Software without specific prior written permission. *
39 !* *
40 !* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *
41 !* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES *
42 !* OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *
43 !* NONINFRINGEMENT. IN NO EVENT SHALL THE CONTRIBUTORS OR *
44 !* COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *
45 !* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, *
46 !* ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE *
47 !* USE OR OTHER DEALINGS WITH THE SOFTWARE. *
48 !*********************************************************************
49 !* Please acknowledge The University of Illinois Center for *
50 !* Simulation of Advanced Rockets in works and publications *
51 !* resulting from this software or its derivatives. *
52 !*********************************************************************
53 SUBROUTINE createk(global)
54 
55  USE implicit_global
56  USE comp_row_global
57  USE rocstar_rocfraccomm
58 
59  IMPLICIT NONE
60 
61  include 'mpif.h'
62 
63  TYPE int_buf
64  INTEGER, DIMENSION(:), POINTER :: rcvbuf
65  END TYPE int_buf
66 
67  TYPE(rocfrac_global) :: global
68  INTEGER :: i, j, m, p, idof, jdof, inode, jnode, counter
69  REAL(kind=wp) :: tempkval
70  INTEGER, ALLOCATABLE, DIMENSION(:) :: amounttoreceive, amounttosend
71  REAL(kind=wp), ALLOCATABLE, DIMENSION(:) :: bufsnd
72  TYPE(int_buf), ALLOCATABLE, DIMENSION(:) :: ki, kj
73 
74 
75  ! Construct the global stiffness matrix
76  IF(myid==0) print*,'CONSTRUCTING THE STIFFNESS MATRIX'
77 ! CALL implicit_v3d8_me_K(global%MeshCoor, global%ElConnVol, global%ci, global%NumNp, 1, global%NumElVol, &
78 ! global%NumElVol, global%MatIdVol, global%NumMatVol, global%enhanced_map, global%mixed_map, &
79 ! global%NumMatVol)
80  CALL implicit_v3d8_me_k(global%MeshCoor, global%ElConnVol, global%ci_full, global%NumNp, 1, global%NumElVol, &
81  global%NumElVol, global%MatIdVol, global%NumMatVol, global%enhanced_map, global%mixed_map, &
82  global%NumMatVol)
83  ALLOCATE(rp_k(1:3*gnumnp+1))
84  ALLOCATE(cval_k(1:nnz_temp))
85  ALLOCATE(aval_k(1:nnz_temp))
86  nnz_k = nnz_temp
87  rp_k = rp_temp
88  cval_k = cval_temp
89  aval_k = aval_temp
90  DEALLOCATE(rp_temp,cval_temp,aval_temp)
91 
92  ! Communicate the K matrix to other procs
93  IF (nprocs > 1) THEN
94  CALL mpi_barrier(rocstar_communicator,ierr)
95  ALLOCATE(req_rcv(1:nprocs))
96  ALLOCATE(req_snd(1:nprocs))
97  ALLOCATE(stat_snd(1:mpi_status_size,1:nprocs))
98  ALLOCATE(stat_rcv(1:mpi_status_size,1:nprocs))
99  DO i = 1, nprocs
100  req_rcv(i) = 0
101  req_snd(i) = 0
102  DO j = 1, mpi_status_size
103  stat_rcv(1,i) = 0
104  stat_snd(j,i) = 0
105  ENDDO
106  ENDDO
107  ALLOCATE(amounttoreceive(1:numcommprocsfrom1))
108  DO i = 1, numcommprocsfrom1
109  CALL mpi_irecv(amounttoreceive(i),1, &
110  mpi_integer,commprocsfrom1(i),10,rocstar_communicator, &
111  req_rcv(i),ierr)
112  ENDDO
113  ALLOCATE(amounttosend(1:numcommprocs1))
114  DO i = 1, numcommprocs1
115  counter = 0
116  DO j = 1, numcommnodes1(i)
117  DO p = 1, 3
118  DO m = 1, 3*gnumnp
119  tempkval = 0.0
120  inode = local2global(commnodes1(i,j))
121  jnode = int((m-0.5)/3)+1
122  idof = p
123  jdof = m - 3*jnode + 3
124  CALL comp_row_getval(3*gnumnp,3*gnumnp,nnz_k,1,rp_k,cval_k,aval_k, &
125  inode*3-3+idof,jnode*3-3+jdof,tempkval)
126  IF (tempkval /= 0.0) THEN
127  counter = counter + 1
128  !print*,myid,Global2Local(inode)*3-3+idof,Global2Local(jnode)*3-3+jdof,tempKval
129  ENDIF
130  ENDDO
131  ENDDO
132  !print*,myid,' sending stuff about node ',Local2Global(CommNodes1(i,j)), &
133  !' to ',CommProcs1(i),' : ',counter
134  ENDDO
135  amounttosend(i) = counter
136  !CALL MPI_ISEND(AmountToSend(i),1,MPI_INTEGER, &
137  ! CommProcs1(i),10,ROCSTAR_COMMUNICATOR,req_snd(i),ierr)
138  CALL mpi_send(amounttosend(i),1,mpi_integer, &
139  commprocs1(i),10,rocstar_communicator,ierr)
140  ENDDO
141  !CALL MPI_WAITALL(NumCommProcsFrom1,req_rcv,stat_rcv,ierr)
142  !CALL MPI_WAITALL(NumCommProcs1,req_snd,stat_snd,ierr)
143  CALL mpi_waitall(nprocs,req_rcv,stat_rcv,ierr)
144  !CALL MPI_WAITALL(nprocs,req_snd,stat_snd,ierr)
145 
146 
147  ! Communicate i locations of nonzeros in K matrix to other procs
148  CALL mpi_barrier(rocstar_communicator,ierr)
149  ALLOCATE(ki(1:numcommprocsfrom1))
150  DO i = 1, numcommprocsfrom1
151  ALLOCATE(ki(i)%rcvbuf(1:amounttoreceive(i)))
152  CALL mpi_irecv(ki(i)%rcvbuf(1),amounttoreceive(i), &
153  mpi_integer,commprocsfrom1(i),10,rocstar_communicator, &
154  req_rcv(i),ierr)
155  ENDDO
156  DO i = 1, numcommprocs1
157  ALLOCATE(bufsnd(1:amounttosend(i)))
158  counter = 0
159  DO j = 1, numcommnodes1(i)
160  DO p = 1, 3
161  DO m = 1, 3*gnumnp
162  tempkval = 0.0
163  inode = local2global(commnodes1(i,j))
164  jnode = int((m-0.5)/3)+1
165  idof = p
166  jdof = m - 3*jnode + 3
167  CALL comp_row_getval(3*gnumnp,3*gnumnp,nnz_k,1,rp_k,cval_k,aval_k, &
168  inode*3-3+idof,jnode*3-3+jdof,tempkval)
169  IF (tempkval /= 0.0) THEN
170  counter = counter + 1
171  bufsnd(counter) = local2global(commnodes1(i,j))*3-3+p
172  ENDIF
173  ENDDO
174  ENDDO
175  ENDDO
176  !CALL MPI_ISEND(INT(bufsnd(:)),AmountToSend(i),MPI_INTEGER, &
177  ! CommProcs1(i),10,ROCSTAR_COMMUNICATOR,req_snd(i),ierr)
178  CALL mpi_send(int(bufsnd(:)),amounttosend(i),mpi_integer, &
179  commprocs1(i),10,rocstar_communicator,ierr)
180  DEALLOCATE(bufsnd)
181  ENDDO
182  CALL mpi_waitall(nprocs,req_rcv,stat_rcv,ierr)
183  !CALL MPI_WAITALL(nprocs,req_snd,stat_snd,ierr)
184 
185  ! Communicate j locations of nonzeros in K matrix to other procs
186  CALL mpi_barrier(rocstar_communicator,ierr)
187  ALLOCATE(kj(1:numcommprocsfrom1))
188  DO i = 1, numcommprocsfrom1
189  ALLOCATE(kj(i)%rcvbuf(1:amounttoreceive(i)))
190  CALL mpi_irecv(kj(i)%rcvbuf(1),amounttoreceive(i), &
191  mpi_integer,commprocsfrom1(i),10,rocstar_communicator, &
192  req_rcv(i),ierr)
193  ENDDO
194  DO i = 1, numcommprocs1
195  ALLOCATE(bufsnd(1:amounttosend(i)))
196  counter = 0
197  DO j = 1, numcommnodes1(i)
198  DO p = 1, 3
199  DO m = 1, 3*gnumnp
200  tempkval = 0.0
201  inode = local2global(commnodes1(i,j))
202  jnode = int((m-0.5)/3)+1
203  idof = p
204  jdof = m - 3*jnode + 3
205  CALL comp_row_getval(3*gnumnp,3*gnumnp,nnz_k,1,rp_k,cval_k,aval_k, &
206  inode*3-3+idof,jnode*3-3+jdof,tempkval)
207  IF (tempkval /= 0.0) THEN
208  counter = counter + 1
209  bufsnd(counter) = m
210  ENDIF
211  ENDDO
212  ENDDO
213  ENDDO
214  !CALL MPI_ISEND(INT(bufsnd(:)),AmountToSend(i),MPI_INTEGER, &
215  ! CommProcs1(i),10,ROCSTAR_COMMUNICATOR,req_snd(i),ierr)
216  CALL mpi_send(int(bufsnd(:)),amounttosend(i),mpi_integer, &
217  commprocs1(i),10,rocstar_communicator,ierr)
218  DEALLOCATE(bufsnd)
219  ENDDO
220  CALL mpi_waitall(nprocs,req_rcv,stat_rcv,ierr)
221  !CALL MPI_WAITALL(nprocs,req_snd,stat_snd,ierr)
222 
223  ! Communicate values of nonzeros in K matrix to other procs
224  CALL mpi_barrier(rocstar_communicator,ierr)
225  ALLOCATE(frmproc(1:numcommprocsfrom1))
226  DO i = 1, numcommprocsfrom1
227  ALLOCATE(frmproc(i)%rcvbuf(1:amounttoreceive(i)))
228  CALL mpi_irecv(frmproc(i)%rcvbuf(1),amounttoreceive(i), &
229  mpi_double_precision,commprocsfrom1(i),10,rocstar_communicator, &
230  req_rcv(i),ierr)
231  ENDDO
232  DO i = 1, numcommprocs1
233  ALLOCATE(bufsnd(1:amounttosend(i)))
234  counter = 0
235  DO j = 1, numcommnodes1(i)
236  DO p = 1, 3
237  DO m = 1, 3*gnumnp
238  tempkval = 0.0
239  inode = local2global(commnodes1(i,j))
240  jnode = int((m-0.5)/3)+1
241  idof = p
242  jdof = m - 3*jnode + 3
243  CALL comp_row_getval(3*gnumnp,3*gnumnp,nnz_k,1,rp_k,cval_k,aval_k, &
244  inode*3-3+idof,jnode*3-3+jdof,tempkval)
245  IF (tempkval /= 0.0) THEN
246  counter = counter + 1
247  bufsnd(counter) = tempkval
248  ENDIF
249  ENDDO
250  ENDDO
251  ENDDO
252  !CALL MPI_ISEND(bufsnd,AmountToSend(i),MPI_DOUBLE_PRECISION, &
253  ! CommProcs1(i),10,ROCSTAR_COMMUNICATOR,req_snd(i),ierr)
254  CALL mpi_send(bufsnd,amounttosend(i),mpi_double_precision, &
255  commprocs1(i),10,rocstar_communicator,ierr)
256  DEALLOCATE(bufsnd)
257  ENDDO
258  CALL mpi_waitall(nprocs,req_rcv,stat_rcv,ierr)
259  !CALL MPI_WAITALL(nprocs,req_snd,stat_snd,ierr)
260 
261  DEALLOCATE(req_rcv)
262  DEALLOCATE(req_snd)
263  DEALLOCATE(stat_snd)
264  DEALLOCATE(stat_rcv)
265 
266  ENDIF
267 
268  CALL comp_row_resize(3*gnumnp,3*gnumnp,nnz_k,1,rp_k,cval_k,aval_k,nstart_km,nrows_km)
269  DEALLOCATE(rp_k,cval_k,aval_k)
270  ALLOCATE(rp_k(1:nrows_km+1))
271  ALLOCATE(cval_k(1:nnz_temp))
272  ALLOCATE(aval_k(1:nnz_temp))
273  nnz_k = nnz_temp
274  rp_k = rp_temp
275  cval_k = cval_temp
276  aval_k = aval_temp
277  DEALLOCATE(rp_temp,cval_temp,aval_temp)
278 
279 
280  IF (nprocs > 1) THEN
281  DO i = 1, numcommprocsfrom1
282  !print*,myid,' received from ',CommProcsFrom1(i), ' : ',frmproc(i)%rcvbuf(:)
283  DO j = 1, amounttoreceive(i)
284  CALL comp_row_addval(3*gnumnp,nrows_km,nnz_k,nstart_km,rp_k,cval_k,aval_k, &
285  ki(i)%rcvbuf(j),kj(i)%rcvbuf(j),frmproc(i)%rcvbuf(j))
286  IF (nnz_temp /= nnz_k) THEN
287  DEALLOCATE(cval_k,aval_k)
288  ALLOCATE(cval_k(nnz_temp),aval_k(nnz_temp))
289  nnz_k = nnz_temp
290  rp_k = rp_temp
291  ENDIF
292  cval_k = cval_temp
293  aval_k = aval_temp
294  DEALLOCATE(rp_temp,cval_temp,aval_temp)
295  ENDDO
296  ENDDO
297  DEALLOCATE(frmproc)
298  DEALLOCATE(ki)
299  DEALLOCATE(kj)
300  ENDIF
301 
302 END SUBROUTINE createk
303 
304 
305 ! LocalWords: RocFracComm
rocstar_rocfraccomm
Definition: ROCSTAR_RocFracComm.f90:53
Aff_transformation_2::m
FT m(int i, int j) const
Definition: Aff_transformation_2.h:228
comp_row_global
Definition: comp_row_global.f90:26
inode
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com WITHOUT WARRANTY OF ANY **EXPRESS OR INCLUDING BUT NOT LIMITED TO THE WARRANTIES **OF FITNESS FOR A PARTICULAR PURPOSE AND **NONINFRINGEMENT IN NO EVENT SHALL THE CONTRIBUTORS OR **COPYRIGHT HOLDERS BE LIABLE FOR ANY DAMAGES OR OTHER WHETHER IN AN ACTION OF TORT OR **Arising OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE **USE OR OTHER DEALINGS WITH THE SOFTWARE **********************************************************************INTERFACE SUBROUTINE inode
Definition: RFLO_CalcGradDummySymm.h:32
createk
subroutine createk(global)
Definition: createK.f90:53
implicit_global
Definition: implicit_global.f90:76
comp_row_getval
subroutine comp_row_getval(ndim, nrows, nnz, nstart, rp, cval, aval, ipos, jpos, val)
Definition: comp_row_support.f90:511
comp_row_resize
subroutine comp_row_resize(ndim, nrows, nnz, nstart, rp, cval, aval, newnstart, newnrows)
Definition: comp_row_support.f90:592
i
blockLoc i
Definition: read.cpp:79
rocstar_rocfrac::rocfrac_global
Definition: ROCSTAR_RocFrac.f90:80
Aff_transformation_repS2::print
virtual std::ostream & print(std::ostream &os) const
Definition: Aff_transformationS2.h:277
j
j indices j
Definition: Indexing.h:6
implicit_v3d8_me_k
subroutine implicit_v3d8_me_k(coor, ElConnVol, ci, numnp, nstart, nend, NumEL, MatType, NumMatType, enhanced_map, mixed_map, NumMatVol)
Definition: implicit_v3d8_me_K.f90:84
jnode
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com WITHOUT WARRANTY OF ANY **EXPRESS OR INCLUDING BUT NOT LIMITED TO THE WARRANTIES **OF FITNESS FOR A PARTICULAR PURPOSE AND **NONINFRINGEMENT IN NO EVENT SHALL THE CONTRIBUTORS OR **COPYRIGHT HOLDERS BE LIABLE FOR ANY DAMAGES OR OTHER WHETHER IN AN ACTION OF TORT OR **Arising OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE **USE OR OTHER DEALINGS WITH THE SOFTWARE **********************************************************************INTERFACE SUBROUTINE jnode
Definition: RFLO_CalcGradDummySymm.h:32
int_buf
Definition: fractography3d.f90:112
comp_row_addval
subroutine comp_row_addval(ndim, nrows, nnz, nstart, rp, cval, aval, ipos, jpos, val)
Definition: comp_row_support.f90:410