C
C-----------------------------------------------------------------------
C
C Comprueba que no se haya producido un bucle en las ultimas
C cuatro iteraciones
C
SUBROUTINE COMPR_ITR(PRB,ZCTO,CNT,ELT,NOD,ITR,DAT_ITR,dX)
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 ZCTO : Zona de contacto
RECORD /S_zncto/ ZCTO(N_MAX_ZCTO)
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 Condiciones de contacto en las ultimas cuatro iteraciones
INTEGER DAT_ITR(N_MAX_ZCTO,N_MAX_NODCNT,5)
C Factor de escala e incremento
REAL*8 dX
C Iteraciones acumuladas (si hay mas de 4 se machacan los detos de las primeras)
INTEGER ITR
C
xC
xC SOL : Solidos
x RECORD /S_solido/ SOL(N_MAX_SOL)
xC X : Factor de escala para el que se viola la primera cond. de contacto
x REAL*8 X
xC Xact : Factor de escala acumulado
x REAL*8 Xact
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Contadores
INTEGER Iz,Ie,Ii
INTEGER Jc,Je,Jn
C Control de cambios
INTEGER COD
xC CCNT,CELT,ANOD,CNOD : Contadores
x INTEGER CCNT,CELT,ANOD,CNOD,PELT,PNOD
xC CELTP : Contador
x INTEGER CELTP
xC r0,rx,r1 : Posicion inicial, intermedia y final de los nodos
x REAL*8 r0(2),rx(2),r1(2)
xC u0,ux,u1 : Desplazamiento inicial, intermedia y final de los nodos
x REAL*8 u0(2),ux(2),u1(2)
xC t0,tx,t1 : Tensiones inicial, intermedia y final de los nodos
x REAL*8 t0(2),tx(2),t1(2)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
IF((dX.EQ.0.d0).AND.(ITR.NE.0))THEN
C
C Comprueba que no hay bucle
C
DO Ii=1,ITR
C
COD=0
C
C Si alguna cdc ha cambiado pone COD a 1
DO Iz=1,PRB.NZCTO
Jc=ZCTO(Iz).CNT(1)
DO Ie=1,CNT(Jc).NELT
Je=CNT(Jc).ELT(Ie)
Jn=ELT(Je).NI(1)
IF(DAT_ITR(Iz,Ie,Ii).NE.(NOD(Jn).CBC(3)))THEN
COD=1
END IF
END DO
Jn=ELT(Je).NI(2)
IF(DAT_ITR(Iz,Ie,Ii).NE.(NOD(Jn).CBC(3)))THEN
COD=1
END IF
END DO
C
C Si COD es 0 es que se repite la iteracion
IF(COD.EQ.0)THEN
C
WRITE(*,*) '**************************************'
WRITE(*,*) ' NO SE HA ALCANZADO LA CONVERGENCIA '
WRITE(*,*) '**************************************'
C
WRITE(F_W,*) '**************************************'
WRITE(F_W,*) ' NO SE HA ALCANZADO LA CONVERGENCIA '
WRITE(F_W,*) '**************************************'
C
STOP
C
END IF
C
END DO
C
ELSE
C
C Comenzamos de nuevo
C
ITR=1
C
END IF
C
C GUARDAMOS ESTA ITERACION
C
IF(ITR.EQ.5)THEN
C
DO Ii=1,3
DO Iz=1,PRB.NZCTO
DO Ie=1,N_MAX_NODCNT
DAT_ITR(Iz,Ie,Ii)=DAT_ITR(Iz,Ie,Ii+1)
END DO
END DO
END DO
C
ITR=4
C
END IF
C
DO Iz=1,PRB.NZCTO
Jc=ZCTO(Iz).CNT(1)
DO Ie=1,CNT(Jc).NELT
Je=CNT(Jc).ELT(Ie)
Jn=ELT(Je).NI(1)
DAT_ITR(Iz,Ie,ITR)=NOD(Jn).CBC(3)
END DO
Jn=ELT(Je).NI(2)
DAT_ITR(Iz,Ie,ITR)=NOD(Jn).CBC(3)
END DO
C
ITR=ITR+1
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
