C Rutina 103
C----------------------------------------------COMPRUEBA_CONTACTO_POT---
C
C SUBRUTINA COMPRUEBA_CONTACTO_POT
C
C ESTA RUTINA TE LOCALIZA TODOS LOS NODOS DEL CONTORNO QUE
C NO VERIFICAN LA CONDICION NO LINEAL DEL CONTACTO IMPERFERTO
C (Q*DELTA>0), Y UNA VEZ LOCALIZADOS CAMBIA SUS CBC(1) A CONTACTO
C PERFECTO. HAY QUE PENSAR SI SERIA MÁS CONVENIENTE HACER ESTE
C CAMBIO NODO POR NODO Y SI ES CONVENIENTE TAMBIEN INDICAR QUE
C LA RESISTENCIA DEL NODO INTRODUCIDO NO ES VALIDA Y SE VA A
C IGUALAR A CERO
C
SUBROUTINE COMPRUEBA_CONTACTO_POT(NZCTO,ZCTO,CNT,ELTP,ELT,NOD,
@ D_LAMBDA,PRV_LAMBDA)
C
IMPLICIT NONE
C
INCLUDE '_param.for'
INCLUDE '_struct.for'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C NZCTO : Numero de zonsa de contacto
INTEGER NZCTO
C ZCTO : Zonas de contacto del problema
RECORD /S_zncto/ ZCTO(N_MAX_ZCTO)
C CNT : Contornos del problema
RECORD /S_contorno/ CNT(N_MAX_CNT)
C ELTP : Tipos de elemento del problema
RECORD /S_tipelt/ ELTP(N_MAX_TPEL)
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 D_LAMBDA : LAMBDA corresp. al incremento
REAL*8 D_LAMBDA
C PRV_LAMBDA : LAMBDA acumulado de incrementos anteriores
REAL*8 PRV_LAMBDA
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C I,J : Contadores
INTEGER I,J
C Contadores
INTEGER CZN,CELTP,CELT,ANOD,CNOD,PNOD,UELTP,UNOD,NCH
INTEGER CNTA,CNTB
C Variables auxiliares
REAL*8 LAMBDA
C Variables auxiliares
INTEGER BC,D_BC(N_MAX_NODCNT),D_NOD(N_MAX_NODCNT)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
D_LAMBDA=1.d0
C
CCCCCCCCCCCCCCC
C RUTINA
CCCCCCCCCCCCCCC
C
C Bucle que recorre las zonas de contacto
C
nch=0
C
DO czn=1,NZCTO
C
SELECT CASE(ZCTO(czn).TIP)
C
C MANTENGO LA MISMA NOMENCLATURA EN EL CONTACTO TERMICO Y EN EL
C ELASTICO. EN PRINCIPIO EL PLANTEAMIENTO DEL CONTACTO TERMICO
C NO CAMBIA INDEPENDIENTEMENTE DE QUE EL CONTACTO ELASTICO SEA
C INTERFASE O CONTACTO
C
CASE(11,21)
cntA=ZCTO(czn).CNT(1)
cntB=ZCTO(czn).CNT(2)
anod=0
pnod =ELT(CNT(cntA).ELT(1)).NI(1)
ueltp=ELT(CNT(cntA).ELT(CNT(cntA).NELT)).TIP
unod =ELT(CNT(cntA).ELT(CNT(cntA).NELT)).NI(ELTP(ueltp).NNI)
C
C
C SOLO HAY QUE RECORRER EL CONTORNO A PORQUE ES EL QUE CONTROLA
C Y GOBIERNA LA COMPROBACION DE LA INCOMPATIBILIDAD EN CONTACTO
C IMPERFECTO. EL CONTORNO B QUEDA INDIFERENTE EN LO QUE SE REFIERE
C A ESTA COMPROBACION.
C
C Bucle que recorre los elementos del contorno de A
C
DO i=1,CNT(cntA).NELT
celt=CNT(cntA).ELT(i)
celtp=ELT(celt).TIP
C
C Bucle que recorre los nodos del elemento
C
DO j=1,ELTP(celtp).NNI
cnod=ELT(celt).NI(j)
C
SELECT CASE(celtp)
CASE(1)
IF(cnod.NE.anod)THEN
anod=cnod
SELECT CASE(NOD(cnod).CBC(1))
C
CASE(65,75,85)
CALL COMPR_INCOMP_CIMP(cnod,NOD(cnod).CBC(1),
@ NOD(cnod).SOLU(3),NOD(cnod).D_SOLU(3),
@ NOD(cnod).D_SOLU(5),BC,LAMBDA)
CASE(55,56,57,58)
CALL COMPR_INCOMP_CIMP(cnod,NOD(cnod).CBC(1),
@ NOD(cnod).SOLU(2),NOD(cnod).D_SOLU(1),
@ NOD(cnod).D_SOLU(4),BC,LAMBDA)
CASE(44,46,47,48,64,74,84,66,67,68,76,77,
@ 78,86,87,88)
CONTINUE
CASE DEFAULT
WRITE(F_W,11002) cnod,NOD(cnod).CBC(1)
WRITE (*,11002) cnod,NOD(cnod).CBC(1)
STOP
C
END SELECT
C
IF((D_LAMBDA.GT.LAMBDA).AND.
@ (D_LAMBDA.LT.1.d0))THEN
C
nch=1
D_LAMBDA=LAMBDA
D_BC(1)=BC
D_NOD(1)=cnod
C
ELSE IF((D_LAMBDA.EQ.LAMBDA).AND.
@ (D_LAMBDA.LT.1.d0))THEN
C
nch=nch+1
D_BC(nch)=BC
D_NOD(nch)=cnod
C
END IF
C
END IF
C
CASE DEFAULT
WRITE(F_W,11001) celtp
WRITE( *,11001) celtp
STOP
END SELECT
C
C Fin bucle que recorre los nodos del elemento
C
END DO
C
C Fin bucle que recorre los elementos del contorno
C
END DO
C
CASE DEFAULT
WRITE(F_W,11000) 2
WRITE( *,11000) 2
STOP
END SELECT
C
C Fin bucle que recorre las zonas de contacto
C
END DO
C
IF(nch.NE.0)THEN
DO i=1,nch
NOD(D_NOD(i)).CBC(1)=D_BC(i)
END DO
ELSE IF(D_LAMBDA.NE.1.d0)THEN
WRITE(F_W,11000) 3
WRITE( *,11000) 3
STOP
END IF
C
IF((D_LAMBDA+PRV_LAMBDA).GT.1.d0)THEN
D_LAMBDA=1.d0-PRV_LAMBDA
END IF
C
WRITE(*,*)
WRITE(*,*) ' Lambda total - Incremento de lambda :'
WRITE(*,*) D_LAMBDA+PRV_LAMBDA,' - ',D_LAMBDA
WRITE(*,*)
IF(W_C.GE.1)THEN
WRITE(F_C,*)
WRITE(F_C,*) D_LAMBDA+PRV_LAMBDA,' - ',D_LAMBDA
WRITE(F_C,*)
END IF
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA.
C
11000 FORMAT(/,2x,'ERROR 11000 - COMPRUEBA_CONTACTO - Error Programa',
@ ' (#',i1,'#)')
11001 FORMAT(/,2x,'ERROR 11001 - COMPRUEBA_CONTACTO',/,' Tipo de',
@ ' elemento (',i2,') no implementado')
11002 FORMAT(/,2x,'ERROR 11002 - COMPRUEBA_CONTACTO_POT',/,' Nodo: ',i4,
@ '. Cond. de contorno ',i2)
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
