C Rutina 041
C-----------------------------------------------------CNTC_NOD_BC_VAR---
C
C SUBRUTINA CNTC_NOD_BC_VAR
C
C RUTINA QUE PASA UNA TENSION QUE ERA CDC A INCOGNITA
C
C CALCULO DE LA NUEVA MATRIZ Gij
C
SUBROUTINE CNTC_NOD_BC_VAR(T,E,NOD,cinc,COD)
C
IMPLICIT NONE
INCLUDE '_param.for'
INCLUDE '_struct.for'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C T : Tension que pasa de ser cdc a ser incognita
INTEGER T
C E : Factor de escalado de las tensiones
REAL*8 E
C NOD : Nodo
RECORD /S_nodo/ NOD
C CINC : Contador del numero de incognitas
INTEGER CINC
C COD=1 : Impone continuidad en tensiones
C =0 : No impone continuidad en tensiones
INTEGER COD
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C I : Contadores
INTEGER I,J,K
C VAR() : Incognitas locales
INTEGER VAR(N_MAX_INCNOD)
C INC() : Incognitas globales
INTEGER INC(N_MAX_INCNOD)
C Gij(,) : Matriz de las cdc
REAL*8 Gij(N_MAX_INCNOD,N_MAX_INCNOD)
C bcT,varT : Posicion inical y final de la variable que cambia
INTEGER BCT,VART
C AUX : Variable auxiliar
INTEGER AUX
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
aux=0
varT=0
bcT=0
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C CALCULO DE LA NUEVA Gij
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Bucle que recorre las incognitas copiando Gij y
C buscando la posicion de la variable T
C
DO i = 1 , NOD.NINC
INC(i)=NOD.INC(i)
VAR(i)=NOD.VAR(i)
C
zz DO j=1,6
DO j=1,N_MAX_INCNOD
Gij(j,i)=NOD.Gij(j,i)
END DO
C
IF(((NOD.VAR(i).EQ.5).OR.(NOD.VAR(i).EQ.6).OR.(NOD.VAR(i).EQ.7)
@ .OR.(NOD.VAR(i).EQ.8).OR.(NOD.VAR(i).EQ.11)).AND.
@ (NOD.VAR(i).GT.T).AND.(aux.EQ.0))THEN
varT=i
aux=1
END IF
C
C Fin bucle que recorre las incognitas
C
END DO
C
IF(varT.EQ.0)THEN
varT=NOD.NINC+1
END IF
C
C Bucle que recorre las cdc copiando Gij y
C buscando la posicion que ocupaba T
C
DO i = NOD.NINC+1 , NOD.NINC+NOD.NBC
C
zz DO j=1,6
DO j=1,N_MAX_INCNOD
Gij(j,i)=NOD.Gij(j,i)
END DO
C
IF((NOD.BC(i-NOD.NINC).EQ.T))THEN
bcT=i
END IF
C
C Fin bucle que recorre las cdc
C
END DO
C
IF(bcT.EQ.0)THEN
WRITE(F_W,05220) 1
WRITE( *,05220) 1
STOP
END IF
C
NOD.NINC=NOD.NINC+1
NOD.NBC=NOD.NBC-1
C
aux=0
C
C Crea la nueva Gij introduciendo la fila que habia en bcT en varT
C
DO i=1,NOD.NINC
IF(i.EQ.varT)THEN
k=bcT
aux=1
zz DO j=1,6
DO j=1,N_MAX_INCNOD
NOD.Gij(j,i)=Gij(j,k)*E
END DO
NOD.VAR(i)=T
NOD.INC(i)=cinc
cinc=cinc+1
ELSE
k=i-aux
zz DO j=1,6
DO j=1,N_MAX_INCNOD
NOD.Gij(j,i)=Gij(j,k)
END DO
NOD.VAR(i)=VAR(k)
NOD.INC(i)=INC(k)
END IF
END DO
C
IF(aux.EQ.0)THEN
WRITE(F_W,05220) 2
WRITE( *,05220) 2
STOP
END IF
C
DO i=NOD.NINC+1 , bcT
k=i-1
zz DO j=1,6
DO j=1,N_MAX_INCNOD
NOD.Gij(j,i)=Gij(j,k)
END DO
END DO
C
C Elimina la cdc que tuviera T
C
IF(NOD.NBC.GT.0)THEN
DO i=bcT+1 , NOD.NINC+NOD.NBC
k=i-NOD.NINC
NOD.BC(k)=NOD.BC(k+1)
NOD.VBC(k)=NOD.VBC(k+1)
END DO
END IF
NOD.BC(NOD.NBC+1)=0
C
C CONTINUIDAD EN TENSIONES
C
IF(COD.EQ.1)THEN
C
SELECT CASE(T)
CASE(5)
NOD.Gij(5,varT)=E
T=7
CASE(6)
NOD.Gij(6,varT)=E
T=8
CASE DEFAULT
WRITE(F_W,05220) 3
WRITE( *,05220) 3
STOP
END SELECT
C
DO i = NOD.NINC+1 , NOD.NINC+NOD.NBC
IF((NOD.BC(i-NOD.NINC).EQ.T))THEN
bcT=i
END IF
END DO
C
NOD.NBC=NOD.NBC-1
C
DO i=bcT,NOD.NINC+NOD.NBC
k=i+1
zz DO j=1,6
DO j=1,N_MAX_INCNOD
NOD.Gij(j,i)=NOD.Gij(j,k)
END DO
END DO
C
IF(NOD.NBC.GT.0)THEN
DO i=bcT , NOD.NINC+NOD.NBC
k=i-NOD.NINC
NOD.BC(k)=NOD.BC(k+1)
NOD.VBC(k)=NOD.VBC(k+1)
END DO
END IF
C
NOD.BC(NOD.NBC+1)=0
C
END IF
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA
C
05220 FORMAT(/,2x,'ERROR 05220 - CNTC_NOD_BC_VAR - Error Programa (#',
@ i1,'#)')
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
