C Rutina 080
C-----------------------------------------------------------------------
C
C Escribe la solucion en los puntos internos
C
SUBROUTINE ESC_PNT(PRB,SOL,PNT)
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
RECORD /S_solido/ SOL(N_MAX_SOL)
C PNT : Puntos internos del problema
RECORD /S_pntint/ PNT(N_MAX_PINT)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Contadores
INTEGER CSOL,CPNT,M,I,J,K
C Tipo de punto interno
INTEGER CPNTP
C Nombre de los ficheros
CHARACTER*50 NAME
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
WRITE(NAME,*) TRIM(PRB.NAME),"_PNT.TXT"
WRITE(*,*) "Archivo de Ptos internos: ",NAME
OPEN(F_P,file=NAME,status='replace')
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCC
C ESCRITURA DEFORMADA
CCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
j=PRB.PINTP(1).DIM
k=PRB.PINTP(1).NVAR
WRITE(F_P,16) 'Punto ',(PRB.PINTP(1).DTXT(i),i=1,j),
@ (PRB.PINTP(1).VTXT(i),i=1,k)
C
DO csol=1,PRB.NSOL
C
DO m = 1 , SOL(csol).NPINT
C
cpnt=SOL(csol).PINT(m)
cpntp=PNT(cpnt).TIP
C
SELECT CASE(cpntp)
CASE(1)
WRITE(F_P,15) cpnt,(PNT(cpnt).XYZ(i) ,i=1 , j),
@ (PNT(cpnt).SOLU(i),i=1 , k)
CASE DEFAULT
CONTINUE
END SELECT
C
END DO
C
WRITE(F_P,15)
C
END DO
C
CLOSE(F_P)
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA
C
15 FORMAT(4x,i5,9(4x,e22.16))
16 FORMAT(4x,a5,9(4x,a22))
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
