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