OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
set_admesh.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!|| set_admesh ../starter/source/model/remesh/set_admesh.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.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_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
31!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.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!||--- uses -----------------------------------------------------
35!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
36!|| message_mod ../starter/share/message_module/message_mod.F
37!|| submodel_mod ../starter/share/modules1/submodel_mod.F
38!||====================================================================
39 SUBROUTINE set_admesh(IPART ,IPADMESH,PADMESH,UNITAB,LSUBMODEL)
40C============================================================================
41C M o d u l e s
42C-----------------------------------------------
43 USE message_mod
44 USE hm_option_read_mod
45 USE submodel_mod
46 USE unitab_mod
47 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
48C----------------------------------------------------------
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "param_c.inc"
57#include "com04_c.inc"
58#include "scr17_c.inc"
59#include "units_c.inc"
60#include "remesh_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER IPART(LIPART1,*), IPADMESH(KIPADMESH,*)
65C REAL
66 my_real
67 . padmesh(kpadmesh,*)
68 TYPE(submodel_data) LSUBMODEL(*)
69 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER ID, N,IP,I,J,INILEV,NPART_ADM,ID_IP
74 my_real angl,angldegr,thkerr
75 CHARACTER MESS*40
76 CHARACTER(LEN=NCHARTITLE) :: TITR
77 CHARACTER(LEN=NCHARKEY) :: KEY,KEY2
78
79 LOGICAL IS_AVAILABLE
80C-----------------------------------------------
81 DATA mess /'OPTIONS FOR ADAPTIVE MESHING DEFINITION '/
82C-----------------------------------------------
83 WRITE(iout,1000)
84C------
85C--------------------------------------------------
86C READING /ADMESH/GLOBAL
87C--------------------------------------------------
88
89C--------* START BROWSING MODEL ADMESH OPTIONS *------
90C
91 CALL hm_option_start('/ADMESH/GLOBAL')
92
93 DO n =1,nadmeshg
94 titr = ''
95
96 CALL hm_option_read_key(lsubmodel,
97 . option_titr = titr,
98 . keyword2 = key,
99 . keyword3 = key2)
100
101C
102 is_available = .false.
103
104 CALL hm_get_intv('LEVEL',levelmax,is_available,lsubmodel)
105 CALL hm_get_intv('Iadmrule',iadmrule,is_available,lsubmodel)
106 CALL hm_get_intv('Istatcnd',istatcnd,is_available,lsubmodel)
107C
108C--------* EXTRACT DATAS (REAL VALUES) *------
109C
110 CALL hm_get_floatv('Tdelay',dtadmesh,is_available,lsubmodel,unitab)
111C
112
113 ENDDO
114C------
115
116 WRITE(iout,1100) levelmax,iadmrule,dtadmesh,istatcnd
117C------
118 WRITE(iout,1200)
119
120C--------------------------------------------------
121C READING /ADMESH/SET
122C--------------------------------------------------
123
124 CALL hm_option_start('/ADMESH/SET')
125
126 DO n =1,nadmeshset
127 titr = ''
128
129 CALL hm_option_read_key(lsubmodel,
130 . option_id = id,
131 . option_titr = titr,
132 . keyword2 = key)
133
134C
135 is_available = .false.
136
137 CALL hm_get_intv('level',INILEV,IS_AVAILABLE,LSUBMODEL)
138 CALL HM_GET_INTV('nip',NPART_ADM,IS_AVAILABLE,LSUBMODEL)
139C
140C--------* EXTRACT DATAS (REAL VALUES) *------
141C
142 CALL HM_GET_FLOATV('angle2',ANGLDEGR,IS_AVAILABLE,LSUBMODEL,UNITAB)
143 CALL HM_GET_FLOATV('thkerr',THKERR,IS_AVAILABLE,LSUBMODEL,UNITAB)
144C
145C
146.OR. IF(ANGLDEGR <= ZERO ANGLDEGR >= HUNDRED80)THEN
147 CALL ANCMSG(MSGID=649,
148 . MSGTYPE=MSGERROR,
149 . ANMODE=ANINFO,
150 . I1=ID,
151 . C1=TITR)
152 END IF
153 ANGL=ANGLDEGR*PI/HUNDRED80
154C
155C pour creer les structures LSH4UPL, PSH4UPL, LSH3UPL, PSH3UPL
156 IF(THKERR > ZERO) IADMERRT=1
157 IF(THKERR == ZERO)THKERR=EP30
158C
159C
160 DO I=1,NPART_ADM
161
162 CALL HM_GET_INT_ARRAY_INDEX('partids1',ID_IP,I,IS_AVAILABLE,LSUBMODEL)
163
164 IF(ID_IP/=0)THEN
165 IP=0
166 DO J=1,NPART
167 IF(IPART(4,J)==ID_IP)THEN
168 IP=J
169 GOTO 50
170 END IF
171 END DO
172 50 CONTINUE
173C
174 IF(IP/=0)THEN
175 IF(IPART(10,IP)/=0)THEN
176 CALL ANCMSG(MSGID=644,
177 . MSGTYPE=MSGERROR,
178 . ANMODE=ANINFO,
179 . I1=IPART(4,IP))
180 END IF
181 IPART(10,IP) =LEVELMAX
182 IPADMESH(1,IP)=MIN(INILEV,LEVELMAX)
183 PADMESH(1,IP) =COS(ANGL)
184 PADMESH(2,IP) =THKERR
185
186 WRITE(IOUT,1250) IPART(4,IP),
187 . IPADMESH(1,IP),
188 . ANGLDEGR,THKERR
189
190 ELSE
191 CALL ANCMSG(MSGID=646,
192 . MSGTYPE=MSGERROR,
193 . ANMODE=ANINFO,
194 . I1=ID,
195 . C1=TITR,
196 . I2=ID_IP)
197 END IF
198 END IF
199
200 ENDDO
201
202 ENDDO
203C
204
205 RETURN
206C-------------------------------------
207
208 1000 FORMAT( /1X,' adaptive meshing ' /
209 . 1X,' -------------------- '// )
210 1100 FORMAT(//
211 . ' global parameters for adaptive meshing ' //
212 . ' ====================================== ' //
213 . ' number of maximum levels . . . . . . . . ',I5/,
214 . ' two to one adaptive rule(0:no/1:yes) . . ',I5/,
215 . ' time between 2 checks for adaptation. . . ',1PG20.13/,
216 . ' time step based on the coarse mesh(0:no/1:yes). . ',I5)
217 1200 FORMAT(//
218 . ' settings per part for adaptive meshing ' //
219 . ' ====================================== ' //)
220 1250 FORMAT(
221 . ' part id . . . . . . . . . . . . . . . . ',I5/,
222 . ' initial number of levels . . . . . . . . ',I5/,
223 . ' angle criteria . . . . . . . . . . . . . ',1PG20.13/,
224 . ' criteria on thickness error . . . . . . . ',1PG20.13/)
225 RETURN
226 END
my_real
#define my_real
Definition cppsort.cpp:32
the
end diagonal values have been computed in the(sparse) matrix id.SOL
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
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
unitab_mod
Definition unitab_mod.F:513
set_admesh
subroutine set_admesh(ipart, ipadmesh, padmesh, unitab, lsubmodel)
Definition set_admesh.F:40
submodel_mod::submodel_data
Definition submodel_mod.F:723