OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
surftag.F File Reference
#include "implicit_f.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine surftag (numel, ix, nix, nix1, nix2, ieltyp, iparte, tagbuf, isu, nseg, flag, nindx, indx, surf_elm)
subroutine surftagadm (numel, ix, nix, nix1, nix2, ieltyp, iparte, tagbuf, igrsurf, nseg, ipart, kshtree, shtree, flag)
subroutine surftagx (numel, ixx, kxx, nixx, ieltyp, iparte, tagbuf, igrslin, nseg, flag)

Function/Subroutine Documentation

◆ surftag()

subroutine surftag ( integer numel,
integer, dimension(nix,*) ix,
integer nix,
integer nix1,
integer nix2,
integer ieltyp,
integer, dimension(*) iparte,
integer, dimension(*) tagbuf,
type (surf_) isu,
integer nseg,
integer flag,
integer nindx,
integer, dimension(*) indx,
type(part_type), dimension(*) surf_elm )

Definition at line 31 of file surftag.F.

34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE groupdef_mod
38 USE surf_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER NIX,IX(NIX,*),NIX1,NIX2,NUMEL,IELTYP,
47 . TAGBUF(*),IPARTE(*),NSEG,FLAG
48 INTEGER :: NINDX
49 INTEGER, DIMENSION(*) :: INDX
50 TYPE(PART_TYPE), DIMENSION(*) :: SURF_ELM
51!
52 TYPE (SURF_) :: ISU
53! *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
54! ----------------
55! NINDX : number of tagged part
56! INDX : tagged part
57! ----------------
58! SURF_ELM : PART_TYPE structure
59! %NSHELL or %NTRI : number of element per part
60! %SHELL_PART or %TRI_PART : ID of the element
61! ----------------
62! *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER JJ,K,INV4(4),INV3(3)
67 DATA inv4/4,3,2,1/
68 DATA inv3/3,2,1/
69 LOGICAL :: FILL_REVERSED
70 INTEGER :: NUM_PART,NUM_ELM,ID_PART
71 INTEGER :: JS_PART,JS_ELM
72C=======================================================================
73 fill_reversed = .false.
74 IF (ALLOCATED(isu%REVERSED)) THEN
75 fill_reversed = .true.
76 ENDIF
77
78 num_part = nindx
79
80 DO js_part=1,num_part
81 id_part = indx(js_part)
82 IF(ieltyp==3) num_elm = surf_elm(id_part)%NSHELL
83 IF(ieltyp==4) num_elm = surf_elm(id_part)%NTRUSS
84 IF(ieltyp==5) num_elm = surf_elm(id_part)%NBEAM
85 IF(ieltyp==6) num_elm = surf_elm(id_part)%NSPRING
86 IF(ieltyp==7) num_elm = surf_elm(id_part)%NTRI
87 DO js_elm=1,num_elm
88 IF(ieltyp==3) jj = surf_elm(id_part)%SHELL_PART(js_elm)
89 IF(ieltyp==4) jj = surf_elm(id_part)%TRUSS_PART(js_elm)
90 IF(ieltyp==5) jj = surf_elm(id_part)%BEAM_PART(js_elm)
91 IF(ieltyp==6) jj = surf_elm(id_part)%SPRING_PART(js_elm)
92 IF(ieltyp==7) jj = surf_elm(id_part)%TRI_PART(js_elm)
93! DO JJ=1,NUMEL
94! IF (IABS(TAGBUF(IPARTE(JJ))) == 1)THEN
95 nseg=nseg+1
96 IF (flag == 1) THEN
97 IF(tagbuf(iparte(jj)) == 1)THEN
98 IF (fill_reversed) isu%REVERSED(nseg) = 0
99 DO k=nix1,nix2
100 isu%NODES(nseg,k-1) = ix(k,jj)
101 ENDDO
102 ELSEIF(tagbuf(iparte(jj)) == -1)THEN
103 IF (fill_reversed) isu%REVERSED(nseg) = 1
104 IF (ieltyp == 3) THEN
105 DO k=nix2,nix1,-1
106 isu%NODES(nseg,inv4(k-1)) = ix(k,jj)
107 ENDDO
108 ELSEIF (ieltyp == 7) THEN
109 DO k=nix2,nix1,-1
110 isu%NODES(nseg,inv3(k-1)) = ix(k,jj)
111 ENDDO
112 ENDIF ! IF (IELTYP == 3)
113 ENDIF
114 IF (nix2-nix1 == 2)THEN
115 isu%NODES(nseg,4) = isu%NODES(nseg,3)
116 ENDIF
117 isu%ELTYP(nseg) = ieltyp
118 isu%ELEM(nseg) = jj
119 ENDIF
120! ENDIF
121 ENDDO ! JS_ELM=1,NUM_ELM
122 ENDDO ! JS_PART=1,NUM_PART
123! ENDDO
124C-----------
125 RETURN
subroutine inv3(a, b)
Definition inv3.F:29

◆ surftagadm()

subroutine surftagadm ( integer numel,
integer, dimension(nix,*) ix,
integer nix,
integer nix1,
integer nix2,
integer ieltyp,
integer, dimension(*) iparte,
integer, dimension(*) tagbuf,
type (surf_) igrsurf,
integer nseg,
integer, dimension(lipart1,*) ipart,
integer kshtree,
integer, dimension(kshtree,*) shtree,
integer flag )

Definition at line 134 of file surftag.F.

137C-----------------------------------------------
138C M o d u l e s
139C-----------------------------------------------
140 USE groupdef_mod
141C-----------------------------------------------
142C I m p l i c i t T y p e s
143C-----------------------------------------------
144#include "implicit_f.inc"
145C-----------------------------------------------
146C C o m m o n B l o c k s
147C-----------------------------------------------
148#include "scr17_c.inc"
149C-----------------------------------------------
150C D u m m y A r g u m e n t s
151C-----------------------------------------------
152 INTEGER NIX,IX(NIX,*),NIX1,NIX2,NUMEL,IELTYP,
153 1 TAGBUF(*),IPARTE(*),IADPART,NSEG,FLAG,
154 2 IPART(LIPART1,*),KSHTREE,SHTREE(KSHTREE,*)
155!
156 TYPE (SURF_) :: IGRSURF
157C-----------------------------------------------
158C L o c a l V a r i a b l e s
159C-----------------------------------------------
160 INTEGER JJ,K,IP,NLEV,MY_LEV,INV4(4),INV3(3)
161cmi+2
162 DATA inv4/4,3,2,1/
163 DATA inv3/3,2,1/
164C-----------------------------------------------
165C only surfaces made of shells or 3-node shells (ieltyp=3 or 7)
166 DO jj=1,numel
167 ip=iparte(jj)
168 nlev =ipart(10,ip)
169 my_lev=shtree(3,jj)
170 IF(my_lev < 0) my_lev=-(my_lev+1)
171 IF(my_lev==nlev)THEN
172 IF(iabs(tagbuf(iparte(jj))) == 1)THEN
173 nseg=nseg+1
174 IF (flag == 1) THEN
175 IF(tagbuf(iparte(jj)) == 1)THEN
176 DO k=nix1,nix2
177 igrsurf%NODES(nseg,k-1) = ix(k,jj)
178 ENDDO
179 ELSEIF(tagbuf(iparte(jj)) == -1)THEN
180 DO k=nix2,nix1,-1
181 IF (ieltyp == 3) THEN
182 igrsurf%NODES(nseg,inv4(k-1)) = ix(k,jj)
183 ELSEIF (ieltyp == 7) THEN
184 igrsurf%NODES(nseg,inv3(k-1)) = ix(k,jj)
185 ENDIF ! IF (IELTYP == 3)
186 ENDDO
187 ENDIF
188 IF(nix2-nix1 == 2)THEN
189 igrsurf%NODES(nseg,4) = igrsurf%NODES(nseg,3)
190 ENDIF
191 igrsurf%ELTYP(nseg) = ieltyp
192 igrsurf%ELEM(nseg) = jj
193 ENDIF
194 ENDIF
195 ENDIF
196 END DO
197CC-----------
198 RETURN

◆ surftagx()

subroutine surftagx ( integer numel,
integer, dimension(*) ixx,
integer, dimension(nixx,*) kxx,
integer nixx,
integer ieltyp,
integer, dimension(*) iparte,
integer, dimension(*) tagbuf,
type (surf_) igrslin,
integer nseg,
integer flag )

Definition at line 207 of file surftag.F.

209C-----------------------------------------------
210C M o d u l e s
211C-----------------------------------------------
212 USE groupdef_mod
213C-----------------------------------------------
214C I m p l i c i t T y p e s
215C-----------------------------------------------
216#include "implicit_f.inc"
217C-----------------------------------------------
218C D u m m y A r g u m e n t s
219C-----------------------------------------------
220 INTEGER NUMEL,IXX(*),KXX(NIXX,*),IELTYP,NIXX,
221 . TAGBUF(*),IPARTE(*),IADPART,NSEG,FLAG
222!
223 TYPE (surf_) :: igrslin
224C-----------------------------------------------
225C L o c a l V a r i a b l e s
226C-----------------------------------------------
227 INTEGER JJ,K,NIX1,NIX2,ISEG
228C=======================================================================
229 DO jj=1,numel
230 IF (iabs(tagbuf(iparte(jj))) == 1)THEN
231 nseg=nseg+kxx(3,jj) - 1
232 iseg = nseg-(kxx(3,jj) - 1)
233 IF (flag == 1) THEN
234 nix1 = kxx(4,jj)
235 nix2 = kxx(4,jj) + kxx(3,jj) - 1
236 IF(tagbuf(iparte(jj)) == 1)THEN
237 DO k=1,kxx(3,jj) - 1 ! loop over Nstrand segments
238 igrslin%NODES(iseg+k,1) = ixx(kxx(4,jj)+k-1)
239 igrslin%NODES(iseg+k,2) = ixx(kxx(4,jj)+k)
240 igrslin%ELTYP(iseg+k) = ieltyp
241 igrslin%ELEM(iseg+k) = jj
242 ENDDO
243c ELSEIF(TAGBUF(IPARTE(JJ)) == -1)THEN
244c DO K=NIX2,NIX1,-1
245c IBUFSSG(IAD)=IX(K,JJ)
246c IAD=IAD+1
247c ENDDO
248 ENDIF
249 ENDIF
250 ENDIF
251 ENDDO
252C-----------
253 RETURN