C ETMCHL SOURCE JK148537 25/04/01 21:15:02 12223 SUBROUTINE ETMCHL(MCHEL1,MCHEL2,IRECHE) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCREEL -INC SMCHAML -INC SMCOORD -INC SMLENTI CHARACTER*(NCONCH) CONCH1,CONCH2 CHARACTER*8 nop1,nop2,CHA8 CHARACTER*(LOCOMP) NOMCH1,NOMCH2 CHARACTER*16 TYPCH1,TYPCH2 CHARACTER*72 SOUTY1,SOUTY2 SEGMENT ISEG(0) SEGMENT IZR1(N11) C IZR1(:) : MCHAM1 si pas de correspondance dans MCHEL2 C -N2 du MCHAML resultat sinon SEGMENT IZR3(N11) SEGMENT IZR2(2,N12) C IZR2(1,:) : POINTEUR MCHAML si correspondance, entier negatif sinon C IZR2(2,:) : Numero de SOUS-ZONE dans le MCHELM resultat SEGMENT ICORE2(2,N22M,N12) C ICORE2(1,:,:) : POINTEUR MELVAL si correspondance, entier negatif sinon C ICORE2(2,:,:) : Numero de COMPOSANTE dans le MCHAML resultat C Cas ultra rapide : Meme POINTEURS MCHELM IF(MCHEL1 .EQ. MCHEL2)THEN IRECHE=MCHEL1 RETURN ENDIF N11=MCHEL1.ICHAML(/1) N12=MCHEL2.ICHAML(/1) JG = N11 segini mlent1 JG = N12 segini mlent2 C Cas "VIDES" IF (N11 .EQ. 0)THEN IRECHE=MCHEL2 RETURN ELSEIF(N12 .EQ. 0)THEN IRECHE=MCHEL1 RETURN ENDIF C Cas rapide : Memes POINTEURS MCHAML c IF(N11 .EQ. N12)THEN DO 5 II=1,N11 ima1 = MCHEL1.imache(II) C inf31 = MCHEL1.infche(II,3) inf61 = MCHEL1.infche(II,6) nop1 = MCHEL1.conche(II)(17:24) CONCH1 = MCHEL1.conche(II) mcham1 = MCHEL1.ichaml(II) DO 4 JJ = 1,N12 if(mlent2.lect(jj).gt.0) goto 4 ima2 = MCHEL2.imache(JJ) C inf32 = MCHEL2.infche(JJ,3) inf62 = MCHEL2.infche(JJ,6) nop2 = MCHEL2.conche(JJ)(17:24) CONCH2 = MCHEL2.conche(JJ) mcham2 = MCHEL2.ichaml(JJ) IF( ima1.NE.ima2 .OR. inf61.NE.inf62 .OR. nop1.NE.nop2 .OR. & CONCH1.NE.CONCH2 .OR. mcham1.NE.mcham2) THEN ELSE mlent1.lect(ii)=jj mlent2.lect(jj)=ii goto 5 ENDIF 4 CONTINUE 5 CONTINUE do ii = 1,N11 if (mlent1.lect(ii).le.0) goto 10 enddo do jj = 1,N12 if (mlent2.lect(jj).le.0) goto 10 enddo IRECHE=MCHEL1 RETURN c ENDIF C Cas lent 10 CONTINUE N21M=0 DO II=1,N11 MCHAM1=MCHEL1.ICHAML(II) N21=MCHAM1.IELVAL(/1) N21M=MAX(N21M,N21) ENDDO N22M=0 DO II=1,N12 MCHAM2=MCHEL2.ICHAML(II) N22=MCHAM2.IELVAL(/1) N22M=MAX(N22M,N22) ENDDO C Tableau de travail CALL oooprl(1) SEGINI,IZR1,IZR2,ICORE2,IZR3 CALL oooprl(0) C Boucle MCHEL1 DO 100 IN11=1,N11 ima1 = MCHEL1.imache(IN11) C inf31 = MCHEL1.infche(IN11,3) inf61 = MCHEL1.infche(IN11,6) nop1 = MCHEL1.conche(IN11)(17:24) CONCH1 = MCHEL1.conche(IN11) mcham1 = MCHEL1.ichaml(IN11) IZR1(IN11)= mcham1 if (mlent1.lect(in11).gt.0) goto 100 C Boucle MCHEL2 DO 110 IN12=1,N12 mcham2 = MCHEL2.ichaml(IN12) IZR2(1,IN12)=mcham2 if (mlent2.lect(in12).gt.0) then IZR2(2,IN12)=0 goto 110 endif ima2 = MCHEL2.imache(IN12) IF(ima2 .NE. ima1)GOTO 110 CONCH2 = MCHEL2.conche(IN12) IF(CONCH2 .NE. CONCH1)GOTO 110 nop2 = MCHEL2.conche(IN12)(17:24) IF(nop2 .NE. nop1)GOTO 110 C inf32 = MCHEL2.infche(IN12,3) inf62 = MCHEL2.infche(IN12,6) C Correspondance de IN11 et IN12 N21=MCHAM1.IELVAL(/1) N22=MCHAM2.IELVAL(/1) IZR1(IN11) = -N21 IZR3(IN11) = N21 IZR2(1,IN12)=-IN12 IZR2(2,IN12)= IN11 C Boucle MCHAM1 DO 120 IN21=1,N21 NOMCH1=MCHAM1.NOMCHE(IN21) TYPCH1=MCHAM1.TYPCHE(IN21) MELVA1=MCHAM1.IELVAL(IN21) C Boucle MCHAM2 DO 130 IN22=1,N22 NOMCH2=MCHAM2.NOMCHE(IN22) MELVA2=MCHAM2.IELVAL(IN22) ICORE2(1,IN22,IN12)=MELVA2 IF(NOMCH2 .NE. NOMCH1)GOTO 130 C Meme composante TYPCH2=MCHAM2.TYPCHE(IN22) IF(inf62 .NE. inf61)THEN C Supports differents moterr(1:4)=NOMCH1(1:4) call erreur(1010) return ENDIF IF(TYPCH2 .NE. TYPCH1)THEN C Types differents moterr(1:4) = NOMCH1(1:4) moterr(5:21) = TYPCH1 moterr(22:38) = TYPCH2 call erreur(917) return ENDIF C Correspondance des COMPOSANTES IN21 et IN22 ICORE2(1,IN22,IN12)=-IN22 ICORE2(2,IN22,IN12)= 0 IF(MELVA1 .NE. MELVA2)THEN IF (TYPCH1 .EQ. 'REAL*8 ')THEN C Teste les valeurs REAL*8 N1PTE1=MELVA1.VELCHE(/1) N1E1 =MELVA1.VELCHE(/2) N1PTE2=MELVA2.VELCHE(/1) N1E2 =MELVA2.VELCHE(/2) N1PMAX=MAX(N1PTE1,N1PTE2) N1EMAX=MAX(N1E1 ,N1E2) DO 131 IEL=1,N1EMAX N1EM1=MIN(IEL ,N1E1) N1EM2=MIN(IEL ,N1E2) DO 132 IPTEL=1,N1PMAX X1=MELVA1.VELCHE(MIN(IPTEL,N1PTE1),N1EM1) X2=MELVA2.VELCHE(MIN(IPTEL,N1PTE2),N1EM2) IF(ABS(X1-X2) .GT. ABS(X1+X2)/2.D6)THEN interr(1) =IPTEL interr(2) =IEL moterr(1:4) =NOMCH1(1:4) call erreur(918) return ENDIF 132 CONTINUE 131 CONTINUE ICORE2(2,IN22,IN12)= -IN21 ELSE C Teste les POINTEURS N2PTE1=MELVA1.IELCHE(/1) N2E1 =MELVA1.IELCHE(/2) N2PTE2=MELVA2.IELCHE(/1) N2E2 =MELVA2.IELCHE(/2) N2PMAX=MAX(N2PTE1,N2PTE2) N2EMAX=MAX(N2E1 ,N2E2) DO 133 IEL=1,N2EMAX N2EM1=MIN(IEL ,N2E1) N2EM2=MIN(IEL ,N2E2) DO 134 IPTEL=1,N2PMAX IP1=MELVA1.IELCHE(MIN(IPTEL,N2PTE1),N2EM1) IP2=MELVA2.IELCHE(MIN(IPTEL,N2PTE2),N2EM2) IF(IP1 .NE. IP2)THEN interr(1) =IPTEL interr(2) =IEL moterr(1:4) =NOMCH1(1:4) call erreur(918) return ENDIF 134 CONTINUE 133 CONTINUE ICORE2(2,IN22,IN12)= -IN21 ENDIF ENDIF 130 CONTINUE 120 CONTINUE C On positionne les composantes de MCHAML2 NON CORRESPONDANTES a la suite N2SUPL=0 DO 135 IN22=1,N22 IF(ICORE2(2,IN22,IN12) .NE. 0) GOTO 135 N2SUPL=N2SUPL+1 ICORE2(2,IN22,IN12)=N21+N2SUPL 135 CONTINUE IF(N2SUPL .EQ. 0) THEN IZR1(IN11) = mcham1 ELSE IZR1(IN11) =-(N21+N2SUPL) ENDIF 110 CONTINUE 100 CONTINUE C On positionne les sous-zones de MCHEL2 NON CORRESPONDANTES a la suite N1SUP=0 DO 101 IN12=1,N12 IF(IZR2(2,IN12).GT.0.or.mlent2.lect(in12).gt.0) GOTO 101 N1SUP=N1SUP+1 IZR2(2,IN12)=-(N11+N1SUP) 101 CONTINUE C Creation du resultat SOUTY1 = MCHEL1.TITCHE L1 = MCHEL1.TITCHE(/1) * CHA8 = SOUTY1(1:8) IF (CHA8 .EQ. ' ') THEN CHA8 = MCHEL2.TITCHE(1:8) IF (CHA8 .NE. ' ') THEN SOUTY1 = MCHEL2.TITCHE L1 = MCHEL2.TITCHE(/1) ENDIF ELSE SOUTY2=MCHEL2.TITCHE IF (SOUTY2 .NE. SOUTY1) THEN CHA8=MCHEL2.TITCHE(1:8) IF (CHA8 .NE. ' ') THEN SOUTY1=' ' L1 =1 ENDIF ENDIF ENDIF L1=MAX(L1,1) N1=N11+N1SUP N31=MCHEL1.INFCHE(/2) N32=MCHEL2.INFCHE(/2) N3=MAX(N31,N32) C Regroupement des SEGINI CALL oooprl(1) SEGINI,MCHELM IRECHE=MCHELM DO IN11=1,N11 IZR=IZR1(IN11) IF(IZR .LT. 0)THEN N2=-IZR SEGINI,MCHAML IZR1(IN11)=-MCHAML ENDIF ENDDO CALL oooprl(0) MCHELM.TITCHE=SOUTY1(1:L1) MCHELM.IFOCHE=ifour C On copie les infos de MCHEL1 DO IN11=1,N11 MCHELM.CONCHE(IN11)=MCHEL1.CONCHE(IN11) MCHELM.IMACHE(IN11)=MCHEL1.IMACHE(IN11) IZR=IZR1(IN11) IF(IZR .GT. 0)THEN MCHELM.ICHAML(IN11)= IZR ELSE MCHAML=-IZR MCHELM.ICHAML(IN11)=MCHAML MCHAM1=MCHEL1.ichaml(IN11) N21=MCHAM1.IELVAL(/1) DO IN21=1,N21 MCHAML.NOMCHE(IN21)=MCHAM1.NOMCHE(IN21) MCHAML.TYPCHE(IN21)=MCHAM1.TYPCHE(IN21) MCHAML.IELVAL(IN21)=MCHAM1.IELVAL(IN21) ENDDO ENDIF DO IN31=1,N31 MCHELM.INFCHE(IN11,IN31)=MCHEL1.INFCHE(IN11,IN31) ENDDO ENDDO C On adjoint les SOUS-ZONES et COMPOSANTES non CORRESPONDANTES de MCHEL2 ! DO 300 IN12=1,N12 IZR=IZR2(2,IN12) IF(IZR .GT. 0) THEN C On adjoint les COMPOSANTES supplementaires des MCHAM2 dans les MCHAML resultat MCHAML=MCHELM.ICHAML(IZR) MCHAM2=MCHEL2.ichaml(IN12) N22=MCHAM2.IELVAL(/1) DO IN22=1,N22 ICR=ICORE2(2,IN22,IN12) IF(ICR .GT. 0) THEN MCHAML.NOMCHE(ICR)=MCHAM2.NOMCHE(IN22) MCHAML.TYPCHE(ICR)=MCHAM2.TYPCHE(IN22) MCHAML.IELVAL(ICR)=MCHAM2.IELVAL(IN22) ENDIF ENDDO N21 = IZR3(IZR) if (icr.gt.N21) then n2 = icr segadj mchaml endif elseif(izr.eq.0) then ELSE C On adjoint les SOUS-ZONES non CORRESPONDANTES de MCHEL2 MIZR=-IZR MCHELM.CONCHE(MIZR)=MCHEL2.CONCHE(IN12) MCHELM.IMACHE(MIZR)=MCHEL2.IMACHE(IN12) MCHELM.ICHAML(MIZR)=MCHEL2.ICHAML(IN12) DO IN32=1,N32 MCHELM.INFCHE(MIZR,IN32)=MCHEL2.INFCHE(IN12,IN32) ENDDO ENDIF 300 CONTINUE if (MIZR.gt.N11) then n1 = MIZR segadj mchelm endif SEGSUP,IZR1,IZR2,IZR3,ICORE2 END