FrontISTR  5.2.0
Large-scale structural analysis program with finit element method
heat_LIB_NEUTRAL.f90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
2 ! Copyright (c) 2019 FrontISTR Commons
3 ! This software is released under the MIT License, see LICENSE.txt
4 !-------------------------------------------------------------------------------
7 contains
8 
9  !----------------------------------------------------------------------
10  ! heat_put_neutral_601 ( hecMESH ) l
11  ! heat_put_neutral_402 ( hecMESH ) l
12  ! heat_put_neutral_403 ( hecMESH ) l
13  ! heat_put_neutral_404 ( hecMESH ) l
14  ! heat_put_neutral_409 ( hecMESH ) l
15  ! heat_put_neutral_450 ( hecMESH ) l
16  ! heat_put_neutral_451 ( hecMESH ) l
17  !----------------------------------------------------------------------
18  subroutine heat_put_neutral_601 ( hecMESH )
19 
20  use m_fstr
21 
22  implicit real(kind=kreal) (a - h, o - z)
23  dimension rdum(0:9)
24  character(len=80) :: line
25 
26  type(hecmwst_local_mesh) :: hecMESH
27 
28  cp = 0.0d0
29  cd = 0.0d0
30  rho = 0.0d0
31 
32  !C
33  !C==put MATERIAL : ( BLOCK NO. = 601 )
34  !C
35  write(ineu,'(a)') ' -1'
36  write(ineu,*) ' 601'
37 
38  icou = 0
39  do im1 = 1, hecmesh%material%n_mat
40  line = ' '
41  line(7:23) = ',-601,55,0,0,1,0,'
42  write(line(1:6),'(i6)') im1
43  write(ineu,'(a23)') line(1:23)
44  write(ineu,*) '<NULL>'
45  write(ineu,*) '10,'
46  write(ineu,*) '0,0,0,0,0,0,0,0,0,0,'
47  write(ineu,*) '25,'
48  write(ineu,*) '0,0,0,0,0,0,0,0,0,0,'
49  write(ineu,*) '0,0,0,0,0,0,0,0,0,0,'
50  write(ineu,*) '0,0,0,0,0,'
51  write(ineu,*) '200,'
52 
53  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
54  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
55  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
56  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
57 
58  do im2= 1, 3
59  icou = icou + 1
60  is= hecmesh%material%mat_TABLE_index(icou -1) + 1
61  val = hecmesh%material%mat_VAL (is)
62 
63  if (im2.eq.3) cd = val
64  if (im2.eq.2) cp = val
65  if (im2.eq.1) rho = val
66  enddo
67 
68  rdum( 0) = 0.d0
69  rdum( 1) = 0.d0
70  rdum( 2) = cd
71  rdum( 3) = cd
72  rdum( 4) = cd
73  rdum( 5) = cd
74  rdum( 6) = cd
75  rdum( 7) = cd
76  rdum( 8) = cp
77  rdum( 9) = rho
78 
79  write(ineu,'(1p,10(E9.2,'',''))') ( rdum(i),i=0,9 )
80 
81  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
82  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
83  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
84  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
85  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
86  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
87  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
88  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
89  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
90  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
91  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
92  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
93  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
94  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
95  write(ineu,*) '0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,'
96  write(ineu,*) '50,'
97  write(ineu,*) '0,0,0,0,0,0,0,0,0,0,'
98  write(ineu,*) '0,0,0,0,0,0,0,0,0,0,'
99  write(ineu,*) '0,0,0,0,0,0,0,0,0,0,'
100  write(ineu,*) '0,0,0,0,0,0,0,0,0,0,'
101  write(ineu,*) '0,0,0,0,0,0,0,0,0,0,'
102  write(ineu,*) '70,'
103  write(ineu,*) '0,0,0,0,0,0,0,0,0,0,'
104  write(ineu,*) '0,0,0,0,0,0,0,0,0,0,'
105  write(ineu,*) '0,0,0,0,0,0,0,0,0,0,'
106  write(ineu,*) '0,0,0,0,0,0,0,0,0,0,'
107  write(ineu,*) '0,0,0,0,0,0,0,0,0,0,'
108  write(ineu,*) '0,0,0,0,0,0,0,0,0,0,'
109  write(ineu,*) '0,0,0,0,0,0,0,0,0,0,'
110 
111  enddo
112  write(ineu,'(a)') ' -1'
113 
114  return
115  end subroutine heat_put_neutral_601
116 
117  !----------------------------------------------------------------------
118 
119  !C
120  subroutine heat_put_neutral_402 ( hecMESH )
121 
122  use m_fstr
123 
124  implicit real(kind=kreal) (a - h, o - z)
125  dimension idum(0:9)
126 
127  type(hecmwst_local_mesh) :: hecMESH
128 
129  !C
130  !C==put Section : ( BLOCK NO. = 402 )
131  !C
132  write(ineu,'(a)') ' -1'
133  write(ineu,*) ' 402'
134 
135  do im = 1, hecmesh%section%n_sect
136  idum(0) = im
137  idum(1) = 110
138  idum(2) = hecmesh%section%sect_mat_ID_item(im)
139  if ( hecmesh%section%sect_type(im) == 1 ) then
140  idum(3) = 25
141  elseif( hecmesh%section%sect_type(im) == 2 ) then
142  idum(3) = 17
143  elseif( hecmesh%section%sect_type(im) == 3 ) then
144  idum(3) = 5
145  elseif( hecmesh%section%sect_type(im) == 4 ) then
146  idum(3) = 9
147  endif
148  idum(4) = 1
149  idum(5) = 0
150 
151  write(ineu,'(6(i6,'',''))') ( idum(i),i=0,5 )
152  write(ineu,*) '<NULL>'
153  write(ineu,*) '0,0,0,0,'
154  write(ineu,*) '90,'
155  write(ineu,*) '0,0,0,0,0,0,0,0,'
156  write(ineu,*) '0,0,0,0,0,0,0,0,'
157  write(ineu,*) '0,0,0,0,0,0,0,0,'
158  write(ineu,*) '0,0,0,0,0,0,0,0,'
159  write(ineu,*) '0,0,0,0,0,0,0,0,'
160  write(ineu,*) '0,0,0,0,0,0,0,0,'
161  write(ineu,*) '0,0,0,0,0,0,0,0,'
162  write(ineu,*) '0,0,0,0,0,0,0,0,'
163  write(ineu,*) '0,0,0,0,0,0,0,0,'
164  write(ineu,*) '0,0,0,0,0,0,0,0,'
165  write(ineu,*) '0,0,0,0,0,0,0,0,'
166  write(ineu,*) '0,0,'
167  write(ineu,*) '190,'
168  write(ineu,*) '0.,0.,0.,0.,0.,'
169  write(ineu,*) '0.,0.,0.,0.,0.,'
170  write(ineu,*) '0.,0.,0.,0.,0.,'
171  write(ineu,*) '0.,0.,0.,0.,0.,'
172  write(ineu,*) '0.,0.,0.,0.,0.,'
173  write(ineu,*) '0.,0.,0.,0.,0.,'
174  write(ineu,*) '0.,0.,0.,0.,0.,'
175  write(ineu,*) '0.,0.,0.,0.,0.,'
176  write(ineu,*) '0.,0.,0.,0.,0.,'
177  write(ineu,*) '0.,0.,0.,0.,0.,'
178  write(ineu,*) '0.,0.,0.,0.,0.,'
179  write(ineu,*) '0.,0.,0.,0.,0.,'
180  write(ineu,*) '0.,0.,0.,0.,0.,'
181  write(ineu,*) '0.,0.,0.,0.,0.,'
182  write(ineu,*) '0.,0.,0.,0.,0.,'
183  write(ineu,*) '0.,0.,0.,0.,0.,'
184  write(ineu,*) '0.,0.,0.,0.,0.,'
185  write(ineu,*) '0.,0.,0.,0.,0.,'
186  write(ineu,*) '0.,0.,0.,0.,0.,'
187  write(ineu,*) '0.,0.,0.,0.,0.,'
188  write(ineu,*) '0.,0.,0.,0.,0.,'
189  write(ineu,*) '0.,0.,0.,0.,0.,'
190  write(ineu,*) '0.,0.,0.,0.,0.,'
191  write(ineu,*) '0.,0.,0.,0.,0.,'
192  write(ineu,*) '0.,0.,0.,0.,0.,'
193  write(ineu,*) '0.,0.,0.,0.,0.,'
194  write(ineu,*) '0.,0.,0.,0.,0.,'
195  write(ineu,*) '0.,0.,0.,0.,0.,'
196  write(ineu,*) '0.,0.,0.,0.,0.,'
197  write(ineu,*) '0.,0.,0.,0.,0.,'
198  write(ineu,*) '0.,0.,0.,0.,0.,'
199  write(ineu,*) '0.,0.,0.,0.,0.,'
200  write(ineu,*) '0.,0.,0.,0.,0.,'
201  write(ineu,*) '0.,0.,0.,0.,0.,'
202  write(ineu,*) '0.,0.,0.,0.,0.,'
203  write(ineu,*) '0.,0.,0.,0.,0.,'
204  write(ineu,*) '0.,0.,0.,0.,0.,'
205  write(ineu,*) '0.,0.,0.,0.,0.,'
206  write(ineu,*) '0,'
207  write(ineu,*) '0,'
208 
209  enddo
210 
211  write(ineu,'(a)') ' -1'
212 
213  return
214  end subroutine heat_put_neutral_402
215 
216  !----------------------------------------------------------------------
217  !C
218  subroutine heat_put_neutral_403 ( hecMESH )
219 
220  use m_fstr
221 
222  implicit real(kind=kreal) (a - h, o - z)
223 
224  type(hecmwst_local_mesh) :: hecMESH
225 
226  !C
227  !C==put NODE : ( BLOCK NO. = 403 )
228  !C
229  write(ineu,'(a)') ' -1'
230  write(ineu,*) ' 403'
231 
232  do i = 1, hecmesh%n_node
233 
234  inod = hecmesh%global_node_ID(i)
235  xx = hecmesh%node( 3*i-2 )
236  yy = hecmesh%node( 3*i-1 )
237  zz = hecmesh%node( 3*i )
238 
239  write(ineu,'(i8,a,3(e15.7,'',''))') &
240  & inod,',0,0,1,46,0,0,0,0,0,0,',xx,yy,zz
241  enddo
242 
243  write(ineu,'(a)') ' -1'
244 
245  return
246  end subroutine heat_put_neutral_403
247 
248  !----------------------------------------------------------------------
249  !C
250  subroutine heat_put_neutral_404 ( hecMESH )
251 
252  use m_fstr
253 
254  implicit real(kind=kreal) (a - h, o - z)
255  dimension nn(20), nna(10), nnb(10)
256 
257  type(hecmwst_local_mesh) :: hecMESH
258 
259  !C
260  !C==put ELEMENT : ( BLOCK NO. = 404 )
261  !C
262 
263  write(ineu,'(a)') ' -1'
264  write(ineu,*) ' 404'
265 
266  do i = 1, hecmesh%n_elem
267 
268  ielm = hecmesh%global_elem_ID(i)
269  icol = 124
270  isid = hecmesh%section_ID(i)
271  isop = hecmesh%section%sect_opt(isid)
272 
273  is = hecmesh%elem_node_index(i-1) + 1
274  ie = hecmesh%elem_node_index(i)
275 
276  k = 0
277  do j = is, ie
278  k = k + 1
279  jj = hecmesh%elem_node_item(j)
280  nn(k) = hecmesh%global_node_ID(jj)
281  enddo
282 
283  nna = 0 ; nnb = 0
284  ietyp = hecmesh%elem_type(i)
285  if( ietyp == 231 ) then
286  istyp = 25
287  if( isop == 1 ) istyp = 19
288  if( isop == 2 ) istyp = 35
289  itopo = 2
290  nna(1) = nn(1)
291  nna(2) = nn(2)
292  nna(3) = nn(3)
293  elseif( ietyp == 731 ) then
294  istyp = 17
295  itopo = 2
296  nna(1) = nn(1)
297  nna(2) = nn(2)
298  nna(3) = nn(3)
299  elseif( ietyp == 232 ) then
300  istyp = 26
301  if( isop == 1 ) istyp = 20
302  if( isop == 2 ) istyp = 36
303  itopo = 3
304  nna(1) = nn(1)
305  nna(2) = nn(2)
306  nna(3) = nn(3)
307  nna(5) = nn(4)
308  nna(6) = nn(5)
309  nna(7) = nn(6)
310  elseif( ietyp == 732 ) then
311  istyp = 18
312  itopo = 3
313  nna(1) = nn(1)
314  nna(2) = nn(2)
315  nna(3) = nn(3)
316  nna(5) = nn(4)
317  nna(6) = nn(5)
318  nna(7) = nn(6)
319  elseif( ietyp == 241 ) then
320  istyp = 25
321  if( isop == 1 ) istyp = 19
322  if( isop == 2 ) istyp = 35
323  itopo = 4
324  nna(1) = nn(1)
325  nna(2) = nn(2)
326  nna(3) = nn(3)
327  nna(4) = nn(4)
328  elseif( ietyp == 741 ) then
329  istyp = 17
330  itopo = 4
331  nna(1) = nn(1)
332  nna(2) = nn(2)
333  nna(3) = nn(3)
334  nna(4) = nn(4)
335  elseif( ietyp == 242 ) then
336  istyp = 26
337  if( isop == 1 ) istyp = 20
338  if( isop == 2 ) istyp = 36
339  itopo = 5
340  do ij = 1, 8
341  nna(ij) = nn(ij)
342  enddo
343  elseif( ietyp == 742 ) then
344  istyp = 18
345  itopo = 5
346  do ij = 1, 8
347  nna(ij) = nn(ij)
348  enddo
349  elseif( ietyp == 341 ) then
350  istyp = 25
351  itopo = 6
352  nna(1) = nn(1)
353  nna(2) = nn(2)
354  nna(3) = nn(3)
355  nna(5) = nn(4)
356  elseif( ietyp == 351 ) then
357  istyp = 25
358  itopo = 7
359  nna(1) = nn(1)
360  nna(2) = nn(2)
361  nna(3) = nn(3)
362  nna(5) = nn(4)
363  nna(6) = nn(5)
364  nna(7) = nn(6)
365  elseif( ietyp == 361 ) then
366  istyp = 25
367  itopo = 8
368  do ij = 1, 8
369  nna(ij) = nn(ij)
370  enddo
371  elseif( ietyp == 342 ) then
372  istyp = 26
373  itopo = 10
374  nna( 1) = nn( 1)
375  nna( 2) = nn( 2)
376  nna( 3) = nn( 3)
377  nna( 5) = nn( 4)
378  nna( 9) = nn( 5)
379  nna(10) = nn( 6)
380  nnb( 1) = nn( 7)
381  nnb( 3) = nn( 8)
382  nnb( 4) = nn( 9)
383  nnb( 5) = nn(10)
384  elseif( ietyp == 352 ) then
385  istyp = 26
386  itopo = 11
387  nna( 1) = nn( 1)
388  nna( 2) = nn( 2)
389  nna( 3) = nn( 3)
390  nna( 5) = nn( 4)
391  nna( 6) = nn( 5)
392  nna( 7) = nn( 6)
393  nna( 9) = nn( 7)
394  nna(10) = nn( 8)
395  nnb( 1) = nn( 9)
396  nnb( 3) = nn(13)
397  nnb( 4) = nn(14)
398  nnb( 5) = nn(15)
399  nnb( 7) = nn(10)
400  nnb( 8) = nn(11)
401  nnb( 9) = nn(12)
402  elseif( ietyp == 362 ) then
403  istyp = 26
404  itopo = 12
405  do ij = 1, 10
406  nna(ij) = nn(ij)
407  enddo
408  nnb( 1) = nn(11)
409  nnb( 2) = nn(12)
410  nnb( 3) = nn(17)
411  nnb( 4) = nn(18)
412  nnb( 5) = nn(19)
413  nnb( 6) = nn(20)
414  nnb( 7) = nn(13)
415  nnb( 8) = nn(14)
416  nnb( 9) = nn(15)
417  nnb(10) = nn(16)
418  endif
419 
420  write(ineu,'(5(i8,'',''),a)') &
421  & ielm,icol,isid,istyp,itopo,'1,0,0,0,0,0,0,0,'
422  write(ineu,'(10(i8,'',''))') (nna(j),j=1,10)
423  write(ineu,'(10(i8,'',''))') (nnb(j),j=1,10)
424  write(ineu,*) '0,0,0,'
425  write(ineu,*) '0,0,0,'
426  write(ineu,*) '0,0,0,'
427  write(ineu,*) '0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,'
428 
429  enddo
430 
431  write(ineu,'(a)') ' -1'
432 
433  return
434  end subroutine heat_put_neutral_404
435 
436  !----------------------------------------------------------------------
437  !C
438  subroutine heat_put_neutral_409( INEU )
439 
440  !C
441  !C==put View : BLOCK NO. = 409 )
442  !C
443  write(ineu,'(a)') ' -1'
444  write(ineu,*) ' 409'
445  write(ineu,*) '1,'
446  write(ineu,*) 'Default XY View'
447  write(ineu,*) '2,0,1,'
448  !C write(INEU,*) '35.2644,-45.,0.,'
449  write(ineu,*) '0.,0.,0.,'
450  write(ineu,*) '2.5,1.25,1.5,'
451  write(ineu,*) '1.,1.,0,0.,0.,0.,0.,0.,0.,'
452  write(ineu,*) '1.03572,0.51035,0.,'
453  write(ineu,*) '1.2574,'
454  write(ineu,*) '0.,0.,1.,1.,'
455  write(ineu,*) '2,0,1,1,0,'
456  write(ineu,*) '-1,-1,0,1,0,1,1,60031,0,4000000,'
457  write(ineu,*) '9,'
458  write(ineu,*) '0,0,0,'
459  write(ineu,*) '0,0,0,'
460  write(ineu,*) '0,0,0,'
461  write(ineu,*) '0,0,0,'
462  write(ineu,*) '0,0,0,'
463  write(ineu,*) '0,0,0,'
464  write(ineu,*) '0,0,0,'
465  write(ineu,*) '0,0,0,'
466  write(ineu,*) '0,0,0,'
467  write(ineu,*) '100.,100.,1,7,'
468  write(ineu,*) '0,1,1.,'
469  write(ineu,*) '0.,0.,0.,'
470  write(ineu,*) '0.,0.,1.,'
471  write(ineu,*) '0,1,0,0,'
472  write(ineu,*) '0.,0.,0.,'
473  write(ineu,*) '1.,0.,0.,'
474  write(ineu,*) '0.,0.,0.,'
475  write(ineu,*) '0.,1.,0.,'
476  write(ineu,*) '2.,1.,70.,0.5,'
477  write(ineu,*) '0.,0.,0.,0.,0.,0,100.,1000.,0.,0.,0.,100.,-100.,1,'
478  write(ineu,*) '5.,90.,10.,10.,1.,'
479  write(ineu,*) '4,176,0,0,0,0,0,0,0,0,0.,0.,0.,'
480  write(ineu,*) '0,0,0,0,0,0,14,110,'
481  write(ineu,*) '0,1,1,1,0,1,0,1,1,0,1,1,0,1,1,1,0,0,1,'
482  write(ineu,*) '0,0,0.00000001,25.,100.,0.,0.,0.,20,'
483  write(ineu,*) '0,1,1,0,0,1,20.,0,'
484  write(ineu,*) '12,'
485  write(ineu,*) '0,0.,'
486  write(ineu,*) '0,0.,'
487  write(ineu,*) '0,0.,'
488  write(ineu,*) '0,0.,'
489  write(ineu,*) '0,0.,'
490  write(ineu,*) '0,0.,'
491  write(ineu,*) '0,0.,'
492  write(ineu,*) '0,0.,'
493  write(ineu,*) '0,0.,'
494  write(ineu,*) '0,0.,'
495  write(ineu,*) '0,0.,'
496  write(ineu,*) '0,0.,'
497  write(ineu,*) '0,5,0,0,0,0.,25.,'
498  write(ineu,*) '4,16408,20,16504,100,16488,'
499  write(ineu,*) '0.,0.,'
500  write(ineu,*) '0.,0.,0.,0.,'
501  write(ineu,*) '9,'
502  write(ineu,*) '1.,'
503  write(ineu,*) '1.,'
504  write(ineu,*) '1.,'
505  write(ineu,*) '1.,'
506  write(ineu,*) '1.,'
507  write(ineu,*) '1.,'
508  write(ineu,*) '1.,'
509  write(ineu,*) '1.,'
510  write(ineu,*) '1.,'
511  write(ineu,*) '2,'
512  write(ineu,*) '<NULL>'
513  write(ineu,*) '<NULL>'
514  write(ineu,*) '0,0,0,0,'
515  write(ineu,*) '0.,0.,0.,0.,'
516  write(ineu,*) '0.,0.,0.,0.,'
517  write(ineu,*) '90,1,124,1,0,'
518  write(ineu,*) '0,60,0,0,'
519  write(ineu,*) '0,24,0,0,'
520  write(ineu,*) '0,100,0,0,'
521  write(ineu,*) '0,2,0,0,'
522  write(ineu,*) '0,24580,0,0,'
523  write(ineu,*) '0,124,0,0,'
524  write(ineu,*) '0,46,0,0,'
525  write(ineu,*) '0,120,0,0,'
526  write(ineu,*) '0,124,0,1,'
527  write(ineu,*) '0,124,0,0,'
528  write(ineu,*) '0,12,0,1,'
529  write(ineu,*) '0,62,0,0,'
530  write(ineu,*) '0,62,0,0,'
531  write(ineu,*) '0,10,0,0,'
532  write(ineu,*) '0,52,0,0,'
533  write(ineu,*) '0,4,0,0,'
534  write(ineu,*) '0,120,0,0,'
535  write(ineu,*) '0,12,0,0,'
536  write(ineu,*) '0,2,0,0,'
537  write(ineu,*) '0,120,0,0,'
538  write(ineu,*) '0,8312,0,0,'
539  write(ineu,*) '0,24600,0,0,'
540  write(ineu,*) '0,0,0,0,'
541  write(ineu,*) '1,74,0,1,'
542  write(ineu,*) '0,0,0,0,'
543  write(ineu,*) '3,124,0,1,'
544  write(ineu,*) '0,24636,0,0,'
545  write(ineu,*) '0,0,0,0,'
546  write(ineu,*) '0,4,0,0,'
547  write(ineu,*) '0,100,0,0,'
548  write(ineu,*) '0,124,0,1,'
549  write(ineu,*) '0,60,0,1,'
550  write(ineu,*) '0,56,0,1,'
551  write(ineu,*) '0,24,0,0,'
552  write(ineu,*) '0,8216,0,1,'
553  write(ineu,*) '0,4,0,0,'
554  write(ineu,*) '0,124,2,0,'
555  write(ineu,*) '0,0,1,1,'
556  write(ineu,*) '0,0,0,1,'
557  write(ineu,*) '1,124,5,1,'
558  write(ineu,*) '0,0,0,1,'
559  write(ineu,*) '0,24,0,1,'
560  write(ineu,*) '0,124,0,0,'
561  write(ineu,*) '0,100,0,1,'
562  write(ineu,*) '1,100,0,1,'
563  write(ineu,*) '0,0,0,1,'
564  write(ineu,*) '0,16,0,0,'
565  write(ineu,*) '0,124,4,1,'
566  write(ineu,*) '0,62,0,0,'
567  write(ineu,*) '2,124,1,1,'
568  write(ineu,*) '1,8254,0,0,'
569  write(ineu,*) '0,124,1,1,'
570  write(ineu,*) '1,0,5,1,'
571  write(ineu,*) '0,124,0,1,'
572  write(ineu,*) '0,100,0,1,'
573  write(ineu,*) '0,100,0,1,'
574  write(ineu,*) '1,46,0,1,'
575  write(ineu,*) '1,120,0,1,'
576  write(ineu,*) '1,4,0,1,'
577  write(ineu,*) '1,52,0,1,'
578  write(ineu,*) '1,24,0,1,'
579  write(ineu,*) '1,93,0,1,'
580  write(ineu,*) '1,12,0,1,'
581  write(ineu,*) '1,10,0,1,'
582  write(ineu,*) '1,104,0,1,'
583  write(ineu,*) '0,100,0,0,'
584  write(ineu,*) '0,24,0,0,'
585  write(ineu,*) '0,60,0,0,'
586  write(ineu,*) '0,104,0,0,'
587  write(ineu,*) '0,0,0,0,'
588  write(ineu,*) '0,0,1,1,'
589  write(ineu,*) '0,0,1,1,'
590  write(ineu,*) '0,0,1,1,'
591  write(ineu,*) '0,0,1,1,'
592  write(ineu,*) '0,0,1,1,'
593  write(ineu,*) '0,4,0,0,'
594  write(ineu,*) '0,0,1,0,'
595  write(ineu,*) '0,0,0,0,'
596  write(ineu,*) '0,0,1,1,'
597  write(ineu,*) '0,0,1,1,'
598  write(ineu,*) '0,0,1,1,'
599  write(ineu,*) '0,0,1,1,'
600  write(ineu,*) '0,0,1,1,'
601  write(ineu,*) '0,0,1,1,'
602  write(ineu,*) '0,0,1,1,'
603  write(ineu,*) '0,62,1,1,'
604  write(ineu,*) '0,60,4,0,'
605  write(ineu,*) '0,0,1,1,'
606  write(ineu,*) '0,0,1,1,'
607  write(ineu,'(a)') '-1,'
608  write(ineu,'(a)') ' -1'
609 
610  return
611  end subroutine heat_put_neutral_409
612 
613  !----------------------------------------------------------------------
614  !C
615  subroutine heat_put_neutral_450( INEU )
616 
617  !C
618  !C==put RESULT : BLOCK NO. = 450 )
619  !C
620  write(ineu,'(a)') ' -1'
621  write(ineu,*) ' 450'
622  write(ineu,*) '1,'
623  write(ineu,*) 'hecmw_FSTR_heat_result'
624  write(ineu,*) '0,0,'
625  write(ineu,*) '0.,'
626  write(ineu,*) '1,'
627  write(ineu,*) '<NULL>'
628  write(ineu,'(a)') ' -1'
629 
630  return
631  end subroutine heat_put_neutral_450
632 
633  !----------------------------------------------------------------------
634  !C
635  subroutine heat_put_neutral_451 ( hecMESH, hecHEAT )
636 
637  use m_fstr
638 
639  implicit real(kind=kreal) (a - h, o - z)
640 
641  type(fstr_heat) :: hecHEAT
642  type(hecmwst_local_mesh) :: hecMESH
643 
644  !C
645  !C==put DISPLACEMENT : ( BLOCK NO. = 451 )
646  !C & STRESS/STRAIN
647  !C
648 
649  tmin = 1.0e9
650  tmax =-1.0e9
651 
652  !C
653 
654  do i = 1, hecmesh%n_node
655 
656  tt = hecheat%TEMP(i)
657  if( tt > tmax ) tmax = tt
658  if( tt < tmin ) tmin = tt
659 
660  enddo
661 
662  absmax = dabs(tmax)
663  absmin = dabs(tmin)
664  if( absmin > absmax ) absmax = absmin
665 
666  write(ineu,'(a)') ' -1'
667  write(ineu,*) ' 451'
668 
669  write(ineu,*) '1,1,1,'
670  write(ineu,*) 'Temperature'
671  write(ineu,'(3(e15.7,'',''))') tmin, tmax, absmax
672  write(ineu,*) '0,0,0,0,0,0,0,0,0,0,'
673  write(ineu,*) '0,0,0,0,0,0,0,0,0,0,'
674  write(ineu,*) '0,0,6,7,'
675  write(ineu,*) '0,0,1,'
676 
677  do i = 1, hecmesh%n_node
678  inod = hecmesh%global_node_ID(i)
679  tt = hecheat%TEMP(i)
680  write(ineu,'(i8,'','',E15.7,'','')') inod,tt
681  enddo
682  write(ineu,*) '-1,0.'
683  !C
684  !C==TERMINATION
685  !C
686  write(ineu,'(a)') ' -1'
687 
688  return
689  end subroutine heat_put_neutral_451
690 end module m_heat_lib_neutral
691 
This module defined coomon data and basic structures for analysis.
Definition: m_fstr.f90:15
integer(kind=kint), parameter ineu
Definition: m_fstr.f90:97
This module provide functions to generate Femap neutral output.
subroutine heat_put_neutral_601(hecMESH)
subroutine heat_put_neutral_409(INEU)
subroutine heat_put_neutral_403(hecMESH)
subroutine heat_put_neutral_404(hecMESH)
subroutine heat_put_neutral_402(hecMESH)
subroutine heat_put_neutral_451(hecMESH, hecHEAT)
subroutine heat_put_neutral_450(INEU)
Data for HEAT ANSLYSIS (fstrHEAT)
Definition: m_fstr.f90:394