C Rutina 070
C-------------------------------------------------------INCR_SOLUCION---
C
C SUBRUTINA SOLUCION
C
C INCREMENTA LA SOLUCION EN EL NODO TRAS UN INCREMENTO DE CARGA
C
SUBROUTINE INCR_SOLUCION(PRB,SOL,CNT,ELT,NOD,LAMBDA)
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 CNT : Contornos del problema
RECORD /S_contorno/ CNT(N_MAX_CNT)
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 ponderacion de la solucion del incremento
REAL*8 LAMBDA
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES LOCALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C I,J,K,M,N : Contadores
INTEGER I,J,K,M,N
C Contadores
INTEGER CCNT,CELT,CELTP,CNOD,CNDTP
C N() : Normal al elemento
REAL*8 Nor(2)
C iPOS,iAPR,iSOLU : Controles de paso
INTEGER iPOS(N_MAX_NOD),iAPR(N_MAX_NOD),iSOLU(N_MAX_NOD)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
DO i=1,N_MAX_NOD
iPOS(i)=0
iAPR(i)=0
iSOLU(i)=0
END DO
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C RUTINA
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Bucle que recorre los solidos
C
DO i=1,PRB.NSOL
C
C Bucle que recorre los contornos del solido
C
DO j = 1 , SOL(i).NCNT
ccnt=SOL(i).CNT(j)
C
C Bucle que recorre los elementos del contorno
C
DO k = 1 , CNT(ccnt).NELT
celt=CNT(ccnt).ELT(k)
celtp=ELT(celt).TIP
C
C Bucle que recorre los nodos(I) del elemento
C
DO m = 1 , PRB.ELTP(celtp).NNI
cnod=ELT(celt).NI(m)
cndtp=NOD(cnod).TIP
C
C Actualizacion de la posicion del nodo
C
IF(iPOS(cnod).EQ.0)THEN
iPOS(cnod)=1
NOD(cnod).XYZ(1)=NOD(cnod).XYZ(1)+LAMBDA*
@ NOD(cnod).D_SOLU(1)
NOD(cnod).XYZ(2)=NOD(cnod).XYZ(2)+LAMBDA*
@ NOD(cnod).D_SOLU(2)
END IF
C
C Actualizacion del apriete
C
IF((NOD(cnod).CBC(1).EQ.15).OR.(NOD(cnod).CBC(1).EQ.55)
@ .OR.(NOD(cnod).CBC(1).EQ.51))THEN
IF(iAPR(cnod).EQ.0)THEN
iAPR(cnod)=1
CALL NOR_ELT(Nor,ELT(celt),NOD)
CALL INCR_APRIETE(Nor,NOD(cnod).VBC,
@ NOD(cnod).D_SOLU,NOD(cnod).CBC(1),LAMBDA)
END IF
END IF
C
C Actualizacion de la solucion
C
IF(iSOLU(cnod).EQ.0)THEN
iSOLU(cnod)=1
DO n = 1 , PRB.NDTP(cndtp).NINC
NOD(cnod).SOLU(n)=NOD(cnod).SOLU(n)+
@ LAMBDA*NOD(cnod).D_SOLU(n)
END DO
END IF
C
C Fin bucle que recorre los nodos(I) del elemento
C
END DO
C
C Fin bucle que recorre los elementos del contorno
C
END DO
C
C Fin bucle que recorre los contornos del solido
C
END DO
C
C Fin bucle que recorre los solidos
C
END DO
C
C BORRA LA SOLUCION DEL INCREMENTO
C
DO i=1,N_MAX_NOD
IF(iSOLU(i).EQ.1)THEN
cndtp=NOD(i).TIP
DO n = 1 , PRB.NDTP(cndtp).NINC
NOD(i).D_SOLU(n)=0.d0
END DO
END IF
END DO
C
C FINAL DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA
C
13600 FORMAT(/,2x,'ERROR 13600 - INCR_SOLUCION - Error Programa (#',
@ i1,'#)')
13601 FORMAT(/,2x,'ERROR 13601 - INCR_SOLUCION - Tipo de problema ',i2,
@ ' no implementado.')
13602 FORMAT(/,2x,'ERROR 13602 - INCR_SOLUCION - Tipo de contorno ',i2,
@ ' no implementado.')
C
10 FORMAT(2x,i4,4x,a,a,e10.4,4x,a,a,e10.4,4x,a,a,e10.4,4x,a,a,e10.4
@ ,4x,a,a,e10.4,4x,a,a,e10.4)
C
END
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
