OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sini43.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "vect01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine sini43 (elbuf_str, mlw, nel, area, volg, rhog, stifm, stifr, viscm, viscr, uparam, mas1, mas2, mas3, mas4, mas5, mas6, mas7, mas8, inn1, inn2, inn3, inn4, inn5, inn6, inn7, inn8, pm, mat, offg, eintg, ptsol, sigsp, nsigi, nuvar)

Function/Subroutine Documentation

◆ sini43()

subroutine sini43 ( type(elbuf_struct_), target elbuf_str,
integer mlw,
integer nel,
area,
volg,
rhog,
stifm,
stifr,
viscm,
viscr,
uparam,
mas1,
mas2,
mas3,
mas4,
mas5,
mas6,
mas7,
mas8,
inn1,
inn2,
inn3,
inn4,
inn5,
inn6,
inn7,
inn8,
pm,
integer, dimension(*) mat,
offg,
eintg,
integer, dimension(*) ptsol,
sigsp,
integer nsigi,
integer nuvar )

Definition at line 29 of file sini43.F.

37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE elbufdef_mod
41C-------------------------------------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "param_c.inc"
49#include "com01_c.inc"
50#include "vect01_c.inc"
51C----------------------------------------------------------
52C D u m m y A r g u m e n t s
53C----------------------------------------------------------
54 INTEGER NEL,MLW,NSIGI,NUVAR
55 INTEGER MAT(*),PTSOL(*)
56 my_real
57 . area(*),volg(*),rhog(*),stifm(*) ,stifr(*) , viscm(*) ,viscr(*) ,
58 . mas1(*),mas2(*),mas3(*),mas4(*),mas5(*),mas6(*),mas7(*),mas8(*),
59 . inn1(*),inn2(*),inn3(*),inn4(*),inn5(*),inn6(*),inn7(*),inn8(*),
60 . uparam(*),offg(*),eintg(*),pm(npropm,*),sigsp(nsigi,nel)
61 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER I,II,JJ,KK(6),IP,IPP,IPSU,IUS,MA,MFLAG,L_PLA,JPS,JPS1,
66 . IFLAGINI,NVAR_TMP,J
67 my_real mass,iner
68 my_real gama(6)
69 TYPE(L_BUFEL_) ,POINTER :: LBUF
70 TYPE(BUF_MAT_) ,POINTER :: MBUF
71 my_real, DIMENSION(:) , POINTER :: uvar,pla,eps,sig
72C-----------------------------------------------------------------------
73C SIMPLIFIED MASS AND INERTIA COMPUTATION
74C=======================================================================
75 IF (mlw == 59) THEN
76 mflag = nint(uparam(7))
77 ELSEIF (mlw == 83) THEN
78 mflag = nint(uparam(9))
79 ELSEIF (mlw == 116) THEN
80 mflag = nint(uparam(3))
81 ELSEIF (mlw == 117) THEN
82 mflag = nint(uparam(12))
83 ELSE
84 mflag = 0
85 ENDIF
86!
87 DO j=1,6
88 kk(j) = (j-1)*nel
89 ENDDO
90!
91c
92 DO i=1,nel
93 ma = mat(i)
94 offg(i) = one
95 eintg(i) = pm(23,ma)
96 rhog(i) = pm(89,ma)
97 ENDDO
98c
99 IF (mflag == 1) THEN ! surface density
100 DO i=1,nel
101 mass = rhog(i)*area(i)*one_over_8
102 mas1(i) = mass
103 mas2(i) = mass
104 mas3(i) = mass
105 mas4(i) = mass
106 mas5(i) = mass
107 mas6(i) = mass
108 mas7(i) = mass
109 mas8(i) = mass
110 ENDDO
111 ELSE ! volume density
112 DO i=1,nel
113 mass = rhog(i)*volg(i)*one_over_8
114 mas1(i) = mass
115 mas2(i) = mass
116 mas3(i) = mass
117 mas4(i) = mass
118 mas5(i) = mass
119 mas6(i) = mass
120 mas7(i) = mass
121 mas8(i) = mass
122 ENDDO
123 ENDIF
124c
125 iner = zero
126 DO i=1,nel
127 inn1(i) = iner
128 inn2(i) = iner
129 inn3(i) = iner
130 inn4(i) = iner
131 inn5(i) = iner
132 inn6(i) = iner
133 inn7(i) = iner
134 inn8(i) = iner
135 stifr(i) = zero
136 stifm(i) = zero
137 viscm(i) = zero
138 viscr(i) = zero
139 ENDDO
140c---------------------------
141 IF (isigi /= 0) THEN ! CONTRAINTES INITIALES
142 l_pla = elbuf_str%BUFLY(1)%L_PLA
143c GAMA(1)=ONE
144c GAMA(2)=ZERO
145c GAMA(3)=ZERO
146c GAMA(4)=ZERO
147c GAMA(5)=ONE
148c GAMA(6)=ZERO
149c Initialize variables per integration point
150 DO ip=1,4
151 lbuf => elbuf_str%BUFLY(1)%LBUF(ip,1,1)
152 mbuf => elbuf_str%BUFLY(1)%MAT(ip,1,1)
153 eps => elbuf_str%BUFLY(1)%LBUF(ip,1,1)%EPE(1:nel*3)
154 sig => elbuf_str%BUFLY(1)%LBUF(ip,1,1)%SIG(1:nel*6)
155 pla => elbuf_str%BUFLY(1)%LBUF(ip,1,1)%PLA(1:nel*l_pla)
156 uvar => elbuf_str%BUFLY(1)%MAT(ip,1,1)%VAR(1:nel*nuvar)
157 jps = 1+ (ip-1)*9
158 jps1 = nvsolid1 + (ip-1)*6
159 DO i=1,nel
160 iflagini = 0
161 ii = nft+i
162 jj = ptsol(ii)
163 iflagini = 1
164 IF (jj == 0) iflagini = 0
165c
166 IF (iflagini == 1) THEN
167 ipp = i
168 IF (nvsolid1 /= 0 ) THEN
169 sig(kk(1) + i) = sigsp(jps+1,jj)
170 sig(kk(2) + i) = sigsp(jps+2,jj)
171 sig(kk(3) + i) = sigsp(jps+3,jj)
172 sig(kk(4) + i) = sigsp(jps+4,jj)
173 sig(kk(5) + i) = sigsp(jps+5,jj)
174 sig(kk(6) + i) = sigsp(jps+6,jj)
175c IF (STRSGLOB(I) == 1)
176c . CALL SROTA6_M1(X,IX(1,II),JCVT,SIG(1,I),GAMA,JHBE,IGTYP)
177
178 IF (sigsp(jps+7,jj) /= zero) lbuf%EINT(i)=sigsp(jps+7,jj)
179 IF (l_pla > 0 .AND. sigsp(jps+8,jj) /= zero)
180 . pla(i) = sigsp(jps+8,jj)
181 IF (l_pla == 2 .AND. sigsp(jps+9,jj) /= zero)
182 . pla(i+nel) = sigsp(jps+9,jj)
183 ENDIF
184 nvar_tmp = sigsp(nvsolid1 + nvsolid2 + 3, jj)
185 ipsu = nvsolid1 + nvsolid2 + 4 + (ip - 1)*nvar_tmp
186 DO ius = 1, nvar_tmp
187 ipp = i + (ius -1)*nel
188 uvar(ipp) = sigsp(ipsu + ius, jj)
189 ENDDO
190 DO ius = nvar_tmp + 1, nuvar
191 ipp = i + (ius -1)*nel
192 uvar(ipp) = zero
193 ENDDO
194 IF (nvsolid2 /= 0) THEN
195 eps(kk(1) + i) = sigsp(jps1 + 3 , jj)
196 eps(kk(2) + i) = sigsp(jps1 + 5 , jj)
197 eps(kk(3) + i) = sigsp(jps1 + 6 , jj)
198c IF (STRAGLOB(I) == 1)
199c . CALL SROTA6_M1(X,IX(1,II),JCVT,EPS(1,I),GAMA,JHBE,IGTYP)
200 ENDIF
201 ENDIF
202
203 ENDDO ! I=1,NEL
204 ENDDO ! IP=1,4
205C-----------
206 ENDIF ! ISIGI /= 0
207c
208C-----------
209 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567