Télécharger la plaquette Cast3M


fr en

Télécharger prdist.eso

Retour à la liste

Numérotation des lignes : 

prdist

  1. C PRDIST    SOURCE    FANDEUR   22/06/02    21:15:06     11371          
  2.  
  3.       SUBROUTINE PRDIST
  4.  
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8(A-H,O-Z)
  7.  
  8. -INC PPARAM
  9. -INC CCOPTIO
  10.  
  11. -INC SMCOORD
  12.  
  13.       INTEGER IP1,IP2
  14.       REAL*8 DIST
  15.       CHARACTER*(8) TYPOBJ
  16.  
  17.       TYPOBJ = 'POINT   '
  18.       CALL LIROBJ(TYPOBJ,IP1,1,iret)
  19.       CALL LIROBJ(TYPOBJ,IP2,1,iret)
  20.       IF (IERR.NE.0) RETURN
  21.  
  22.       DIST = 0.D0
  23.  
  24.       IF (IP1 .NE. IP2) THEN
  25.  
  26.         SEGACT,MCOORD
  27.         IDIMP1 = IDIM + 1
  28.  
  29.         ip1 = (IP1-1)*IDIMP1
  30.         ip2 = (IP2-1)*IDIMP1
  31.  
  32.         IF      (IDIM .EQ. 3) THEN
  33.           DIST =   (XCOOR(ip1+1) - XCOOR(ip2+1))**2
  34.      &           + (XCOOR(ip1+2) - XCOOR(ip2+2))**2
  35.      &           + (XCOOR(ip1+3) - XCOOR(ip2+3))**2
  36.           DIST = SQRT(DIST)
  37.         ELSE IF (IDIM .EQ. 2) THEN
  38.           DIST =   (XCOOR(ip1+1) - XCOOR(ip2+1))**2
  39.      &           + (XCOOR(ip1+2) - XCOOR(ip2+2))**2
  40.           DIST = SQRT(DIST)
  41.         ELSE IF (IDIM .EQ. 1) THEN
  42.           DIST = ABS( XCOOR(ip1+1) - XCOOR(ip2+1) )
  43.         ELSE
  44.           CALL ERREUR(5)
  45.         END IF
  46.  
  47.       END IF
  48.  
  49.       CALL ECRREE(DIST)
  50.  
  51. c      return
  52.       END
  53.  
  54.  
  55.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales