C Rutina 050
C------------------------------------------------------MONTAJE_PC_POT---
C
C SUBRUTINA MONTAJE_PC_POT
C
C MONTAJE DE LOS PUNTOS DE COLOCACION
C
SUBROUTINE MONTAJE_PC_POT(PRB,SOL,MAT,CNT,ELTP,ELT,NOD,PC)
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 MAT : Tipo de material
RECORD /S_material/ MAT(N_MAX_SOL)
C CNT : Contornos del problema
RECORD /S_contorno/ CNT(N_MAX_CNT)
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 PC : Nodos del problema
RECORD /S_coloc/ PC(N_MAX_PC)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C I,J,K : Contadores
INTEGER I,J,K
C CSOL,CCNT,CELT : Contadores
INTEGER CSOL,CCNT,CELT
C PELT,PNOD : Primer elemento, nodo
INTEGER PNOD
C UCNT, UELT,UNOD : Ultimo contorno, elemento, nodo
INTEGER UCNT,AELT,UELT,CNOD,UNOD
C ANOD : Nodo anterior, ultimo
INTEGER ANOD
C NI1,NI2 : Nodos auxiliares
INTEGER NI1,NI2
xC Na,Nd : Normal correspondiente a los elementos anterior y posterior
x REAL*8 Na(MAX_DIM),Nd(MAX_DIM)
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 ELTTIP : Tipo de un elemento
INTEGER ELTTIP
C CPC : Contador del numero de puntos de colocacion
INTEGER CPC
C TP : Tipo de problema
INTEGER TP
C NSOL : Numero de solidos
INTEGER NSOL
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
TP=PRB.TP.TIP
NSOL=PRB.NSOL
PRB.NBIE=0
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C MONTAJE DE LOS PUNTOS DE COLOCACION
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Bucle que recorre los solidos
C
cpc=1
DO csol = 1 , NSOL
SOL(csol).NBIE=0
SOL(csol).NPC=0
anod=0
C
C Bucle que recorre los contornos del solido
C
DO i = 1 , SOL(csol).NCNT
ccnt=SOL(csol).CNT(i)
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)
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,07100) 1
WRITE (*,07100) 1
STOP
END IF
END DO
C
ELSE
C
C NODO INTERMEDIO EN EL CONTORNO
C
cod=1
END IF
C
CALL CALC_PC_POT(cpc,PC,aelt,celt,ELT,NOD,TP,
@ SOL(csol),MAT(csol),COD)
C
cod=1
anod=ni2
aelt=celt
C
CASE DEFAULT
WRITE(F_W,07101) celt , ELTTIP
WRITE (*,07101) celt , ELTTIP
STOP
END SELECT
C
C Fin bucle que recorre los elementos del contorno
C
END DO
C
C Ultimo nodo
C
SELECT CASE (ELTTIP)
CASE(1)
C
IF(ni2.EQ.pnod) THEN
C Caso de contorno cerrado
anod=0
cod=1
C
ELSE IF (i.EQ.SOL(csol).NCNT) THEN
C Caso de contorno abierto
anod=0
cod=3
C
CALL CALC_PC(cpc,PC,celt,0,ELT,NOD,TP,
@ SOL(csol),MAT(csol),3)
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
C
CALL CALC_PC(cpc,PC,celt,0,ELT,NOD,TP,
@ SOL(csol),MAT(csol),3)
C
END IF
END IF
CASE DEFAULT
WRITE(F_W,07100) 3
WRITE (*,07100) 3
STOP
END SELECT
C
C Fin bucle que recorre los contornos del solido
C
END DO
PRB.NBIE=PRB.NBIE+SOL(csol).NBIE
IF(PRB.NBIE.GT.N_MAX_INC) THEN
WRITE(F_W,07102)
WRITE( *,07102)
STOP
END IF
C
C TRANSFORMACION DE LOS PC SI MATERIAL ANISTROPO O FGM
C
SELECT CASE(MAT(csol).TIP)
C
C Materiales Isotropos
C
CASE(1)
CONTINUE
C
C Material Anisotropo y FGM
C
CASE(2,3,4)
C
CALL TRNSFMA_PC_POT(SOL(csol),PC,PRB.TP.DIM,MAT(csol))
C
CASE DEFAULT
WRITE(F_W,07105) MAT.TIP
WRITE(*,07105) MAT.TIP
STOP
END SELECT
C
C Fin bucle que recorre los solidos
C
END DO
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA
C
07100 FORMAT(/,2x,'ERROR 07100 - MONTAJE_PC_POT - Error Programa (#',
@ i1,'#)')
07101 FORMAT(/,2x,'ERROR 07101 - MONTAJE_PC_POT - Elemento: ',i4,
@ '. Tipo de elemento (',i2,') no implementado.')
07102 FORMAT(/,2x,'ERROR 07102 - MONTAJE_PC_POT - Numero de ecuaciones ',
@ 'fuera del rango permitido.')
07103 FORMAT(/,2x,'ERROR 07103 - MONTAJE_PC_POT - Tipo de problema (',i2,
@ ') no implementado.')
07104 FORMAT(/,2x,'ERROR 00004 - MONTAJE_PC_POT - Tipo de problema (',
@ i2,') erronea.')
07105 FORMAT(/,2x,'ERROR 01205 - MONTAJE_PC_POT - Tipo de material (',
@ i2,') no implementado.')
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
