C
C--------------------------------------------------------------CALC_APOYO---
C
C SUBRUTINA CALC_APOYO
C
C MONTAJE DE LAS ECUACIONES PARA EVITAR MOVIMIENTOS DE SOLIDO RIGIDO
C
SUBROUTINE CALC_APOYO(PRB,SOL,NOD,VT,W)
C
IMPLICIT NONE
INCLUDE '_param.for'
INCLUDE '_struct.for'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C PRB : Variables globales del problema
RECORD /S_problema/ PRB
C SOL : Solidos del problema
RECORD /S_solido/ SOL(N_MAX_SOL)
C NOD : Nodos del problema
RECORD /S_nodo/ NOD(N_MAX_NOD)
C VT : Ecuación correspondiente a los apoyos puntuales
REAL*8 VT(3*N_MAX_SOL,N_MAX_INC)
C W : Proyeccion de los MSR sobre las incognitas
REAL*8 W(N_MAX_INC,3*N_MAX_SOL)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Contadores
INTEGER i,j,k,m
INTEGER CSOL,CNOD,CAPO
INTEGER CINC
C MSR() : Valor del MSR en el nodo
REAL*8 MSR(2)
C CDC : Proyeccion de los MSR sobre las condiciones de contorno
REAL*8 CDC
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C MONTAJE ECUACIONES SOLIDO
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Ecuaciones de apoyo (Vectores VT)
C
capo=0
DO i=1,PRB.NSOL
csol=SOL(i).NUM
DO j=1,SOL(csol).NAPO
capo=capo+1
DO k=1,PRB.NINC
VT(capo,k)=0.d0
END DO
END DO
END DO
C
C Proyeccion de los MSR (Vectores W)
C
capo=0
DO i=1,PRB.NSOL
csol=SOL(i).NUM
DO j=1,SOL(csol).NAPO
capo=capo+1
DO k=1,PRB.NINC
W(k,capo)=0.d0
END DO
END DO
END DO
C
C Bucle que recorre los solidos
C
capo=0
DO i=1,PRB.NSOL
csol=SOL(i).NUM
C
C Bucle que recorre las ecuaciones de apoyo de cada solido
C
DO j=1,SOL(csol).NAPO
capo=capo+1
C
C Ecuaciones de apoyo (Vectores VT)
C
cnod=SOL(csol).APO(j).NOD
C
CDC=0.d0
DO k=1,SOL(csol).NNOD
IF(SOL(csol).NOD(k).EQ.cnod)THEN
CDC=1.d0
END IF
END DO
C
IF( CDC.EQ.0.d0 )THEN
WRITE(F_W,13701) csol,j,NOD(cnod).NUM
WRITE (*,13701) csol,j,NOD(cnod).NUM
STOP
END IF
C
DO m=1,NOD(cnod).NINC
cinc=NOD(cnod).INC(m)
VT(capo,cinc)=SOL(csol).APO(j).DIR(1)*NOD(cnod).Gij(1,m)
@ +SOL(csol).APO(j).DIR(2)*NOD(cnod).Gij(2,m)
END DO
C
DO m=NOD(cnod).NINC+1,NOD(cnod).NINC+NOD(cnod).NBC
C
CDC=SOL(csol).APO(j).DIR(1)*NOD(cnod).Gij(1,m)
@ +SOL(csol).APO(j).DIR(2)*NOD(cnod).Gij(2,m)
C
IF(DABS(CDC).GT.TOL)THEN
WRITE(F_W,13702) csol,NOD(cnod).NUM,NOD(cnod).CBC(1)
WRITE (*,13702) csol,NOD(cnod).NUM,NOD(cnod).CBC(1)
STOP
END IF
C
END DO
C
C
C Proyeccion de los MSR (Vectores W)
C
C Bucle que recorre los nodos del solido
C
DO k=1,SOL(csol).NNOD
C
cnod=SOL(csol).NOD(k)
C
SELECT CASE(SOL(csol).APO(j).TIP)
C TRANSLACION
CASE(1)
MSR(1)=SOL(csol).APO(j).MSR(1)
MSR(2)=SOL(csol).APO(j).MSR(2)
C ROTACION
CASE(2)
MSR(1)=NOD(cnod).XYZo(2)-SOL(csol).APO(j).MSR(2)
MSR(2)=SOL(csol).APO(j).MSR(1)-NOD(cnod).XYZo(1)
CASE DEFAULT
WRITE(F_W,13700) 1
WRITE (*,13700) 1
STOP
END SELECT
C
DO m=1,NOD(cnod).NINC
cinc=NOD(cnod).INC(m)
W(cinc,capo)=MSR(1)*NOD(cnod).Gij(1,m)
@ +MSR(2)*NOD(cnod).Gij(2,m)
END DO
C
DO m=NOD(cnod).NINC+1,NOD(cnod).NINC+NOD(cnod).NBC
CDC=MSR(1)*NOD(cnod).Gij(1,m)+MSR(2)*NOD(cnod).Gij(2,m)
C
IF(DABS(CDC).GT.TOL)THEN
WRITE(F_W,13704) csol,NOD(cnod).NUM,j
WRITE (*,13704) csol,NOD(cnod).NUM,j
STOP
END IF
C
END DO
C
C Fin bucle que recorre los nodos del solido
C
END DO
C
C Fin bucle que recorre las ecuaciones de apoyo de cada solido
C
END DO
C
C Fin bucle que recorre los solidos
C
END DO
C
PRB.NMSR=capo
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA.
C
13700 FORMAT(/,2x,'ERROR 13700 - APOYO - Error programa (#',i1,'#).')
13701 FORMAT(/,2x,'ERROR 13701 - APOYO - Solido (',i2,'). Apoyo (',i1,
@ ').',/,' El nodo especificado (',i4,
@ ') no pertenece al solido.')
13702 FORMAT(/,2x,'ERROR 13702 - APOYO - Solido (',i4,'). Nodo (',i4,
@ ').',/,' Condicion de contorno (',i2,') no valida.')
13703 FORMAT(/,2x,'ERROR 13703 - APOYO - Numero de incognitas',
@ /,' mayor de lo permitido (',i4,').')
13704 FORMAT(/,2x,'WARNING 13704 - APOYO - Solido (',i4,'). Nodo (',i4,
@ ').',/,2x,'La condicion de contorno en el nodo no permite ',
@ 'el movimiento como',/,2x,'solido rigido que se quiere ',
@ 'impedir (',i1,').',/)
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
