OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cstraini4.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine cstraini4 (jft, jlt, nft, nel, numshel, istrain, gstr, sigsh, nsigsh, numel, ix, nix, ptsh, thke, gstrm, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)

Function/Subroutine Documentation

◆ cstraini4()

subroutine cstraini4 ( integer, intent(in) jft,
integer, intent(in) jlt,
integer, intent(in) nft,
integer, intent(in) nel,
integer, intent(in) numshel,
integer, intent(in) istrain,
intent(out) gstr,
intent(in) sigsh,
integer, intent(in) nsigsh,
integer, intent(in) numel,
integer, dimension(nix,numel), intent(in) ix,
integer, intent(in) nix,
integer, dimension(numel), intent(in) ptsh,
intent(in) thke,
intent(out) gstrm,
intent(in) e1x,
intent(in) e2x,
intent(in) e3x,
intent(in) e1y,
intent(in) e2y,
intent(in) e3y,
intent(in) e1z,
intent(in) e2z,
intent(in) e3z )

Definition at line 33 of file cstraini4.F.

39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE message_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C A n a l y s e M o d u l e
49C-----------------------------------------------
50C-----------------------------------------------
51C G l o b a l P a r a m e t e r s
52C-----------------------------------------------
53#include "mvsiz_p.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com01_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER, INTENT(IN) :: JFT,JLT,NUMEL,NIX,NFT,
62 . ISTRAIN,NEL,NSIGSH,NUMSHEL
63 INTEGER, DIMENSION(NIX,NUMEL), INTENT(IN) :: IX
64 INTEGER, DIMENSION(NUMEL), INTENT(IN) :: PTSH
65 my_real, DIMENSION(NSIGSH,NUMSHEL),INTENT(IN) :: sigsh
66 my_real, DIMENSION(NEL,8,4),INTENT(OUT) :: gstr
67 my_real, DIMENSION(NEL,8), INTENT(OUT) :: gstrm
68 my_real, DIMENSION(NEL),INTENT(IN) :: thke
69 my_real, DIMENSION(MVSIZ),INTENT(IN) ::
70 . e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z
71C------------------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER I,II,J,JJ,N,NPTI,I1,I2,PT,PID1,IPID1,L_PLA,NLAY,
75 . ILAY,LAYNPT_MAX,LAY_MAX,NPTT,NPTMX,IP,PTS,LENS,IPT_ALL,
76 . IPT,PTN,JDIR,ILAW,NPGI,NPG,NPGII
77 INTEGER LI(MVSIZ)
78 my_real
79 . e1(6),e2(6),z1,z2,z0,aa,e1g(6,4),e2g(6,4),z1g(4),z2g(4),ung,r1
80C=======================================================================
81!
82 npg=4
83 DO i=jft,jlt
84 IF (abs(isigi) /= 3.AND.abs(isigi) /= 4.AND.abs(isigi) /= 5)THEN
85 ii = i+nft
86 n = nint(sigsh(1,ii))
87 IF (n /= ix(nix,ii)) THEN
88 jj = ii
89 DO j = 1,numel
90 ii= j
91 n = nint(sigsh(1,ii))
92 IF (n == 0) GOTO 100
93 IF (n == ix(nix,jj)) GOTO 60
94 ENDDO
95 60 CONTINUE
96 ENDIF
97 ELSE
98 jj=nft+i
99 n =ix(nix,jj)
100 ii=ptsh(jj)
101 IF (ii == 0) GOTO 100
102 ENDIF
103 li(i) = ii
104 npti=nint(sigsh(2,ii))
105 npgii=nint(sigsh(nvshell,ii))
106 npgi = nint(sigsh(inishvar1,ii)) ! NPGI could be 1
107C--- in global sys NPGI=4 for QEPH like stress now
108 IF(sigsh(17,ii) == one .AND. npgii==npg )THEN
109 pt = inishvar1 + 1
110 IF (npti==1) THEN
111 DO ip = 1,npgi
112 e1(1:6) = sigsh(pt:pt+5,ii)
113 z1 = sigsh(pt+6,ii)
114 CALL cg2leps(
115 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
116 8 e1z(i) ,e2z(i),e3z(i),e1 )
117 gstr(i,1:5,ip) = e1(1:5)
118 pt = pt + 7
119 END DO
120 ELSE
121 aa = half*thke(i)
122 DO ip = 1,npgi
123 e1g(1:6,ip) = sigsh(pt:pt+5,ii)
124 z1g(ip) = sigsh(pt+6,ii)
125 pt = pt + 7
126 END DO
127 DO ip = 1,npgi
128 e2g(1:6,ip) = sigsh(pt:pt+5,ii)
129 z2g(ip) = sigsh(pt+6,ii)
130 pt = pt + 7
131 END DO
132 DO ip = 1,npgi
133 CALL cg2leps(
134 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
135 8 e1z(i) ,e2z(i),e3z(i),e1g(1,ip))
136 CALL cg2leps(
137 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
138 8 e1z(i) ,e2z(i),e3z(i),e2g(1,ip))
139 IF (z1g(ip)==z2g(ip)) THEN
140c error out
141 CALL ancmsg(msgid=1904,
142 . anmode=aninfo,
143 . msgtype=msgerror,
144 . i1=n,
145 . r1=z1g(ip))
146 ELSEIF (z1g(ip)==zero) THEN
147 gstr(i,1:5,ip)=e1g(1:5,ip)
148 z0 = aa*z2g(ip)
149 gstr(i,6:8,ip)=(e2g(1:3,ip)-e1g(1:3,ip))/z0
150 ELSEIF (z2g(ip)==zero) THEN
151 gstr(i,1:5,ip)=e2g(1:5,ip)
152 z0 = aa*z1g(ip)
153 gstr(i,6:8,ip)=(e1g(1:3,ip)-e2g(1:3,ip))/z0
154 ELSE
155 z0 = aa*(z2g(ip)-z1g(ip))
156 gstr(i,6:8,ip)=(e2g(1:3,ip)-e1g(1:3,ip))/z0
157 gstr(i,1:3,ip)=e1g(1:3,ip)-aa*z1g(ip)*gstr(i,6:8,ip)
158 gstr(i,4:5,ip)= half*(e2g(4:5,ip)+e1g(4:5,ip))
159 END IF
160 END DO
161 END IF
162 IF (npg>npgi) THEN
163 DO ip = npgi+1,npg
164 gstr(i,1:8,ip) = gstr(i,1:8,npgi)
165 END DO
166 END IF
167 gstrm(i,1:8) = zero
168 ung = one/npg
169 DO ip = 1,npg
170 gstrm(i,1:8) = gstrm(i,1:8) + ung*gstr(i,1:8,ip)
171 END DO
172 ENDIF
173 100 CONTINUE
174 ENDDO
175C-----------
176 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
message_mod
Definition message_mod.F:1257
cg2leps
subroutine cg2leps(e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, eps)
Definition scigini4.F:794
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895