1 : C NUHARM SOURCE CHAT 05/01/13 02:03:01 5004 2 : SUBROUTINE NUHARM(ICHPOI,IFO,IHARM) 3 : C-------------------------------------------------------------------- 4 : C POUR UN CHPOINT AVEC IFOPOI=1 : 5 : C SI TOUS LES NOHARM SONT EGAUX RENVOIE :IFO=1 IHARM=NOHARM 6 : C SINON :IFO=3 IHARM=0 7 : C-------------------------------------------------------------------- 8 : IMPLICIT INTEGER(I-N) 9 : -INC SMCHPOI 10 : -INC CCOPTIO 11 : MCHPOI=ICHPOI 12 : IFO=1 13 : MSOUPO=IPCHP(1) 14 : SEGACT MSOUPO 15 : IHARM=NOHARM(1) 16 : DO 1 I=1,IPCHP(/1) 17 : MSOUPO=IPCHP(I) 18 : SEGACT MSOUPO 19 : NC=NOHARM(/1) 20 : DO 2 IC=1,NC 21 : IF(IHARM.EQ.NOHARM(IC)) GOTO 2 22 : SEGDES MSOUPO 23 : IHARM=0 24 : IFO=3 25 : GOTO 3 26 : 2 CONTINUE 27 : SEGDES MSOUPO 28 : 1 CONTINUE 29 : 3 CONTINUE 30 : RETURN 31 : END 32 :
© Cast3M 2003 - All rights reserved.
Disclaimer