OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prethgrou.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| hm_read_prethgrou ../starter/source/output/th/hm_read_prethgrou.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
29!|| hm_option_count ../starter/source/devtools/hm_reader/hm_option_count.F
30!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
31!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
32!||--- uses -----------------------------------------------------
33!|| checksum_starter_option_mod ../starter/source/output/checksum/checksum_option.F90
34!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
35!|| submodel_mod ../starter/share/modules1/submodel_mod.F
36!||====================================================================
37 SUBROUTINE hm_read_prethgrou(IFI,NVARTOT,LSUBMODEL,IFLAG,OUTPUT)
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
566 END
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_count(entity_type, hm_option_number)
subroutine hm_option_start(entity_type)
subroutine hm_read_prethgrou(ifi, nvartot, lsubmodel, iflag, output)
integer, parameter nchartitle
integer, parameter ncharline