OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prethgrou.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_prethgrou (ifi, nvartot, lsubmodel, iflag, output)

Function/Subroutine Documentation

◆ hm_read_prethgrou()

subroutine hm_read_prethgrou ( integer ifi,
integer nvartot,
type(submodel_data), dimension(*) lsubmodel,
integer iflag,
type(output_) output )

Definition at line 37 of file hm_read_prethgrou.F.

38C-----------------------------------------------
39C D e s c r i p t i o n
40C-----------------------------------------------
41C This Subroutine is defining
42C allocation sizes (NVARTOT & IFI) related to /TH entities
43C-----------------------------------------------
44C A n a l y s e M o d u l e
45C-----------------------------------------------
47 USE submodel_mod
48 USE groupdef_mod
50 USE output_mod
51 USE checksum_starter_option_mod
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "com04_c.inc"
60#include "param_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER IFI,NVARTOT,IFLAG
65 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
66 TYPE(output_) OUTPUT
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70
71 INTEGER I, IGS, ID
72 CHARACTER(LEN=NCHARLINE) :: KEY
73 CHARACTER(LEN=NCHARTITLE) :: TITR
74C-----------------------------------------------
75C P a r a m e t e r s
76C-----------------------------------------------
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, NVARRBG,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
95C
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)
120C-----------------------------------------------
121C E x t e r n a l
122C-----------------------------------------------
123 CHARACTER THFILE*4
124C=======================================================================
125 igs=0
126 is_available = .false.
127 hm_nthgrp = 0
128c
129 ! Choose TH file type
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
151C
152 !-------------------------------------------
153 ! /TH/ACCEL
154 !-------------------------------------------
155 CALL hm_option_count(trim(thfile)//'/ACCEL',nthaccel)
156 IF (nthaccel > 0) THEN
157 CALL hm_option_start(trim(thfile)//'/ACCEL')
158 hm_nthgrp = hm_nthgrp + nthaccel
159 DO i = 1, nthaccel
160 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/INTER
168 !-------------------------------------------
169 CALL hm_option_count(trim(thfile)//'/INTER' ,nthinter )
170 IF (nthinter > 0) THEN
171 CALL hm_option_start(trim(thfile)//'/INTER')
172 hm_nthgrp = hm_nthgrp + nthinter
173 DO i = 1, nthinter
174 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/RWALL
182 !-------------------------------------------
183 CALL hm_option_count(trim(thfile)//'/RWALL' ,nthrwall )
184 IF (nthrwall > 0) THEN
185 CALL hm_option_start(trim(thfile)//'/RWALL')
186 hm_nthgrp = hm_nthgrp + nthrwall
187 DO i = 1, nthrwall
188 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/SECTIO
196 !-------------------------------------------
197 CALL hm_option_count(trim(thfile)//'/SECTIO' ,nthsectio)
198 IF (nthsectio > 0) THEN
199 CALL hm_option_start(trim(thfile)//'/SECTIO')
200 hm_nthgrp = hm_nthgrp + nthsectio
201 DO i = 1, nthsectio
202 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/CLUSTER
210 !-------------------------------------------
211 CALL hm_option_count(trim(thfile)//'/CLUSTER' ,nthclus)
212 IF (nthclus > 0) THEN
213 CALL hm_option_start(trim(thfile)//'/CLUSTER')
214 hm_nthgrp = hm_nthgrp + nthclus
215 DO i = 1, nthclus
216 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/BEAM
224 !-------------------------------------------
225 CALL hm_option_count(trim(thfile)//'/BEAM' ,nthbeam)
226 IF (nthbeam > 0) THEN
227 CALL hm_option_start(trim(thfile)//'/BEAM')
228 hm_nthgrp = hm_nthgrp + nthbeam
229 DO i = 1, nthbeam
230 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
231 CALL hm_get_intv('idsmax',idsmax,is_available,lsubmodel)
232 nvartot = nvartot + 180
233 ifi = ifi + nvarp + lvarithb*idsmax + 40*idsmax
234 ENDDO
235 ENDIF
236 !-------------------------------------------
237 ! /TH/TRUS
238 !-------------------------------------------
239 CALL hm_option_count(trim(thfile)//'/TRUSS' ,nthtrus)
240 IF (nthtrus > 0) THEN
241 CALL hm_option_start(trim(thfile)//'/TRUSS')
242 hm_nthgrp = hm_nthgrp + nthtrus
243 DO i = 1, nthtrus
244 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/SPRING
252 !-------------------------------------------
253 CALL hm_option_count(trim(thfile)//'/SPRING' ,nthspring)
254 IF (nthspring > 0) THEN
255 CALL hm_option_start(trim(thfile)//'/SPRING')
256 hm_nthgrp = hm_nthgrp + nthspring
257 DO i = 1, nthspring
258 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/BRIC
266 !-------------------------------------------
267 CALL hm_option_count(trim(thfile)//'/BRIC' ,nthbric)
268 IF (nthbric > 0) THEN
269 CALL hm_option_start(trim(thfile)//'/BRIC')
270 hm_nthgrp = hm_nthgrp + nthbric
271 DO i = 1, nthbric
272 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/NODE
280 !-------------------------------------------
281 CALL hm_option_count(trim(thfile)//'/NODE' ,nthnode)
282 IF (nthnode > 0) THEN
283 CALL hm_option_start(trim(thfile)//'/NODE')
284 hm_nthgrp = hm_nthgrp + nthnode
285 DO i = 1, nthnode
286 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/SHEL
294 !-------------------------------------------
295 CALL hm_option_count(trim(thfile)//'/SHEL' ,nthshel)
296 IF (nthshel > 0) THEN
297 CALL hm_option_start(trim(thfile)//'/SHEL')
298 hm_nthgrp = hm_nthgrp + nthshel
299 DO i = 1, nthshel
300 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/SH3N
308 !-------------------------------------------
309 CALL hm_option_count(trim(thfile)//'/SH3N' ,nthsh3n)
310 IF (nthsh3n > 0) THEN
311 CALL hm_option_start(trim(thfile)//'/SH3N')
312 hm_nthgrp = hm_nthgrp + nthsh3n
313 DO i = 1, nthsh3n
314 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/RBODY
322 !-------------------------------------------
323 CALL hm_option_count(trim(thfile)//'/RBODY' ,nthrbody)
324 IF (nthrbody > 0) THEN
325 CALL hm_option_start(trim(thfile)//'/RBODY')
326 hm_nthgrp = hm_nthgrp + nthrbody
327 DO i = 1, nthrbody
328 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/MONV
336 !-------------------------------------------
337 CALL hm_option_count(trim(thfile)//'/MONV' ,nthmonvol)
338 IF (nthmonvol > 0) THEN
339 CALL hm_option_start(trim(thfile)//'/MONV')
340 hm_nthgrp = hm_nthgrp + nthmonvol
341 DO i = 1, nthmonvol
342 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/PART
350 !-------------------------------------------
351 CALL hm_option_count(trim(thfile)//'/PART' ,hm_nthpart)
352 IF (hm_nthpart > 0) THEN
353 CALL hm_option_start(trim(thfile)//'/PART')
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 ! /TH/SUBSET
362 !-------------------------------------------
363 CALL hm_option_count(trim(thfile)//'/SUBS' ,hm_nthsubs)
364 IF (hm_nthsubs > 0) THEN
365 CALL hm_option_start(trim(thfile)//'/SUBS')
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 ! /TH/FXBODY
374 !-------------------------------------------
375 CALL hm_option_count(trim(thfile)//'/FXBODY' ,hm_nthfxbody)
376 IF (hm_nthfxbody > 0) THEN
377 CALL hm_option_start(trim(thfile)//'/FXBODY')
378 hm_nthgrp = hm_nthgrp + hm_nthfxbody
379 DO i = 1, hm_nthfxbody
380 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/SPHCEL
388 !-------------------------------------------
389 CALL hm_option_count(trim(thfile)//'/SPHCEL' ,hm_nthsphcel )
390 IF (hm_nthsphcel > 0) THEN
391 CALL hm_option_start(trim(thfile)//'/SPHCEL')
392 hm_nthgrp = hm_nthgrp + hm_nthsphcel
393 DO i = 1, hm_nthsphcel
394 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/CYL_JO
402 !-------------------------------------------
403 CALL hm_option_count(trim(thfile)//'/CYL_JO' ,hm_nthcyljo)
404 IF (hm_nthcyljo > 0) THEN
405 CALL hm_option_start(trim(thfile)//'/CYL_JO')
406 hm_nthgrp = hm_nthgrp + hm_nthcyljo
407 DO i = 1, hm_nthcyljo
408 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/FRAME
416 !-------------------------------------------
417 CALL hm_option_count(trim(thfile)//'/FRAME' ,hm_nthframe)
418 IF (hm_nthframe > 0) THEN
419 CALL hm_option_start(trim(thfile)//'/FRAME')
420 hm_nthgrp = hm_nthgrp + hm_nthframe
421 DO i = 1, hm_nthframe
422 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/GAUGE
430 !-------------------------------------------
431 CALL hm_option_count(trim(thfile)//'/GAUGE' ,hm_nthgauge)
432 IF (hm_nthgauge > 0) THEN
433 CALL hm_option_start(trim(thfile)//'/GAUGE')
434 hm_nthgrp = hm_nthgrp + hm_nthgauge
435 DO i = 1, hm_nthgauge
436 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/SPH_FLOW
444 !-------------------------------------------
445 CALL hm_option_count(trim(thfile)//'/SPH_FLOW' ,hm_nthsphflow)
446 IF (hm_nthsphflow > 0) THEN
447 CALL hm_option_start(trim(thfile)//'/SPH_FLOW')
448 hm_nthgrp = hm_nthgrp + hm_nthsphflow
449 DO i = 1, hm_nthsphflow
450 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/QUAD
458 !-------------------------------------------
459 CALL hm_option_count(trim(thfile)//'/QUAD' ,hm_nthquad )
460 IF (hm_nthquad > 0) THEN
461 CALL hm_option_start(trim(thfile)//'/QUAD')
462 hm_nthgrp = hm_nthgrp + hm_nthquad
463 DO i = 1, hm_nthquad
464 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/NSTRAND
472 !-------------------------------------------
473 CALL hm_option_count(trim(thfile)//'/NSTRAND' ,hm_nthnstrand )
474 IF (hm_nthnstrand > 0) THEN
475 CALL hm_option_start(trim(thfile)//'/NSTRAND')
476 hm_nthgrp = hm_nthgrp + hm_nthnstrand
477 DO i = 1, hm_nthnstrand
478 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
479 CALL hm_get_intv('Num_Cards',idsmax,is_available,lsubmodel)
480 nvartot = nvartot + 180 !NVARTOT = NVARTOT + PRETHGRVAR()
481 ifi = ifi + nvarns + lvarithb*idsmax + 40*idsmax ! IFI = IFI + PRETHGRNS(NVARNS)
482 ENDDO
483 ENDIF
484 !-------------------------------------------
485 ! /TH/SURF
486 !-------------------------------------------
487 CALL hm_option_count(trim(thfile)//'/SURF' ,hm_nthsurf )
488 IF (hm_nthsurf > 0) THEN
489 CALL hm_option_start(trim(thfile)//'/SURF')
490 hm_nthgrp = hm_nthgrp + hm_nthsurf
491 DO i = 1, hm_nthsurf
492 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
493 CALL hm_get_intv('idsmax',idsmax,is_available,lsubmodel)
494 nvartot = nvartot + 180 !NVARTOT = NVARTOT + PRETHGRVAR()
495 ifi = ifi + nvarsurf + 43*idsmax ! IFI = IFI + PRETHGRKI(NVARSURF)
496 ENDDO
497 ENDIF
498 !-------------------------------------------
499 ! /TH/TRIA
500 !-------------------------------------------
501 CALL hm_option_count(trim(thfile)//'/TRIA' ,hm_nthtria )
502 IF (hm_nthtria> 0) THEN
503 CALL hm_option_start(trim(thfile)//'/TRIA')
504 hm_nthgrp = hm_nthgrp + hm_nthtria
505 DO i = 1, hm_nthtria
506 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
507 CALL hm_get_intv('idsmax',idsmax,is_available,lsubmodel)
508 nvartot = nvartot + 180 !NVARTOT = NVARTOT + PRETHGRVAR()
509 ifi = ifi + nvars + lvarithb*idsmax + 40*idsmax
510 ENDDO
511 ENDIF
512 !-------------------------------------------
513 ! /TH/SLIPRING
514 !-------------------------------------------
515 CALL hm_option_count(trim(thfile)//'/SLIPRING' ,hm_nthslipring )
516 IF (hm_nthslipring > 0) THEN
517 CALL hm_option_start(trim(thfile)//'/SLIPRING')
518 hm_nthgrp = hm_nthgrp + hm_nthslipring
519 DO i = 1, hm_nthslipring
520 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
521 CALL hm_get_intv('idsmax',idsmax,is_available,lsubmodel)
522 nvartot = nvartot + 180 !NVARTOT = NVARTOT + PRETHGRVAR()
523 ifi = ifi + nvarslip + lvarithb*idsmax + 40*idsmax
524 ENDDO
525 ENDIF
526 !-------------------------------------------
527 ! /TH/RETRACTOR
528 !-------------------------------------------
529 CALL hm_option_count(trim(thfile)//'/RETRACTOR' ,hm_nthretractor )
530 IF (hm_nthretractor > 0) THEN
531 CALL hm_option_start(trim(thfile)//'/RETRACTOR')
532 hm_nthgrp = hm_nthgrp + hm_nthretractor
533 DO i = 1, hm_nthretractor
534 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
535 CALL hm_get_intv('idsmax',idsmax,is_available,lsubmodel)
536 nvartot = nvartot + 180 !NVARTOT = NVARTOT + PRETHGRVAR()
537 ifi = ifi + nvarret + lvarithb*idsmax + 40*idsmax
538 ENDDO
539 ENDIF
540 !-------------------------------------------
541 ! /TH/SENSOR
542 !-------------------------------------------
543 CALL hm_option_count(trim(thfile)//'/SENSOR' ,hm_nthsens )
544 IF (hm_nthsens > 0) THEN
545 CALL hm_option_start(trim(thfile)//'/SENSOR')
546 hm_nthgrp = hm_nthgrp + hm_nthsens
547 DO i = 1, hm_nthsens
548 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/CHECKSUM ( activated automaticaly if /CHECKSUM is used )
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
564c-----------
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)
initmumps id
integer, parameter nchartitle
integer, parameter ncharline