C Rutina 092
C---------------------------------------------------------DER_SOL_FUND2---
C
C SUBRUTINA DER_SOL_FUND2
C
C PROBLEMA DE ELASTICIDAD PLANA ISOTROPA
C NUCLEOS PARA EL CALCULO DE TENSIONES EN EL DOMINIO
C
SUBROUTINE DER_SOL_FUND2(X,Y,PMAT,Skij,Dkij,Nx,Ny,COD,TP)
C
USE MSIMSLMD
C
IMPLICIT NONE
C
INCLUDE '_param.for'
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C X() : Coordenadas del punto de colocacion
REAL*8 X(2)
C Y() : Coordenadas del punto de integracion
REAL*8 Y(2)
C PMAT() : Propiedades del material
REAL*8 PMAT(2)
C Skij,Dkij : Nucleos en el calculo de tensiones en el dominio
C Dkij(1,1)=Dxxx, Skij(1,1)=Sxxx
C Dkij(2,1)=Dxxy, Skij(2,1)=Sxxy
C Dkij(3,1)=Dxyx, Skij(3,1)=Sxyx
C Dkij(4,1)=Dxyy, Skij(4,1)=Sxyy
C Dkij(1,2)=Dyxx, Skij(1,2)=Syxx
C Dkij(2,2)=Dyxy, Skij(2,2)=Syxy
C Dkij(3,2)=Dyyx, Skij(3,2)=Syyx
C Dkij(4,2)=Dyyy, Skij(4,2)=Syyy
REAL*8 Skij(5,2),Dkij(5,2)
C Nx,Ny : Componentes del vector normal al elemento
REAL*8 Nx,Ny
C COD: 0 Regular
C 1 Singularidad en el origen
C 2 Singularidad en el extremo
INTEGER COD
C TP : Tipo de problema
INTEGER TP
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C r : Radio vector
REAL*8 r
C dr : dr/dXi
REAL*8 dr(2)
C drdn : dr/dn
REAL*8 drdn
C n : Vector normal al elemento
REAL*8 n(2)
C G,nu : Propiedades del material
REAL*8 G,nu
C FCS,FCD : Factor comun que afecta a todos los terminos
REAL*8 FCS,FCD
C PI : Numero Pi
REAL*8 PI
C d : Delta de Kroenecker
REAL*8 d(2,2)
C I,J,K: Contadores
INTEGER I,J,K
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
IF(COD.NE.0)THEN
WRITE(F_W,09520) 1
WRITE (*,09520) 1
STOP
END IF
C
DO i= 1 , 4
DO j=1 , 2
Skij(i,j)=0.d0
Dkij(i,j)=0.d0
END DO
END DO
C
r=DSQRT((Y(1)-X(1))**2.d0+(Y(2)-X(2))**2.d0)
dr(1)=(Y(1)-X(1))/r
dr(2)=(Y(2)-X(2))/r
n(1)=Nx
n(2)=Ny
drdn=n(1)*dr(1)+n(2)*dr(2)
d(1,1)=1.d0
d(1,2)=0.d0
d(2,1)=0.d0
d(2,2)=1.d0
C
C PROPIEDADES DEL MATERIAL
C
SELECT CASE (TP)
C Tension plana
CASE(21)
G=PMAT(1)/2.d0/(1.d0+PMAT(2))
nu=PMAT(2)/(1.d0+PMAT(2))
C Deformacion plana
CASE(22)
G=PMAT(1)/2.d0/(1.d0+PMAT(2))
nu=PMAT(2)
CASE DEFAULT
WRITE(F_W,09520) 2
WRITE (*,09520) 2
STOP
END SELECT
PI=DACOS(-1.d0)
C
C Factor comun
C
FCD=1.d0/r/4.d0/PI/(1.d0-nu)
FCS=G/(r**2.d0)/2.d0/PI/(1.d0-nu) !EG000605
C
C NUCLEOS Dkij
C
DO k=1,2
DO i=1,2
DO j=1,2
Dkij(2*(i-1)+j,k)=((1.d0-2.d0*nu)*
@ (d(k,i)*dr(j)+d(k,j)*dr(i)-d(i,j)*dr(k))+
@ 2.d0*dr(i)*dr(j)*dr(k))*FCD
END DO
END DO
END DO
C
C NUCLEOS Skij
C
DO k=1,2
DO i=1,2
DO j=1,2
Skij(2*(i-1)+j,k)=
@ ( 2.d0*drdn*((1.d0-2.d0*nu)*d(i,j)*dr(k) +
@ nu*(d(k,i)*dr(j)+d(k,j)*dr(i)) -
@ 4.d0*dr(i)*dr(j)*dr(k)) +
@ 2.d0*nu*(n(i)*dr(j)*dr(k)+n(j)*dr(i)*dr(k)) +
@ (1.d0-2.d0*nu)*(2.d0*n(k)*dr(i)*dr(j)+
@ n(j)*d(i,k)+n(i)*d(j,k)) -
@ (1.d0-4.d0*nu)*n(k)*d(i,j) )*FCS
END DO
END DO
END DO
C
C FORMATOS DE ESCRITURA.
C
09520 FORMAT(/,2x,'ERROR 09520 - DER_SOL_FUND2 - Error Programa (#',
@ i1,'#)')
C
C FIN DE LA RUTINA
C
RETURN
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
