1!$Id:$ 2 subroutine blktem(ndm,t,prt,prth) 3 4! * * F E A P * * A Finite Element Analysis Program 5 6!.... Copyright (c) 1984-2017: Regents of the University of California 7! All rights reserved 8 9!-----[--.----+----.----+----.-----------------------------------------] 10! Purpose: Generate block of nodal temperatures in 't' array. 11 12! Inputs: 13! ndm - Space dimension of mesh 14! prt - Print generated data if true 15! prth - Print headers if true 16 17! Outputs: 18! t(*) - Generated temperatures on block 19!-----[--.----+----.----+----.-----------------------------------------] 20 implicit none 21 22 include 'cdata.h' 23 include 'iofile.h' 24 25 logical prt,prth, errck, pinput 26 integer ndm,l,n,nn,nr,ns,nt,ni,nm,ng,nodinc 27 real*8 dr,ds,dt 28 integer ixl(27) 29 real*8 t(*),tl(27),td(7) 30 31 save 32 33! Block mesh generation routine 34 35100 if(ior.lt.0) write(*,1000) 36 errck = pinput(td,7) 37 if(errck) go to 100 38 nn = nint(td(1)) 39 nr = nint(td(2)) 40 ns = nint(td(3)) 41 nt = nint(td(4)) 42 ni = nint(td(5)) 43 nodinc = nint(td(6)) 44 45! 2-d generations 46 47 if(ndm.lt.3) then 48 nt = 1 49 endif 50 51! Reset to default values if necessary 52 53 nodinc = max(nodinc,0) 54 nr = max(nr,1) 55 ns = max(ns,1) 56 nt = max(nt,1) 57 ni = max(ni,1) 58 if(prt) then 59 call prtitl(prth) 60 write(iow,2000) nr,ns,nt,ni,nodinc 61 write(iow,2002) 62 if(ior.lt.0) then 63 write(*,2000) nr,ns,nt,ni,nodinc 64 write(*,2002) 65 endif 66 endif 67 do n = 1,27 68 tl(n) = 0.0 69 ixl(n) = 0 70 end do 71 nm = 0 72 do n = 1,nn 7321 if(ior.lt.0) write(*,1001) 74 errck = pinput(td,2) 75 if(errck) go to 21 76 l = nint(td(1)) 77 if(l.eq.0) l = n 78 nm = max0(nm,l) 79 ixl(l) = l 80 tl(l) = td(2) 81 if(prt.and.ior.gt.0) write(iow,2001) l,tl(l) 82 if(prt.and.ior.lt.0) write(*,2001) l,tl(l) 83 end do 84 85! Set generation increments of natural coordinates 86 87 dr = 2.d0/nr 88 ds = 2.d0/ns 89 dt = 2.d0/nt 90 nr = nr + 1 91 ns = ns + 1 92 93! Determine last node number to be generated 94 95 if(ndm.lt.3) then 96 if(ndm.eq.1) ns = 1 97 ng = nr*ns + ni -1 98 else 99 nt = nt + 1 100 ng = nr*ns*nt + ni -1 101 endif 102 if(ng.gt.numnp) go to 400 103 104! Form block of temperatures 105 106 call tblk(nr,ns,nt,tl,t,ixl,dr,ds,dt,ni,ndm,nodinc,nm,prt,prth) 107 return 108 109! Error messages 110 111400 if(ior.gt.0) write(iow,3001) ng,numnp 112 if(ior.lt.0) write( *,3001) ng,numnp 113 114! Input prompts 115 1161000 format(' Input: nn,nr,ns,nt,ni,nodinc'/3x,'>',$) 1171001 format(' Input: node, Temp'/3x,'>',$) 118 119! Output Formats 120 1212000 format(' T e m p e r a t u r e G e n e r a t i o n s'// 122 & 10x,'Number of r-increments ',i5/ 123 & 10x,'Number of s-increments ',i5/ 124 & 10x,'Number of t-increments ',i5/ 125 & 10x,'First node number ',i5/ 126 & 10x,'Node line increment ',i5/1x) 1272001 format(i9,1p,3e12.3) 1282002 format(5x,'node',6x,' Temp.') 129 130! Error format 131 1323001 format(' *ERROR* Insufficient storage for temperatures'/ 133 1 10x,'final node =',i5,5x,'numnp =',i5) 134 135 end 136