C Diógenes Morales Sierra
C-------------------------------------------------------------ACT1_TERM---
C
C SUBRUTINA ACT1_TERM
C
C MONTAJE DE LAS ECUACIONES INTEGRALES DE CONTORNO
C
SUBROUTINE ACT1_TERM(I,J,K,NODS,NODT,FRES)
C
IMPLICIT NONE
INCLUDE '_param.for'
INCLUDE '_struct.for'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C I,J,K : NODOS ANTERIOR,QUE SE ACTUALIZA Y POSTERIOR
INTEGER I
INTEGER J
INTEGER K
C NODS,NODT: NODOS ELASTICOS Y TÉRMICOS
RECORD /S_nodo/ NODT(N_MAX_NOD)
RECORD /S_nodo/ NODS(N_MAX_NOD)
C FRES : Funcion de resistencia-tension
RECORD /S_fresTERM/ FRES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C A,B,C: VALOR DE LA CDC CUANDO SE PIERDE EL CONTACTO
INTEGER A,B,C
C
A=NODT(I).CBC(3)
B=NODT(J).CBC(3)
C=NODT(K).CBC(3)
IF(NODS(K).CBC(3).EQ.0)THEN
SELECT CASE(NODT(K).CBC(1))
CASE(66)
C=6
CASE(77)
C=7
CASE(88)
C=8
END SELECT
END IF
IF(NODS(I).CBC(3).EQ.0)THEN
SELECT CASE(NODT(I).CBC(1))
CASE(66,76,86)
A=6
CASE(77,67,87)
A=7
CASE(88,68,78)
A=8
END SELECT
END IF
SELECT CASE (NODS(J).CBC(3))
CASE (1)
IF(NODS(I).CBC(3).EQ.0)THEN
SELECT CASE(A)
CASE(6)
SELECT CASE(NODT(J).CBC(3))
CASE(6)
NODT(J).CBC(1)=66
CASE(7)
NODT(J).CBC(1)=67
CASE(8)
NODT(J).CBC(1)=68
END SELECT
CASE(7)
SELECT CASE(NODT(J).CBC(3))
CASE(6)
NODT(J).CBC(1)=76
CASE(7)
NODT(J).CBC(1)=77
CASE(8)
NODT(J).CBC(1)=78
END SELECT
CASE(8)
SELECT CASE(NODT(J).CBC(3))
CASE(6)
NODT(J).CBC(1)=86
CASE(7)
NODT(J).CBC(1)=87
CASE(8)
NODT(J).CBC(1)=88
END SELECT
END SELECT
ELSE IF(NODS(K).CBC(3).EQ.0)THEN
SELECT CASE(C)
CASE(6)
SELECT CASE(NODT(J).CBC(3))
CASE(6)
NODT(J).CBC(1)=66
CASE(7)
NODT(J).CBC(1)=76
CASE(8)
NODT(J).CBC(1)=86
END SELECT
CASE(7)
SELECT CASE(NODT(J).CBC(3))
CASE(6)
NODT(J).CBC(1)=67
CASE(7)
NODT(J).CBC(1)=77
CASE(8)
NODT(J).CBC(1)=87
END SELECT
CASE(8)
SELECT CASE(NODT(J).CBC(3))
CASE(6)
NODT(J).CBC(1)=68
CASE(7)
NODT(J).CBC(1)=78
CASE(8)
NODT(J).CBC(1)=88
END SELECT
END SELECT
ELSE
SELECT CASE(NODT(J).CBC(3))
CASE(6)
NODT(J).CBC(1)=66
CASE(7)
NODT(J).CBC(1)=77
CASE(8)
NODT(J).CBC(1)=88
END SELECT
END IF
CASE (2,3,-3)
SELECT CASE(NODS(K).CBC(3))
CASE(0,1)
SELECT CASE(NODS(I).CBC(3))
CASE(0,1)
WRITE(F_W,11000) J
WRITE(*,11000) J
STOP
CASE(2,3,-3)
SELECT CASE(C)
CASE(6)
IF (FRES.KR.EQ.0)THEN
NODT(J).CBC(1)=46
ELSE
NODT(J).CBC(1)=56
END IF
CASE(7)
IF (FRES.KR.EQ.0)THEN
NODT(J).CBC(1)=47
ELSE
NODT(J).CBC(1)=57
END IF
CASE(8)
IF (FRES.KR.EQ.0)THEN
NODT(J).CBC(1)=48
ELSE
NODT(J).CBC(1)=58
END IF
END SELECT
END SELECT
CASE (2,3,-3)
SELECT CASE(NODS(I).CBC(3))
CASE(0,1)
SELECT CASE(A)
CASE(6)
IF (FRES.KR.EQ.0)THEN
NODT(J).CBC(1)=64
ELSE
NODT(J).CBC(1)=65
END IF
CASE(7)
IF (FRES.KR.EQ.0)THEN
NODT(J).CBC(1)=74
ELSE
NODT(J).CBC(1)=75
END IF
CASE(8)
IF (FRES.KR.EQ.0)THEN
NODT(J).CBC(1)=84
ELSE
NODT(J).CBC(1)=85
END IF
CASE(0)
WRITE(F_W,11001) J
WRITE(*,11001) J
STOP
END SELECT
CASE(2,3,-3)
IF (FRES.KR.EQ.0)THEN
NODT(J).CBC(1)=44
ELSE
NODT(J).CBC(1)=55
END IF
END SELECT
END SELECT
END SELECT
RETURN
C
C FORMATOS DE ESCRITURA
C
11000 FORMAT(/,2x,'ERROR 11000 - ACT1_TERM ',/,
@ ' Nodo numero ',i3,' NO SE HA ACTUALIZADO BIEN.')
11001 FORMAT(/,2x,'ERROR 11000 - ACT1_TERM ',/,
@ ' Nodo numero ',i3,' FALLO EN CDC ELASTICA.')
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
