1 subroutine genblk (IBKSZ) 2c 3c---------------------------------------------------------------------- 4c 5c This routine reads the interior elements and generates the 6c appropriate blocks. 7c 8c Zdenek Johan, Fall 1991. 9c---------------------------------------------------------------------- 10c 11 use pointer_data 12c 13 include "common.h" 14c 15 integer, allocatable :: ientp(:,:) 16 integer mater(ibksz) 17 integer intfromfile(50) ! integers read from headers 18 character*255 fname1 19c 20 iel=1 21 itpblk=nelblk 22 23 nelblk=0 24 mattyp = 0 25 ndofl = ndof 26 nsymdl = nsymdf 27 do iblk = 1, itpblk 28c 29c read(igeom) neltp,nenl,ipordl,nshl, ijunk, ijunk, lcsyst 30 iseven=7 31c call creadlist(igeom,iseven, 32c & neltp,nenl,ipordl,nshl, ijunk, ijunk, lcsyst) 33 iseven=7 34 fname1='connectivity interior?' 35 call readheader(igeom,fname1,intfromfile,iseven, 36 & "integer", iotype) 37 neltp =intfromfile(1) 38 nenl =intfromfile(2) 39 ipordl =intfromfile(3) 40 nshl =intfromfile(4) 41 ijunk =intfromfile(5) 42 ijunk =intfromfile(6) 43 lcsyst =intfromfile(7) 44 allocate (ientp(neltp,nshl)) 45c read(igeom) ientp 46 iientpsiz=neltp*nshl 47 call readdatablock(igeom,fname1,ientp,iientpsiz, 48 & "integer", iotype) 49 50 do n=1,neltp,ibksz 51 52 nelblk=nelblk+1 53 npro= min(IBKSZ, neltp - n + 1) 54c 55 lcblk(1,nelblk) = iel 56c lcblk(2,nelblk) = iopen ! available for later use 57 lcblk(3,nelblk) = lcsyst 58 lcblk(4,nelblk) = ipordl 59 lcblk(5,nelblk) = nenl 60 lcblk(6,nelblk) = nfacel 61 lcblk(7,nelblk) = mattyp 62 lcblk(8,nelblk) = ndofl 63 lcblk(9,nelblk) = nsymdl 64 lcblk(10,nelblk) = nshl ! # of shape functions per elt 65c 66c.... allocate memory for stack arrays 67c 68 allocate (mmat(nelblk)%p(npro)) 69c 70 allocate (mien(nelblk)%p(npro,nshl)) 71 allocate (mxmudmi(nelblk)%p(npro,maxsh)) 72c 73c.... save the element block 74c 75 n1=n 76 n2=n+npro-1 77 mater=1 ! all one material for now 78 call gensav (ientp(n1:n2,1:nshl), 79 & mater, mien(nelblk)%p, 80 & mmat(nelblk)%p) 81 iel=iel+npro 82c 83 enddo 84 deallocate(ientp) 85 enddo 86 lcblk(1,nelblk+1) = iel 87c 88c.... return 89c 90CAD call timer ('Back ') 91c 92 return 93c 941000 format(a80,//, 95 & ' N o d a l C o n n e c t i v i t y',//, 96 & ' Elem ',/, 97 & ' Number ',7x,27('Node',i2,:,2x)) 981100 format(2x,i5,6x,27i8) 99 end 100