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, IGS, ID
72 CHARACTER(LEN=NCHARLINE) :: KEY
73 CHARACTER(LEN=NCHARTITLE) :: TITR
74
75
76
77 INTEGER NVARN,NVARS,NVARC,NVART,NVARP,NVARR,NVARUR
78 INTEGER NVARNS,NVARSPH
79 INTEGER NVARIN,NVARRW,NVARRB,NVARAC,NVARSE,NVARJO,NVARFX,NVARFXM,NVARGAU
80 INTEGER NVARAB,NVARMV4,NVARMV,NVARPA
81 INTEGER NVARF1,NVARFR
82 INTEGER NVARRIV, NVARRIVG
83 INTEGER NVARNG,NVARSG,NVARCG,NVARTG,NVARPG,NVARRG,NVARURG
84 INTEGER NVARNSG,NVARSPG,NVARSENS,NVARCHECKSUM
85 INTEGER NVARING,NVARRWG, ,NVARACG,NVARSEG,NVARJOG
86 INTEGER NVARABG,NVARMG4,NVARMVG,NVARPAG,NVARFXG,NVARFXMG
87 INTEGER NVARF1G,NVARFRG,NVARGAUG,NVARCLUS,NVARCLUSG,NVARFLOW
88 INTEGER NVARSURF,NVARSLIP,NVARSLIPG,NVARRET,NVARRETG
89 INTEGER HM_NTHGRP,NTHACCEL,NTHINTER,NTHRWALL,NTHSECTIO,NTHCLUS,IDSMAX
90 INTEGER NTHBEAM,NTHTRUS,NTHBRIC,NTHNODE,NTHSHEL,NTHSH3N,NTHSPRING,NTHRBODY
91 INTEGER NTHMONVOL,HM_NTHPART,HM_NTHSUBS,HM_NTHSPHCEL, HM_NTHQUAD, HM_NTHSPHFLOW
92 INTEGER HM_NTHGAUGE, HM_NTHFXBODY, HM_NTHFRAME, HM_NTHCYLJO, HM_NTHNSTRAND,HM_NTHSURF
93 INTEGER HM_NTHTRIA,HM_NTHSLIPRING,HM_NTHRETRACTOR,HM_NTHSENS,HM_NTHCHECKSUM
94 LOGICAL IS_AVAILABLE
95
96 parameter(nvarriv = 10,nvarrivg = 1)
97 parameter(nvarn = 628,nvars =239554 ,nvarc = 37856,nvart = 6)
98 parameter(nvarp = 337,nvarr = 66,nvarur = 12)
99 parameter(nvarns = 4,nvarsph = 41)
100 parameter(nvarin = 29,nvarrw = 6,nvarrb =15,nvarfx =4)
101 parameter(nvarfxm = 3)
102 parameter(nvarac = 3,nvarse =39,nvarjo = 6,nvargau = 8)
103 parameter(nvarab = 7,nvarmv4= 9,nvarmv = 150)
104 parameter(nvarpa = 32)
105 parameter(nvarf1 = 18,nvarfr = 24,nvarclus=11)
106 parameter(nvarng = 7,nvarsg = 39766,nvarcg =574 ,nvartg = 1)
107 parameter(nvarpg = 1,nvarrg = 1,nvarurg = 1)
108 parameter(nvarnsg = 1,nvarspg = 2)
109 parameter(nvaring = 6,nvarrwg = 3,nvarrbg = 6,nvarfxg = 1)
110 parameter(nvarfxmg =1)
111 parameter(nvaracg = 2,nvarseg = 7,nvarjog = 3)
112 parameter(nvarabg = 1,nvarmg4 = 1,nvarmvg = 62)
113 parameter(nvarpag = 1)
114 parameter(nvarf1g = 3,nvarfrg = 4,nvargaug = 1,nvarclusg = 2)
115 parameter(nvarflow = 1)
116 parameter(nvarsurf = 6)
117 parameter(nvarslip = 6,nvarslipg = 6,nvarret = 3,nvarretg = 3)
118 parameter(nvarsens = 1)
119 parameter(nvarchecksum = 1)
120
121
122
123 CHARACTER THFILE*4
124
125 igs=0
126 is_available = .false.
127 hm_nthgrp = 0
128
129
130 IF (iflag == 0) THEN
131 thfile = '/TH'
132 ELSEIF (iflag == 1) THEN
133 thfile = '/ATH'
134 ELSEIF (iflag == 2) THEN
135 thfile = '/BTH'
136 ELSEIF (iflag == 3) THEN
137 thfile = '/CTH'
138 ELSEIF (iflag == 4) THEN
139 thfile = '/DTH'
140 ELSEIF (iflag == 5) THEN
141 thfile = '/ETH'
142 ELSEIF (iflag == 6) THEN
143 thfile = '/FTH'
144 ELSEIF (iflag == 7) THEN
145 thfile = '/GTH'
146 ELSEIF (iflag == 8) THEN
147 thfile = '/HTH'
148 ELSEIF (iflag == 9) THEN
149 thfile = '/ITH'
150 ENDIF
151
152
153
154
156 IF (nthaccel > 0) THEN
158 hm_nthgrp = hm_nthgrp + nthaccel
159 DO i = 1, nthaccel
161 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
162 nvartot = nvartot + 180
163 ifi = ifi + nvarac + 3*idsmax + 40*idsmax
164 ENDDO
165 ENDIF
166
167
168
170 IF (nthinter > 0) THEN
172 hm_nthgrp = hm_nthgrp + nthinter
173 DO i = 1, nthinter
175 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
176 nvartot = nvartot + 180
177 ifi = ifi + nvarin + 3*idsmax + 40*idsmax
178 ENDDO
179 ENDIF
180
181
182
184 IF (nthrwall > 0) THEN
186 hm_nthgrp = hm_nthgrp + nthrwall
187 DO i = 1, nthrwall
189 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
190 nvartot = nvartot + 180
191 ifi = ifi + nvarrw + 3*idsmax + 40*idsmax
192 ENDDO
193 ENDIF
194
195
196
198 IF (nthsectio > 0) THEN
200 hm_nthgrp = hm_nthgrp + nthsectio
201 DO i = 1, nthsectio
203 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
204 nvartot = nvartot + 180
205 ifi = ifi + nvarse + 3*idsmax + 40*idsmax
206 ENDDO
207 ENDIF
208
209
210
212 IF (nthclus > 0) THEN
214 hm_nthgrp = hm_nthgrp + nthclus
215 DO i = 1, nthclus
217 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
218 nvartot = nvartot + 180
219 ifi = ifi + nvarclus + 3*idsmax + 40*idsmax
220 ENDDO
221 ENDIF
222
223
224
226 IF (nthbeam > 0) THEN
228 hm_nthgrp = hm_nthgrp + nthbeam
229 DO i = 1, nthbeam
231 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
232 nvartot = nvartot + 180
233 ifi = ifi + nvarp + lvarithb*idsmax
234 ENDDO
235 ENDIF
236
237
238
240 IF (nthtrus > 0) THEN
242 hm_nthgrp = hm_nthgrp + nthtrus
243 DO i = 1, nthtrus
245 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
246 nvartot = nvartot + 180
247 ifi = ifi + nvart + lvarithb*idsmax + 40*idsmax
248 ENDDO
249 ENDIF
250
251
252
254 IF (nthspring > 0) THEN
256 hm_nthgrp = hm_nthgrp + nthspring
257 DO i = 1, nthspring
259 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
260 nvartot = nvartot + 180
261 ifi = ifi + nvarr + lvarithb*idsmax + 40*idsmax
262 ENDDO
263 ENDIF
264
265
266
268 IF (nthbric > 0) THEN
270 hm_nthgrp = hm_nthgrp + nthbric
271 DO i = 1, nthbric
273 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
274 nvartot = nvartot + 180
275 ifi = ifi + nvars + lvarithb*idsmax + 40*idsmax
276 ENDDO
277 ENDIF
278
279
280
282 IF (nthnode > 0) THEN
284 hm_nthgrp = hm_nthgrp + nthnode
285 DO i = 1, nthnode
287 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
288 nvartot = nvartot + 180
289 ifi = ifi + nvarn + lvarithb*idsmax + 40*idsmax
290 ENDDO
291 ENDIF
292
293
294
296 IF (nthshel > 0) THEN
298 hm_nthgrp = hm_nthgrp + nthshel
299 DO i = 1, nthshel
301 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
302 nvartot = nvartot + 180
303 ifi = ifi + nvarc + lvarithb*idsmax + 40*idsmax
304 ENDDO
305 ENDIF
306
307
308
310 IF (nthsh3n > 0) THEN
312 hm_nthgrp = hm_nthgrp + nthsh3n
313 DO i = 1, nthsh3n
315 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
316 nvartot = nvartot + 180
317 ifi = ifi + nvarc + lvarithb*idsmax + 40*idsmax
318 ENDDO
319 ENDIF
320
321
322
324 IF (nthrbody > 0) THEN
326 hm_nthgrp = hm_nthgrp + nthrbody
327 DO i = 1, nthrbody
329 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
330 nvartot = nvartot + 180
331 ifi = ifi + nvarrb + 3*idsmax + 40*idsmax
332 ENDDO
333 ENDIF
334
335
336
338 IF (nthmonvol > 0) THEN
340 hm_nthgrp = hm_nthgrp + nthmonvol
341 DO i = 1, nthmonvol
343 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
344 nvartot = nvartot + 180
345 ifi = ifi + (nvarmv + 3*idsmax + 40*idsmax)*10*nvolu
346 ENDDO
347 ENDIF
348
349
350
352 IF (hm_nthpart > 0) THEN
354 hm_nthgrp = hm_nthgrp + hm_nthpart
355 DO i = 1, hm_nthpart
356 nvartot = nvartot + 180
357 ifi = ifi + nvarpa
358 ENDDO
359 ENDIF
360
361
362
364 IF (hm_nthsubs > 0) THEN
366 hm_nthgrp = hm_nthgrp + hm_nthsubs
367 DO i = 1, hm_nthsubs
368 nvartot = nvartot + 180
369 ifi = ifi + nvarpa
370 ENDDO
371 ENDIF
372
373
374
376 IF (hm_nthfxbody > 0) THEN
378 hm_nthgrp = hm_nthgrp + hm_nthfxbody
379 DO i = 1, hm_nthfxbody
381 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
382 nvartot = nvartot + 180
383 ifi = ifi + nvarfx + 3*idsmax + 40*idsmax
384 ENDDO
385 ENDIF
386
387
388
390 IF (hm_nthsphcel > 0) THEN
392 hm_nthgrp = hm_nthgrp + hm_nthsphcel
393 DO i = 1, hm_nthsphcel
395 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
396 nvartot = nvartot + 180
397 ifi = ifi + nvarsph + lvarithb*idsmax + 40*idsmax
398 ENDDO
399 ENDIF
400
401
402
404 IF (hm_nthcyljo > 0) THEN
406 hm_nthgrp = hm_nthgrp + hm_nthcyljo
407 DO i = 1, hm_nthcyljo
409 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
410 nvartot = nvartot + 180
411 ifi = ifi + nvarjo + 3*idsmax + 40*idsmax
412 ENDDO
413 ENDIF
414
415
416
418 IF (hm_nthframe > 0) THEN
420 hm_nthgrp = hm_nthgrp + hm_nthframe
421 DO i = 1, hm_nthframe
423 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
424 nvartot = nvartot + 180
425 ifi = ifi + nvarfr + 3*idsmax + 40*idsmax
426 ENDDO
427 ENDIF
428
429
430
432 IF (hm_nthgauge > 0) THEN
434 hm_nthgrp = hm_nthgrp + hm_nthgauge
435 DO i = 1, hm_nthgauge
437 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
438 nvartot = nvartot + 180
439 ifi = ifi + nvargau + 3*idsmax + 40*idsmax
440 ENDDO
441 ENDIF
442
443
444 !-------------------------------------------
446 IF (hm_nthsphflow > 0) THEN
448 hm_nthgrp = hm_nthgrp + hm_nthsphflow
449 DO i = 1, hm_nthsphflow
451 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
452 nvartot = nvartot + 180
453 ifi = ifi + nvarflow + 3*idsmax + 40*idsmax
454 ENDDO
455 ENDIF
456
457
458
460 IF (hm_nthquad > 0) THEN
462 hm_nthgrp = hm_nthgrp + hm_nthquad
463 DO i = 1, hm_nthquad
465 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
466 nvartot = nvartot + 180
467 ifi = ifi + nvars + lvarithb*idsmax + 40*idsmax
468 ENDDO
469 ENDIF
470
471
472
474 IF (hm_nthnstrand > 0) THEN
476 hm_nthgrp = hm_nthgrp + hm_nthnstrand
477 DO i = 1, hm_nthnstrand
479 CALL hm_get_intv(
'Num_Cards',idsmax,is_available,lsubmodel)
480 nvartot = nvartot + 180
481 ifi = ifi + nvarns + lvarithb*idsmax + 40*idsmax
482 ENDDO
483 ENDIF
484
485
486
488 IF (hm_nthsurf > 0) THEN
490 hm_nthgrp = hm_nthgrp + hm_nthsurf
491 DO i = 1, hm_nthsurf
493 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
494 nvartot = nvartot + 180
495 ifi = ifi + nvarsurf + 43*idsmax
496 ENDDO
497 ENDIF
498
499
500
502 IF (hm_nthtria> 0) THEN
504 hm_nthgrp = hm_nthgrp + hm_nthtria
505 DO i = 1, hm_nthtria
507 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
508 nvartot = nvartot + 180
509 ifi = ifi + nvars + lvarithb*idsmax + 40*idsmax
510 ENDDO
511 ENDIF
512
513
514
516 IF (hm_nthslipring > 0) THEN
518 hm_nthgrp = hm_nthgrp + hm_nthslipring
519 DO i = 1, hm_nthslipring
521 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
522 nvartot = nvartot + 180
523 ifi = ifi + nvarslip + lvarithb*idsmax + 40*idsmax
524 ENDDO
525 ENDIF
526
527
528
530 IF (hm_nthretractor > 0) THEN
532 hm_nthgrp = hm_nthgrp + hm_nthretractor
533 DO i = 1, hm_nthretractor
535 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
536 nvartot = nvartot + 180
537 ifi = ifi + nvarret + lvarithb*idsmax + 40*idsmax
538 ENDDO
539 ENDIF
540
541
542
544 IF (hm_nthsens > 0) THEN
546 hm_nthgrp = hm_nthgrp + hm_nthsens
547 DO i = 1, hm_nthsens
549 CALL hm_get_intv(
'idsmax',idsmax,is_available,lsubmodel)
550 nvartot = nvartot + 180
551 ifi = ifi + nvarsens + 43*idsmax
552 ENDDO
553 ENDIF
554
555
556
557
558 hm_nthchecksum = output%CHECKSUM%checksum_count
559 IF (hm_nthchecksum > 0) THEN
560 hm_nthgrp = hm_nthgrp + 1
561 nvartot = nvartot + 180
562 ifi = ifi + nvarchecksum + 40 * hm_nthchecksum
563 ENDIF
564
565 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