Télécharger la plaquette Cast3M


fr en

Télécharger etmchl.eso

Retour à la liste

Numérotation des lignes : 

etmchl

  1. C ETMCHL    SOURCE    CB215821  20/11/04    21:16:46     10766          
  2.       SUBROUTINE ETMCHL(MCHEL1,MCHEL2,IRECHE)
  3.  
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6.  
  7.  
  8. -INC PPARAM
  9. -INC CCOPTIO
  10. -INC CCREEL
  11. -INC SMCHAML
  12.  
  13.  
  14.       CHARACTER*(NCONCH) CONCH1,CONCH2
  15.       CHARACTER*8  nop1,nop2,CHA8
  16.       CHARACTER*(LOCOMP)  NOMCH1,NOMCH2
  17.       CHARACTER*16 TYPCH1,TYPCH2
  18.       CHARACTER*72 SOUTY1,SOUTY2
  19.  
  20.       SEGMENT ISEG(0)
  21.  
  22.       SEGMENT IZR1(N11)
  23. C       IZR1(:)       : MCHAM1 si pas de correspondance dans MCHEL2
  24. C                      -N2 du MCHAML resultat sinon
  25.       SEGMENT IZR2(2,N12)
  26. C       IZR2(1,:)     : POINTEUR MCHAML si correspondance, entier negatif sinon
  27. C       IZR2(2,:)     : Numero de SOUS-ZONE dans le MCHELM resultat
  28.  
  29.       SEGMENT ICORE2(2,N22M,N12)
  30. C       ICORE2(1,:,:) : POINTEUR MELVAL si correspondance, entier negatif sinon
  31. C       ICORE2(2,:,:) : Numero de COMPOSANTE dans le MCHAML resultat
  32.  
  33. C     Cas ultra rapide : Meme POINTEURS MCHELM
  34.       IF(MCHEL1 .EQ. MCHEL2)THEN
  35.         IRECHE=MCHEL1
  36.         RETURN
  37.       ENDIF
  38.  
  39.       N11=MCHEL1.ICHAML(/1)
  40.       N12=MCHEL2.ICHAML(/1)
  41.  
  42. C     Cas "VIDES"
  43.       IF    (N11 .EQ. 0)THEN
  44.         IRECHE=MCHEL2
  45.         RETURN
  46.       ELSEIF(N12 .EQ. 0)THEN
  47.         IRECHE=MCHEL1
  48.         RETURN
  49.       ENDIF
  50.  
  51. C     Cas rapide : Memes POINTEURS MCHAML
  52.       IF(N11 .EQ. N12)THEN
  53.         DO II=1,N11
  54.           ima1   = MCHEL1.imache(II)
  55. C         inf31  = MCHEL1.infche(II,3)
  56.           inf61  = MCHEL1.infche(II,6)
  57.           nop1   = MCHEL1.conche(II)(17:24)
  58.           CONCH1 = MCHEL1.conche(II)
  59.           mcham1 = MCHEL1.ichaml(II)
  60.  
  61.           ima2   = MCHEL2.imache(II)
  62. C         inf32  = MCHEL2.infche(II,3)
  63.           inf62  = MCHEL2.infche(II,6)
  64.           nop2   = MCHEL2.conche(II)(17:24)
  65.           CONCH2 = MCHEL2.conche(II)
  66.           mcham2 = MCHEL2.ichaml(II)
  67.           IF(  ima1.NE.ima2   .OR. inf61.NE.inf62 .OR. nop1.NE.nop2 .OR.
  68.      &       CONCH1.NE.CONCH2 .OR. mcham1.NE.mcham2) GOTO 10
  69.         ENDDO
  70.         IRECHE=MCHEL1
  71.         RETURN
  72.       ENDIF
  73.  
  74. C     Cas lent
  75.  10   CONTINUE
  76.  
  77.       N21M=0
  78.       DO II=1,N11
  79.         MCHAM1=MCHEL1.ICHAML(II)
  80.         N21=MCHAM1.IELVAL(/1)
  81.         N21M=MAX(N21M,N21)
  82.       ENDDO
  83.  
  84.       N22M=0
  85.       DO II=1,N12
  86.         MCHAM2=MCHEL2.ICHAML(II)
  87.         N22=MCHAM2.IELVAL(/1)
  88.         N22M=MAX(N22M,N22)
  89.       ENDDO
  90.  
  91. C     Tableau de travail
  92.       CALL oooprl(1)
  93.       SEGINI,IZR1,IZR2,ICORE2
  94.       CALL oooprl(0)
  95.  
  96. C     Boucle MCHEL1
  97.       DO 100 IN11=1,N11
  98.         ima1      = MCHEL1.imache(IN11)
  99. C       inf31     = MCHEL1.infche(IN11,3)
  100.         inf61     = MCHEL1.infche(IN11,6)
  101.         nop1      = MCHEL1.conche(IN11)(17:24)
  102.         CONCH1    = MCHEL1.conche(IN11)
  103.         mcham1    = MCHEL1.ichaml(IN11)
  104.         IZR1(IN11)= mcham1
  105.  
  106. C       Boucle MCHEL2
  107.         DO 110 IN12=1,N12
  108.           mcham2 = MCHEL2.ichaml(IN12)
  109.           IZR2(1,IN12)=mcham2
  110.           ima2   = MCHEL2.imache(IN12)
  111.           IF(ima2 .NE. ima1)GOTO 110
  112.           CONCH2 = MCHEL2.conche(IN12)
  113.           IF(CONCH2 .NE. CONCH1)GOTO 110
  114.           nop2   = MCHEL2.conche(IN12)(17:24)
  115.           IF(nop2 .NE. nop1)GOTO 110
  116. C         inf32  = MCHEL2.infche(IN12,3)
  117.           inf62  = MCHEL2.infche(IN12,6)
  118.  
  119. C         Correspondance de IN11 et IN12
  120.           N21=MCHAM1.IELVAL(/1)
  121.           N22=MCHAM2.IELVAL(/1)
  122.  
  123.           IZR1(IN11)  = -N21
  124.           IZR2(1,IN12)=-IN12
  125.           IZR2(2,IN12)= IN11
  126.  
  127. C         Boucle MCHAM1
  128.           DO 120 IN21=1,N21
  129.             NOMCH1=MCHAM1.NOMCHE(IN21)
  130.             TYPCH1=MCHAM1.TYPCHE(IN21)
  131.             MELVA1=MCHAM1.IELVAL(IN21)
  132. C           Boucle MCHAM2
  133.             DO 130 IN22=1,N22
  134.               NOMCH2=MCHAM2.NOMCHE(IN22)
  135.               MELVA2=MCHAM2.IELVAL(IN22)
  136.               ICORE2(1,IN22,IN12)=MELVA2
  137.               IF(NOMCH2 .NE. NOMCH1)GOTO 130
  138. C             Meme composante
  139.  
  140.               TYPCH2=MCHAM2.TYPCHE(IN22)
  141.               IF(inf62 .NE. inf61)THEN
  142. C               Supports differents
  143.                   moterr(1:4)=NOMCH1(1:4)
  144.                   call erreur(1010)
  145.                   return
  146.               ENDIF
  147.               IF(TYPCH2 .NE. TYPCH1)THEN
  148. C               Types differents
  149.                   moterr(1:4)   = NOMCH1(1:4)
  150.                   moterr(5:21)  = TYPCH1
  151.                   moterr(22:38) = TYPCH2
  152.                   call erreur(917)
  153.                   return
  154.               ENDIF
  155. C             Correspondance des COMPOSANTES IN21 et IN22
  156.               ICORE2(1,IN22,IN12)=-IN22
  157.               ICORE2(2,IN22,IN12)= 0
  158.               IF(MELVA1 .NE. MELVA2)THEN
  159.                 IF    (TYPCH1 .EQ. 'REAL*8          ')THEN
  160. C                 Teste les valeurs REAL*8
  161.                   N1PTE1=MELVA1.VELCHE(/1)
  162.                   N1E1  =MELVA1.VELCHE(/2)
  163.                   N1PTE2=MELVA2.VELCHE(/1)
  164.                   N1E2  =MELVA2.VELCHE(/2)
  165.                   N1PMAX=MAX(N1PTE1,N1PTE2)
  166.                   N1EMAX=MAX(N1E1  ,N1E2)
  167.                   DO 131 IEL=1,N1EMAX
  168.                     N1EM1=MIN(IEL  ,N1E1)
  169.                     N1EM2=MIN(IEL  ,N1E2)
  170.                     DO 132 IPTEL=1,N1PMAX
  171.                       X1=MELVA1.VELCHE(MIN(IPTEL,N1PTE1),N1EM1)
  172.                       X2=MELVA2.VELCHE(MIN(IPTEL,N1PTE2),N1EM2)
  173.                       IF(ABS(X1-X2) .GT. ABS(X1+X2)/2.D6)THEN
  174.                         interr(1)   =IPTEL
  175.                         interr(2)   =IEL
  176.                         moterr(1:4) =NOMCH1(1:4)
  177.                         call erreur(918)
  178.                         return
  179.                       ENDIF
  180.  132                CONTINUE
  181.  131              CONTINUE
  182.  
  183.                 ELSE
  184. C                 Teste les POINTEURS
  185.                   N2PTE1=MELVA1.IELCHE(/1)
  186.                   N2E1  =MELVA1.IELCHE(/2)
  187.                   N2PTE2=MELVA2.IELCHE(/1)
  188.                   N2E2  =MELVA2.IELCHE(/2)
  189.                   N2PMAX=MAX(N2PTE1,N2PTE2)
  190.                   N2EMAX=MAX(N2E1  ,N2E2)
  191.                   DO 133 IEL=1,N2EMAX
  192.                     N2EM1=MIN(IEL  ,N2E1)
  193.                     N2EM2=MIN(IEL  ,N2E2)
  194.                     DO 134 IPTEL=1,N2PMAX
  195.                       IP1=MELVA1.IELCHE(MIN(IPTEL,N2PTE1),N2EM1)
  196.                       IP2=MELVA2.IELCHE(MIN(IPTEL,N2PTE2),N2EM2)
  197.                       IF(IP1 .NE. IP2)THEN
  198.                         interr(1)   =IPTEL
  199.                         interr(2)   =IEL
  200.                         moterr(1:4) =NOMCH1(1:4)
  201.                         call erreur(918)
  202.                         return
  203.                       ENDIF
  204.  134                CONTINUE
  205.  133              CONTINUE
  206.                 ENDIF       
  207.               ENDIF              
  208.  130        CONTINUE
  209.  120      CONTINUE
  210.  
  211. C         On positionne les composantes de MCHAML2 NON CORRESPONDANTES a la suite
  212.           N2SUPL=0  
  213.           DO 135 IN22=1,N22
  214.             IF(ICORE2(2,IN22,IN12) .NE. 0) GOTO 135
  215.             N2SUPL=N2SUPL+1
  216.             ICORE2(2,IN22,IN12)=N21+N2SUPL
  217.  135      CONTINUE
  218.           IF(N2SUPL .EQ. 0) THEN
  219.             IZR1(IN11) = mcham1
  220.           ELSE
  221.             IZR1(IN11) =-(N21+N2SUPL)
  222.           ENDIF
  223.  110    CONTINUE
  224.  100  CONTINUE
  225.  
  226. C     On positionne les sous-zones de MCHEL2 NON CORRESPONDANTES a la suite
  227.       N1SUP=0  
  228.       DO 101 IN12=1,N12
  229.         IF(IZR2(2,IN12) .GT. 0) GOTO 101
  230.         N1SUP=N1SUP+1
  231.         IZR2(2,IN12)=-(N11+N1SUP)
  232.  101  CONTINUE
  233.  
  234. C     Creation du resultat
  235.       SOUTY1 = MCHEL1.TITCHE
  236.       L1     = MCHEL1.TITCHE(/1)
  237. *
  238.       CHA8  = SOUTY1(1:8)
  239.       IF (CHA8 .EQ. '        ') THEN
  240.          CHA8 = MCHEL2.TITCHE(1:8)
  241.          IF (CHA8 .NE. '        ') THEN
  242.             SOUTY1 = MCHEL2.TITCHE
  243.             L1     = MCHEL2.TITCHE(/1)
  244.          ENDIF
  245.       ELSE
  246.          SOUTY2=MCHEL2.TITCHE
  247.          IF (SOUTY2 .NE. SOUTY1)  THEN
  248.             CHA8=MCHEL2.TITCHE(1:8)
  249.             IF (CHA8 .NE. '        ') THEN
  250.                SOUTY1=' '
  251.                L1    =1
  252.             ENDIF
  253.          ENDIF
  254.       ENDIF
  255.       L1=MAX(L1,1)
  256.  
  257.       N1=N11+N1SUP
  258.       N31=MCHEL1.INFCHE(/2)
  259.       N32=MCHEL2.INFCHE(/2)
  260.       N3=MAX(N31,N32)
  261.  
  262. C     Regroupement des SEGINI
  263.       CALL oooprl(1)
  264.       SEGINI,MCHELM
  265.       IRECHE=MCHELM
  266.       DO IN11=1,N11
  267.         IZR=IZR1(IN11)
  268.         IF(IZR .LT. 0)THEN
  269.           N2=-IZR
  270.           SEGINI,MCHAML
  271.           IZR1(IN11)=-MCHAML
  272.         ENDIF
  273.       ENDDO
  274.       CALL oooprl(0)
  275.  
  276.       MCHELM.TITCHE=SOUTY1(1:L1)
  277.       MCHELM.IFOCHE=ifour
  278.  
  279. C     On copie les infos de MCHEL1
  280.       DO IN11=1,N11
  281.         MCHELM.CONCHE(IN11)=MCHEL1.CONCHE(IN11)
  282.         MCHELM.IMACHE(IN11)=MCHEL1.IMACHE(IN11)
  283.         IZR=IZR1(IN11)
  284.         IF(IZR .GT. 0)THEN
  285.           MCHELM.ICHAML(IN11)= IZR
  286.  
  287.         ELSE
  288.           MCHAML=-IZR
  289.           MCHELM.ICHAML(IN11)=MCHAML
  290.           MCHAM1=MCHEL1.ichaml(IN11)
  291.           N21=MCHAM1.IELVAL(/1)
  292.           DO IN21=1,N21
  293.             MCHAML.NOMCHE(IN21)=MCHAM1.NOMCHE(IN21)
  294.             MCHAML.TYPCHE(IN21)=MCHAM1.TYPCHE(IN21)
  295.             MCHAML.IELVAL(IN21)=MCHAM1.IELVAL(IN21)
  296.           ENDDO          
  297.         ENDIF
  298.  
  299.         DO IN31=1,N31
  300.           MCHELM.INFCHE(IN11,IN31)=MCHEL1.INFCHE(IN11,IN31)
  301.         ENDDO        
  302.       ENDDO 
  303.  
  304. C     On adjoint les SOUS-ZONES et COMPOSANTES non CORRESPONDANTES de MCHEL2 !
  305.       DO 300 IN12=1,N12
  306.         IZR=IZR2(2,IN12)
  307.         IF(IZR .GT. 0) THEN
  308. C         On adjoint les COMPOSANTES supplementaires des MCHAM2 dans les MCHAML resultat
  309.           MCHAML=MCHELM.ICHAML(IZR)
  310.           MCHAM2=MCHEL2.ichaml(IN12)
  311.           N22=MCHAM2.IELVAL(/1)
  312.           DO IN22=1,N22
  313.             ICR=ICORE2(2,IN22,IN12)
  314.             IF(ICR .NE. 0) THEN
  315.               MCHAML.NOMCHE(ICR)=MCHAM2.NOMCHE(IN22)
  316.               MCHAML.TYPCHE(ICR)=MCHAM2.TYPCHE(IN22)
  317.               MCHAML.IELVAL(ICR)=MCHAM2.IELVAL(IN22)
  318.             ENDIF
  319.           ENDDO        
  320.  
  321.         ELSE
  322. C         On adjoint les SOUS-ZONES non CORRESPONDANTES de MCHEL2
  323.           MIZR=-IZR
  324.           MCHELM.CONCHE(MIZR)=MCHEL2.CONCHE(IN12)
  325.           MCHELM.IMACHE(MIZR)=MCHEL2.IMACHE(IN12)
  326.           MCHELM.ICHAML(MIZR)=MCHEL2.ICHAML(IN12)
  327.           DO IN32=1,N32
  328.             MCHELM.INFCHE(MIZR,IN32)=MCHEL2.INFCHE(IN12,IN32)
  329.           ENDDO
  330.         ENDIF
  331.  300  CONTINUE
  332.  
  333.       SEGSUP,IZR1,IZR2,ICORE2
  334.  
  335.       END
  336.  
  337.  
  338.  
  339.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales