Numérotation des lignes :

C DIST      SOURCE    JC220346  16/11/29    21:15:12     9221           C---------------------------------------------------------------------|C                                                                     |       SUBROUTINE DIST(IP,JP,GL,IOK,I1,I2,I3,I4,I5,I6,I7,I8,I9,I10)C                                                                     |C      CETTE SUBROUTINE RECHERCHE LE POINT JP LE PLUS PROCHE DE       |C      IP. LA DISTANCE ENTRE LES 2 POINTS EST MEMORISEE DANS GL.      |C      LES POINTS I* SONT EXCLUS DE LA RECHERCHE                      |C                                                                     |C---------------------------------------------------------------------|C      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8(A-H,O-Z)-INC TDEMAIT -INC PPARAM-INC CCOPTIOC       IOK=1       GL=1.0E+30       JP=0C       xp=XYZ(1,IP)       yp=XYZ(2,IP)       zp=XYZ(3,IP)       tp=XYZ(4,IP)       DO 100 I=NPTDIS,NPTMAX              IF (NPF(1,I).EQ.0) GOTO 100              IF (I.EQ.IP) GOTO 100              IF (I.EQ.I1) GOTO 100              IF (I.EQ.I2) GOTO 100              IF (I.EQ.I3) GOTO 100              IF (I.EQ.I4) GOTO 100              IF (I.EQ.I5) GOTO 100              IF (I.EQ.I6) GOTO 100              IF (I.EQ.I7) GOTO 100              IF (I.EQ.I8) GOTO 100              IF (I.EQ.I9) GOTO 100              IF (I.EQ.I10) GOTO 100              S1=xp-XYZ(1,I)              if (abs(s1).gt.2*tp) goto 100              S2=yp-XYZ(2,I)              if (abs(s2).gt.2*tp) goto 100              S3=zp-XYZ(3,I)              if (abs(s3).gt.2*tp) goto 100              S=S1**2+s2**2+s3**2              IF (S.GT.GL) GOTO 100              GL=S              JP=I100    CONTINUE       if (jp.ne.0) then          xyztes=XYZ(4,JP)       else          xyztes=1e30       endif*  maintenant test avec le milieu des aretes*      do 200 i=1,naret       do 200 i=1,-1        ii=iigard(i)        jj=jjgard(i)        if (ii.lt.0) goto 200         if ((ii.eq.i1.or.ii.eq.i2.or.ii.eq.i3.or.ii.eq.i4.or.ii.eq.i5     >   .or.ii.eq.i6.or.ii.eq.i7.or.ii.eq.i8.or.ii.eq.i9.or.ii.eq.i10)     >   .or.(jj.eq.i1.or.jj.eq.i2.or.jj.eq.i3.or.jj.eq.i4.or.jj.eq.i5     >   .or.jj.eq.i6.or.jj.eq.i7.or.jj.eq.i8.or.jj.eq.i9.or.jj.eq.i10))     >   goto 200              S1=(xp-(XYZ(1,II)+XYZ(1,JJ))/2)              if (abs(s1).gt.2*tp) goto 200              S2=(yp-(XYZ(2,II)+XYZ(2,JJ))/2)              if (abs(s2).gt.2*tp) goto 200              S3=(zp-(XYZ(3,II)+XYZ(3,JJ))/2)              if (abs(s3).gt.2*tp) goto 200              S=S1**2+S2**2+S3**2              IF (S.GT.GL) GOTO 200              GL=S              xyztes=sqrt(XYZ(4,II)*XYZ(4,JJ))              jp=0 200   continue        IF (GL.LE.tp*xyztes*CDIST) IOK=0        GL=SQRT(GL)*      write (6,*) ' dist gl ',gl*      write (6,*) ' ip ',XYZ(1,IP),XYZ(2,IP),XYZ(3,IP)*      write (6,*) ' jp ',XYZ(1,jP),XYZ(2,jP),XYZ(3,jP)C       RETURNC      FIN DE LA SUBROUTINE DIST       END

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