38
39
40
41
42
43
44
45
50 USE output_mod
51 USE checksum_starter_option_mod
52
53
54
55#include "implicit_f.inc"
56
57
58
59#include "com04_c.inc"
60#include "param_c.inc"
61
62
63
64 INTEGER IFI,NVARTOT,IFLAG
65 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
66 TYPE(output_) OUTPUT
67
68
69
70
71 INTEGER I,IG,IGS,ID
72 INTEGER IFIX_TMP
73 CHARACTER(LEN=NCHARLINE) :: KEY
74 CHARACTER(LEN=NCHARTITLE) :: TITR
75
76
77
78 INTEGER NVARN,NVARS,NVARC,NVART,NVARP,NVARR,NVARUR
79 INTEGER NVARNS,NVARSPH
80 INTEGER NVARIN,NVARRW,NVARRB,NVARAC,NVARSE,NVARJO,NVARFX,NVARFXM,NVARGAU
81 INTEGER NVARAB,NVARMV4
82INTEGER NVARF1,NVARFR
83 INTEGER NVARRIV,NVARRIVG,NSELRT
84 INTEGER NVARNG,NVARSG,NVARCG,NVARTG,NVARPG,NVARRG,NVARURG
85 INTEGER NVARNSG,NVARSPG,NVARSENS,NVARCHECKSUM
86 INTEGER NVARING,NVARRWG, NVARRBG,NVARACG,NVARSEG,NVARJOG
87 INTEGER NVARABG,NVARMG4,NVARMVG,NVARPAG,NVARFXG,NVARFXMG
88 INTEGER NVARF1G,NVARFRG,NVARGAUG,NVARCLUS,NVARCLUSG,NVARFLOW
89 INTEGER NVARSURF,NVARSLIP,NVARSLIPG,NVARRET,NVARRETG
90 INTEGER HM_NTHGRP,NTHACCEL,NTHINTER,NTHRWALL,NTHSECTIO,NTHCLUS,IDSMAX
91 INTEGER NTHBEAM,NTHTRUS,NTHBRIC,NTHNODE,NTHSHEL,NTHSH3N,NTHSPRING,NTHRBODY
92 INTEGER NTHMONVOL,HM_NTHPART,HM_NTHSUBS,HM_NTHSPHCEL, HM_NTHQUAD, HM_NTHSPHFLOW
93 INTEGER HM_NTHGAUGE, HM_NTHFXBODY, HM_NTHFRAME, HM_NTHCYLJO, HM_NTHNSTRAND,HM_NTHSURF
94 INTEGER HM_NTHTRIA,HM_NTHSLIPRING,,HM_NTHSENS,HM_NTHCHECKSUM
95 LOGICAL IS_AVAILABLE
96
97 parameter(nvarriv = 10,nvarrivg = 1)
98 parameter(nvarn = 628,nvars =239554 ,nvarc = 37856,nvart = 6)
99 parameter(nvarp = 337,nvarr = 66,nvarur = 12)
100 parameter(nvarns = 4,nvarsph = 41)
101 parameter(nvarin = 29,nvarrw = 6,nvarrb =15,nvarfx =4)
102 parameter(nvarfxm = 3)
103 parameter(nvarac = 3,nvarse =39,nvarjo = 6,nvargau = 8)
104 parameter(nvarab = 7,nvarmv4= 9,nvarmv = 150)
105 parameter(nvarpa = 32)
106 parameter(nvarf1 = 18,nvarfr = 24,nvarclus=11)
107 parameter(nvarng = 7,nvarsg = 39766,nvarcg =574 ,nvartg = 1)
108 parameter(nvarpg = 1,nvarrg = 1,nvarurg = 1)
109 parameter(nvarnsg = 1,nvarspg = 2)
110 parameter(nvaring = 6,nvarrwg = 3,nvarrbg = 6,nvarfxg = 1)
111 parameter(nvarfxmg =1)
112 parameter(nvaracg = 2,nvarseg = 7,nvarjog = 3)
113 parameter(nvarabg = 1,nvarmg4 = 1,nvarmvg = 62)
114 parameter(nvarpag = 1)
115 parameter(nvarf1g = 3,nvarfrg = 4,nvargaug = 1,nvarclusg = 2)
116 parameter(nvarflow = 1)
117 parameter(nvarsurf = 6)
118 parameter(nvarslip = 6,nvarslipg = 6,nvarret = 3,nvarretg = 3)
119 parameter(nvarsens = 1)
120 parameter(nvarchecksum = 1)
121
122
123
124 INTEGER PRETHGRNE,PRETHGRKI,PRETHGRPA,PRETHGRNS,PRETHGRVAR
125 CHARACTER THFILE*4
126
127 igs=0
128 is_available = .false.
129 hm_nthgrp = 0
130
131
132 IF (iflag == 0) THEN
133 thfile = '/TH'
134 ELSEIF (iflag == 1) THEN
135 thfile = '/ATH'
136 ELSEIF (iflag == 2) THEN
137 thfile = '/BTH'
138 ELSEIF (iflag == 3) THEN
139 thfile = '/CTH'
140 ELSEIF (iflag == 4) THEN
141 thfile = '/DTH'
142 ELSEIF (iflag == 5) THEN
143 thfile = '/ETH'
144 ELSEIF (iflag == 6) THEN
145 thfile = '/FTH'
146 ELSEIF (iflag == 7) THEN
147 thfile = '/GTH'
148 ELSEIF (iflag == 8) THEN
149 thfile = '/HTH'
150 ELSEIF (iflag == 9) THEN
151 thfile = '/ITH'
152 ENDIF
153
154
155
156
158 IF (nthaccel > 0) THEN
160 hm_nthgrp = hm_nthgrp + nthaccel
161 DO i = 1, nthaccel
163 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
164 nvartot = nvartot + 180
165 ifi = ifi + nvarac + 3*idsmax + 40*idsmax
166 ENDDO
167 ENDIF
168
169
170
172 IF (nthinter > 0) THEN
174 hm_nthgrp = hm_nthgrp + nthinter
175 DO i = 1, nthinter
177 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
178 nvartot = nvartot + 180
179 ifi = ifi + nvarin + 3*idsmax + 40*idsmax
180 ENDDO
181 ENDIF
182
183
184
186 IF (nthrwall > 0) THEN
188 hm_nthgrp = hm_nthgrp + nthrwall
189 DO i = 1, nthrwall
191 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
192 nvartot = nvartot + 180
193 ifi = ifi + nvarrw + 3*idsmax + 40*idsmax
194 ENDDO
195 ENDIF
196
197
198
200 IF (nthsectio > 0) THEN
202 hm_nthgrp = hm_nthgrp + nthsectio
203 DO i = 1, nthsectio
205 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
206 nvartot = nvartot + 180
207 ifi = ifi + nvarse + 3*idsmax + 40*idsmax
208 ENDDO
209 ENDIF
210
211
212
214 IF (nthclus > 0) THEN
216 hm_nthgrp = hm_nthgrp + nthclus
217 DO i = 1, nthclus
219 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
220 nvartot = nvartot + 180
221 ifi = ifi + nvarclus + 3*idsmax + 40*idsmax
222 ENDDO
223 ENDIF
224
225
226
228 IF (nthbeam > 0) THEN
230 hm_nthgrp = hm_nthgrp + nthbeam
231 DO i = 1, nthbeam
233 CALL hm_get_intv('idsmax
',IDSMAX,IS_AVAILABLE,LSUBMODEL)
234 NVARTOT = NVARTOT + 180
235 IFI = IFI + NVARP + LVARITHB*IDSMAX + 40*IDSMAX
236 ENDDO
237 ENDIF
238 !-------------------------------------------
239 ! /TH/TRUS
240 !-------------------------------------------
241 CALL HM_OPTION_COUNT(TRIM(THFILE)//'/truss' ,NTHTRUS)
242 IF (NTHTRUS > 0) THEN
243 CALL HM_OPTION_START(TRIM(THFILE)//'/truss')
244 HM_NTHGRP = HM_NTHGRP + NTHTRUS
245 DO I = 1, NTHTRUS
246 CALL HM_OPTION_READ_KEY(LSUBMODEL, OPTION_ID=ID, OPTION_TITR=TITR)
247 CALL HM_GET_INTV('idsmax',IDSMAX,IS_AVAILABLE,LSUBMODEL)
248 NVARTOT = NVARTOT + 180
249 IFI = IFI + NVART + LVARITHB*IDSMAX + 40*IDSMAX
250 ENDDO
251 ENDIF
252 !-------------------------------------------
253 ! /TH/SPRING
254 !-------------------------------------------
255 CALL HM_OPTION_COUNT(TRIM(THFILE)//'/spring' ,NTHSPRING)
256 IF (NTHSPRING > 0) THEN
257 CALL HM_OPTION_START(TRIM(THFILE)//'/spring')
258 HM_NTHGRP = HM_NTHGRP + NTHSPRING
259 DO I = 1, NTHSPRING
260 CALL HM_OPTION_READ_KEY(LSUBMODEL, OPTION_ID=ID, OPTION_TITR=TITR)
261 CALL HM_GET_INTV('idsmax',idsmax,is_available,lsubmodel)
262 nvartot = nvartot + 180
263 ifi = ifi + nvarr + lvarithb*idsmax + 40*idsmax
264 ENDDO
265 ENDIF
266
267
268
270 IF (nthbric > 0) THEN
272 hm_nthgrp = hm_nthgrp + nthbric
273 DO i = 1, nthbric
275 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
276 nvartot = nvartot + 180
277 ifi = ifi + nvars + lvarithb*idsmax + 40*idsmax
278 ENDDO
279 ENDIF
280
281
282
284 IF (nthnode > 0) THEN
286 hm_nthgrp = hm_nthgrp + nthnode
287 DO i = 1, nthnode
289 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
290 nvartot = nvartot + 180
291 ifi = ifi + nvarn + lvarithb*idsmax + 40*idsmax
292 ENDDO
293 ENDIF
294
295
296
298 IF (nthshel > 0) THEN
300 hm_nthgrp = hm_nthgrp + nthshel
301 DO i = 1, nthshel
303 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
304 nvartot = nvartot + 180
305 ifi = ifi + nvarc + lvarithb*idsmax + 40*idsmax
306 ENDDO
307 ENDIF
308
309
310
312 IF (nthsh3n > 0) THEN
314 hm_nthgrp = hm_nthgrp + nthsh3n
315 DO i = 1, nthsh3n
317 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
318 nvartot = nvartot + 180
319 ifi = ifi + nvarc + lvarithb*idsmax + 40*idsmax
320 ENDDO
321 ENDIF
322
323
324
326 IF (nthrbody > 0) THEN
328 hm_nthgrp = hm_nthgrp + nthrbody
329 DO i = 1, nthrbody
331 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
332 nvartot = nvartot + 180
333 ifi = ifi + nvarrb + 3*idsmax + 40*idsmax
334 ENDDO
335 ENDIF
336
337
338
340 IF (nthmonvol > 0) THEN
342 hm_nthgrp = hm_nthgrp + nthmonvol
343 DO i = 1, nthmonvol
345 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
346 nvartot = nvartot + 180
347 ifi = ifi + (nvarmv + 3*idsmax + 40*idsmax)*10*nvolu
348 ENDDO
349 ENDIF
350
351
352
354 IF (hm_nthpart > 0) THEN
356 hm_nthgrp = hm_nthgrp + hm_nthpart
357 DO i = 1, hm_nthpart
358 nvartot = nvartot + 180
359 ifi = ifi + nvarpa
360 ENDDO
361 ENDIF
362
363
364
366 IF (hm_nthsubs > 0) THEN
368 hm_nthgrp = hm_nthgrp + hm_nthsubs
369 DO i = 1, hm_nthsubs
370 nvartot = nvartot + 180
371 ifi = ifi + nvarpa
372 ENDDO
373 ENDIF
374
375
376
378 IF (hm_nthfxbody > 0) THEN
380 hm_nthgrp = hm_nthgrp + hm_nthfxbody
381 DO i = 1, hm_nthfxbody
383 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
384 nvartot = nvartot + 180
385 ifi = ifi + nvarfx + 3*idsmax + 40*idsmax
386 ENDDO
387 ENDIF
388
389
390
392 IF (hm_nthsphcel > 0) THEN
394 hm_nthgrp = hm_nthgrp + hm_nthsphcel
395 DO i = 1, hm_nthsphcel
397 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
398 nvartot = nvartot + 180
399 ifi = ifi + nvarsph + lvarithb*idsmax + 40*idsmax
400 ENDDO
401 ENDIF
402
403
404
406 IF (hm_nthcyljo > 0) THEN
408 hm_nthgrp = hm_nthgrp + hm_nthcyljo
409 DO i = 1, hm_nthcyljo
411 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
412 nvartot = nvartot + 180
413 ifi = ifi + nvarjo + 3*idsmax + 40*idsmax
414 ENDDO
415 ENDIF
416
417
418
420 IF (hm_nthframe > 0) THEN
422 hm_nthgrp = hm_nthgrp + hm_nthframe
423 DO i = 1, hm_nthframe
425 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
426 nvartot = nvartot + 180
427 ifi = ifi + nvarfr + 3*idsmax + 40*idsmax
428 ENDDO
429 ENDIF
430
431
432
434 IF (hm_nthgauge > 0) THEN
436 hm_nthgrp = hm_nthgrp + hm_nthgauge
437 DO i = 1, hm_nthgauge
439 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
440 nvartot = nvartot + 180
441 ifi = ifi + nvargau + 3*idsmax + 40*idsmax
442 ENDDO
443 ENDIF
444
445
446
448 IF (hm_nthsphflow > 0) THEN
450 hm_nthgrp = hm_nthgrp + hm_nthsphflow
451 DO i = 1, hm_nthsphflow
453 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
454 nvartot = nvartot + 180
455 ifi = ifi + nvarflow + 3*idsmax + 40*idsmax
456 ENDDO
457 ENDIF
458
459
460
462 IF (hm_nthquad > 0) THEN
464 hm_nthgrp = hm_nthgrp + hm_nthquad
465 DO i = 1, hm_nthquad
467 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
468 nvartot = nvartot + 180
469 ifi = ifi + nvars + lvarithb*idsmax + 40*idsmax
470 ENDDO
471 ENDIF
472
473
474
476 IF (hm_nthnstrand > 0) THEN
478 hm_nthgrp = hm_nthgrp + hm_nthnstrand
479 DO i = 1, hm_nthnstrand
481 CALL hm_get_intv(
'Num_Cards',idsmax,is_available,lsubmodel)
482 nvartot = nvartot + 180
483 ifi = ifi + nvarns + lvarithb*idsmax + 40*idsmax
484 ENDDO
485 ENDIF
486
487
488
490 IF (hm_nthsurf > 0) THEN
492 hm_nthgrp = hm_nthgrp + hm_nthsurf
493 DO i = 1, hm_nthsurf
495 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
496 nvartot = nvartot + 180
497 ifi = ifi + nvarsurf + 43*idsmax
498 ENDDO
499 ENDIF
500
501
502
504 IF (hm_nthtria> 0) THEN
506 hm_nthgrp = hm_nthgrp + hm_nthtria
507 DO i = 1, hm_nthtria
509 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
510 nvartot = nvartot + 180
511 ifi = ifi + nvars + lvarithb*idsmax + 40*idsmax
512 ENDDO
513 ENDIF
514
515
516
518 IF (hm_nthslipring > 0) THEN
520 hm_nthgrp = hm_nthgrp + hm_nthslipring
521 DO i = 1, hm_nthslipring
523 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
524 nvartot = nvartot + 180
525 ifi = ifi + nvarslip + lvarithb*idsmax + 40*idsmax
526 ENDDO
527 ENDIF
528
529
530
532 IF (hm_nthretractor > 0) THEN
534 hm_nthgrp = hm_nthgrp + hm_nthretractor
535 DO i = 1, hm_nthretractor
537 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
538 nvartot = nvartot + 180
539 ifi = ifi + nvarret + lvarithb*idsmax + 40*idsmax
540 ENDDO
541 ENDIF
542
543
544
546 IF (hm_nthsens > 0) THEN
548 hm_nthgrp = hm_nthgrp + hm_nthsens
549 DO i = 1, hm_nthsens
551 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
552 nvartot = nvartot + 180
553 ifi = ifi + nvarsens + 43*idsmax
554 ENDDO
555 ENDIF
556
557
558
559
560 hm_nthchecksum = output%CHECKSUM%checksum_count
561 IF (hm_nthchecksum > 0) THEN
562 hm_nthgrp = hm_nthgrp + 1
563 nvartot = nvartot + 180
564 ifi = ifi + nvarchecksum + 40 * hm_nthchecksum
565 ENDIF
566
567 RETURN
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_count(entity_type, hm_option_number)
subroutine hm_option_start(entity_type)
integer, parameter nchartitle
integer, parameter ncharline