OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop34.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_prop34 ../starter/source/properties/sph/hm_read_prop34.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_prop_generic ../starter/source/properties/hm_read_prop_generic.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.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!|| set_u_geo ../starter/source/user_interface/uaccess.F
33!|| set_u_pnu ../starter/source/user_interface/uaccess.F
34!||--- uses -----------------------------------------------------
35!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
36!|| message_mod ../starter/share/message_module/message_mod.F
37!|| submodel_mod ../starter/share/modules1/submodel_mod.F
38!||====================================================================
39 SUBROUTINE hm_read_prop34(GEO, IGEO ,IOUT ,NUVAR ,PARGEO,
40 . QA, QB ,ISKN ,IG ,TITR ,UNITAB,
41 . PROP_TAG,IGTYP,LSUBMODEL)
42C============================================================================
43C M o d u l e s
44C-----------------------------------------------
45 USE unitab_mod
46 USE message_mod
47 USE elbuftag_mod
48 USE submodel_mod
49 USE names_and_titles_mod , ONLY : nchartitle
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com01_c.inc"
58#include "param_c.inc"
59#include "sphcom.inc"
60#include "tablen_c.inc"
61C-----------------------------------------------
62C A n a l y s e M o d u l e
63C-----------------------------------------------
64C----------+---------+---+---+--------------------------------------------
65C VAR | SIZE |TYP| RW| DEFINITION
66C----------+---------+---+---+--------------------------------------------
67C IOUT | 1 | I | R | OUTPUT FILE UNIT (L00 file)
68C NUVAR | 1 | I | W | NUMBER OF USER ELEMENT VARIABLES
69C----------+---------+---+---+--------------------------------------------
70C PARGEO | * | F | W | 1)SKEW NUMBER
71C | | | | 2)STIFNESS FOR INTERFACE
72C | | | | 3)FRONT WAVE OPTION
73C | | | | 4)... not yet used
74C----------+---------+---+---+--------------------------------------------
75C
76C This subroutine read the user geometry parameters.
77C
78C The geometry datas has to bee stored in radioss storage
79C with the function SET_U_GEO(value_index,value).
80C
81C If some standard radioss functions (time function or
82C x,y function) are used, this function IDs has to
83C bee stored with the function SET_U_PNU(func_index,func_id,KFUNC).
84C
85C If this property refers to a user material, this
86C material IDs has to bee stored with the function
87C SET_U_PNU(mat_index,mat_id,KMAT).
88C
89C If this property refers to a user property, this
90C sub-property IDs has to bee stored with the function
91C SET_U_PNU(sub_prop_index,sub_prop_id,KMAT).
92C
93C SET_U_GEO and SET_U_PNU return 0 if no error
94C SET_U_GEO and SET_U_PNU return the maximum allowed index
95C if index is larger than this maximum
96C-----------------------------------------------
97C D u m m y A r g u m e n t s
98C-----------------------------------------------
99 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
100 INTEGER IOUT,NUVAR,ISKN(LISKN,*),IG,IGTYP,IGEO(*)
101 CHARACTER(LEN=NCHARTITLE)::TITR
102 my_real
103 . pargeo(*), geo(*)
104 TYPE(prop_tag_) , DIMENSION(0:MAXPROP) :: PROP_TAG
105 INTEGER SET_U_PNU,SET_U_GEO
106 EXTERNAL set_u_pnu,set_u_geo
107 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
108C=======================================================================
109C-----------------------------------------------
110C C o m m o n B l o c k s
111C-----------------------------------------------
112#include "com04_c.inc"
113C-----------------------------------------------
114C L o c a l V a r i a b l e s
115C-----------------------------------------------
116 INTEGER IERROR,IORDER,ISK,K
117 my_real
118 . xk,mp,qa,qb,alpcs,xorder,dist,pun,zstab,
119 . hmin,hmax,h_scal
120 INTEGER IFLG_H
121 my_real
122 . h_dilat_coeff,rflg_h
123 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
124C-----------------------------------------------
125C E x t e r n a l F u n c t i o n s
126C-----------------------------------------------
127 DATA pun/0.1/
128C-----------------------------------------------
129
130 nuvar=0
131 pargeo(1) = 0
132 xk=0.0
133 pargeo(2)=xk
134C front wave=1
135 pargeo(3) =1
136C-------
137 isk=0
138 iflg_h=0
139 iorder=-1
140 dist =zero
141 zstab =zero
142C
143C--------------------------------------------------
144C EXTRACT DATA (IS OPTION CRYPTED)
145C--------------------------------------------------
146 CALL hm_option_is_encrypted(is_encrypted)
147C--------------------------------------------------
148C EXTRACT DATAS (INTEGER VALUES)
149C--------------------------------------------------
150 CALL hm_get_intv('SKEW_CSID',isk,is_available,lsubmodel)
151 CALL hm_get_intv('h_1d',IFLG_H,IS_AVAILABLE,LSUBMODEL)
152 CALL HM_GET_INTV('order',IORDER,IS_AVAILABLE,LSUBMODEL)
153C--------------------------------------------------
154C EXTRACT DATAS (REAL VALUES)
155C--------------------------------------------------
156 CALL HM_GET_FLOATV('mass',MP,IS_AVAILABLE,LSUBMODEL,UNITAB)
157 CALL HM_GET_FLOATV('qa',QA,IS_AVAILABLE,LSUBMODEL,UNITAB)
158 CALL HM_GET_FLOATV('qb',QB,IS_AVAILABLE,LSUBMODEL,UNITAB)
159 CALL HM_GET_FLOATV('alpha1',ALPCS,IS_AVAILABLE,LSUBMODEL,UNITAB)
160 CALL HM_GET_FLOATV('h',DIST,IS_AVAILABLE,LSUBMODEL,UNITAB)
161 CALL HM_GET_FLOATV('xi_stab',ZSTAB,IS_AVAILABLE,LSUBMODEL,UNITAB)
162 CALL HM_GET_FLOATV('hmin',HMIN,IS_AVAILABLE,LSUBMODEL,UNITAB)
163 CALL HM_GET_FLOATV('hmax',HMAX,IS_AVAILABLE,LSUBMODEL,UNITAB)
164 CALL HM_GET_FLOATV('h_scal',H_SCAL,IS_AVAILABLE,LSUBMODEL,UNITAB)
165C----------------------
166C
167 WRITE(IOUT,1100) IG
168
169 IF(QA==ZERO)QA=TWO
170 IF(QB==ZERO)QB=ONE
171 IF (ZSTAB>0) NSPBUF=15
172C
173 IF (IFLG_H == 3) THEN
174 IF(HMIN==ZERO) HMIN = ZEP2
175 IF(HMAX==ZERO) HMAX = TWO
176 IF(H_SCAL==ZERO) H_SCAL = ONEP2
177 ENDIF
178C
179 IF(ISK /= 0)THEN
180 DO K=1,NUMSKW
181 IF(ISK == ISKN(4,K+1)) THEN
182 PARGEO(1)=(K+1)+PUN
183 GO TO 100
184 ENDIF
185 ENDDO
186 CALL ANCMSG(MSGID=137,ANMODE=ANINFO,MSGTYPE=MSGERROR,
187 . C1='property',
188 . C2='property',
189 . I1=IG,I2=ISK,C3=TITR)
190100 CONTINUE
191 ELSE
192 PARGEO(1)=ZERO
193 K = 1
194 ENDIF
195C------
196C IF(NSPMD > 1 .AND. IORDER==1)THEN
197C CALL ANCMSG(MSGID=755,
198C . MSGTYPE=MSGERROR,
199C . ANMODE=ANINFO,
200C . C1='SPH CORRECTION ORDER 1')
201C END IF
202C
203 RFLG_H = IFLG_H
204C
205 IF (IFLG_H==1) THEN
206 H_DILAT_COEFF = ONE
207 ELSEIF (IFLG_H==2) THEN
208 H_DILAT_COEFF = ZERO
209 ELSE
210 H_DILAT_COEFF = THIRD
211 ENDIF
212C
213 IF(IS_ENCRYPTED)THEN
214 WRITE(IOUT,'(5x,a,//)')' confidential data'
215 ELSE
216 IF(DIST==ZERO)THEN
217 WRITE(IOUT,1000)MP,QA,QB,ALPCS,ZSTAB,ISK,IORDER
218 IF (IFLG_H==3) THEN
219 WRITE(IOUT,1005)
220 ELSE
221 WRITE(IOUT,1004)
222 ENDIF
223 ELSE
224 WRITE(IOUT,1001)MP,QA,QB,ALPCS,ZSTAB,ISK,IORDER,DIST
225 ENDIF
226 IF (IFLG_H==1) THEN
227 WRITE(IOUT,1002)
228 ELSEIF (IFLG_H==2) THEN
229 WRITE(IOUT,1003)
230 ELSEIF (IFLG_H==3) THEN
231 WRITE(IOUT,1006) HMIN,HMAX,H_SCAL
232 END IF
233 ENDIF
234
235 IF(MP<=ZERO)THEN
236 CALL ANCMSG(MSGID=138,ANMODE=ANINFO,MSGTYPE=MSGWARNING,
237 . C1=TITR,I1=IG)
238 MP=ONE
239 ENDIF
240C
241 IERROR = SET_U_GEO(1,MP)
242 IERROR = SET_U_GEO(2,QA)
243 IERROR = SET_U_GEO(3,QB)
244 IERROR = SET_U_GEO(4,ALPCS)
245 XORDER = IORDER+EM01
246 IERROR = SET_U_GEO(5,XORDER)
247 IERROR = SET_U_GEO(6,DIST)
248 IERROR = SET_U_GEO(7,ZSTAB)
249 IERROR = SET_U_GEO(8,H_DILAT_COEFF)
250 IERROR = SET_U_GEO(9,RFLG_H)
251 IERROR = SET_U_GEO(10,HMIN)
252 IERROR = SET_U_GEO(11,HMAX)
253 IERROR = SET_U_GEO(12,H_SCAL)
254C
255 GEO(14)=QA
256 GEO(15)=QB
257.OR. IF (GEO(16) /= ZERO GEO(17) /= ZERO) THEN
258 IGEO(33) = 1 ! ISVIS flag
259 ENDIF
260C
261 PROP_TAG(IGTYP)%G_SIG = 6
262 PROP_TAG(IGTYP)%G_VOL = 1
263 PROP_TAG(IGTYP)%G_EINT = 1
264 PROP_TAG(IGTYP)%G_QVIS = 1
265 PROP_TAG(IGTYP)%L_SIG = 6
266 PROP_TAG(IGTYP)%L_EINT = 1
267 PROP_TAG(IGTYP)%L_VOL = 1
268 PROP_TAG(IGTYP)%L_QVIS = 1
269C
270 RETURN
271C------
272 999 CONTINUE
273C WRITE(IOUT,*)' **ERROR IN SPH PROPERTY INPUT.'
274C IERR=IERR+1
275C CALL ARRET(2)
276 CALL ANCMSG(MSGID=401,
277 . MSGTYPE=MSGERROR,
278 . ANMODE=ANINFO,
279 . I1=IG,
280 . C2=TITR,
281 . C1='sph')
282 RETURN
283C------
284 1000 FORMAT(
285 & 5X,'particles mass. . . . . . . . . . . . .=',1PG20.13/,
286 & 5X,'qa. . . . . . . . . . . . . . . . . . .=',1PG20.13/,
287 & 5X,'qb. . . . . . . . . . . . . . . . . . .=',1PG20.13/,
288 & 5X,'alpcs . . . . . . . . . . . . . . . . .=',1PG20.13/,
289 & 5X,'coefficient wrt tensile instability . .=',1PG20.13/,
290 & 5X,'orthotropic initial skew system . . . .=',I10/,
291 & 5X,'formulation correction order. . . . . .=',I10/,
292 & 5X,'smoothing length automatically computed')
293 1001 FORMAT(
294 & 5X,'particles mass. . . . . . . . . . . . .=',1PG20.13/,
295 & 5X,'qa. . . . . . . . . . . . . . . . . . .=',1PG20.13/,
296 & 5X,'qb. . . . . . . . . . . . . . . . . . .=',1PG20.13/,
297 & 5X,'alpcs . . . . . . . . . . . . . . . . .=',1PG20.13/,
298 & 5X,'coefficient wrt tensile instability . .=',1PG20.13/,
299 & 5X,'orthotropic initial skew system . . . .=',I10/,
300 & 5X,'formulation correction order. . . . . .=',I10/,
301 & 5X,'smoothing length. . . . . . . . . . . .=',1PG20.13)
302 1002 FORMAT(
303 & 5X,'uniaxial dilatation of smoothing length')
304 1003 FORMAT(
305 & 5X,'constant smoothing length')
306 1004 FORMAT(
307 & 5X,'smoothing length computed from particle mass')
308 1005 FORMAT(
309 & 5X,'smoothing length computed from interparticle distance')
310 1006 FORMAT(
311 & 5X,'bounded dilatation of smoothing length'/,
312 & 5X,'minimum dilatation ratio . . . . . . . =',1PG20.13/,
313 & 5X,'maximum dilatation ratio . . . . . . . =',1PG20.13/,
314 & 5X,'smoothing length scaling factor. . . . =',1PG20.13)
315 1100 FORMAT(
316 & 5X,'sph property set'/,
317 & 5X,'property set number . . . . . . . . . .=',I10)
318 END
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
hm_read_prop34
subroutine hm_read_prop34(geo, igeo, iout, nuvar, pargeo, qa, qb, iskn, ig, titr, unitab, prop_tag, igtyp, lsubmodel)
Definition hm_read_prop34.F:42
elbuftag_mod
Definition elbuftag_mod.F:227
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
unitab_mod
Definition unitab_mod.F:513
elbuftag_mod::prop_tag_
Definition elbuftag_mod.F:374
submodel_mod::submodel_data
Definition submodel_mod.F:723