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