OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
parsorf.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!|| parsorf ../starter/source/output/anim/parsorf.F
25!||--- called by ------------------------------------------------------
26!|| genani1 ../starter/source/output/anim/genani1.F
27!||--- calls -----------------------------------------------------
28!||====================================================================
29 SUBROUTINE parsorf(IADD ,IPARG,IXT ,IXP ,IXR ,
30 . MATER,EL2FA,
31 . IPARTT,IPARTP,IPARTR,NFACPTX,IXEDGE)
32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35#include "implicit_f.inc"
36C-----------------------------------------------
37C C o m m o n B l o c k s
38C-----------------------------------------------
39#include "com01_c.inc"
40#include "com04_c.inc"
41#include "param_c.inc"
42C-----------------------------------------------
43C D u m m y A r g u m e n t s
44C-----------------------------------------------
45 INTEGER IADD(*),IPARG(NPARG,*),
46 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),
47 . mater(*),el2fa(*),
48 . ipartt(*),ipartp(*),ipartr(*),
49 . nfacptx(3,*),ixedge(2,*)
50C-----------------------------------------------
51 INTEGER II(4),IE,NG, ITY, LFT, LLT, KPT, N, I, J,
52 . IPRT, NEL, IAD, NPAR, NFT, IMID,IALEL,MTN,
53 . nn1,nn2,nn3,nn4,nn5,nn6,nn7,nn8,jj, k,nax1d
54C-----------------------------------------------
55 ie = 0
56C
57 nn1 = 1
58 nn2 = 1
59 nn3 = 1
60 nn4 = nn3
61 nn5 = nn4
62 nn6 = nn5
63 nn7 = nn6 + numelt
64 nn8 = nn7 + numelp
65c NN9 = NN8 + NUMELR
66c NN10= NN9
67C-----------------------------------------------
68 npar = 0
69C-----------------------------------------------
70C PART
71C-----------------------------------------------
72 IF(numelp + numelt + numelr/=0)THEN
73 jj = 0
74 DO 500 iprt=1,npart
75 IF(mater(iprt)/=3)GOTO 500
76 IF(numelx>0)THEN
77 IF(nfacptx(1,iprt)>0)GOTO 500
78 ENDIF
79 npar = npar + 1
80 DO 490 ng=1,ngroup
81 mtn =iparg(1,ng)
82 nel =iparg(2,ng)
83 nft =iparg(3,ng)
84 iad =iparg(4,ng)
85 ity =iparg(5,ng)
86 lft=1
87 llt=nel
88C-----------------------------------------------
89C TRUSS
90C-----------------------------------------------
91 IF(ity==4)THEN
92 DO 140 i=lft,llt
93 n = i + nft
94 IF(ipartt(n)/=iprt)GOTO 140
95 ii(1) = ixt(2,n)-1
96 ii(2) = ixt(3,n)-1
97 CALL write_i_c(ii,2)
98 ie = ie + 1
99 el2fa(nn6+n) = ie
100 jj = jj + 2
101 140 CONTINUE
102C-----------------------------------------------
103C POUTRES
104C-----------------------------------------------
105 ELSEIF(ity==5)THEN
106 DO 150 i=lft,llt
107 n = i + nft
108 IF(ipartp(n)/=iprt)GOTO 150
109 ii(1) = ixp(2,n)-1
110 ii(2) = ixp(3,n)-1
111 CALL write_i_c(ii,2)
112 ie = ie + 1
113 el2fa(nn7+n) = ie
114 jj = jj + 2
115 150 CONTINUE
116C-----------------------------------------------
117C RESSORTS
118C-----------------------------------------------
119 ELSEIF(ity==6)THEN
120 DO 160 i=lft,llt
121 n = i + nft
122 IF(ipartr(n)/=iprt)GOTO 160
123 ii(1) = ixr(2,n)-1
124 ii(2) = ixr(3,n)-1
125 CALL write_i_c(ii,2)
126 ie = ie + 1
127 el2fa(nn8+n) = ie
128 jj = jj + 2
129 IF(mtn==3)THEN
130 ii(1) = ixr(3,n)-1
131 ii(2) = ixr(4,n)-1
132 CALL write_i_c(ii,2)
133 ie = ie + 1
134 jj = jj + 2
135 ENDIF
136 160 CONTINUE
137 ELSE
138 ENDIF
139 490 CONTINUE
140C-----------------------------------------------
141C PART ADRESS
142C-----------------------------------------------
143 iadd(npar) = ie
144 500 CONTINUE
145 ENDIF
146C-----------------------------------------------
147C X-ELEMENTS PARTS ARE WRITTEN AFTER ALL (BUT RBODIES) 1D PARTS.
148C-----------------------------------------------
149 IF (nanim1d>0) THEN
150 nax1d=0
151 DO 600 iprt=1,npart
152 IF(mater(iprt)/=3)GOTO 600
153 IF(nfacptx(1,iprt)/=0) THEN
154 npar = npar + 1
155 DO j=1,nfacptx(1,iprt)
156 ii(1)=ixedge(1,nax1d+j)-1
157 ii(2)=ixedge(2,nax1d+j)-1
158 CALL write_i_c(ii,2)
159 jj = jj+2
160 ENDDO
161 nax1d=nax1d+nfacptx(1,iprt)
162 ie=ie+nfacptx(1,iprt)
163 iadd(npar)=ie
164 ENDIF
165 600 CONTINUE
166 ENDIF
167C-----------------------------------------------
168 RETURN
169 END
parsorf
subroutine parsorf(iadd, iparg, ixt, ixp, ixr, mater, el2fa, ipartt, ipartp, ipartr, nfacptx, ixedge)
Definition parsorf.F:32
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645