C Rutina 103
C-------------------------------------------------------COMPR_INTERP---
C
C SUBRUTINA COMPR_INTERP
C
C COMPROBACION DE PENETRACION DE NODOS DE A EN B
C ALGORITMO INCREMENTAL
C
SUBROUTINE COMPR_INTERP(CNOD,CNTB,ELT,NOD,LAMBDA,BC,DIS,COD)
C
IMPLICIT NONE
C
INCLUDE '_param.for'
INCLUDE '_struct.for'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS 1
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C CNOD : Nodo
INTEGER CNOD
C CNTB : Contorno B de la zona de contacto
RECORD /S_contorno/ CNTB
C ELT : ELEMENTOS DEL PROBLEMA
RECORD /S_elemento/ ELT(N_MAX_ELT)
C NOD : Nodos del problema
RECORD /S_nodo/ NOD(N_MAX_NOD)
C LAMBDA : Coef. de pond. de la sol. del incr. de carga
REAL*8 LAMBDA
C BC : Condicion de contorno final
INTEGER BC
C DIS : Distancia para la que se produce el cruce
REAL *8 DIS
C COD = 1 : Nodo inicial
C = 2 : Nodo intermedio
C = 3 : Nodo final
INTEGER COD
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C I : Contador
INTEGER I
C Contadores
INTEGER CELT,N1,N2
C x1A,x2A: Posicion del nodo
REAL*8 X1A,X2A
C x1B1,x2B1,x1B2,x2B2: Posicion de los extremos del elemento
REAL*8 X1B1,X2B1,X1B2,X2B2
C u1A,u2A: Desplazamiento del nodo
REAL*8 U1A,U2A
C u1B1,u2B1,u1B2,u2B2: Desplazamientos de los extremos del elemento
REAL*8 U1B1,U2B1,U1B2,U2B2
C A,B,C,D : Variables auxiliares
REAL*8 A,B,C,D
C L : Valor de LAMBDA para el cual el nodo
C cruza la recta del elemento
REAL*8 L1,L2
XXX REAL*8 L3
C P : Coordenada local del nodo cuando cruza el elemento
REAL*8 P
C DSL : DESLIZAMIENTO
REAL*8 DSL
C
CCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCC
C
x1A=NOD(cnod).XYZ(1)
x2A=NOD(cnod).XYZ(2)
C
u1A=NOD(cnod).D_SOLU(1)
u2A=NOD(cnod).D_SOLU(2)
C
CCCCCCCCCCCCCCC
C RUTINA
CCCCCCCCCCCCCCC
C
C Bucle que recorre los elementos de B
C
i=0
DO WHILE (i.LT.CNTB.NELT)
i=i+1
celt=CNTB.ELT(i)
n1=ELT(celt).NI(1)
n2=ELT(celt).NI(2)
x1B1=NOD(n1).XYZ(1)
x2B1=NOD(n1).XYZ(2)
x1B2=NOD(n2).XYZ(1)
x2B2=NOD(n2).XYZ(2)
u1B1=NOD(n1).D_SOLU(1)
u2B1=NOD(n1).D_SOLU(2)
u1B2=NOD(n2).D_SOLU(1)
u2B2=NOD(n2).D_SOLU(2)
C
a=(u1A-u1B1)*(u2B2-u2B1)-(u2A-u2B1)*(u1B2-u1B1)
b=(u1A-u1B1)*(x2B2-x2B1)+(u2B2-u2B1)*(x1A-x1B1)-
@ (u1B2-u1B1)*(x2A-x2B1)-(u2A-u2B1)*(x1B2-x1B1)
c=(x1A-x1B1)*(x2B2-x2B1)-(x1B2-x1B1)*(x2A-x2B1)
C
d=b*b-4.d0*a*c
C
C TOLERANCIAS
C
IF(DABS(a).LT.1d-16)THEN
a=0.d0
END IF
IF(DABS(b).LT.1d-14)THEN
b=0.d0
END IF
IF(DABS(c).LT.1d-50)THEN
c=0.d0
END IF
IF(DABS(d).LT.1d-29)THEN
d=0.d0
END IF
C
L1=2.d0
L2=2.d0
C
IF(a.GT.0.d0)THEN
C a>0
IF(d.GT.0)THEN
C d>0 -> dos raices distintas
IF(c.GT.0)THEN
C c>0 -> inicialmente fuera
L1=(-b-DSQRT(d))/a/2.d0
IF((L1.GT.0.d0).AND.(L1.LT.1.d0))THEN
L2=L1
ELSE
L1=(-b+DSQRT(d))/a/2.d0
IF((L1.GT.0.d0).AND.(L1.LT.1.d0))THEN
WRITE(F_W,11120) 2
WRITE (*,11120) 2
STOP
ELSE
L2=1.d0
END IF
END IF
ELSE
C c<=0 -> inicialmente dentro (o en el elemento)
IF(b.LT.0)THEN
L2=0.d0
ELSE
L2=1.d0
END IF
END IF
ELSE IF(d.EQ.0)THEN
C d=0 -> dos raices iguales
L2=1.d0
ELSE
C d<0 -> No corta
L2=1.d0
END IF
ELSE IF(a.LT.0.d0)THEN
C a<0
IF(d.GT.0.d0)THEN
C d>0 -> dos raices distintas
IF(c.GT.0.d0)THEN
C c>0 -> inicialmente fuera
L1=(-b-DSQRT(d))/a/2.d0
IF((L1.GT.0.d0).AND.(L1.LT.1.d0))THEN
L2=L1
ELSE
L1=(-b+DSQRT(d))/a/2.d0
IF((L1.GT.0.d0).AND.(L1.LT.1.d0))THEN
WRITE(F_W,11120) 4
WRITE (*,11120) 4
STOP
ELSE
L2=1.d0
END IF
END IF
ELSE
C c<=0 -> inicialmente dentro (o en el elemento)
IF(b.LE.0.d0)THEN
C b<=0 -> entrando mas
L2=0.d0
ELSE
C b>0 -> saliendo
L1=(-b-DSQRT(d))/a/2.d0
IF((L1.GT.0.d0).AND.(L1.LT.1.d0))THEN
L2=L1
ELSE
L2=1.d0
END IF
END IF
END IF
ELSE IF(d.EQ.0.d0)THEN
C d=0 -> dos raices iguales
IF(b.LE.0.d0)THEN
C b<=0 -> entrando mas
L2=0.d0
ELSE
C b>0 -> saliendo
L1=-b/a/2.d0
IF((L1.GT.0.d0).AND.(L1.LT.1.d0))THEN
L2=L1
ELSE
L2=1.d0
END IF
END IF
ELSE
C d<0 -> No corta
IF(b.LE.0.d0)THEN
C b<=0 -> entrando mas
L2=0.d0
ELSE
C b>0 -> saliendo
L1=-b/a/2.d0
IF((L1.GT.0.d0).AND.(L1.LT.1.d0))THEN
L2=L1
ELSE
L2=1.d0
END IF
END IF
END IF
ELSE
C a=0
IF(b.GE.0.d0)THEN
C b>=0 saliendo
L2=1.d0
ELSE
C b<0 entrando
L1=-c/b
IF((L1.GE.0.d0).AND.(L1.LT.1.d0))THEN
L2=L1
ELSE
L2=1.d0
END IF
END IF
END IF
C
IF((L2.GE.0.d0).AND.(L2.LT.1.d0))THEN
C
x1B1=x1B1+L2*u1B1
x2B1=x2B1+L2*u2B1
x1B2=x1B2+L2*u1B2
x2B2=x2B2+L2*u2B2
C
IF((x1B2-x1B1).NE.0.d0)THEN
P=2.d0*((x1A+L2*u1A-x1B1)/(x1B2-x1B1))-1.d0
ELSE
P=2.d0*((x2A+L2*u2A-x2B1)/(x2B2-x2B1))-1.d0
END IF
C
IF((P.GE.-1.d0).AND.(P.LE.1.d0))THEN
LAMBDA=L2
C
SELECT CASE(COD)
CASE(1)
DIS=-LAMBDA*(NOD(cnod).D_SOLU(9))
CASE(2,3)
DIS=-LAMBDA*(NOD(cnod).D_SOLU(7))
CASE DEFAULT
WRITE(F_W,11120) 5
WRITE (*,11120) 5
STOP
END SELECT
C
i=CNTB.NELT+1
END IF
C
ELSE IF(L2.NE.1.d0)THEN
WRITE(F_W,11120) 6
WRITE (*,11120) 6
STOP
END IF
C
C Fin bucle que recorre los elementos de B
C
END DO
C
IF(LAMBDA.LT.1.d0)THEN
C
C HAY INTERPENETRACIÓN: Calculamos el deslizamiento
C
SELECT CASE(COD)
C NODO INICIAL
CASE(1)
DSL=NOD(cnod).D_SOLU(10)
C NODO INTERMEDIO O FINAL
CASE(2,3)
DSL=NOD(cnod).D_SOLU(8)
C ERROR
CASE DEFAULT
WRITE(F_W,11120) 7
WRITE (*,11120) 7
STOP
END SELECT
C
IF(DSL.LT.0.d0)THEN
BC=-3
ELSE IF(DSL.GT.0.d0)THEN
BC=3
ELSE
BC=2
END IF
C
END IF
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA.
C
11120 FORMAT(/,2x,'ERROR 11120 - COMPR_INTERP - Error Programa',
@ ' (#',i1,'#)')
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
