C Rutina 013
C-----------------------------------------------------------LEE_PINTS---
C
C SUBRUTINA LEE_PINTS
C
C LECTURA DE DATOS DE LOS PUNTOS INTERNOS
C
SUBROUTINE LEE_PINTS(SOL,PNT,PINTP)
C
IMPLICIT NONE
INCLUDE '_param.for'
INCLUDE '_struct.for'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C SOL : Solido
RECORD /S_solido/ SOL
C PNT : Puntos internos
RECORD /S_pntint/ PNT(N_MAX_PINT)
C PNT : Tipos de puntos internos
RECORD /S_tipint/ PINTP(N_MAX_TPINT)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES LOCALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C PPINT : Primer punto interno del solido
INTEGER PPINT
C UPINT : Ultimo punto interno del solido
INTEGER UPINT
C I : Contador
INTEGER I
C N,cpint : Numero del punto intermo (local/global)
INTEGER N,CPINT
C XYZ() : Coordenadas
REAL*8 XYZ(MAX_DIM)
C TIP : Tipo de punto interno
INTEGER TIP
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
i=0
cpint=0
n=1
ppint=0
upint=1
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C LECTURA VARIABLES DE LOS PINT
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C BUCLE QUE RECORRE LOS PUNTOS INTERNOS DEL SOLIDO
C
DO WHILE (cpint.LT.UPINT)
C
C LECTURA DE DATOS DE UN PUNTO INTERNO
C
READ(F_E,*) cpint, tip , (XYZ(i) , i=1,PINTP(tip).DIM)
C
IF(PINTP(tip).TIP.NE.tip)THEN
WRITE(F_W,01604) tip
WRITE (*,01604) tip
STOP
END IF
C
IF(n.EQ.1) THEN
C Primer pint del sólido
IF(ppint.EQ.0)THEN
ppint=cpint
upint=SOL.NPINT+PPINT-1
END IF
PNT(cpint).NUM=cpint
SOL.PINT(n)=cpint
PNT(cpint).TIP=tip
DO i = 1 , PINTP(tip).DIM
PNT(cpint).XYZ(i)=XYZ(i)
END DO
n=n+1
ppint=ppint+1
C
ELSE IF(ppint.LE.cpint.AND.cpint.LE.(upint+1)) THEN
C Genera los puntos internos entre ppint y cpint (ambos inclusive)
PNT(cpint).NUM=cpint
PNT(cpint).TIP=tip
DO i = 1 , PINTP(tip).DIM
PNT(cpint).XYZ(i)=XYZ(i)
XYZ(i)=(XYZ(i)-PNT(ppint-1).XYZ(i))/(cpint-ppint+1)
END DO
DO WHILE (ppint.LT.cpint)
PNT(ppint).NUM=ppint
PNT(ppint).TIP=tip
DO i= 1,PINTP(tip).DIM
PNT(ppint).XYZ(i)=PNT(cpint).XYZ(i)
@ -(cpint-ppint)*XYZ(i)
SOL.PINT(n)=ppint
END DO
ppint=ppint+1
n=n+1
END DO
SOL.PINT(n)=cpint
ppint=ppint+1
n=n+1
C
C Borra el ultimo punto interno cuando es NPINT+1
C
IF(n.EQ.SOL.NPINT+2) THEN
PNT(n-1).NUM=0
END IF
ELSE
C
C El punto interno leido no es valido
C
IF(N.LT.cpint) THEN
WRITE(F_W,01602) cpint,SOL.NUM
WRITE (*,01602) cpint,SOL.NUM
STOP
ELSE IF(cpint.GT.upint+1) THEN
WRITE(F_W,01603) SOL.NUM
WRITE (*,01603) SOL.NUM
STOP
ELSE
WRITE(F_W,01600) 1
WRITE(*, 01600) 1
STOP
END IF
END IF
C
C FIN DEL BUCLE QUE RECORRE LOS PUNTOS INTERNOS DEL SOLIDO
C
END DO
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA
C
01600 FORMAT(/,2x,'ERROR 01600 - LEE_PINTS - Error Programa (#',i1,'#)')
01601 FORMAT(/,2x,'ERROR 01601 - LEE_PINTS',/,
* ' Primer punto interno del sólido ',i2,' erroneo.')
01602 FORMAT(/,2x,'ERROR 01602 - LEE_PINTS',/,
* ' Pint ',i4,'del solido ',i2,' repetido.')
01603 FORMAT(/,2x,'ERROR 01603 - LEE_PINTS',/,
* ' El solido ',i2,
* ' tiene mas puntos internos de los esperados')
01604 FORMAT(/,2x,'ERROR 01604 - LEE_PINTS',/,
* ' Tipo erroneo de punto interno (',i2,').')
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
