OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
qdlen2.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "vect01_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine qdlen2 (iparg, aire, deltax, y1, y2, y3, y4, z1, z2, z3, z4)

Function/Subroutine Documentation

◆ qdlen2()

subroutine qdlen2 ( integer, dimension(63:63) iparg,
aire,
deltax,
y1,
y2,
y3,
y4,
z1,
z2,
z3,
z4 )

Definition at line 35 of file qdlen2.F.

39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE ale_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
50#include "mvsiz_p.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "vect01_c.inc"
55#include "com01_c.inc"
56C-----------------------------------------------
57C E x t e r n a l
58C-----------------------------------------------
59 LOGICAL,EXTERNAL :: LOI_FLUID
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER IPARG(63:63)
65 . aire(*), deltax(*),
66 . y1(*), y2(*), y3(*), y4(*),
67 . z1(*), z2(*), z3(*), z4(*)
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER I, NFAC, ISFLUID
73 . al1(mvsiz), al2(mvsiz), al3(mvsiz), al4(mvsiz),
74 . almx(mvsiz),
75 . xoff(mvsiz), atest(mvsiz)
76C--------------------------------------------------------------------
77C
78 DO i=lft,llt
79 xoff(i)=one
80 END DO
81
82 isfluid = 0
83 IF(loi_fluid(mtn))isfluid=1
84
85 IF(ale%GLOBAL%ICAA==1 .AND. n2d==2 .AND. isfluid==1 .AND. mtn/=5)THEN
86 DO i=lft,llt
87 al1(i)=(z3(i)-z1(i))*(z3(i)-z1(i))+(y3(i)-y1(i))*(y3(i)-y1(i))
88 al2(i)=(z4(i)-z2(i))*(z4(i)-z2(i))+(y4(i)-y2(i))*(y4(i)-y2(i))
89 almx(i)=fourth*(al1(i)+al2(i))
90 ENDDO
91 ELSE
92 DO i=lft,llt
93 al1(i)=(z2(i)-z1(i))*(z2(i)-z1(i))+
94 . (y2(i)-y1(i))*(y2(i)-y1(i))
95 al2(i)=(z3(i)-z2(i))*(z3(i)-z2(i))+
96 . (y3(i)-y2(i))*(y3(i)-y2(i))
97 al3(i)=(z4(i)-z3(i))*(z4(i)-z3(i))+
98 . (y4(i)-y3(i))*(y4(i)-y3(i))
99 al4(i)=(z4(i)-z1(i))*(z4(i)-z1(i))+
100 . (y4(i)-y1(i))*(y4(i)-y1(i))
101
102 almx(i)= max(al1(i),al2(i),al3(i),al4(i))
103
104 al1(i)=(z3(i)-z1(i))*(z3(i)-z1(i))+
105 . (y3(i)-y1(i))*(y3(i)-y1(i))
106 al2(i)=(z4(i)-z2(i))*(z4(i)-z2(i))+
107 . (y4(i)-y2(i))*(y4(i)-y2(i))
108
109 almx(i)= max(al1(i),al2(i),almx(i))
110 END DO
111 IF(ale%GLOBAL%ICAA==0)THEN
112 DO i=lft,llt
113 atest(i)=em4*almx(i)
114 nfac=0
115 IF(al1(i)<atest(i)) nfac=nfac+1
116 IF(al2(i)<atest(i)) nfac=nfac+1
117 IF(al3(i)<atest(i)) nfac=nfac+1
118 IF(al4(i)<atest(i)) nfac=nfac+1
119 IF(nfac>=2) xoff(i)=ep03
120 END DO
121 ENDIF
122 ENDIF
123
124 DO i=lft,llt
125 deltax(i)=aire(i)*xoff(i)/sqrt(almx(i))
126 END DO
127
128 RETURN
129
#define my_real
Definition cppsort.cpp:32
logical function loi_fluid(mln)
Definition loi_fluid.F:32
#define max(a, b)
Definition macros.h:21
type(ale_) ale
Definition ale_mod.F:249