OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
tshgeodel3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "comlock.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine tshgeodel3 (ngl, offg, volg, area, volg0, l_sh, geo, nnod, dt, nel)

Function/Subroutine Documentation

◆ tshgeodel3()

subroutine tshgeodel3 ( integer, dimension(mvsiz), intent(in) ngl,
intent(inout) offg,
intent(in) volg,
intent(in) area,
intent(in) volg0,
intent(in) l_sh,
intent(in) geo,
integer, intent(in) nnod,
type(dt_), intent(inout) dt,
integer, intent(in) nel )

Definition at line 35 of file tshgeodel3.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE message_mod
40 USE dt_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45#include "mvsiz_p.inc"
46#include "comlock.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "units_c.inc"
51#include "param_c.inc"
52#include "scr17_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER ,INTENT(IN) :: NNOD,NEL
57 INTEGER ,DIMENSION(MVSIZ) ,INTENT(IN) :: NGL
58 my_real, DIMENSION(NPROPG) , INTENT(IN) :: geo
59 my_real, DIMENSION(NEL) , INTENT(IN) :: volg0
60 my_real, DIMENSION(MVSIZ) , INTENT(IN) :: volg,area,l_sh ! L_SH=L_MAX**2
61 my_real, DIMENSION(NEL) , INTENT(INOUT) :: offg
62 TYPE(DT_), INTENT(INOUT) :: DT
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I,J,ICOUNT,LIST(MVSIZ)
68 . tet_colla(mvsiz),def_v(mvsiz),aps_r(mvsiz),
69 . c_min,al,vdefmin,vdefmax,aspmax,colmin,c_max,gdel
70C---------------------------------------------
71 vdefmin = geo(190)
72 vdefmax = geo(191)
73 aspmax = geo(192)
74 colmin = geo(193)
75C-----
76 gdel=vdefmin+vdefmax+aspmax+colmin
77 IF(gdel==zero.AND.dt%IDEL_BRICK==0) RETURN
78C-----
79 IF(dt%BRICK_DEL_DEFV_MAX>zero .AND. (dt%BRICK_DEL_DEFV_MAX<vdefmax
80 . .OR.vdefmax==zero) ) vdefmax = dt%BRICK_DEL_DEFV_MAX
81 IF(dt%BRICK_DEL_ASP_MAX>zero .AND. ( dt%BRICK_DEL_ASP_MAX<aspmax
82 . .OR.aspmax==zero) ) aspmax = dt%BRICK_DEL_ASP_MAX
83 c_min = one
84 c_max = one
85C--- penta6
86 IF (nnod ==6) THEN
87 c_max = fourth*sqr3
88 c_min = one/c_max
89 END IF
90C
91 IF ((vdefmin+vdefmax) >zero) THEN
92 DO i=1,nel
93 IF (offg(i)==zero) cycle
94 def_v(i) = volg(i)/volg0(i)
95 END DO
96 END IF
97 IF (vdefmin >zero) THEN
98 icount = 0
99 DO i=1,nel
100 IF (offg(i)==zero) cycle
101 IF (def_v(i) < vdefmin) THEN
102 offg(i) = zero
103 icount=icount+1
104 list(icount)=i
105 END IF
106 END DO
107 IF (icount > 0) THEN
108#include "lockon.inc"
109 WRITE(iout,1001)
110 WRITE(istdo,1001)
111 DO j=1,icount
112 i=list(j)
113 WRITE(iout,'(6X,I10,1PG20.13)')ngl(i),def_v(i)
114 WRITE(istdo,'(6X,I10,1PG20.13)')ngl(i),def_v(i)
115 ENDDO
116 WRITE(iout,*)
117 WRITE(istdo,*)
118#include "lockoff.inc"
119 idel7nok = 1
120 END IF !(ICOUNT > 0) THEN
121 END IF
122C
123 IF (vdefmax >zero) THEN
124 icount = 0
125 DO i=1,nel
126 IF (offg(i)==zero) cycle
127 IF (def_v(i) > vdefmax) THEN
128 offg(i) = zero
129 icount=icount+1
130 list(icount)=i
131 END IF
132 END DO
133 IF (icount > 0) THEN
134#include "lockon.inc"
135 WRITE(iout,1002)
136 WRITE(istdo,1002)
137 DO j=1,icount
138 i=list(j)
139 WRITE(iout,'(6X,I10,1PG20.13)')ngl(i),def_v(i)
140 WRITE(istdo,'(6X,I10,1PG20.13)')ngl(i),def_v(i)
141 ENDDO
142 WRITE(iout,*)
143 WRITE(istdo,*)
144#include "lockoff.inc"
145 idel7nok = 1
146 END IF !(ICOUNT > 0) THEN
147 END IF
148C--- Hexa : APS_r=lmax/lmin lmax~sqrt(L_SH); lmin~A/lmax ->
149C--- APS_r~lmax^2/A
150 IF (aspmax>zero) THEN
151 icount = 0
152 DO i=1,nel
153 IF (offg(i)==zero) cycle
154 aps_r(i) = c_max*l_sh(i)/area(i)
155 IF (aps_r(i) > aspmax) THEN
156 offg(i) = zero
157 icount=icount+1
158 list(icount)=i
159 END IF
160 END DO
161 IF (icount > 0) THEN
162#include "lockon.inc"
163 WRITE(iout,1003)
164 WRITE(istdo,1003)
165 DO j=1,icount
166 i=list(j)
167 WRITE(iout,'(6X,I10,1PG20.13)')ngl(i),aps_r(i)
168 WRITE(istdo,'(6X,I10,1PG20.13)')ngl(i),aps_r(i)
169 ENDDO
170 WRITE(iout,*)
171 WRITE(istdo,*)
172#include "lockoff.inc"
173 idel7nok = 1
174 END IF !(ICOUNT > 0) THEN
175 END IF
176C
177C--- TET_c =1/ASP_r
178 IF (colmin>zero) THEN
179 icount = 0
180 DO i=1,nel
181 IF (offg(i)==zero) cycle
182 tet_colla(i) = c_min *area(i)/l_sh(i)
183 IF (tet_colla(i) < colmin) THEN
184 offg(i) = zero
185 icount=icount+1
186 list(icount)=i
187 END IF
188 END DO
189 IF (icount > 0) THEN
190#include "lockon.inc"
191 WRITE(iout,1004)
192 WRITE(istdo,1004)
193 DO j=1,icount
194 i=list(j)
195 WRITE(iout,'(6X,I10,1PG20.13)')ngl(i),tet_colla(i)
196 WRITE(istdo,'(6X,I10,1PG20.13)')ngl(i),tet_colla(i)
197 ENDDO
198 WRITE(iout,*)
199 WRITE(istdo,*)
200#include "lockoff.inc"
201 idel7nok = 1
202 END IF !(ICOUNT > 0) THEN
203 END IF
204C
205 RETURN
206 1001 FORMAT(/
207 . 'THE FOLLOWING THICK-SHELL ELEMENTS WILL BE DELETED BY MINIMUM VOLUME RATIO' /)
208 1002 FORMAT(/
209 . 'THE FOLLOWING THICK-SHELL ELEMENTS WILL BE DELETED BY MAXIMUM VOLUME RATIO' /)
210 1003 FORMAT(/
211 . 'THE FOLLOWING THICK-SHELL ELEMENTS WILL BE DELETED BY MAXIMUM ASPECT RATIO' /)
212 1004 FORMAT(/
213 . 'THE FOLLOWING THICK-SHELL ELEMENTS WILL BE DELETED BY MINIMUM COLLAPSE RATIO' /)
#define my_real
Definition cppsort.cpp:32
subroutine area(d1, x, x2, y, y2, eint, stif0)