OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_thvarc.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_thvarc ../starter/source/output/th/hm_read_thvarc.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_thgrki ../starter/source/output/th/hm_read_thgrki.F
27!|| hm_read_thgrki_rbody ../starter/source/output/th/hm_read_thgrki_rbody.F
28!|| hm_read_thgrne ../starter/source/output/th/hm_read_thgrne.F
29!|| hm_read_thgrns ../starter/source/output/th/hm_read_thgrns.F
30!|| hm_read_thgrpa ../starter/source/output/th/hm_read_thgrpa.F
31!|| hm_read_thgrpa_sub ../starter/source/output/th/hm_read_thgrpa.F
32!|| hm_read_thgrsens ../starter/source/output/th/hm_read_thgrsens.F
33!|| hm_read_thgrsurf ../starter/source/output/th/hm_read_thgrsurf.F
34!|| hm_thgrki_vent ../starter/source/output/th/hm_thgrki_vent.F
35!||--- calls -----------------------------------------------------
36!|| ancmsg ../starter/source/output/message/message.F
37!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
38!|| hm_get_string_index ../starter/source/devtools/hm_reader/hm_get_string_index.F
39!||--- uses -----------------------------------------------------
40!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
41!|| message_mod ../starter/share/message_module/message_mod.F
42!|| submodel_mod ../starter/share/modules1/submodel_mod.F
43!|| th_mod ../starter/share/modules1/th_mod.F90
44!||====================================================================
45 INTEGER FUNCTION hm_thvarc(VARE,NV,IVAR,VARG,NVG,IVARG,NV0,ID,TITR,LSUBMODEL)
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE message_mod
50 USE submodel_mod
51 USE hm_option_read_mod
52 USE names_and_titles_mod , ONLY : nchartitle
53 USE th_mod , ONLY : th_has_noda_pext
54C-----------------------------------------------
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57#include "implicit_f.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "r2r_c.inc"
62C-----------------------------------------------
63 INTEGER nv,nvg,IVAR(*),ivarg(18,*),NV0
64 CHARACTER*10,TARGET :: vare(nv),varg(nvg)
65 INTEGER id
66 CHARACTER(LEN=NCHARTITLE) :: titr
67 TYPE(submodel_data) lsubmodel(nsubmod)
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 LOGICAL is_available
72 INTEGER,DIMENSION(:),ALLOCATABLE :: tag
73 CHARACTER var*10
74 INTEGER jrec,nvar,tru,n,l,m,i,j,k,ok
75C-----------------------------------------------
76C S o u r c e L i n e s
77C-----------------------------------------------
78 ! Tag must start from 0
79 ALLOCATE(tag(0:nv))
80C
81 ! Number of variables indicated by the user
82 CALL hm_get_intv('Number_Of_Variables',nvar,is_available,lsubmodel)
83c
84 ! Initialization of the tag table
85 DO i=1,nv
86 tag(i)=0
87 ENDDO
88c
89 ! Loop over variables
90 DO k=1,nvar
91 CALL hm_get_string_index('VAR',var,k,10,is_available)
92 var(len_trim(var)+1:10)=' '
93 IF (var(1:4) == 'QVIS')var='BULK'
94 IF (var(1:6) == 'ALL_42') THEN
95 DO i=1,nv0
96 tag(i)=1
97 ENDDO
98 ELSEIF (var(1:3) == 'ALL') THEN
99 CALL ancmsg(msgid=551,
100 . msgtype=msgerror,
101 . anmode=aninfo,
102 . i1=id,
103 . c1=titr,
104 . c2=var)
105 ELSEIF (var(1:5) == ' ') THEN
106 cycle
107 ELSE
108 ok = 0
109 DO i=1,nvg
110 IF(var == varg(i))THEN
111 DO j=1,18
112 tag(ivarg(j,i))=1
113 ENDDO
114 ok=1
115 EXIT
116 ENDIF
117 ENDDO
118c
119 IF(ok==0)THEN
120 DO i=1,nv
121 IF(var == vare(i))THEN
122 IF(var(1:4) == 'PEXT ')THEN
123 th_has_noda_pext = 1
124 ENDIF
125 tag(i)=1
126 ok=1
127C---------Multidomaines : pour les subsets, on stocke des infos en plus dans le th pour merge---------
128 IF ((nsubdom>0).AND.(sub_flag==1002)) THEN
129 IF (i>=9) THEN
130 tag(3) = 1
131 tag(4) = 1
132 tag(5) = 1
133 tag(6) = 1
134 tag(9) = 1
135 tag(10) = 1
136 tag(11) = 1
137 ENDIF
138 IF (i==23) THEN
139 DO j=12,20
140 tag(j)=1
141 ENDDO
142 ENDIF
143 ENDIF
144C--------- ----------------------------------------------------------------------------------------------
145 EXIT
146 ENDIF
147 ENDDO
148 ENDIF
149
150 IF(ok==0)THEN
151 CALL ancmsg(msgid=260,
152 . msgtype=msgerror,
153 . anmode=aninfo,
154 . i1=id,
155 . c1=titr,
156 . c2=var)
157 ENDIF
158 ENDIF
159 ENDDO
160
161 nvar=0
162 DO i=1,nv
163 IF(tag(i) /= 0)THEN
164 nvar=nvar+1
165 ivar(nvar)=i
166 ENDIF
167 ENDDO
168
169
170 hm_thvarc=nvar
171
172 DEALLOCATE(tag)
173 RETURN
174 END
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_get_string_index
subroutine hm_get_string_index(name, sval, index, size, is_available)
Definition hm_get_string_index.F:53
hm_thvarc
integer function hm_thvarc(vare, nv, ivar, varg, nvg, ivarg, nv0, id, titr, lsubmodel)
Definition hm_read_thvarc.F:46
id
initmumps id
Definition multiplerhs_example.m:4
hm_option_read_mod
Definition hm_option_read_mod.F:408
message_mod
Definition message_mod.F:1249
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
submodel_mod
Definition submodel_mod.F:712
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
th_mod
Definition th_mod.F:42
th_mod::th_has_noda_pext
integer th_has_noda_pext
Definition th_mod.F:121
nvar
integer function nvar(text)
Definition nvar.F:32
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
submodel_mod::submodel_data
Definition submodel_mod.F:723