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

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