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-----------------------------------------------
46 USE hm_option_read_mod
47 USE submodel_mod
48 USE groupdef_mod
49 USE names_and_titles_mod , ONLY : nchartitle, ncharline
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,IG,IGS,ID
72 INTEGER IFIX_TMP
73 CHARACTER(LEN=NCHARLINE) :: KEY
74 CHARACTER(LEN=NCHARTITLE) :: TITR
75C-----------------------------------------------
76C P a r a m e t e r s
77C-----------------------------------------------
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,NVARMV,NVARPA
82 INTEGER 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_NTHRETRACTOR,HM_NTHSENS,HM_NTHCHECKSUM
95 LOGICAL IS_AVAILABLE
96C
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)
121C-----------------------------------------------
122C E x t e r n a l
123C-----------------------------------------------
124 INTEGER PRETHGRNE,PRETHGRKI,PRETHGRPA,PRETHGRNS,PRETHGRVAR
125 CHARACTER THFILE*4
126C=======================================================================
127 igs=0
128 is_available = .false.
129 hm_nthgrp = 0
130c
131 ! Choose TH file type
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
153C
154 !-------------------------------------------
155 ! /TH/ACCEL
156 !-------------------------------------------
157 CALL hm_option_count(trim(thfile)//'/ACCEL',nthaccel)
158 IF (nthaccel > 0) THEN
159 CALL hm_option_start(trim(thfile)//'/ACCEL')
160 hm_nthgrp = hm_nthgrp + nthaccel
161 DO i = 1, nthaccel
162 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/INTER
170 !-------------------------------------------
171 CALL hm_option_count(trim(thfile)//'/INTER' ,nthinter )
172 IF (nthinter > 0) THEN
173 CALL hm_option_start(trim(thfile)//'/INTER')
174 hm_nthgrp = hm_nthgrp + nthinter
175 DO i = 1, nthinter
176 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/RWALL
184 !-------------------------------------------
185 CALL hm_option_count(trim(thfile)//'/RWALL' ,nthrwall )
186 IF (nthrwall > 0) THEN
187 CALL hm_option_start(trim(thfile)//'/RWALL')
188 hm_nthgrp = hm_nthgrp + nthrwall
189 DO i = 1, nthrwall
190 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/SECTIO
198 !-------------------------------------------
199 CALL hm_option_count(trim(thfile)//'/SECTIO' ,nthsectio)
200 IF (nthsectio > 0) THEN
201 CALL hm_option_start(trim(thfile)//'/SECTIO')
202 hm_nthgrp = hm_nthgrp + nthsectio
203 DO i = 1, nthsectio
204 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/CLUSTER
212 !-------------------------------------------
213 CALL hm_option_count(trim(thfile)//'/CLUSTER' ,nthclus)
214 IF (nthclus > 0) THEN
215 CALL hm_option_start(trim(thfile)//'/CLUSTER')
216 hm_nthgrp = hm_nthgrp + nthclus
217 DO i = 1, nthclus
218 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/BEAM
226 !-------------------------------------------
227 CALL hm_option_count(trim(thfile)//'/BEAM' ,nthbeam)
228 IF (nthbeam > 0) THEN
229 CALL hm_option_start(trim(thfile)//'/BEAM')
230 hm_nthgrp = hm_nthgrp + nthbeam
231 DO i = 1, nthbeam
232 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/BRIC
268 !-------------------------------------------
269 CALL hm_option_count(trim(thfile)//'/BRIC' ,nthbric)
270 IF (nthbric > 0) THEN
271 CALL hm_option_start(trim(thfile)//'/BRIC')
272 hm_nthgrp = hm_nthgrp + nthbric
273 DO i = 1, nthbric
274 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/NODE
282 !-------------------------------------------
283 CALL hm_option_count(trim(thfile)//'/NODE' ,nthnode)
284 IF (nthnode > 0) THEN
285 CALL hm_option_start(trim(thfile)//'/NODE')
286 hm_nthgrp = hm_nthgrp + nthnode
287 DO i = 1, nthnode
288 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/SHEL
296 !-------------------------------------------
297 CALL hm_option_count(trim(thfile)//'/SHEL' ,nthshel)
298 IF (nthshel > 0) THEN
299 CALL hm_option_start(trim(thfile)//'/SHEL')
300 hm_nthgrp = hm_nthgrp + nthshel
301 DO i = 1, nthshel
302 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/SH3N
310 !-------------------------------------------
311 CALL hm_option_count(trim(thfile)//'/SH3N' ,nthsh3n)
312 IF (nthsh3n > 0) THEN
313 CALL hm_option_start(trim(thfile)//'/SH3N')
314 hm_nthgrp = hm_nthgrp + nthsh3n
315 DO i = 1, nthsh3n
316 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/RBODY
324 !-------------------------------------------
325 CALL hm_option_count(trim(thfile)//'/RBODY' ,nthrbody)
326 IF (nthrbody > 0) THEN
327 CALL hm_option_start(trim(thfile)//'/RBODY')
328 hm_nthgrp = hm_nthgrp + nthrbody
329 DO i = 1, nthrbody
330 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/MONV
338 !-------------------------------------------
339 CALL hm_option_count(trim(thfile)//'/MONV' ,nthmonvol)
340 IF (nthmonvol > 0) THEN
341 CALL hm_option_start(trim(thfile)//'/MONV')
342 hm_nthgrp = hm_nthgrp + nthmonvol
343 DO i = 1, nthmonvol
344 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/PART
352 !-------------------------------------------
353 CALL hm_option_count(trim(thfile)//'/PART' ,hm_nthpart)
354 IF (hm_nthpart > 0) THEN
355 CALL hm_option_start(trim(thfile)//'/PART')
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 ! /TH/SUBSET
364 !-------------------------------------------
365 CALL hm_option_count(trim(thfile)//'/SUBS' ,hm_nthsubs)
366 IF (hm_nthsubs > 0) THEN
367 CALL hm_option_start(trim(thfile)//'/SUBS')
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 ! /TH/FXBODY
376 !-------------------------------------------
377 CALL hm_option_count(trim(thfile)//'/FXBODY' ,hm_nthfxbody)
378 IF (hm_nthfxbody > 0) THEN
379 CALL hm_option_start(trim(thfile)//'/FXBODY')
380 hm_nthgrp = hm_nthgrp + hm_nthfxbody
381 DO i = 1, hm_nthfxbody
382 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/SPHCEL
390 !-------------------------------------------
391 CALL hm_option_count(trim(thfile)//'/SPHCEL' ,hm_nthsphcel )
392 IF (hm_nthsphcel > 0) THEN
393 CALL hm_option_start(trim(thfile)//'/SPHCEL')
394 hm_nthgrp = hm_nthgrp + hm_nthsphcel
395 DO i = 1, hm_nthsphcel
396 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/CYL_JO
404 !-------------------------------------------
405 CALL hm_option_count(trim(thfile)//'/CYL_JO' ,hm_nthcyljo)
406 IF (hm_nthcyljo > 0) THEN
407 CALL hm_option_start(trim(thfile)//'/CYL_JO')
408 hm_nthgrp = hm_nthgrp + hm_nthcyljo
409 DO i = 1, hm_nthcyljo
410 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/FRAME
418 !-------------------------------------------
419 CALL hm_option_count(trim(thfile)//'/FRAME' ,hm_nthframe)
420 IF (hm_nthframe > 0) THEN
421 CALL hm_option_start(trim(thfile)//'/FRAME')
422 hm_nthgrp = hm_nthgrp + hm_nthframe
423 DO i = 1, hm_nthframe
424 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/GAUGE
432 !-------------------------------------------
433 CALL hm_option_count(trim(thfile)//'/GAUGE' ,hm_nthgauge)
434 IF (hm_nthgauge > 0) THEN
435 CALL hm_option_start(trim(thfile)//'/GAUGE')
436 hm_nthgrp = hm_nthgrp + hm_nthgauge
437 DO i = 1, hm_nthgauge
438 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/SPH_FLOW
446 !-------------------------------------------
447 CALL hm_option_count(trim(thfile)//'/SPH_FLOW' ,hm_nthsphflow)
448 IF (hm_nthsphflow > 0) THEN
449 CALL hm_option_start(trim(thfile)//'/SPH_FLOW')
450 hm_nthgrp = hm_nthgrp + hm_nthsphflow
451 DO i = 1, hm_nthsphflow
452 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/QUAD
460 !-------------------------------------------
461 CALL hm_option_count(trim(thfile)//'/QUAD' ,hm_nthquad )
462 IF (hm_nthquad > 0) THEN
463 CALL hm_option_start(trim(thfile)//'/QUAD')
464 hm_nthgrp = hm_nthgrp + hm_nthquad
465 DO i = 1, hm_nthquad
466 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/NSTRAND
474 !-------------------------------------------
475 CALL hm_option_count(trim(thfile)//'/NSTRAND' ,hm_nthnstrand )
476 IF (hm_nthnstrand > 0) THEN
477 CALL hm_option_start(trim(thfile)//'/NSTRAND')
478 hm_nthgrp = hm_nthgrp + hm_nthnstrand
479 DO i = 1, hm_nthnstrand
480 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
481 CALL hm_get_intv('Num_Cards',idsmax,is_available,lsubmodel)
482 nvartot = nvartot + 180 !NVARTOT = NVARTOT + PRETHGRVAR()
483 ifi = ifi + nvarns + lvarithb*idsmax + 40*idsmax ! IFI = IFI + PRETHGRNS(NVARNS)
484 ENDDO
485 ENDIF
486 !-------------------------------------------
487 ! /TH/SURF
488 !-------------------------------------------
489 CALL hm_option_count(trim(thfile)//'/SURF' ,hm_nthsurf )
490 IF (hm_nthsurf > 0) THEN
491 CALL hm_option_start(trim(thfile)//'/SURF')
492 hm_nthgrp = hm_nthgrp + hm_nthsurf
493 DO i = 1, hm_nthsurf
494 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
495 CALL hm_get_intv('idsmax',idsmax,is_available,lsubmodel)
496 nvartot = nvartot + 180 !NVARTOT = NVARTOT + PRETHGRVAR()
497 ifi = ifi + nvarsurf + 43*idsmax ! IFI = IFI + PRETHGRKI(NVARSURF)
498 ENDDO
499 ENDIF
500 !-------------------------------------------
501 ! /TH/TRIA
502 !-------------------------------------------
503 CALL hm_option_count(trim(thfile)//'/TRIA' ,hm_nthtria )
504 IF (hm_nthtria> 0) THEN
505 CALL hm_option_start(trim(thfile)//'/TRIA')
506 hm_nthgrp = hm_nthgrp + hm_nthtria
507 DO i = 1, hm_nthtria
508 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
509 CALL hm_get_intv('idsmax',idsmax,is_available,lsubmodel)
510 nvartot = nvartot + 180 !NVARTOT = NVARTOT + PRETHGRVAR()
511 ifi = ifi + nvars + lvarithb*idsmax + 40*idsmax
512 ENDDO
513 ENDIF
514 !-------------------------------------------
515 ! /TH/SLIPRING
516 !-------------------------------------------
517 CALL hm_option_count(trim(thfile)//'/SLIPRING' ,hm_nthslipring )
518 IF (hm_nthslipring > 0) THEN
519 CALL hm_option_start(trim(thfile)//'/SLIPRING')
520 hm_nthgrp = hm_nthgrp + hm_nthslipring
521 DO i = 1, hm_nthslipring
522 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
523 CALL hm_get_intv('idsmax',idsmax,is_available,lsubmodel)
524 nvartot = nvartot + 180 !NVARTOT = NVARTOT + PRETHGRVAR()
525 ifi = ifi + nvarslip + lvarithb*idsmax + 40*idsmax
526 ENDDO
527 ENDIF
528 !-------------------------------------------
529 ! /TH/RETRACTOR
530 !-------------------------------------------
531 CALL hm_option_count(trim(thfile)//'/RETRACTOR' ,hm_nthretractor )
532 IF (hm_nthretractor > 0) THEN
533 CALL hm_option_start(trim(thfile)//'/RETRACTOR')
534 hm_nthgrp = hm_nthgrp + hm_nthretractor
535 DO i = 1, hm_nthretractor
536 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
537 CALL hm_get_intv('idsmax',idsmax,is_available,lsubmodel)
538 nvartot = nvartot + 180 !NVARTOT = NVARTOT + PRETHGRVAR()
539 ifi = ifi + nvarret + lvarithb*idsmax + 40*idsmax
540 ENDDO
541 ENDIF
542 !-------------------------------------------
543 ! /TH/SENSOR
544 !-------------------------------------------
545 CALL hm_option_count(trim(thfile)//'/SENSOR' ,hm_nthsens )
546 IF (hm_nthsens > 0) THEN
547 CALL hm_option_start(trim(thfile)//'/SENSOR')
548 hm_nthgrp = hm_nthgrp + hm_nthsens
549 DO i = 1, hm_nthsens
550 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
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 ! /TH/CHECKSUM ( activated automaticaly if /CHECKSUM is used )
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
566c-----------
567 RETURN
568 END
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_count
subroutine hm_option_count(entity_type, hm_option_number)
Definition hm_option_count.F:105
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_read_prethgrou
subroutine hm_read_prethgrou(ifi, nvartot, lsubmodel, iflag, output)
Definition hm_read_prethgrou.F:38
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1001
submodel_mod
Definition submodel_mod.F:712
submodel_mod::submodel_data
Definition submodel_mod.F:723