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

Go to the source code of this file.

Functions/Subroutines

subroutine aniskewf (geo, skew, iparg, ixr, lrbuf)

Function/Subroutine Documentation

◆ aniskewf()

subroutine aniskewf ( geo,
skew,
integer, dimension(nparg,*) iparg,
integer, dimension(nixr,*) ixr,
integer lrbuf )

Definition at line 29 of file aniskewf.F.

30C-----------------------------------------------
31C I m p l i c i t T y p e s
32C-----------------------------------------------
33#include "implicit_f.inc"
34C-----------------------------------------------
35C C o m m o n B l o c k s
36C-----------------------------------------------
37#include "com01_c.inc"
38#include "com04_c.inc"
39#include "param_c.inc"
40C-----------------------------------------------
41C D u m m y A r g u m e n t s
42C-----------------------------------------------
43C REAL
45 . geo(npropg,*), skew(lskew,*)
46 INTEGER IXR(NIXR,*),IPARG(NPARG,*),LRBUF
47C-----------------------------------------------
48C L o c a l V a r i a b l e s
49C-----------------------------------------------
50 INTEGER I, J,ISK,NB1,NB2,NB3,NB4,NB5,NB6,NB7,NB8,NB9,
51 . NB10,NB11,NB12,NB13,NB14,NEL,LFT,LLT,NG,
52 . ITY,IAD,MLW,NFT,N,II,ISKK,MSGTAG,LEN
53 INTEGER SRBUF(LRBUF)
54C
55C-----------------------------------------------
56C SKEW
57C-----------------------------------------------
58 isk=numskw-1
59C-----------------------------------------------
60C SKEW ELEMENT 1D
61C-----------------------------------------------
62C
63 DO ng=1,ngroup
64 mlw =iparg(1,ng)
65 nel =iparg(2,ng)
66 ity =iparg(5,ng)
67 nft =iparg(3,ng)
68 iad =iparg(4,ng)
69 lft = 1
70 llt = nel
71C-----------------------------------------------
72C TRUSS
73C-----------------------------------------------
74 IF(ity==4)THEN
75 DO i=lft,llt
76 isk=isk+1
77 CALL write_i_c(isk,1)
78 ENDDO
79C-----------------------------------------------
80C POUTRES
81C-----------------------------------------------
82 ELSEIF(ity==5)THEN
83 DO i=lft,llt
84 isk=isk+1
85 CALL write_i_c(isk,1)
86 ENDDO
87C-----------------------------------------------
88C RESSORTS
89C-----------------------------------------------
90 ELSEIF(ity==6)THEN
91 IF(mlw==1)THEN
92 DO i=lft,llt
93 isk=isk+1
94 CALL write_i_c(isk,1)
95 ENDDO
96 ELSEIF(mlw==2)THEN
97 DO i=lft,llt
98 n=i+nft
99 iskk=nint(geo(2,ixr(1,n)))-1
100 CALL write_i_c(iskk,1)
101 ENDDO
102 ELSEIF(mlw==3)THEN
103 DO i=lft,llt
104 isk=isk+1
105 CALL write_i_c(isk,1)
106 isk=isk+1
107 CALL write_i_c(isk,1)
108 ENDDO
109 ELSEIF(mlw==4.OR.mlw==5)THEN
110 DO i=lft,llt
111 isk=isk+1
112 CALL write_i_c(isk,1)
113 ENDDO
114 ENDIF
115C
116 ELSE
117 ENDIF
118 ENDDO
119C
120 RETURN
#define my_real
Definition cppsort.cpp:32
void write_i_c(int *w, int *len)