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