OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_skin_tensor.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!|| h3d_skin_tensor ../engine/source/output/h3d/h3d_results/h3d_skin_tensor.F
25!||--- called by ------------------------------------------------------
26!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
27!||--- calls -----------------------------------------------------
28!|| h3d_sol_skin_tensor ../engine/source/output/h3d/h3d_results/h3d_sol_skin_tensor.F
29!|| initbuf ../engine/share/resol/initbuf.F
30!|| roto_sig2d ../engine/source/output/h3d/h3d_results/h3d_skin_tensor.F
31!|| tsh_dir2 ../engine/source/output/h3d/h3d_results/h3d_skin_tensor.F
32!||--- uses -----------------------------------------------------
33!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
34!|| initbuf_mod ../engine/share/resol/initbuf.F
35!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
36!||====================================================================
37 SUBROUTINE h3d_skin_tensor(
38 . ELBUF_TAB,SKIN_TENSOR, IPARG ,IXS ,X ,PM ,
39 4 IPARTS ,IPM ,IGEO ,IXS10 ,IXS16 , IXS20 ,
40 5 IS_WRITTEN_SKIN ,H3D_PART,INFO1 ,KEYWORD,
41 6 IAD_ELEM ,FR_ELEM , WEIGHT ,TAG_SKINS6)
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE initbuf_mod
46 USE elbufdef_mod
47 USE names_and_titles_mod, ONLY: ncharline100
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "vect01_c.inc"
56#include "mvsiz_p.inc"
57#include "com01_c.inc"
58#include "com04_c.inc"
59#include "param_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63C REAL
64 my_real
65 . skin_tensor(3,*),pm(npropm,*), x(3,*)
66 INTEGER IPARG(NPARG,*),
67 . IXS(NIXS,*),IPM(NPROPMI,*),IPARTS(*),
68 . ixs10(6,*) ,ixs16(8,*) ,ixs20(12,*) ,
69 . igeo(npropgi,*),is_written_skin(*),
70 . h3d_part(*),info1,tag_skins6(*),iad_elem(2,*),fr_elem(*),weight(*)
71 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
72 CHARACTER(LEN=NCHARLINE100) :: KEYWORD
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 my_real
77 . evar(3,mvsiz),dir(mvsiz,2),dirb(mvsiz,2)
78 my_real
79 . f_exp,f_str,f_gauss(9)
80 INTEGER I,I1,II,J,NEL,NPTR,NPTS,NPTT,NLAY,L,IFAIL,ILAY,
81 . IR,IS,IT,IL,MLW, NUVAR,IUS,LENF,PTF,PTM,PTS,NFAIL,
82 . n,nn,k,k1,k2,jturb,mt,imid,ialel,ipid,ish3n,nni,
83 . nn1,nn2,nn3,nn4,nn5,nn6,nn9,nf,buf,nvarf,
84 . ihbe,nptm,npg, mpt,ipt,iadd,iadr,ipmat,ifailt,
85 . iigeo,iadi,isubstack,ithk,
86 . id_ply,nb_plyoff,ng,nskin,icstr
87 INTEGER NPT_ALL,IPLY,ISOLNOD,IVISC,NPTG,TSHELL,TSH_ORT,
88 . ISTRAIN,KCVT,IOR_TSH,MT1,ICSIG,PTI,IOK,IPRT,IOK_PART(MVSIZ),
89 . JJ(6),IS_WRITTEN_TENSOR(MVSIZ),MLWI,MID,PID
90
91 TYPE(g_bufel_) ,POINTER :: GBUF
92 TYPE(L_BUFEL_) ,POINTER :: LBUF
93 TYPE(BUF_LAY_) ,POINTER :: BUFLY
94C----- facter of extrapolation
95 DATA f_gauss /
96 9 1.000000000000000,1.732050807568877,1.290994448735806,
97 9 1.161256338324528,1.103533701926633,1.072421119155361,
98 9 1.053620970803647,1.041352247171806,1.032886870574820/
99C-----------------------------------------------
100 nskin = 0
101 iok_part(1:mvsiz)=0
102 DO ng=1,ngroup
103 gbuf => elbuf_tab(ng)%GBUF
104 icstr = iparg(17,ng)
105 istrain = iparg(44,ng)
106 isolnod = iparg(28,ng)
107 ivisc = iparg(61,ng)
108 CALL initbuf(iparg ,ng ,
109 2 mlw ,nel ,nft ,iad ,ity ,
110 3 npt ,jale ,ismstr ,jeul ,jtur ,
111 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
112 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
113 6 irep ,iint ,igtyp ,israt ,isrot ,
114 7 icsen ,isorth ,isorthg ,ifailure,jsms )
115!
116 DO i=1,6
117 jj(i) = nel*(i-1)
118 ENDDO
119!
120 IF(mlw == 13 .OR. mlw == 0) cycle
121C-----------------------------------------------
122C THICK-SHELL
123C-----------------------------------------------
124! 8--------------7
125! / | /|
126! 5--------------|6
127! | | | |
128! | 4-----------|-3
129! | / |/
130! 1--------------2
131 IF (ity == 1.AND.(igtyp==20 .OR. igtyp==21 .OR. igtyp==22)) THEN
132 ior_tsh = 0
133 IF (igtyp == 21) THEN
134 ior_tsh = 1
135 ELSEIF (igtyp == 22) THEN
136 ior_tsh = 2
137 END IF
138 IF (kcvt==1.AND.ior_tsh/=0) kcvt=2
139 iok_part(1:nel) = 0
140 DO i=1,nel
141 n = i + nft
142 IF( h3d_part(iparts(n)) == 1) iok_part(i) = 1
143 is_written_tensor(i) = 0
144 evar(1:3,i) = zero
145 ENDDO
146 nlay = elbuf_tab(ng)%NLAY
147 nptr = elbuf_tab(ng)%NPTR
148 npts = elbuf_tab(ng)%NPTS
149 nptt = elbuf_tab(ng)%NPTT
150 IF (igtyp == 22 .AND. nlay>9) THEN
151 f_exp = one
152 ELSE
153 f_exp = f_gauss(nlay)
154 END IF
155 IF (jhbe==14.OR.jhbe==16) f_exp = f_exp/(nptr*npts)
156C-----------------------------------------------
157 IF (keyword == 'TENS/STRESS/OUTER') THEN
158 is_written_tensor(1:nel) = 1
159C-----------------------------------------------
160 ilay=1
161 it = 1
162C-------- grp skin_inf first
163 IF (jhbe==15) THEN
164 ir = 1
165 is = 1
166 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
167 DO i=1,nel
168 evar(1:2,i) = lbuf%SIG(jj(1:2) + i)
169 evar(3,i) = lbuf%SIG(jj(4) + i)
170 ENDDO
171 IF(ivisc > 0) THEN
172 DO i=1,nel
173 evar(1:2,i) = evar(1:2,i) + lbuf%VISC(jj(1:2) + i)
174 evar(3,i) = evar(3,i) + lbuf%VISC(jj(4) + i)
175 ENDDO
176 ENDIF
177 ELSE ! 14,16
178 DO ir=1,nptr
179 DO is=1,npts
180 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
181 DO i=1,nel
182 evar(1:2,i) = evar(1:2,i) + lbuf%SIG(jj(1:2) + i)
183 evar(3,i) = evar(3,i) + lbuf%SIG(jj(4) + i)
184 ENDDO
185 IF(ivisc > 0) THEN
186 DO i=1,nel
187 evar(1:2,i) = evar(1:2,i) + lbuf%VISC(jj(1:2) + i)
188 evar(3,i) = evar(3,i) + lbuf%VISC(jj(4) + i)
189 ENDDO
190 ENDIF
191 ENDDO
192 ENDDO
193C----------
194 END IF !IF (JHBE==15)
195 evar(1:3,1:nel) = f_exp*evar(1:3,1:nel)
196C------to see if need rotate EVAR, Isolid=16 incompatible to orthotropic
197 IF (kcvt==2) THEN
198 IF(ior_tsh==1)THEN
199 DO i=1,nel
200 dir(i,1:2)= gbuf%GAMA(jj(1:2) + i)
201 ENDDO
202 ELSEIF(ior_tsh==2)THEN
203 IF(jhbe==14)THEN
204 ir = 1
205 is = 1
206 END IF
207 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
208 DO i=1,nel
209 dir(i,1:2)= lbuf%GAMA(jj(1:2) + i)
210 ENDDO
211 END IF
212 CALL tsh_dir2(x,ixs,dir,dirb,icstr,nel)
213 CALL roto_sig2d(1,nel,evar,dirb)
214 END IF !(KCVT==2) THEN
215 DO i=1,nel
216 n = i + nft
217 skin_tensor(1:3,nskin+i) = evar(1:3,i)
218 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_tensor(i)
219 END DO
220 nskin = nskin + nel
221 evar(1:3,1:nel) = zero
222C-------- grp skin_up
223 ilay=nlay
224 it = 1
225 IF (jhbe==15) THEN
226 ir = 1
227 is = 1
228 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
229 DO i=1,nel
230 evar(1:2,i) = lbuf%SIG(jj(1:2) + i)
231 evar(3,i) = lbuf%SIG(jj(4) + i)
232 ENDDO
233 IF(ivisc > 0) THEN
234 DO i=1,nel
235 evar(1:2,i) = evar(1:2,i) + lbuf%VISC(jj(1:2) + i)
236 evar(3,i) = evar(3,i) + lbuf%VISC(jj(4) + i)
237 ENDDO
238 ENDIF
239 ELSE ! 14,16
240 DO ir=1,nptr
241 DO is=1,npts
242 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
243 DO i=1,nel
244 evar(1:2,i) = evar(1:2,i) + lbuf%SIG(jj(1:2) + i)
245 evar(3,i) = evar(3,i) + lbuf%SIG(jj(4) + i)
246 ENDDO
247 IF(ivisc > 0) THEN
248 DO i=1,nel
249 evar(1:2,i) = evar(1:2,i) + lbuf%VISC(jj(1:2) + i)
250 evar(3,i) = evar(3,i) + lbuf%VISC(jj(4) + i)
251 ENDDO
252 ENDIF
253 ENDDO
254 ENDDO
255 END IF !IF (JHBE==15)
256 evar(1:3,1:nel) = f_exp*evar(1:3,1:nel)
257C--- orthotropic
258 IF (kcvt==2) THEN
259 IF(ior_tsh==1)THEN
260 DO i=1,nel
261 dir(i,1:2)= gbuf%GAMA(jj(1:2) + i)
262 ENDDO
263 ELSEIF(ior_tsh==2)THEN
264 IF(jhbe==14)THEN
265 ir = 1
266 is = 1
267 END IF
268 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
269 DO i=1,nel
270 dir(i,1:2)= lbuf%GAMA(jj(1:2) + i)
271 ENDDO
272 END IF
273 CALL tsh_dir2(x,ixs,dir,dirb,icstr,nel)
274 CALL roto_sig2d(1,nel,evar,dirb)
275 END IF !(KCVT==2) THEN
276 DO i=1,nel
277 n = i + nft
278 skin_tensor(1:3,nskin+i) = evar(1:3,i)
279 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_tensor(i)
280 END DO
281 nskin = nskin + nel
282C-----------------------------------------------
283 ELSEIF (keyword == 'TENS/STRAIN/OUTER') THEN
284C-----------------------------------------------
285 is_written_tensor(1:nel) = 1
286C-------- grp skin_inf first
287 ilay=1
288 it = 1
289 mlwi = mlw
290 IF (igtyp == 22) THEN
291 pid = ixs(nixs-1,1 + nft)
292 mid = igeo(100+ilay,pid)
293 mlwi=nint(pm(19,mid))
294 END IF
295 IF (jhbe==15) THEN
296 ir = 1
297 is = 1
298 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
299 IF (mlwi == 12 .OR. mlwi == 14) THEN
300 DO i=1,nel
301 evar(1:2,i) = lbuf%EPE(jj(1:2) + i)
302 evar(3,i) = half*lbuf%EPE(jj(4) + i)
303 ENDDO
304 ELSEIF (mlwi /= 49 ) THEN
305 DO i=1,nel
306 evar(1:2,i) = lbuf%STRA(jj(1:2) + i)
307 evar(3,i) = half*lbuf%STRA(jj(4) + i)
308 ENDDO
309 ELSE
310 is_written_tensor(1:nel) = 0
311 END IF
312C------to see if need rotate EVARL
313 ELSE ! 14,16
314 DO ir=1,nptr
315 DO is=1,npts
316 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
317 IF (mlwi == 12 .OR. mlwi == 14) THEN
318 DO i=1,nel
319 evar(1:2,i) = evar(1:2,i)+lbuf%EPE(jj(1:2) + i)
320 evar(3,i) = evar(3,i)+half*lbuf%EPE(jj(4) + i)
321 ENDDO
322 ELSEIF (mlwi /= 49 ) THEN
323 DO i=1,nel
324 evar(1:2,i) = evar(1:2,i)+lbuf%STRA(jj(1:2) + i)
325 evar(3,i) = evar(3,i)+ half*lbuf%STRA(jj(4) + i)
326 ENDDO
327 ELSE
328 is_written_tensor(1:nel) = 0
329 END IF
330 ENDDO
331 ENDDO
332 END IF
333 evar(1:3,1:nel) = f_exp*evar(1:3,1:nel)
334C------to see if need rotate EVAR, Isolid=16 incompatible to orthotropic
335 IF (kcvt==2) THEN
336 IF(ior_tsh==1)THEN
337 DO i=1,nel
338 dir(i,1:2)= gbuf%GAMA(jj(1:2) + i)
339 ENDDO
340 ELSEIF(ior_tsh==2)THEN
341 IF(jhbe==14)THEN
342 ir = 1
343 is = 1
344 END IF
345 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
346 DO i=1,nel
347 dir(i,1:2)= lbuf%GAMA(jj(1:2) + i)
348 ENDDO
349 END IF
350 CALL tsh_dir2(x,ixs,dir,dirb,icstr,nel)
351 CALL roto_sig2d(1,nel,evar,dirb)
352 END IF !(KCVT==2) THEN
353 DO i=1,nel
354 n = i + nft
355 skin_tensor(1:3,nskin+i) = evar(1:3,i)
356 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_tensor(i)
357 END DO
358 nskin = nskin + nel
359 evar(1:3,1:nel) = zero
360C-------- grp skin_sup
361 ilay=nlay
362 it = 1
363 mlwi = mlw
364 IF (igtyp == 22) THEN
365 pid = ixs(nixs-1,1 + nft)
366 mid = igeo(100+ilay,pid)
367 mlwi=nint(pm(19,mid))
368 END IF
369 IF (jhbe==15) THEN
370 ir = 1
371 is = 1
372 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
373 IF (mlwi == 12 .OR. mlwi == 14) THEN
374 DO i=1,nel
375 evar(1:2,i) = lbuf%EPE(jj(1:2) + i)
376 evar(3,i) = half*lbuf%EPE(jj(4) + i)
377 ENDDO
378 ELSEIF (mlwi /= 49 ) THEN
379 DO i=1,nel
380 evar(1:2,i) = lbuf%STRA(jj(1:2) + i)
381 evar(3,i) = half*lbuf%STRA(jj(4) + i)
382 ENDDO
383 ELSE
384 is_written_tensor(1:nel) = 0
385 END IF
386C------to see if need rotate EVARL
387 ELSE ! 14,16
388 DO ir=1,nptr
389 DO is=1,npts
390 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
391 IF (mlwi == 12 .OR. mlwi == 14) THEN
392 DO i=1,nel
393 evar(1:2,i) = evar(1:2,i)+lbuf%EPE(jj(1:2) + i)
394 evar(3,i) = evar(3,i)+half*lbuf%EPE(jj(4) + i)
395 ENDDO
396 ELSEIF (mlwi /= 49 ) THEN
397 DO i=1,nel
398 evar(1:2,i) = evar(1:2,i)+lbuf%STRA(jj(1:2) + i)
399 evar(3,i) = evar(3,i)+ half*lbuf%STRA(jj(4) + i)
400 ENDDO
401 ELSE
402 is_written_tensor(1:nel) = 0
403 END IF
404 ENDDO
405 ENDDO
406 END IF
407 evar(1:3,1:nel) = f_exp*evar(1:3,1:nel)
408C------to see if need rotate EVAR, Isolid=16 incompatible to orthotropic
409 IF (kcvt==2) THEN
410 IF(ior_tsh==1)THEN
411 DO i=1,nel
412 dir(i,1:2)= gbuf%GAMA(jj(1:2) + i)
413 ENDDO
414 ELSEIF(ior_tsh==2)THEN
415 IF(jhbe==14)THEN
416 ir = 1
417 is = 1
418 END IF
419 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
420 DO i=1,nel
421 dir(i,1:2)= lbuf%GAMA(jj(1:2) + i)
422 ENDDO
423 END IF
424 CALL tsh_dir2(x,ixs,dir,dirb,icstr,nel)
425 CALL roto_sig2d(1,nel,evar,dirb)
426 END IF !(KCVT==2) THEN
427 DO i=1,nel
428 n = i + nft
429 skin_tensor(1:3,nskin+i) = evar(1:3,i)
430 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_tensor(i)
431 END DO
432 nskin = nskin + nel
433C-----------------------------------------------
434 ELSEIF (keyword == 'TENS/STRAIN/OUTER_AVERAGE') THEN
435C-----------------------------------------------
436 is_written_tensor(1:nel) = 1
437C-------- grp skin_inf first
438 ilay=(1+nlay)/2
439 it = 1
440 mlwi = mlw
441 IF (igtyp == 22) THEN
442 pid = ixs(nixs-1,1 + nft)
443 mid = igeo(100+ilay,pid)
444 mlwi=nint(pm(19,mid))
445 END IF
446 IF (jhbe==15) THEN
447 ir = 1
448 is = 1
449 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
450 IF (mlwi == 12 .OR. mlwi == 14) THEN
451 DO i=1,nel
452 evar(1:2,i) = lbuf%EPE(jj(1:2) + i)
453 evar(3,i) = half*lbuf%EPE(jj(4) + i)
454 ENDDO
455 ELSEIF (mlwi /= 49 ) THEN
456 DO i=1,nel
457 evar(1:2,i) = lbuf%STRA(jj(1:2) + i)
458 evar(3,i) = half*lbuf%STRA(jj(4) + i)
459 ENDDO
460 ELSE
461 is_written_tensor(1:nel) = 0
462 END IF
463C------to see if need rotate EVARL
464 ELSE ! 14,16
465 DO ir=1,nptr
466 DO is=1,npts
467 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
468 IF (mlwi == 12 .OR. mlwi == 14) THEN
469 DO i=1,nel
470 evar(1:2,i) = evar(1:2,i)+lbuf%EPE(jj(1:2) + i)
471 evar(3,i) = evar(3,i)+half*lbuf%EPE(jj(4) + i)
472 ENDDO
473 ELSEIF (mlwi /= 49 ) THEN
474 DO i=1,nel
475 evar(1:2,i) = evar(1:2,i)+lbuf%STRA(jj(1:2) + i)
476 evar(3,i) = evar(3,i)+ half*lbuf%STRA(jj(4) + i)
477 ENDDO
478 ELSE
479 is_written_tensor(1:nel) = 0
480 END IF
481 ENDDO
482 ENDDO
483 END IF
484 evar(1:3,1:nel) = f_exp*evar(1:3,1:nel)
485C------to see if need rotate EVAR, Isolid=16 incompatible to orthotropic
486 IF (kcvt==2) THEN
487 IF(ior_tsh==1)THEN
488 DO i=1,nel
489 dir(i,1:2)= gbuf%GAMA(jj(1:2) + i)
490 ENDDO
491 ELSEIF(ior_tsh==2)THEN
492 IF(jhbe==14)THEN
493 ir = 1
494 is = 1
495 END IF
496 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
497 DO i=1,nel
498 dir(i,1:2)= lbuf%GAMA(jj(1:2) + i)
499 ENDDO
500 END IF
501 CALL tsh_dir2(x,ixs,dir,dirb,icstr,nel)
502 CALL roto_sig2d(1,nel,evar,dirb)
503 END IF !(KCVT==2) THEN
504 DO i=1,nel
505 skin_tensor(1:3,nskin+i) = evar(1:3,i)
506 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_tensor(i)
507 END DO
508 nskin = nskin + nel
509 evar(1:3,1:nel) = zero
510C-------- grp skin_sup
511 ilay=(1+nlay)/2
512 it = 1
513 mlwi = mlw
514 IF (igtyp == 22) THEN
515 pid = ixs(nixs-1,1 + nft)
516 mid = igeo(100+ilay,pid)
517 mlwi=nint(pm(19,mid))
518 END IF
519 IF (jhbe==15) THEN
520 ir = 1
521 is = 1
522 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
523 IF (mlwi == 12 .OR. mlwi == 14) THEN
524 DO i=1,nel
525 evar(1:2,i) = lbuf%EPE(jj(1:2) + i)
526 evar(3,i) = half*lbuf%EPE(jj(4) + i)
527 ENDDO
528 ELSEIF (mlwi /= 49 ) THEN
529 DO i=1,nel
530 evar(1:2,i) = lbuf%STRA(jj(1:2) + i)
531 evar(3,i) = half*lbuf%STRA(jj(4) + i)
532 ENDDO
533 ELSE
534 is_written_tensor(1:nel) = 0
535 END IF
536C------to see if need rotate EVARL
537 ELSE ! 14,16
538 DO ir=1,nptr
539 DO is=1,npts
540 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
541 IF (mlwi == 12 .OR. mlwi == 14) THEN
542 DO i=1,nel
543 evar(1:2,i) = evar(1:2,i)+lbuf%EPE(jj(1:2) + i)
544 evar(3,i) = evar(3,i)+half*lbuf%EPE(jj(4) + i)
545 ENDDO
546 ELSEIF (mlwi /= 49 ) THEN
547 DO i=1,nel
548 evar(1:2,i) = evar(1:2,i)+lbuf%STRA(jj(1:2) + i)
549 evar(3,i) = evar(3,i)+ half*lbuf%STRA(jj(4) + i)
550 ENDDO
551 ELSE
552 is_written_tensor(1:nel) = 0
553 END IF
554 ENDDO
555 ENDDO
556 END IF
557 evar(1:3,1:nel) = f_exp*evar(1:3,1:nel)
558C------to see if need rotate EVAR, Isolid=16 incompatible to orthotropic
559 IF (kcvt==2) THEN
560 IF(ior_tsh==1)THEN
561 DO i=1,nel
562 dir(i,1:2)= gbuf%GAMA(jj(1:2) + i)
563 ENDDO
564 ELSEIF(ior_tsh==2)THEN
565 IF(jhbe==14)THEN
566 ir = 1
567 is = 1
568 END IF
569 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
570 DO i=1,nel
571 dir(i,1:2)= lbuf%GAMA(jj(1:2) + i)
572 ENDDO
573 END IF
574 CALL tsh_dir2(x,ixs,dir,dirb,icstr,nel)
575 CALL roto_sig2d(1,nel,evar,dirb)
576 END IF !(KCVT==2) THEN
577 DO i=1,nel
578 skin_tensor(1:3,nskin+i) = evar(1:3,i)
579 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_tensor(i)
580 END DO
581 nskin = nskin + nel
582 END IF !(KEYWORD
583 ENDIF !IF (ITY == 1.AND.(IGTYP==20
584C
585 END DO ! NG=1,NGROUP
586C------for solid elements
587 IF (numskin> nskin)
588 . CALL h3d_sol_skin_tensor(
589 . elbuf_tab,skin_tensor, iparg ,ixs ,x ,pm ,
590 4 iparts ,ipm ,igeo ,ixs10 ,ixs16 , ixs20 ,
591 5 is_written_skin ,h3d_part,info1 ,keyword ,nskin ,
592 6 iad_elem ,fr_elem , weight ,tag_skins6)
593C-----------
594 RETURN
595 END
596!||====================================================================
597!|| tsh_dir2 ../engine/source/output/h3d/h3d_results/h3d_skin_tensor.F
598!||--- called by ------------------------------------------------------
599!|| h3d_fld_strain ../engine/source/output/h3d/h3d_results/h3d_fld_strain.F
600!|| h3d_skin_tensor ../engine/source/output/h3d/h3d_results/h3d_skin_tensor.F
601!||--- calls -----------------------------------------------------
602!|| scortho3 ../engine/source/elements/thickshell/solidec/scortho3.F
603!|| srepisot3 ../engine/source/elements/solid/solide/srepisot3.F
604!||====================================================================
605 SUBROUTINE tsh_dir2(X,IXS,DIR,DIRB,ICSTR,NEL)
606C-----------------------------------------------
607C I m p l i c i t T y p e s
608C-----------------------------------------------
609#include "implicit_f.inc"
610C-----------------------------------------------
611C G l o b a l P a r a m e t e r s
612C-----------------------------------------------
613#include "mvsiz_p.inc"
614C-----------------------------------------------
615C C o m m o n B l o c k s
616C-----------------------------------------------
617#include "vect01_c.inc"
618C-----------------------------------------------
619C D u m m y A r g u m e n t s
620C-----------------------------------------------
621 INTEGER ICSTR,NEL,IXS(NIXS,*)
622 my_real
623 . X(3,*),DIR(MVSIZ,2),DIRB(MVSIZ,2)
624C-----------------------------------------------
625C L o c a l V a r i a b l e s
626C-----------------------------------------------
627 INTEGER I, J, N
628 INTEGER
629 . IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),IX5(MVSIZ),
630 . IX6(MVSIZ),IX7(MVSIZ),IX8(MVSIZ)
631C REAL
632 my_real
633 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
634 . x5(mvsiz), x6(mvsiz), x7(mvsiz), x8(mvsiz),
635 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
636 . y5(mvsiz), y6(mvsiz), y7(mvsiz), y8(mvsiz),
637 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
638 . z5(mvsiz), z6(mvsiz), z7(mvsiz), z8(mvsiz),
639 . rx(mvsiz) , ry(mvsiz) , rz(mvsiz) ,
640 . sx(mvsiz) , sy(mvsiz) , sz(mvsiz) ,
641 . tx(mvsiz) , ty(mvsiz) , tz(mvsiz) ,
642 . e1x(mvsiz),e2x(mvsiz),e3x(mvsiz),
643 . e1y(mvsiz),e2y(mvsiz),e3y(mvsiz),
644 . e1z(mvsiz),e2z(mvsiz),e3z(mvsiz),
645 . v1,v2,v3,vr,vs,aa,bb,suma
646C-----------------------------------------------
647 IF (irep == 0) THEN
648 DO i=1,nel
649 dirb(i,1) = dir(i,1)
650 dirb(i,2) = dir(i,2)
651 ENDDO
652 ELSE
653 DO i=1,nel
654 ix1(i)=ixs(2,i)
655 ix2(i)=ixs(3,i)
656 ix3(i)=ixs(4,i)
657 ix4(i)=ixs(5,i)
658 ix5(i)=ixs(6,i)
659 ix6(i)=ixs(7,i)
660 ix7(i)=ixs(8,i)
661 ix8(i)=ixs(9,i)
662 x1(i)=x(1,ix1(i))
663 y1(i)=x(2,ix1(i))
664 z1(i)=x(3,ix1(i))
665 x2(i)=x(1,ix2(i))
666 y2(i)=x(2,ix2(i))
667 z2(i)=x(3,ix2(i))
668 x3(i)=x(1,ix3(i))
669 y3(i)=x(2,ix3(i))
670 z3(i)=x(3,ix3(i))
671 x4(i)=x(1,ix4(i))
672 y4(i)=x(2,ix4(i))
673 z4(i)=x(3,ix4(i))
674 x5(i)=x(1,ix5(i))
675 y5(i)=x(2,ix5(i))
676 z5(i)=x(3,ix5(i))
677 x6(i)=x(1,ix6(i))
678 y6(i)=x(2,ix6(i))
679 z6(i)=x(3,ix6(i))
680 x7(i)=x(1,ix7(i))
681 y7(i)=x(2,ix7(i))
682 z7(i)=x(3,ix7(i))
683 x8(i)=x(1,ix8(i))
684 y8(i)=x(2,ix8(i))
685 z8(i)=x(3,ix8(i))
686 ENDDO
687 CALL srepisot3(
688 1 x1, x2, x3, x4,
689 2 x5, x6, x7, x8,
690 3 y1, y2, y3, y4,
691 4 y5, y6, y7, y8,
692 5 z1, z2, z3, z4,
693 6 z5, z6, z7, z8,
694 7 rx, ry, rz, sx,
695 8 sy, sz, tx, ty,
696 9 tz, nel)
697 CALL scortho3(
698 1 rx, ry, rz, sx,
699 2 sy, sz, tx, ty,
700 3 tz, e1x, e2x, e3x,
701 4 e1y, e2y, e3y, e1z,
702 5 e2z, e3z, nel)
703 IF (jhbe == 15) THEN
704 DO i=1,nel
705 aa = dir(i,1)
706 bb = dir(i,2)
707 v1 = aa*tx(i) + bb*rx(i)
708 v2 = aa*ty(i) + bb*ry(i)
709 v3 = aa*tz(i) + bb*rz(i)
710 vr=v1*e1x(i)+v2*e1y(i)+v3*e1z(i)
711 vs=v1*e2x(i)+v2*e2y(i)+v3*e2z(i)
712 suma=sqrt(vr*vr + vs*vs)
713 suma=one/max(em20,suma)
714 dirb(i,1) = vr*suma
715 dirb(i,2) = vs*suma
716 ENDDO
717 ELSEIF (jhbe == 14) THEN
718 SELECT CASE (icstr)
719 CASE (1)
720 DO i=1,nel
721 aa = dir(i,1)
722 bb = dir(i,2)
723 v1 = aa*rx(i) + bb*sx(i)
724 v2 = aa*ry(i) + bb*sy(i)
725 v3 = aa*rz(i) + bb*sz(i)
726 vr=v1*e2x(i)+v2*e2y(i)+v3*e2z(i)
727 vs=v1*e3x(i)+v2*e3y(i)+v3*e3z(i)
728 suma=sqrt(vr*vr + vs*vs)
729 suma=one/max(em20,suma)
730 dirb(i,1) = vr*suma
731 dirb(i,2) = vs*suma
732 ENDDO
733 CASE (100)
734 DO i=1,nel
735 aa = dir(i,1)
736 bb = dir(i,2)
737 v1 = aa*sx(i) + bb*tx(i)
738 v2 = aa*sy(i) + bb*ty(i)
739 v3 = aa*sz(i) + bb*tz(i)
740 vr=v1*e3x(i)+v2*e3y(i)+v3*e3z(i)
741 vs=v1*e1x(i)+v2*e1y(i)+v3*e1z(i)
742 suma=sqrt(vr*vr + vs*vs)
743 suma=one/max(em20,suma)
744 dirb(i,1) = vr*suma
745 dirb(i,2) = vs*suma
746 ENDDO
747 CASE (10)
748 DO i=1,nel
749 aa = dir(i,1)
750 bb = dir(i,2)
751 v1 = aa*tx(i) + bb*rx(i)
752 v2 = aa*ty(i) + bb*ry(i)
753 v3 = aa*tz(i) + bb*rz(i)
754 vr=v1*e1x(i)+v2*e1y(i)+v3*e1z(i)
755 vs=v1*e2x(i)+v2*e2y(i)+v3*e2z(i)
756 suma=sqrt(vr*vr + vs*vs)
757 suma=one/max(em20,suma)
758 dirb(i,1) = vr*suma
759 dirb(i,2) = vs*suma
760 ENDDO
761 END SELECT
762 END IF !(JHBE == 15) THEN
763 ENDIF
764C-----------
765 RETURN
766 END SUBROUTINE tsh_dir2
767!||====================================================================
768!|| roto_sig2d ../engine/source/output/h3d/h3d_results/h3d_skin_tensor.F
769!||--- called by ------------------------------------------------------
770!|| h3d_fld_strain ../engine/source/output/h3d/h3d_results/h3d_fld_strain.F
771!|| h3d_skin_tensor ../engine/source/output/h3d/h3d_results/h3d_skin_tensor.F
772!||====================================================================
773 SUBROUTINE roto_sig2d(JFT,JLT,SIG,DIR)
774C-----------------------------------------------
775C I m p l i c i t T y p e s
776C-----------------------------------------------
777#include "implicit_f.inc"
778C-----------------------------------------------
779C G l o b a l P a r a m e t e r s
780C-----------------------------------------------
781#include "mvsiz_p.inc"
782C-----------------------------------------------
783C D u m m y A r g u m e n t s
784C-----------------------------------------------
785 INTEGER JFT, JLT
786 my_real
787 . SIG(3,MVSIZ), DIR(MVSIZ,2)
788C-----------------------------------------------
789C L o c a l V a r i a b l e s
790C-----------------------------------------------
791 INTEGER I
792 my_real
793 . X2,Y2,XY,XYS2,SIGN(3)
794C-----------------------------------------------
795 DO i=jft,jlt
796 x2=dir(i,1)*dir(i,1)
797 y2=dir(i,2)*dir(i,2)
798 xy=dir(i,1)*dir(i,2)
799 xys2=two*xy*sig(3,i)
800 sign(1) = x2*sig(1,i)+y2*sig(2,i)-xys2
801 sign(2) = y2*sig(1,i)+x2*sig(2,i)+xys2
802 sign(3) =(sig(1,i)-sig(2,i))*xy+(x2-y2)*sig(3,i)
803 sig(1,i) = sign(1)
804 sig(2,i) = sign(2)
805 sig(3,i) = sign(3)
806 ENDDO
807C-----------
808 RETURN
809 END
810!||====================================================================
811!|| tens3dto2d ../engine/source/output/h3d/h3d_results/h3d_skin_tensor.F
812!||--- called by ------------------------------------------------------
813!|| h3d_sol_skin_scalar1 ../engine/source/output/h3d/h3d_results/h3d_sol_skin_scalar1.f
814!|| h3d_sol_skin_tensor ../engine/source/output/h3d/h3d_results/h3d_sol_skin_tensor.F
815!||--- calls -----------------------------------------------------
816!|| clskew3 ../engine/source/elements/sh3n/coquedk/cdkcoor3.F
817!|| rot3dto2d ../engine/source/output/h3d/h3d_results/h3d_skin_tensor.F
818!||====================================================================
819 SUBROUTINE tens3dto2d(NEL,IXC,X,TEN3,TEN2)
820C-----------------------------------------------
821C I m p l i c i t T y p e s
822C-----------------------------------------------
823#include "implicit_f.inc"
824C-----------------------------------------------
825C G l o b a l P a r a m e t e r s
826C-----------------------------------------------
827#include "mvsiz_p.inc"
828C-----------------------------------------------
829C D u m m y A r g u m e n t s
830C-----------------------------------------------
831 INTEGER NEL,IXC(5,*)
832 my_real
833 . X(3,*),TEN3(6,*),TEN2(3,*)
834C-----------------------------------------------
835C L o c a l V a r i a b l e s
836C-----------------------------------------------
837 INTEGER I, J, N , K
838 INTEGER
839 . IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ)
840C REAL
841 my_real
842 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
843 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
844 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
845 . rx(mvsiz) ,ry(mvsiz) ,rz(mvsiz) ,
846 . sx(mvsiz) ,sy(mvsiz) ,sz(mvsiz) ,
847 . tx(mvsiz) ,ty(mvsiz) ,tz(mvsiz) ,
848 . e1x(mvsiz),e2x(mvsiz),e3x(mvsiz),
849 . e1y(mvsiz),e2y(mvsiz),e3y(mvsiz),
850 . e1z(mvsiz),e2z(mvsiz),e3z(mvsiz),
851 . deta1(mvsiz),offg(mvsiz),tens(6,mvsiz)
852C-----------------------------------------------
853 DO i=1,nel
854 ix1(i)=ixc(2,i)
855 ix2(i)=ixc(3,i)
856 ix3(i)=ixc(4,i)
857 ix4(i)=ixc(5,i)
858 x1(i)=x(1,ix1(i))
859 y1(i)=x(2,ix1(i))
860 z1(i)=x(3,ix1(i))
861 x2(i)=x(1,ix2(i))
862 y2(i)=x(2,ix2(i))
863 z2(i)=x(3,ix2(i))
864 x3(i)=x(1,ix3(i))
865 y3(i)=x(2,ix3(i))
866 z3(i)=x(3,ix3(i))
867 x4(i)=x(1,ix4(i))
868 y4(i)=x(2,ix4(i))
869 z4(i)=x(3,ix4(i))
870 ENDDO
871 DO i=1,nel
872 rx(i)=x2(i)+x3(i)-x1(i)-x4(i)
873 sx(i)=x3(i)+x4(i)-x1(i)-x2(i)
874 ry(i)=y2(i)+y3(i)-y1(i)-y4(i)
875 sy(i)=y3(i)+y4(i)-y1(i)-y2(i)
876 rz(i)=z2(i)+z3(i)-z1(i)-z4(i)
877 sz(i)=z3(i)+z4(i)-z1(i)-z2(i)
878 ENDDO
879 k = 0
880 offg(1:nel) = one
881 CALL clskew3(1,nel,k,
882 . rx, ry, rz,
883 . sx, sy, sz,
884 . e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z,
885 . deta1,offg )
886 DO i=1,nel
887 IF (ix3(i)==ix4(i)) THEN
888 tens(1:6,i) = third*(ten3(1:6,ix1(i))+ten3(1:6,ix2(i))+ten3(1:6,ix3(i)))
889 ELSE
890 tens(1:6,i) = fourth*(ten3(1:6,ix1(i))+ten3(1:6,ix2(i))
891 . +ten3(1:6,ix3(i))+ten3(1:6,ix4(i)))
892 END IF
893 ENDDO
894 CALL rot3dto2d(nel,tens,ten2,e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)
895C-----------
896 RETURN
897 END SUBROUTINE tens3dto2d
898!||====================================================================
899!|| rot3dto2d ../engine/source/output/h3d/h3d_results/h3d_skin_tensor.F
900!||--- called by ------------------------------------------------------
901!|| tens3dto2d ../engine/source/output/h3d/h3d_results/h3d_skin_tensor.F
902!||====================================================================
903 SUBROUTINE rot3dto2d(NEL,SIG3D,SIG2D,
904 . G1X,G1Y,G1Z,G2X,G2Y,G2Z,G3X,G3Y,G3Z)
905C-----------------------------------------------
906C I m p l i c i t T y p e s
907C-----------------------------------------------
908#include "implicit_f.inc"
909C-----------------------------------------------
910C D u m m y A r g u m e n t s
911C-----------------------------------------------
912 INTEGER NEL
913 my_real
914 . SIG3D(6,*),SIG2D(3,*), G1X(*),G1Y(*),G1Z(*),
915 . G2X(*),G2Y(*),G2Z(*),G3X(*),G3Y(*),G3Z(*)
916C-----------------------------------------------
917C L o c a l V a r i a b l e s
918C-----------------------------------------------
919 INTEGER I
920 my_real
921 . SX,SY,SZ
922C-----------------------------------------------
923 DO I=1,nel
924 sx = sig3d(1,i)*g1x(i)+sig3d(4,i)*g1y(i)+sig3d(6,i)*g1z(i)
925 sy = sig3d(4,i)*g1x(i)+sig3d(2,i)*g1y(i)+sig3d(5,i)*g1z(i)
926 sz = sig3d(6,i)*g1x(i)+sig3d(5,i)*g1y(i)+sig3d(3,i)*g1z(i)
927 sig2d(1,i) = sx*g1x(i)+sy*g1y(i)+sz*g1z(i)
928 sig2d(3,i) = sx*g2x(i)+sy*g2y(i)+sz*g2z(i)
929 sx = sig3d(1,i)*g2x(i)+sig3d(4,i)*g2y(i)+sig3d(6,i)*g2z(i)
930 sy = sig3d(4,i)*g2x(i)+sig3d(2,i)*g2y(i)+sig3d(5,i)*g2z(i)
931 sz = sig3d(6,i)*g2x(i)+sig3d(5,i)*g2y(i)+sig3d(3,i)*g2z(i)
932 sig2d(2,i) = sx*g2x(i)+sy*g2y(i)+sz*g2z(i)
933 ENDDO
934C-----------
935 RETURN
936 END SUBROUTINE rot3dto2d
937!||====================================================================
938!|| reorder_n ../engine/source/output/h3d/h3d_results/h3d_skin_tensor.F
939!||====================================================================
940 SUBROUTINE reorder_n(N,IC)
941C----6---------------------------------------------------------------7---------8
942C I m p l i c i t T y p e s
943C-----------------------------------------------
944#include "implicit_f.inc"
945C-----------------------------------------------------------------
946C D u m m y A r g u m e n t s
947C-----------------------------------------------
948 INTEGER N ,IC(*)
949C-----------------------------------------------
950C L o c a l V a r i a b l e s
951C-----------------------------------------------
952 INTEGER I,J,IMIN,IT,II
953C
954 IF (n<=0) RETURN
955 DO i =1,n
956 imin=ic(i)
957 ii=i
958 DO j =i+1,n
959 IF (ic(j)<imin) THEN
960 imin=ic(j)
961 ii=j
962 ENDIF
963 ENDDO
964 it=ic(i)
965 ic(i)=imin
966 ic(ii)=it
967 ENDDO
968C----6---------------------------------------------------------------7---------8
969 RETURN
970 END
971C 12
clskew3
subroutine clskew3(jft, jlt, irep, rx, ry, rz, sx, sy, sz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, det)
Definition clskew.F:34
my_real
#define my_real
Definition cppsort.cpp:32
tsh_dir2
subroutine tsh_dir2(x, ixs, dir, dirb, icstr, nel)
Definition h3d_skin_tensor.F:606
h3d_skin_tensor
subroutine h3d_skin_tensor(elbuf_tab, skin_tensor, iparg, ixs, x, pm, iparts, ipm, igeo, ixs10, ixs16, ixs20, is_written_skin, h3d_part, info1, keyword, iad_elem, fr_elem, weight, tag_skins6)
Definition h3d_skin_tensor.F:42
tens3dto2d
subroutine tens3dto2d(nel, ixc, x, ten3, ten2)
Definition h3d_skin_tensor.F:820
roto_sig2d
subroutine roto_sig2d(jft, jlt, sig, dir)
Definition h3d_skin_tensor.F:774
rot3dto2d
subroutine rot3dto2d(nel, sig3d, sig2d, g1x, g1y, g1z, g2x, g2y, g2z, g3x, g3y, g3z)
Definition h3d_skin_tensor.F:905
reorder_n
subroutine reorder_n(n, ic)
Definition h3d_skin_tensor.F:941
h3d_sol_skin_scalar1
subroutine h3d_sol_skin_scalar1(elbuf_tab, iparg, iparts, ixs, ixs10, skin_scalar, tag_skins6, t6gps, x, npf, tf, h3d_part, is_written_skin, keyword, nskin, mat_param)
Definition h3d_sol_skin_scalar1.F:42
h3d_sol_skin_tensor
subroutine h3d_sol_skin_tensor(elbuf_tab, skin_tensor, iparg, ixs, x, pm, iparts, ipm, igeo, ixs10, ixs16, ixs20, is_written_skin, h3d_part, info1, keyword, nskin, iad_elem, fr_elem, weight, tag_skins6)
Definition h3d_sol_skin_tensor.F:44
max
#define max(a, b)
Definition macros.h:21
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261
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
srepisot3
subroutine srepisot3(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, nel)
Definition srepisot3.F:42
scortho3
subroutine scortho3(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)
Definition scortho3.F:34