OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lec_inistate.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!|| lec_inistate ../starter/source/elements/initia/lec_inistate.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| hm_read_inistate_d00 ../starter/source/elements/initia/hm_read_inistate_d00.F
29!|| lec_inistate_tri ../starter/source/elements/initia/lec_inistate_tri.F
30!|| lec_inistate_yfile ../starter/source/initial_conditions/inista/lec_inistate_yfile.F
31!||--- uses -----------------------------------------------------
32!|| mapping_option_mod ../starter/share/modules1/dichotomy_mod.F
33!|| stack_mod ../starter/share/modules1/stack_mod.F
34!|| submodel_mod ../starter/share/modules1/submodel_mod.F
35!||====================================================================
36 SUBROUTINE lec_inistate( IXS ,IXQ ,IXC ,IXT ,
37 1 IXP ,IXR ,GEO ,PM ,KXSP ,
38 2 IXTG ,INDEX ,ITRI ,
39 3 NSIGSH ,IGEO ,IPM ,NSIGS ,NSIGSPH ,
40 4 KSYSUSR ,PTSHEL ,PTSH3N ,PTSOL ,PTQUAD ,
41 5 PTSPH ,NUMEL ,NSIGRS ,UNITAB ,ISOLNODD00,
42 6 LSUBMODEL ,RTRANS ,IDRAPE ,NSIGI ,
43 7 PTSPRI ,NSIGBEAM ,PTBEAM ,NSIGTRUSS ,PTTRUSS ,
44 8 SIGI ,SIGSH ,SIGSP ,SIGSPH ,SIGRS ,
45 9 SIGBEAM ,SIGTRUSS ,STRSGLOB ,STRAGLOB ,ORTHOGLOB,
46 A ISIGSH ,IYLDINI ,KSIGSH3 ,FAIL_INI ,IUSOLYLD ,
47 B IUSER ,IGRBRIC ,MAP_TABLES ,IPARG ,STACK ,
48 C IWORKSH ,MAT_PARAM ,NUMSPH ,NISP )
49C-----------------------------------------------
50C M o d u l e s
51C-----------------------------------------------
52 USE unitab_mod
53 USE groupdef_mod
54 USE submodel_mod
56 USE stack_mod
57 USE matparam_def_mod
58 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62#include "implicit_f.inc"
63C-----------------------------------------------
64C C o m m o n B l o c k s
65C-----------------------------------------------
66#include "com01_c.inc"
67#include "com04_c.inc"
68#include "param_c.inc"
69#include "scry_c.inc"
70#include "scr16_c.inc"
71#include "units_c.inc"
72C-----------------------------------------------
73C D u m m y A r g u m e n t s
74C-----------------------------------------------
75 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
76 INTEGER IXS(NIXS,*), IXQ(NIXQ,*),IXC(NIXC,*),
77 . IGEO(NPROPGI,*), IXT(NIXT,*),IXP(NIXP,*), IXR(NIXR,*),
78 . IXTG(NIXTG,*),INDEX(*),ITRI(*),KXSP(*),IPM(NPROPMI,*),
79 . KSYSUSR(*),PTSHEL(*),PTSH3N(*),PTSOL(*),PTQUAD(*),PTSPH(*),
80 . IDRAPE(NPLYMAX,*),PTSPRI(*),PTBEAM(*),PTTRUSS(*)
81 INTEGER NSIGI,NSIGSH,NSIGS, NSIGSPH, NSIGRS,
82 . NUMEL,ISOLNODD00(*),NSIGBEAM,NSIGTRUSS,STRSGLOB(*),
83 . STRAGLOB(*),ORTHOGLOB(*),ISIGSH,IYLDINI,KSIGSH3,FAIL_INI(5),
84 . IUSOLYLD,IUSER,VARMAX
85 INTEGER, DIMENSION(NPARG,NGROUP) ,INTENT(IN):: IPARG
86 my_real
87 . geo(*),pm(npropm,*),rtrans(ntransf,*),
88 . sigi(nsigs,*),sigsh(max(1,nsigsh),*),sigtruss(nsigtruss,*),
89 . sigsp(nsigi,*),sigsph(nsigsph,*),sigrs(nsigrs,*),sigbeam(nsigbeam,*)
90C
91 TYPE(submodel_data) LSUBMODEL(*)
92 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
93C
94 TYPE(mapping_struct_) :: MAP_TABLES
95 TYPE (STACK_PLY) :: STACK
96 INTEGER, INTENT(IN) :: IWORKSH(3,NUMELC + NUMELTG)
97 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
98 INTEGER, INTENT(IN) :: NUMSPH
99 INTEGER, INTENT(IN) :: NISP
100C-----------------------------------------------
101C L o c a l V a r i a b l e s
102C-----------------------------------------------
103 INTEGER I, J, N, stat
104 INTEGER NIBRICK, NIQUAD, NISHELL, NISH3N, NISPRING, NIBEAM, NITRUSS, NISPHCEL
105 INTEGER, DIMENSION(:), ALLOCATABLE :: ID_SIGSH
106 INTEGER, DIMENSION(:), ALLOCATABLE :: ID_SOLID_SIGI
107 INTEGER, DIMENSION(:), ALLOCATABLE :: ID_QUAD_SIGI
108 INTEGER, DIMENSION(:), ALLOCATABLE :: ID_SIGSPRI
109 INTEGER, DIMENSION(:), ALLOCATABLE :: ID_SIGBEAM
110 INTEGER, DIMENSION(:), ALLOCATABLE :: ID_SIGTRUSS
111 INTEGER, DIMENSION(:), ALLOCATABLE :: ID_SIGSPH
112 INTEGER, DIMENSION(:), ALLOCATABLE :: WORK
113 LOGICAL IS_STATE
114C=======================================================================
115C
116C -- READING OF INITIAL STATE DATA - EXTRACTED FROM INITIA.F
117C
118C=======================================================================
119 iuser = 0
120 iyldini = 0
121 iusolyld = 0
122 fail_ini(1:5) = 0
123 isigsh =0
124 ksigsh3 = 0
125 iortshel = 0
126 inispri = 0
127 varmax = max(nsigsh,nsigi,nsigi,nsigtruss,nsigbeam,nsigrs)
128 is_state = .false.
129C
130 ALLOCATE (id_sigsh(numshel+numsh3n) ,stat=stat)
131 ALLOCATE (id_solid_sigi(numsol) ,stat=stat)
132 ALLOCATE (id_quad_sigi(numquad) ,stat=stat)
133 ALLOCATE (id_sigspri(numspri) ,stat=stat)
134 ALLOCATE (id_sigbeam(numbeam) ,stat=stat)
135 ALLOCATE (id_sigtruss(numtrus) ,stat=stat)
136 ALLOCATE (id_sigsph(numsph) ,stat=stat)
137 ALLOCATE (work(70000) ,stat=stat)
138C
139 IF(numshel+numsh3n > 0) id_sigsh(1:numshel+numsh3n) = 0
140 IF(numsol > 0 )id_solid_sigi(1:numsol) = 0
141 IF(numquad > 0 )id_quad_sigi(1:numquad) = 0
142 IF(numspri > 0 )id_sigspri(1:numspri) = 0
143 IF(numbeam > 0 )id_sigbeam(1:numbeam) = 0
144 IF(numtrus > 0 )id_sigtruss(1:numtrus) = 0
145 work(1:70000) = 0
146C
147 IF (abs(isigi) == 3.OR.abs(isigi) == 4.OR.abs(isigi) == 5) THEN
148 DO i=1,numshel+numsh3n
149 DO j=1,nsigsh
150 sigsh(j,i)=zero
151 ENDDO
152 ENDDO
153 ENDIF
154
155C--------------------------------------------------------
156C CONTRAINTES INITIALES + ENERGIES DENSITES EPS-PLAST
157C SOLIDE-QUAD-SPRING READ ON FILE
158C--------------------------------------------------------
159
160 IF (isigi == 1.OR.isigi == 2) THEN
161C
162C FICHIER S00 (Obsolete)
163C
164 IF (ioutp_fmt == 2) THEN
165 DO i=1,numels+numelq
166 READ(iin4,'(I8,3F16.0/8X,3F16.0)') n,(sigi(j,i),j=1,6)
167 sigi(7,i) = n
168 ENDDO
169 ELSE
170 DO i=1,numels+numelq
171 READ(iin4,'(I10,3F20.0/8X,3F20.0)') n,(sigi(j,i),j=1,6)
172 sigi(7,i) = n
173 ENDDO
174 ENDIF
175
176 ELSEIF (isigi == 3.OR.isigi == 4.OR.isigi == 5) THEN
177C
178C FICHIER Y000
179C
180 CALL lec_inistate_yfile(
181 1 nsigsh ,nsigs ,nsigsph ,nsigrs ,nsigi ,
182 2 sigsh ,sigi ,sigsph ,sigrs ,sigsp ,
183 3 isigsh ,iuser ,
184 4 id_sigsh , id_solid_sigi, id_quad_sigi )
185
186 ENDIF
187
188C-----------------------------------------
189C CONTRAINTES INITIALES FICHIER D00
190C-----------------------------------------
191 IF (isigi == -3.OR.isigi == -4.OR.isigi == -5) is_state = .true.
192
193 IF (isigi == -3.OR.isigi == -4.OR.isigi == -5) THEN
194 isigi = -isigi
195! CALL LEC_INISTATE_D00 (
196! 1 ixs ,ixq ,ixc ,ixt ,ixp ,
197! 2 IXR ,GEO ,PM ,IXTG ,INDEX ,
198! 3 ITRI ,NSIGSH ,IGEO ,
199! 4 IPM ,NSIGS ,NSIGSPH ,KSYSUSR ,NSIGRS ,
200! 5 UNITAB ,ISOLNODD00 ,LSUBMODEL ,RTRANS ,IDRAPE ,
201! 6 NSIGI ,NSIGBEAM ,NSIGTRUSS ,
202! 7 SIGI ,SIGSH ,SIGSP ,SIGSPH ,SIGRS ,
203! 8 SIGBEAM ,SIGTRUSS ,STRSGLOB ,STRAGLOB ,ORTHOGLOB ,
204! 9 ISIGSH ,IYLDINI ,FAIL_INI ,IUSOLYLD ,IUSER ,
205! a id_sigsh ,id_solid_sigi,id_quad_sigi ,id_sigspri ,id_sigbeam,
206! b id_sigtruss,work ,igrbric )
208 1 ixs ,ixq ,ixc ,ixt ,ixp ,
209 2 ixr ,geo ,pm ,ixtg ,index ,
210 3 itri ,nsigsh ,igeo ,
211 4 ipm ,nsigs ,nsigsph ,ksysusr ,nsigrs ,
212 5 unitab ,isolnodd00 ,lsubmodel ,rtrans ,idrape ,
213 6 nsigi ,nsigbeam ,nsigtruss ,
214 7 sigi ,sigsh ,sigsp ,sigsph ,sigrs ,
215 8 sigbeam ,sigtruss ,strsglob ,straglob ,orthoglob ,
216 9 isigsh ,iyldini ,fail_ini ,iusolyld ,iuser ,
217 a id_sigsh ,id_solid_sigi,id_quad_sigi ,id_sigspri ,id_sigbeam,
218 b id_sigtruss,work ,igrbric ,nibrick ,niquad ,
219 c nishell ,nish3n ,nispring ,nibeam ,nitruss ,
220 d map_tables ,varmax ,iparg ,ptshel ,ptsh3n ,
221 e stack ,iworksh ,iout ,mat_param ,nisphcel ,
222 f numsph ,nisp ,kxsp ,id_sigsph)
223 ENDIF
224C------------------------------------------------------------------------------------------
225 CALL lec_inistate_tri(
226 1 ixs ,ixq ,ixc ,ixt ,ixp ,
227 2 ixr ,kxsp ,ixtg ,index ,itri ,
228 3 nsigsh ,nsigs ,nsigsph ,ksysusr ,ksigsh3 ,
229 4 nsigrs ,nsigi ,nsigbeam ,nsigtruss ,
230 5 ptshel ,ptsh3n ,ptsol ,ptquad ,ptsph ,
231 6 ptspri ,ptbeam ,pttruss ,sigi ,sigsh ,
232 7 sigsp ,sigsph ,sigrs ,sigbeam ,sigtruss ,
233 8 id_sigsh ,id_solid_sigi,id_quad_sigi ,id_sigspri ,id_sigbeam ,
234 9 id_sigtruss,work ,id_sigsph ,is_state)
235
236C
237 IF(numsol > 0) DEALLOCATE (id_solid_sigi)
238 IF(numquad > 0 )DEALLOCATE (id_quad_sigi)
239 IF(numshel+numsh3n > 0 )DEALLOCATE (id_sigsh)
240 IF(numspri > 0 )DEALLOCATE (id_sigspri)
241 IF(numbeam > 0 )DEALLOCATE (id_sigbeam)
242 IF(numtrus > 0 )DEALLOCATE (id_sigtruss)
243 IF(numsph > 0 )DEALLOCATE (id_sigsph)
244 DEALLOCATE (work)
245C
246 RETURN
247 END
subroutine hm_read_inistate_d00(ixs, ixq, ixc, ixt, ixp, ixr, geo, pm, ixtg, index, itri, nsigsh, igeo, ipm, nsigs, nsigsph, ksysusr, nsigrs, unitab, isolnodd00, lsubmodel, rtrans, idrape, nsigi, nsigbeam, nsigtruss, sigi, sigsh, sigsp, sigsph, sigrs, sigbeam, sigtruss, strsglob, straglob, orthoglob, isigsh, iyldini, fail_ini, iusolyld, iuser, id_sigsh, id_solid_sigi, id_quad_sigi, id_sigspri, id_sigbeam, id_sigtruss, work, igrbric, nibrick, niquad, nishell, nish3n, nispring, nibeam, nitruss, map_tables, varmax, iparg, ptshel, ptsh3n, stack, iworksh, iout, mat_param, nisphcel, numsph, nisp, kxsp, id_sigsph)
subroutine lec_inistate(ixs, ixq, ixc, ixt, ixp, ixr, geo, pm, kxsp, ixtg, index, itri, nsigsh, igeo, ipm, nsigs, nsigsph, ksysusr, ptshel, ptsh3n, ptsol, ptquad, ptsph, numel, nsigrs, unitab, isolnodd00, lsubmodel, rtrans, idrape, nsigi, ptspri, nsigbeam, ptbeam, nsigtruss, pttruss, sigi, sigsh, sigsp, sigsph, sigrs, sigbeam, sigtruss, strsglob, straglob, orthoglob, isigsh, iyldini, ksigsh3, fail_ini, iusolyld, iuser, igrbric, map_tables, iparg, stack, iworksh, mat_param, numsph, nisp)
subroutine lec_inistate_tri(ixs, ixq, ixc, ixt, ixp, ixr, kxsp, ixtg, index, itri, nsigsh, nsigs, nsigsph, ksysusr, ksigsh3, nsigrs, nsigi, nsigbeam, nsigtruss, ptshel, ptsh3n, ptsol, ptquad, ptsph, ptspri, ptbeam, pttruss, sigi, sigsh, sigsp, sigsph, sigrs, sigbeam, sigtruss, id_sigsh, id_solid_sigi, id_quad_sigi, id_sigspri, id_sigbeam, id_sigtruss, work, id_sigsphcel, is_state)
subroutine lec_inistate_yfile(nsigsh, nsigs, nsigsph, nsigrs, nsigi, sigsh, sigi, sigsph, sigrs, sigsp, isigsh, iuser, id_sigsh, id_solid_sigi, id_quad_sigi)
#define max(a, b)
Definition macros.h:21