OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
create_h3d_input.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!|| create_h3d_input ../engine/source/output/h3d/h3d_build_fortran/create_h3d_input.F
25!||--- called by ------------------------------------------------------
26!|| h3d_read ../engine/source/output/h3d/h3d_build_fortran/h3d_read.F
27!|| lech3d ../engine/source/output/h3d/h3d_build_fortran/lech3d.F
28!||--- calls -----------------------------------------------------
29!|| arret ../engine/source/system/arret.F
30!|| wriusc2 ../engine/source/input/wriusc2.F
31!||--- uses -----------------------------------------------------
32!|| h3d_mod ../engine/share/modules/h3d_mod.F
33!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
34!||====================================================================
35 SUBROUTINE create_h3d_input(H3D_DATA,IKAD,IKEY,IREC,NBC,KEY0,KEY2,KEY3,KEY4,KEY5,KEY6,KEY7,KEY8)
36C-----------------------------------------------
37C D e s c r i p t i o n
38C-----------------------------------------------
39C This subroutine is activating flags which are used by Engine
40C to make allocation or specific calculatations.
41C Example :
42C H3D_DATA%N_VECT_CONT = 1
43C means /H3D/ELEM/VECT/CONT is defined and
44C specific calculation & storage are requested
45C to output this result
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE h3d_mod
50 USE names_and_titles_mod, ONLY: ncharline100,ncharkey
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55#include "units_c.inc"
56#include "scr14_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 TYPE (H3D_DATABASE) :: H3D_DATA
61 INTEGER IKAD(0:*),IKEY,IREC
62 INTEGER NBC
63 CHARACTER KEY0(*)*5
64 CHARACTER(LEN=NCHARKEY) :: KEY2, KEY3, KEY4, KEY5,KEY6,KEY7,KEY8
65C-----------------------------------------------
66C E x t e r n a l F u n c t i o n s
67C-----------------------------------------------
68 INTEGER NVAR
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 CHARACTER(LEN=NCHARLINE100):: CARTE,CARTE1,KEY3_GLOB
73 INTEGER I,J,L,N_H3D_PART,CPT,
74 . IS_CHAR_KEY3,IS_CHAR_KEY4,IS_CHAR_KEY5,IS_CHAR_KEY6,IS_CHAR_KEY7,IS_CHAR_KEY8,
75 . IS_EMPTY_KEY3,IS_EMPTY_KEY4,IS_EMPTY_KEY5,IS_EMPTY_KEY6,IS_EMPTY_KEY7,IS_EMPTY_KEY8
76C=========================================================================
77 h3d_data%N_INPUT_H3D = h3d_data%N_INPUT_H3D + 1
78 h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%KEY2 = key2
79 h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%KEY3 = key3
80 h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%KEY4 = key4
81 h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%KEY5 = key5
82 h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%KEY6 = key6
83 h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%KEY7 = key7
84 h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%KEY8 = key8
85
86
87 n_h3d_part = 0
88 DO j=1,nbc
89 READ(iusc1,rec=irec+j-1,fmt='(A)',err=999)carte
90 n_h3d_part=n_h3d_part + nvar(carte)
91 ENDDO
92c
93 h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%NB_PART = n_h3d_part
94 IF (n_h3d_part /= 0 )
95 . ALLOCATE(h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%PART_LIST(n_h3d_part))
96c
97 n_h3d_part = 0
98 DO j=1,nbc
99 READ(iusc1,rec=irec+j-1,fmt='(A)',err=999)carte
100 CALL wriusc2(irec+j-1,1,key0(ikey))
101 READ(iusc2,*,err=999,END=999)
102 . (h3d_data%INPUT_LIST(h3d_data%N_INPUT_H3D)%PART_LIST(n_h3d_part + l),l=1,nvar(carte))
103 n_h3d_part=n_h3d_part + nvar(carte)
104 ENDDO
105c DO J=1,N_H3D_PART
106c print *,'ds la construct du read_input',H3D_DATA%INPUT_LIST(H3D_DATA%N_INPUT_H3D)%PART_LIST(J)
107c ENDDO
108c
109C--------------------------------------------------
110C SEARCH Keywords for Activation of some output computation
111C--------------------------------------------------
112 is_char_key3 = 1
113 is_empty_key3 = 1
114 is_char_key4 = 1
115 is_empty_key4 = 1
116 is_char_key5 = 1
117 is_empty_key5 = 1
118 is_char_key6 = 1
119 is_empty_key6 = 1
120 is_char_key7 = 1
121 is_empty_key7 = 1
122 is_char_key8 = 1
123 is_empty_key8 = 1
124 key3_glob = ''
125 DO i=1,ncharkey
126 IF ( key3(i:i) == '=' ) is_char_key3 = 0
127 IF ( key3(i:i) /= ' ' ) is_empty_key3 = 0
128 IF ( key4(i:i) == '=' ) is_char_key4 = 0
129 IF ( key4(i:i) /= ' ' ) is_empty_key4 = 0
130 IF ( key5(i:i) == '=' ) is_char_key5 = 0
131 IF ( key5(i:i) /= ' ' ) is_empty_key5 = 0
132 IF ( key6(i:i) == '=' ) is_char_key6 = 0
133 IF ( key6(i:i) /= ' ' ) is_empty_key6 = 0
134 IF ( key7(i:i) == '=' ) is_char_key7 = 0
135 IF ( key7(i:i) /= ' ' ) is_empty_key7 = 0
136 IF ( key8(i:i) == '=' ) is_char_key8 = 0
137 IF ( key8(i:i) /= ' ' ) is_empty_key8 = 0
138 ENDDO
139C--------------------------------------------------
140 cpt = 0
141 IF ( is_char_key3 == 1 .AND. is_empty_key3 == 0) THEN
142 DO i=1,ncharkey
143 IF ( key3(i:i) /= ' ' ) THEN
144 cpt = cpt + 1
145 key3_glob(cpt:cpt) = key3(i:i)
146 ENDIF
147 ENDDO
148 ENDIF
149 IF ( is_char_key4 == 1 .AND. is_empty_key4 == 0 ) THEN
150 cpt = cpt + 1
151 key3_glob(cpt:cpt) = '/'
152 DO i=1,ncharkey
153 IF ( key4(i:i) /= ' ' ) THEN
154 cpt = cpt + 1
155 key3_glob(cpt:cpt) = key4(i:i)
156 ENDIF
157 ENDDO
158 ENDIF
159 IF ( is_char_key5 == 1 .AND. is_empty_key5 == 0 ) THEN
160 cpt = cpt + 1
161 key3_glob(cpt:cpt) = '/'
162 DO i=1,ncharkey
163 IF ( key5(i:i) /= ' ' ) THEN
164 cpt = cpt + 1
165 key3_glob(cpt:cpt) = key5(i:i)
166 ENDIF
167 ENDDO
168 ENDIF
169 IF ( is_char_key6 == 1 .AND. is_empty_key6 == 0 ) THEN
170 cpt = cpt + 1
171 key3_glob(cpt:cpt) = '/'
172 DO i=1,ncharkey
173 IF ( key6(i:i) /= ' ' ) THEN
174 cpt = cpt + 1
175 key3_glob(cpt:cpt) = key6(i:i)
176 ENDIF
177 ENDDO
178 ENDIF
179 IF ( is_char_key7 == 1 .AND. is_empty_key7 == 0 ) THEN
180 cpt = cpt + 1
181 key3_glob(cpt:cpt) = '/'
182 DO i=1,ncharkey
183 IF ( key7(i:i) /= ' ' ) THEN
184 cpt = cpt + 1
185 key3_glob(cpt:cpt) = key7(i:i)
186 ENDIF
187 ENDDO
188 ENDIF
189 IF ( is_char_key8 == 1 .AND. is_empty_key8 == 0 ) THEN
190 cpt = cpt + 1
191 key3_glob(cpt:cpt) = '/'
192 DO i=1,ncharkey
193 IF ( key8(i:i) /= ' ' ) THEN
194 cpt = cpt + 1
195 key3_glob(cpt:cpt) = key8(i:i)
196 ENDIF
197 ENDDO
198 ENDIF
199C--------------------------------------------------
200 IF(key2 == 'NODA') THEN
201c scalar
202 IF (key3_glob == 'DT') h3d_data%N_SCAL_DT = 1
203 IF (key3_glob == 'DMASS') h3d_data%N_SCAL_DMAS = 1
204 IF (key3_glob == 'DINER') h3d_data%N_SCAL_DINER = 1
205 IF (key3_glob == 'DAMA2') h3d_data%N_SCAL_DAMA2 = 1
206 IF (key3_glob == 'SKID_LINE') h3d_data%N_SCAL_SKID = 1
207 IF (key3_glob == 'STIFR') h3d_data%N_SCAL_STIFR = 1
208 IF (key3_glob == 'STIF') h3d_data%N_SCAL_STIFN = 1
209 IF (key3_glob == 'CSE_FRICG') h3d_data%N_SCAL_CSE_FRIC = 1
210 IF (key3_glob == 'CSE_FRIC') h3d_data%N_SCAL_CSE_FRICINT = 1
211c vector
212 IF (key3_glob == 'CONT'.OR.key3_glob == 'CONT/TMAX') h3d_data%N_VECT_CONT = 1
213 IF (key3_glob == 'CONT/TMAX') h3d_data%N_VECT_CONT_MAX = 1
214 IF (key3_glob == 'FINT') h3d_data%N_VECT_FINT = 1
215 IF (key3_glob == 'FEXT') h3d_data%N_VECT_FEXT = 1
216 IF (key3_glob == 'PCONT'.OR.key3_glob == 'PCONT/TMAX') h3d_data%N_VECT_PCONT = 1
217 IF (key3_glob == 'PCONT/TMAX') h3d_data%N_VECT_PCONT_MAX = 1
218 IF (key3_glob == 'CONT2'.OR.key3_glob == 'CONT2/TMAX'.OR.
219 . key3_glob == 'CONT2/TMIN') h3d_data%N_VECT_CONT2 = 1
220 IF (key3_glob == 'PCONT2'.OR.key3_glob == 'PCONT2/TMAX'.OR.
221 . key3_glob == 'PCONT2/TMIN' .OR.key3_glob == 'MAXPCONT2/NORMAL')
222 . h3d_data%N_VECT_PCONT2 = 1
223 IF (key3_glob == 'CONT2/TMAX') h3d_data%N_VECT_CONT2_MAX = 1
224 IF (key3_glob == 'CONT2/TMIN') h3d_data%N_VECT_CONT2_MIN = 1
225 IF (key3_glob == 'PCONT2/TMAX'.OR.key3_glob == 'MAXPCONT2/NORMAL')
226 . h3d_data%N_VECT_PCONT2_MAX = 1
227 IF (key3_glob == 'PCONT2/TMIN'.OR.key3_glob == 'MINPCONT2/NORMAL')
228 . h3d_data%N_VECT_PCONT2_MIN = 1
229 IF (key3_glob == 'CONT2/MOMENT') h3d_data%N_VECT_CONT2M = 1
230 IF (key3_glob == 'DROT') h3d_data%N_VECT_DROT = 1
231 IF (key3_glob == 'DXANC') h3d_data%N_VECT_DXANC = 1
232 IF (key3_glob == 'FREAC') h3d_data%N_VECT_FREAC = 1
233 IF (key3_glob == 'MREAC') h3d_data%N_VECT_MREAC = 1
234 IF (key3_glob == 'CLUST/FORCE') h3d_data%N_VECT_CLUST_FORCE = 1
235 IF (key3_glob == 'CLUST/MOM') h3d_data%N_VECT_CLUST_MOM = 1
236 ENDIF
237
238 IF(key2 == "ELEM" .OR. key2 == 'SOLID' .OR. key2 == 'QUAD')THEN
239 IF (key3_glob == 'VECT/CONT') h3d_data%N_VECT_CONT = 1
240 IF (key3_glob == 'VECT/ACC') h3d_data%N_VECT_ACC = 1
241 IF (key3_glob == 'TENS/EPSDOT') iepsdot = 1
242 IF (key3_glob == 'VORTX') h3d_data%SOL_SCAL_VORTX = 1
243 IF (key3_glob == 'VORTY') h3d_data%SOL_SCAL_VORTY = 1
244 IF (key3_glob == 'VORTZ') h3d_data%SOL_SCAL_VORTZ = 1
245 IF (key3_glob == 'VORT') THEN
246 h3d_data%SOL_SCAL_VORTX = 1
247 h3d_data%SOL_SCAL_VORTY = 1
248 h3d_data%SOL_SCAL_VORTZ = 1
249 ENDIF
250 ENDIF
251c
252 IF(key2 == 'SHELL') THEN
253c scalar
254 IF (key3_glob == 'ERROR/THICK') h3d_data%SH_SCAL_ERR_THK = 1
255c tensor
256 IF (key3_glob == 'TENS/EPSDOT') iepsdot = 1
257 ENDIF
258c
259 IF(key2 == 'SPRING' .OR. key2 == 'BEAM' .OR. key2 == 'TRUSS' ) THEN
260 IF (key3_glob == 'FORC') h3d_data%UND_FORC = 1
261 ENDIF
262c
263 ! Just for STRAIN
264 IF (key2 == 'QUAD') THEN
265c tensor
266 IF (key3_glob == 'TENS/STRAIN') h3d_data%STRAIN = 1
267 ENDIF
268C--------------------------------------------------
269
270c
271 RETURN
272 999 print *,'error lecture'
273 CALL arret(0)
274 END
create_h3d_input
subroutine create_h3d_input(h3d_data, ikad, ikey, irec, nbc, key0, key2, key3, key4, key5, key6, key7, key8)
Definition create_h3d_input.F:36
h3d_mod
Definition h3d_mod.F:308
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
nvar
integer function nvar(text)
Definition nvar.F:32
arret
subroutine arret(nn)
Definition arret.F:87
wriusc2
subroutine wriusc2(irec, nbc, key0)
Definition wriusc2.F:60