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