1 : C EXISCO SOURCE PV 09/03/12 21:21:58 6325 2 : SUBROUTINE EXISCO(MOTYP,IVAL,MACOMP,IRET) 3 : C---------------------------------------------------------------------- 4 : C EXISTENCE D'UNE COMPOSANTE DANS UN CHPOINT OU UN MCHAML 5 : C---------------------------------------------------------------------- 6 : IMPLICIT INTEGER(I-N) 7 : -INC CCOPTIO 8 : -INC SMCHPOI 9 : -INC SMCHAML 10 : CHARACTER*8 MOTYP 11 : CHARACTER*4 MACOMP 12 : LOGICAL IRET 13 : IF(MOTYP.EQ.'MCHAML ') THEN 14 : ICHAM=1 15 : GO TO 1 16 : ELSE IF(MOTYP.EQ.'CHPOINT ') THEN 17 : ICHAM=2 18 : GO TO 1 19 : ENDIF 19 : CALL ERREUR(21) 20 : RETURN 21 : 1 CONTINUE 22 : C 23 : GO TO (600,700),ICHAM 24 : C---------------------------- 25 : C CAS DU MCHAML 26 : C---------------------------- 27 : 600 CONTINUE 28 : MCHELM=IVAL 29 : SEGACT MCHELM 30 : NSOUS=IMACHE(/1) 31 : C 32 : C BOUCLE SUR LES SOUS PAQUETS DE MCHELM 33 : C 34 : DO 100 IA=1,NSOUS 35 : MCHAML=ICHAML(IA) 36 : SEGACT MCHAML 37 : NCP=NOMCHE(/2) 38 : DO 110 IB=1,NCP 39 : IF(MACOMP.NE.NOMCHE(IB))GOTO 110 40 : SEGDES MCHAML 41 : IRET=.TRUE. 42 : GO TO 120 43 : 110 CONTINUE 44 : SEGDES MCHAML 45 : 100 CONTINUE 46 : IRET=.FALSE. 47 : C 48 : 120 CONTINUE 49 : SEGDES MCHELM 50 : GO TO 800 51 : C------------------------- 52 : C CAS DU CHPOINT 53 : C------------------------- 54 : 700 CONTINUE 55 : MCHPOI=IVAL 56 : SEGACT MCHPOI 57 : NBSOUS=IPCHP(/1) 58 : C 59 : C BOUCLE SUR LES SOUS-ZONES DU CHPOINT 60 : C 61 : DO 11 I=1,NBSOUS 62 : MSOUPO=IPCHP(I) 63 : SEGACT MSOUPO 64 : DO 12 IC=1,NOCOMP(/2) 65 : IF(NOCOMP(IC).NE.MACOMP) GO TO 12 66 : SEGDES MSOUPO 67 : IRET=.TRUE. 68 : GO TO 15 69 : 12 CONTINUE 70 : SEGDES MSOUPO 71 : 11 CONTINUE 72 : IRET=.FALSE. 73 : 15 CONTINUE 74 : SEGDES MCHPOI 75 : C 76 : 800 RETURN 77 : END 78 : 79 : 80 :
© Cast3M 2003 - All rights reserved.
Disclaimer