OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_thpart.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_thpart ../starter/source/output/thpart/hm_read_thpart.f
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl ../starter/source/starter/freform.F
30!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
32!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
33!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
34!|| nintri ../starter/source/system/nintrr.F
35!|| nintrigr ../starter/source/system/nintrr.F
36!|| udouble ../starter/source/system/sysfus.F
37!||--- uses -----------------------------------------------------
38!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
39!|| message_mod ../starter/share/message_module/message_mod.F
40!|| submodel_mod ../starter/share/modules1/submodel_mod.F
41!||====================================================================
42 SUBROUTINE hm_read_thpart(IPART ,IGRBRIC ,IGRQUAD ,IGRSH4N ,IGRSH3N,
43 . IGRTRUSS ,IGRBEAM ,IGRSPRING, LSUBMODEL)
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE message_mod
48 USE groupdef_mod
49 USE submodel_mod
50 USE hm_option_read_mod
51 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
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 "scr03_c.inc"
60#include "scr17_c.inc"
61#include "units_c.inc"
62#include "com01_c.inc"
63#include "com04_c.inc"
64#include "com10_c.inc"
65#include "warn_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 INTEGER IPART(LIPART1,*)
70 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
71 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD
72 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
73 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
74 TYPE (GROUP_) , DIMENSION(NGRTRUS) :: IGRTRUSS
75 TYPE (GROUP_) , DIMENSION(NGRBEAM) :: IGRBEAM
76 TYPE (GROUP_) , DIMENSION(NGRSPRI) :: IGRSPRING
77 TYPE(submodel_data) LSUBMODEL(NSUBMOD)
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER PID,MID,SID,ID,I,IMID,IPID,ISID,K,ITH,IGTYP,N,GR,IGR
82 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
83 CHARACTER MESS*40,TYP*6
84 INTEGER IDS, CNT, FLAG_FMT, FLAG_FMT_TMP, IFIX_TMP,NGROU,ITYP
85 CHARACTER(LEN=NCHARKEY) :: KEY
86 LOGICAL IS_ENCRYPTED,IS_AVAILABLE,IS_FOUND_SURF
87 my_real bid
88C-----------------------------------------------
89C E x t e r n a l F u n c t i o n s
90C-----------------------------------------------
91 INTEGER NINTRI,NINTRIGR
92 DATA mess/' THPART DEFINITION '/
93C-----------------------------------------------
94C S o u r c e L i n e s
95C-----------------------------------------------
96 WRITE(iout,'(//A)')' thparts'
97 WRITE(IOUT,'(a//)')' -----'
98
99 IS_ENCRYPTED = .FALSE.
100 IS_AVAILABLE = .FALSE.
101 IS_FOUND_SURF = .FALSE.
102
103 IGRELEM = 0
104 IF(NTHPART>0) IGRELEM = 1
105 CALL HM_OPTION_START('/thpart')
106
107 DO I=1,NTHPART
108
109 TITR = ''
110 TYP = ''
111 CALL HM_OPTION_READ_KEY(LSUBMODEL,OPTION_ID = ID,OPTION_TITR = TITR ,KEYWORD2 = KEY )
112 CALL HM_OPTION_IS_ENCRYPTED(IS_ENCRYPTED)
113
114 TYP(1:6)=KEY(1:6)
115 TITR1=TITR
116 CALL FRETITL(TITR,IPART(LIPART1-LTITR+1,NPART+I),LTITR)
117 CALL HM_GET_INTV('grelem_id', GR ,IS_AVAILABLE,LSUBMODEL)
118
119C ITYP : 1 BRIC,
120C 2 QUAD,
121C 3 SHELL,
122C 4 TRUSS,
123C 5 BEAM,
124C 6 SPRINGS,
125C 7 SHELL_3N
126
127 ITYP = 0
128 IGR = 0
129
130 IF (TYP(1:6) == 'grbric') THEN
131 ITYP = 1
132 IGR = NINTRIGR(GR,IGRBRIC,NGRBRIC)
133 IF (ITYP == IGRBRIC(IGR)%GRTYPE) IS_FOUND_SURF = .TRUE.
134
135 ELSEIF (TYP(1:6) == 'grquad') THEN
136 ITYP = 2
137 IGR = NINTRIGR(GR,IGRQUAD,NGRQUAD)
138 IF (ITYP == IGRQUAD(IGR)%GRTYPE) IS_FOUND_SURF = .TRUE.
139
140 ELSEIF (TYP(1:6) == 'grshel') THEN
141 ITYP = 3
142 IGR = NINTRIGR(GR,IGRSH4N,NGRSHEL)
143 IF (ITYP == IGRSH4N(IGR)%GRTYPE) IS_FOUND_SURF = .TRUE.
144
145 ELSEIF (TYP(1:6) == 'grtrus') THEN
146 ITYP = 4
147 IGR = NINTRIGR(GR,IGRTRUSS,NGRTRUS)
148 IF (ITYP == IGRTRUSS(IGR)%GRTYPE) IS_FOUND_SURF = .TRUE.
149
150 ELSEIF (TYP(1:6) == 'grbeam') THEN
151 ITYP = 5
152 IGR = NINTRIGR(GR,IGRBEAM,NGRBEAM)
153 IF (ITYP == IGRBEAM(IGR)%GRTYPE) IS_FOUND_SURF = .TRUE.
154
155 ELSEIF (TYP(1:6) == 'grspri') THEN
156 ITYP = 6
157 IGR = NINTRIGR(GR,IGRSPRING,NGRSPRI)
158 IF (ITYP == IGRSPRING(IGR)%GRTYPE) IS_FOUND_SURF = .TRUE.
159
160 ELSEIF (TYP(1:6) == 'grsh3n.OR.' TYP(1:6) == 'grtria') THEN
161 ITYP = 7
162 IGR = NINTRIGR(GR,IGRSH3N,NGRSH3N)
163 IF (ITYP == IGRSH3N(IGR)%GRTYPE) IS_FOUND_SURF = .TRUE.
164 ENDIF
165
166.NOT. IF( IS_FOUND_SURF)THEN
167 CALL ANCMSG(MSGID=763,MSGTYPE=MSGERROR,ANMODE=ANINFO,I1=ID,C1=TITR,I2=GR,C2=TYP(1:6))
168 ENDIF
169
170 WRITE(IOUT,'(/a,i10,2a)')'thpart:',ID,',',TRIM(TITR)
171 WRITE(IOUT,'(a)') '----'
172 WRITE(IOUT,'(a,a)')'TYPE of element group : ',TYP(1:6)
173 WRITE(IOUT,'(a,i10)')'element group id : ',GR
174
175 IPART(1,NPART+I)=IGR
176 IPART(2,NPART+I)=ITYP
177 IPART(4,NPART+I)=ID
178
179 IF(IPART(4,NPART+I) == 0) THEN
180 CALL ANCMSG(MSGID=493,MSGTYPE=MSGERROR,ANMODE=ANINFO_BLIND_1,C1=TITR1)
181 ENDIF
182
183 ENDDO
184
185 !-------------------------------------
186 ! Recherche des ID doubles
187 !-------------------------------------
188 CALL UDOUBLE(IPART(4,1),LIPART1,NPART+NTHPART,MESS,0,BID)
189
190 RETURN
191C
192 END
my_real
#define my_real
Definition cppsort.cpp:32
hm_read_thpart
subroutine hm_read_thpart(ipart, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, lsubmodel)
Definition hm_read_thpart.F:44
groupdef_mod
Definition groupdef_mod.F:662
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
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
submodel_mod
Definition submodel_mod.F:712
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723