C EXCOPP SOURCE CB215821 20/11/25 13:28:31 10792 SUBROUTINE EXCOPP(IPCH1,MOT,NIF1,IPCH2,MOT2,NIF2,IVID) C======================================================================= C C EXTRACTION D UNE COMPOSANTE D UN CHPOINT C ROUTINE APPELLEE PAR L OPERATEUR EXCOMP C ENTREE C IPCH1= POINTEUR SUR UN CHPOINT C MOT = NOM DE LA COMPOSANTE A EXTRAIRE C NIF1 = harmonique de Fourier C SORTIE C IPCH2= POINTEUR SUR LE CHPOINT CONTENANT UNIQUEMENT LA C COMPOSANTE MOT LE NOM DE CETTE COMPOSANTE EST C REPABTISE MOT2 + harmonique NIF2 C CODE DECEMBRE 84 MODIFIE NOVEMBRE 1986 C======================================================================= IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC SMCHPOI -INC SMELEME -INC PPARAM -INC CCOPTIO CHARACTER*(*) MOT,MOT2 CHARACTER*(LOCOMP) MOT1 C c write(*,*) 'EXCOPP: search ',MOT,NIF1,' a renommer en ',MOT2,NIF2 MCHPO1=IPCH1 C C INITIALISATION DES SEGMENTS DE TRAVAIL C C MPOVAL=0 IPT1 =0 NBSOUS=0 NBREF =0 NSOUP1=MCHPO1.IPCHP(/1) C C BOUCLE SUR LES SOUS PAQUETS DE MCHPO1 C DO 100 IA=1,NSOUP1 MSOUP1=MCHPO1.IPCHP(IA) NC1=MSOUP1.NOCOMP(/2) DO 110 IB=1,NC1 MOT1=MSOUP1.NOCOMP(IB) IHA =MSOUP1.NOHARM(IB) IF(MOT1.NE.MOT .OR. IHA.NE.NIF1) GOTO 110 IBVAL=IB GOTO 120 110 CONTINUE C C ON A PAS TROUVE UNE COMPOSANTE MOT DANS CE SOUS PAQUET C GOTO 130 C C ON A TROUVE DANS LE SOUS PAQUET UNE COMPOSANTE MOT C 120 CONTINUE MELEME=MSOUP1.IGEOC MPOVA1=MSOUP1.IPOVAL NBNN =NUM(/1) NBELEM=NUM(/2) IF(MPOVAL.EQ.0) THEN NDEJ=0 NC =1 N =NBELEM SEGINI,MPOVAL,IPT1 ELSE NC =1 N =NBELEM+NDEJ NBELEM=N SEGADJ,MPOVAL,IPT1 ENDIF DO 140 IC=1,NUM(/2) IPT1.NUM(1,IC+NDEJ)=NUM(1,IC) MPOVAL.VPOCHA(IC+NDEJ,1)=MPOVA1.VPOCHA(IC,IBVAL) 140 CONTINUE NDEJ=NDEJ+NUM(/2) 130 CONTINUE 100 CONTINUE C IF(MPOVAL.NE.0) GOTO 200 C C ERREUR PAS DE COMPOSANTE DU TYPE RECHERCHE DANS MCHPOI C IF(IVID.EQ.1) THEN NSOUPO=0 NAT=MCHPO1.JATTRI(/1) SEGINI,MCHPOI mochde='chpoint vide' mtypoi='SCALAIRE' IFOPOI=MCHPO1.IFOPOI DO 160 II=1,NAT JATTRI(II)=MCHPO1.JATTRI(II) 160 CONTINUE IPCH2=MCHPOI RETURN ELSE MOTERR=MOT CALL ERREUR(181) RETURN ENDIF 200 CONTINUE C C ON REMPLIT LE NOUVEAU CHPOINT C NSOUPO=1 NAT=MCHPO1.JATTRI(/1) SEGINI,MCHPOI IPCH2=MCHPOI MTYPOI='SCALAIRE' MOCHDE=MCHPO1.MOCHDE DO 170 II=1,NAT JATTRI(II)=MCHPO1.JATTRI(II) 170 CONTINUE IFOPOI=MCHPO1.IFOPOI NC=1 SEGINI,MSOUPO IPCHP(1)=MSOUPO NOCOMP(1)=MOT2 NOHARM(1)=NIF2 IPOVAL=MPOVAL IPT1.ITYPEL=1 call crech1(ipt1,1) IGEOC=IPT1 END