C Rutina 030POT
C---------------------------------------------------------MONTAJE_CDC_POT---
C
C SUBRUTINA MONTAJE_CDC_POT
C
C MONTAJE DE LAS CONDICIONES DE CONTORNO EN LOS NODOS(POTENCIAL)
C
SUBROUTINE MONTAJE_CDC_POT(PRB,SOL,ZCTO,CNT,ELTP,ELT,NOD)
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 ZCTO : Zonas de contacto del problema
RECORD /S_zncto/ ZCTO(N_MAX_ZCTO)
C ELTP : Tipos de elemento
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
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C I,J,K,ACNT,BCNT,INI : Contadores
INTEGER I,J,K,ACNT,BCNT,INI
C Contadores
INTEGER CSOL,CCNT,UCNT,AELT,CELT,UELT,PNOD,ANOD,CNOD,UNOD
C NG1,NG2,NI1,NI2,NI : Nodos auxiliares
INTEGER NI1,NI2
C COD : Cod=1 - Nodo normal
C Cod=2 - Nodo inicial (No existe k-1 ==> k nodo(1) del elemento k)
C Cod=3 - Nodo final (No existe k+1 ==> k nodo(2) del elemento k)
INTEGER COD
C Na,Nd : Normal correspondiente a los elementos anterior y posterior
REAL*8 Na(MAX_DIM),Nd(MAX_DIM)
C ELTTIP : Tipo de un elemento
INTEGER ELTTIP
C CINC : Contador del numero de incognitas
INTEGER CINC
C NSOL : Numero de solidos
INTEGER NSOL
C TP : Tipo de problema
INTEGER TP
C ABC,ABCant :Caracteres que identifican el contorno
C = 'A' :Contorno del tipo A
C = 'B' :Contorno del tipo B o sin contacto
C = 'C' :Contorno sin contacto
CHARACTER ABC,ABCant
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
NSOL=PRB.NSOL
TP=PRB.TP.TIP
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C CALCULO DE GIJ
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C BUCLE QUE RECORRE LOS SOLIDOS
C
cinc=1
DO csol = 1 , NSOL
anod=0
C
C BUCLE QUE RECORRE LOS CONTORNOS DEL SOLIDO
C
DO i = 1 , SOL(csol).NCNT
ini=0
ccnt=SOL(csol).CNT(i)
C
C ***********************************************
C Bucle que comprueba si el contorno actual es un
C contorno de contacto tipo 'A' para realizar el
C montaje a parte.
C ***********************************************
C
ABC='C'
DO k = 1, PRB.NZCTO
IF(ccnt.EQ.ZCTO(k).CNT(1)) THEN
Acnt=K
ABC='A'
END IF
IF(ccnt.EQ.ZCTO(k).CNT(2)) THEN
Bcnt=K
ABC='B'
END IF
END DO
C
C ***********************************************
C
C
C BUCLE QUE RECORRE LOS ELEMENTOS DEL CONTORNO
C
DO j = 1 , CNT(ccnt).NELT
celt=CNT(ccnt).ELT(j)
C
ELTTIP=ELT(celt).TIP
SELECT CASE (ELTTIP)
C
C ELEMENTO LINEAL CONTINUO
C
CASE(1)
ni1=ELT(celt).NI(1)
C
C *********************************************************
C El primer nodo de un contorno siguiente a uno de contacto
C tipo 'A' tambien es de contacto.(CASO DE QUE EL CONTORNO
C ACTUAL (=el siguiente al de contacto) NO SEA EL PRIMER
C CONTORNO DEL SOLIDO)
C *********************************************************
C
IF (ini.EQ.1) THEN
ABC=ABCant
END IF
IF ((I.GT.1).AND.(j.EQ.1).AND.(SOL(csol).CNT(i-1).EQ.
@ ZCTO(Acnt).CNT(1))) THEN
ABCant=ABC
ABC='A'
ini=1
END IF
IF ((I.GT.1).AND.(j.EQ.1).AND.(SOL(csol).CNT(i-1).EQ.
@ ZCTO(Bcnt).CNT(2))) THEN
ABCant=ABC
ABC='B'
ini=1
END IF
C
C *********************************************************
C
ni2=ELT(celt).NI(2)
C
IF(anod.NE.ni1) THEN
C
C PRIMER NODO EN --TODO-- EL CONTORNO
C
C Caracterización del tipo
C
pnod=ni1
cod=0
k=i-1
DO WHILE(cod.EQ.0)
k = k+1
ucnt=SOL(csol).CNT(k)
uelt=CNT(ucnt).ELT(CNT(ucnt).NELT)
unod=ELT(uelt).NG(ELTP(ELT(uelt).TIP).NNG)
IF(unod.EQ.ni1) THEN
aelt=uelt
cod=1
ELSE IF(k.EQ.SOL(csol).NCNT.AND.TP.EQ.1) THEN
anod=pnod
cod=2
ELSE IF(k.EQ.SOL(csol).NCNT.AND.TP.NE.1) THEN
WRITE(F_W,04000) 1
WRITE (*,04000) 1
STOP
END IF
END DO
C
C Calculo de las normales anterior y posterior
C
SELECT CASE (cod)
CASE(1)
CALL NOR_ELT(Na,ELT(aelt),NOD)
CALL NOR_ELT(Nd,ELT(celt),NOD)
CASE(2)
CALL NOR_ELT(Nd,ELT(celt),NOD)
CASE DEFAULT
WRITE(F_W,04000) 2
WRITE (*,04000) 2
STOP
END SELECT
C
C *********************************************************
C El primer nodo de un contorno siguiente a uno de contacto
C tipo 'A' tambien es de contacto.(CASO DE QUE EL CONTORNO
C ACTUAL(=el siguiente al de contacto) SEA EL PRIMER
C CONTORNO DEL SOLIDO)
C *********************************************************
C
DO k = 1, PRB.NZCTO
IF (ucnt.EQ.ZCTO(k).CNT(1)) THEN
ABCant=ABC
ABC='A'
IF (ccnt.EQ.ZCTO(Acnt).CNT(1)) THEN
ini=0
ELSE
ini=1
END IF
END IF
IF (ucnt.EQ.ZCTO(k).CNT(2)) THEN
ABCant=ABC
ABC='B'
IF (ccnt.EQ.ZCTO(Bcnt).CNT(2)) THEN
ini=0
ELSE
ini=1
END IF
END IF
END DO
C
C *********************************************************
C
ELSE
C
C NODO INTERMEDIO EN EL CONTORNO
C
cod=1
CALL NOR_ELT(Na,ELT(aelt),NOD)
CALL NOR_ELT(Nd,ELT(celt),NOD)
C
END IF
C
CALL COND_CONT_POT(NOD(ni1),cod,cinc,TP,ABC)
cod=1
anod=ni2
aelt=celt
C
CASE DEFAULT
WRITE(F_W,04001) celt , ELTTIP
WRITE (*,04001) celt , ELTTIP
STOP
END SELECT
C
C Fin bucle que recorre los elementos del contorno
C
END DO
C
C ULTIMO NODO DEL CONTORNO ACTUAL
C
SELECT CASE (ELTTIP)
CASE(1)
C
IF(ni2.EQ.pnod) THEN
C Caso de contorno cerrado
anod=0
C
ELSE IF (i.EQ.SOL(csol).NCNT) THEN
C Caso de contorno abierto
anod=0
cod=3
CALL NOR_ELT(Na,ELT(celt),NOD)
CALL COND_CONT_POT(NOD(ni2),cod,cinc,TP,ABC)
C
ELSE
C Siguiente nodo
cnod=ELT(CNT(SOL(csol).CNT(i+1)).ELT(1)).NI(1)
IF(ni2.NE.cnod)THEN
C Caso de contorno abierto
anod=0
cod=3
CALL NOR_ELT(Na,ELT(celt),NOD)
CALL COND_CONT_POT(NOD(ni2),cod,cinc,TP,ABC)
END IF
END IF
CASE DEFAULT
WRITE(F_W,04000) 3
WRITE (*,04000) 3
STOP
END SELECT
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
IF((cinc-1).LE.N_MAX_INC) THEN
PRB.NINC=cinc-1
ELSE
WRITE(F_W,04002)
WRITE (*,04002)
STOP
END IF
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA
C
04000 FORMAT(/,2x,'ERROR 04000 - MONTAJE_CDC_POT - Error Programa (#',
@ i1,'#)')
04001 FORMAT(/,2x,'ERROR 04001 - MONTAJE_CDC_POT - Elemento: ',i4,
@ '. Tipo de elemento (',i2,') no implementado.')
04002 FORMAT(/,2x,'ERROR 04002 - MONTAJE_CDC_POT - Numero de ',
@ 'incognitas fuera del rango permitido.')
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
