Download genrd1.eso

Back to the list

   1 : C GENRD1    SOURCE    CHAT      05/01/13    00:17:37     5004           
   2 :       SUBROUTINE GENRD1(FAC1,FAC2,NUM2,NPTO,TOL2,IRET)
   3 : C--------------------------------------------------------------------
   4 : C
   5 : C     ON ORDONNE FAC2 SUIVANT FAC1 EN FAISANT SUIVRE LES PERMUTATIONS
   6 : C            SUR NUM2
   7 : C
   8 : C     PP 9/97
   9 : C     Pierre Pegon/JRC Ispra
  10 : C--------------------------------------------------------------------
  11 :       IMPLICIT INTEGER(I-N)
  12 :       IMPLICIT REAL*8 (A-H,O-Z)
  13 : C
  14 : -INC CCOPTIO
  15 : C
  16 :       DIMENSION FAC1(3,NPTO),FAC2(3,NPTO),NUM2(NPTO)
  17 : C
  18 :       DO IE1=1,NPTO-1
  19 :         DO IE2=IE1,NPTO
  20 :           DIST=0.D0
  21 :           DO IE3=1,3
  22 :             DIST=DIST+(FAC1(IE3,IE1)-FAC2(IE3,IE2))**2
  23 :           ENDDO
  24 :           IF(DIST.LT.TOL2)GOTO 1
  25 :         ENDDO
  26 :         IRET=IRET+1
  27 :         WRITE(IOIMP,*)'GENRD1: Impossible de ce retrouver la!'
  28 :         GOTO 2
  29 :  1      CONTINUE
  30 :         IF(IE2.NE.IE1)THEN
  31 :           DO IE3=1,3
  32 :             PDUM=FAC2(IE3,IE2)
  33 :             FAC2(IE3,IE2)=FAC2(IE3,IE1)
  34 :             FAC2(IE3,IE1)=PDUM
  35 :           ENDDO
  36 :           NDUM=NUM2(IE2)
  37 :           NUM2(IE2)=NUM2(IE1)
  38 :           NUM2(IE1)=NDUM
  39 :         ENDIF
  40 :       ENDDO
  41 : C
  42 :  2    CONTINUE
  43 :       RETURN
  44 :       END
  45 :  
  46 :  

© Cast3M 2003 - All rights reserved.
Disclaimer