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

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