1 : C EXCOPP SOURCE PV 13/04/16 21:15:16 7765 2 : SUBROUTINE EXCOPP(IPCH1,MOT,IPCH2,MOT2,IVID) 3 : C======================================================================= 4 : C 5 : C EXTRACTION D UNE COMPOSANTE D UN CHPOINT 6 : C ROUTINE APPELLEE PAR L OPERATEUR EXCOMP 7 : C ENTREE 8 : C IPCH1= POINTEUR SUR UN CHPOINT 9 : C MOT = NOM DE LA COMPOSANTE A EXTRAIRE 10 : C SORTIE 11 : C IPCH2= POINTEUR SUR LE CHPOINT CONTENANT UNIQUEMENT LA 12 : C COMPOSANTE MOT LE NOM DE CETTE COMPOSANTE EST 13 : C REPABTISE LE CONTENU DE MOT2 14 : C CODE DECEMBRE 84 MODIFIE NOVEMBRE 1986 15 : C======================================================================= 16 : IMPLICIT INTEGER(I-N) 17 : -INC SMCHPOI 18 : -INC SMELEME 19 : -INC CCOPTIO 20 : CHARACTER*4 MOT,MOT1,MOT2 21 : C 22 : MCHPO1=IPCH1 23 : SEGACT MCHPO1 24 : C 25 : C INITIALISATION DES SEGMENTS DE TRAVAIL 26 : C 27 : C 28 : MPOVAL=0 29 : IPT1=0 30 : NBSOUS=0 31 : NBREF=0 32 : NSOUP1=MCHPO1.IPCHP(/1) 33 : C 34 : C BOUCLE SUR LES SOUS PAQUETS DE MCHPO1 35 : C 36 : DO 100 IA=1,NSOUP1 37 : MSOUP1=MCHPO1.IPCHP(IA) 38 : SEGACT MSOUP1 39 : NC1=MSOUP1.NOCOMP(/2) 40 : DO 110 IB=1,NC1 41 : MOT1=MSOUP1.NOCOMP(IB) 42 : IHA=MSOUP1.NOHARM(IB) 43 : IF(MOT1.NE.MOT.OR.IHA.NE.NIFOUR) GOTO 110 44 : IBVAL=IB 45 : GOTO 120 46 : 110 CONTINUE 47 : C 48 : C ON A PAS TROUVE UNE COMPOSANTE MOT DANS CE SOUS PAQUET 49 : C 50 : GOTO 130 51 : C 52 : C ON A TROUVE DANS LE SOUS PAQUET UNE COMPOSANTE MOT 53 : C 54 : 120 CONTINUE 55 : MELEME=MSOUP1.IGEOC 56 : MPOVA1=MSOUP1.IPOVAL 57 : SEGACT MELEME,MPOVA1 58 : NBNN =NUM(/1) 59 : NBELEM=NUM(/2) 60 : IF(MPOVAL.EQ.0) THEN 61 : NDEJ=0 62 : NC=1 63 : N=NBELEM 64 : SEGINI MPOVAL 65 : SEGINI IPT1 66 : ELSE 67 : NC=1 68 : N=NBELEM+NDEJ 69 : NBELEM=N 70 : SEGADJ MPOVAL 71 : SEGADJ IPT1 72 : ENDIF 73 : DO 140 IC=1,NUM(/2) 74 : IPT1.NUM(1,IC+NDEJ)=NUM(1,IC) 75 : MPOVAL.VPOCHA(IC+NDEJ,1)=MPOVA1.VPOCHA(IC,IBVAL) 76 : 140 CONTINUE 77 : NDEJ=NDEJ+NUM(/2) 78 : SEGDES MELEME,MPOVA1 79 : 130 CONTINUE 80 : SEGDES MSOUP1 81 : 100 CONTINUE 82 : C 83 : 84 : IF(MPOVAL.NE.0) GOTO 200 85 : C 86 : C ERREUR PAS DE COMPOSANTE DU TYPE RECHERCHE DANS MCHPOI 87 : C 88 : IF(IVID.EQ.1) THEN 89 : NSOUPO=0 90 : NAT=MCHPO1.JATTRI(/1) 91 : SEGINI MCHPOI 92 : mochde='chpoint vide' 93 : mtypoi='SCALAIRE' 94 : IFOPOI=MCHPO1.IFOPOI 95 : DO 160 II=1,NAT 96 : JATTRI(II)=MCHPO1.JATTRI(II) 97 : 160 CONTINUE 98 : IPCH2=MCHPOI 99 : SEGDES MCHPOI 100 : GO TO 666 101 : ELSE 102 : MOTERR(1:4)=MOT 102 : CALL ERREUR(181) 103 : GOTO 666 104 : ENDIF 105 : 200 CONTINUE 106 : C 107 : C ON REMPLIT LE NOUVEAU CHPOINT 108 : C 109 : NSOUPO=1 110 : NAT=MCHPO1.JATTRI(/1) 111 : SEGINI MCHPOI 112 : IPCH2=MCHPOI 113 : MTYPOI='SCALAIRE' 114 : MOCHDE=MCHPO1.MOCHDE 115 : DO 170 II=1,NAT 116 : JATTRI(II)=MCHPO1.JATTRI(II) 117 : 170 CONTINUE 118 : IFOPOI=MCHPO1.IFOPOI 119 : NC=1 120 : SEGINI MSOUPO 121 : IPCHP(1)=MSOUPO 122 : NOCOMP(1)=MOT2 123 : NOHARM(1)=NIFOUR 124 : IPOVAL=MPOVAL 125 : SEGDES MCHPOI,MSOUPO 126 : SEGDES MPOVAL 127 : segact ipt1*mod 128 : IPT1.ITYPEL=1 128 : call crech1(ipt1,1) 129 : IGEOC=IPT1 130 : SEGDES IPT1 131 : C 132 : 666 CONTINUE 133 : C 134 : C SUPPRESSION DES SEGMENTS DE TRAVAIL 135 : C 136 : C 137 : SEGDES MCHPO1 138 : RETURN 139 : END 140 : 141 : 142 : 143 : 144 :
© Cast3M 2003 - All rights reserved.
Disclaimer