Télécharger la plaquette Cast3M


fr en

Télécharger masche.eso

Retour à la liste

Numérotation des lignes : 

masche

  1. C MASCHE    SOURCE    PASCAL    22/02/09    21:15:03     11279          
  2.       SUBROUTINE MASCHE(X1,X2,MCH,MOT1,ICLE,IPCHMA,ISOM,IRET)
  3. ***********************************************************************
  4. *            OPERATEUR MASQ (APPELE PAR MASQ)
  5. *
  6. *    ENTREES :
  7. *    ---------
  8. *       X1,X2   :NB AVEC LEQUEL SONT COMPAREES LES VALEURS DU MCHAML
  9. *       MCH     :POINTEUR SUR UN MCHAML AVEC LEQUEL SE COMPARER
  10. *       MOT1    :NOM DE LA COMPOSANTE DONT IL FAUT TESTER L EXISTENCE
  11. *       ICLE    :ENTIER CARACTERISANT LE TYPE DE COMPARAISON
  12. *       ISOM    =1 SI L ON VEUT LA SOMME
  13. *                0 SINON
  14. *
  15. *
  16. *    SORTIES :
  17. *    ---------
  18. *       IPCHMA  :- POINTEUR SUR UN MCHALM RESULTAT SI ISOM=0
  19. *                - SOMME DES 1 ET DES 0 SI OPTION ISOM=1
  20. *       IRET    =1 OU 0 SUIVANT SUCCES OU PAS
  21. *
  22. *
  23. *    PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 01/91
  24. *
  25. ***********************************************************************
  26.       IMPLICIT INTEGER(I-N)
  27.       REAL*8 X1,X2,X3
  28.       CHARACTER*(*) MOT1
  29. *
  30.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC SMCHAML
  34. -INC SMLREEL
  35. -INC SMCOORD
  36. -INC SMELEME
  37. -INC SMINTE
  38. *
  39. C     write(6,*) ' ******** Dans MASCHE'
  40.       IRET=1
  41.       IPCHAM=1
  42.       IF (ISOM.EQ.0) THEN
  43.          MCHEL1 = MCH
  44.          SEGINI,MCHELM=MCHEL1
  45.       ELSE
  46.          MCHELM = MCH
  47.          IPCHMA=0
  48.       ENDIF
  49. *
  50. *==== BOUCLE SUR LES ZONES ===================================
  51.       DO 1 ISOUS=1,ICHAML(/1)
  52.  
  53.          IF (ISOM.EQ.0) THEN
  54.             MCHAM1=ICHAML(ISOUS)
  55.             SEGINI,MCHAML=MCHAM1
  56.             ICHAML(ISOUS)=MCHAML
  57.          ELSE
  58.             MCHAML=ICHAML(ISOUS)
  59.          ENDIF
  60.  
  61. *        ON ENLEVE LES COMPOSANTES DONT L'EXISTENCE NE DOIT PAS ETRE
  62. *        TESTEES
  63.          IF(ICLE.EQ.8) THEN
  64.             NCOMP=IELVAL(/1)
  65.             N2=0
  66.             DO 3 ICOMP=1,NCOMP
  67.                IF(MOT1.NE.'TOUS'.AND.MOT1.NE.NOMCHE(ICOMP)) GOTO 3
  68.                N2=N2+1
  69.                NOMCHE(N2)=NOMCHE(ICOMP)
  70.                TYPCHE(N2)=TYPCHE(ICOMP)
  71.                IELVAL(N2)=IELVAL(ICOMP)
  72.    3        CONTINUE
  73.             SEGADJ,MCHAML
  74.          ENDIF
  75. *
  76.          NCOMP=IELVAL(/1)
  77. *
  78. *   ==== BOUCLE SUR LES COMPOSANTES =====
  79.          DO 30 ICOMP=1,NCOMP
  80.  
  81.             MELVAL=IELVAL(ICOMP)
  82.             IF (TYPCHE(ICOMP).EQ.'REAL*8') THEN
  83.                ICOD=1
  84.             ELSEIF (TYPCHE(ICOMP).EQ.'POINTEURLISTREEL') THEN
  85.                ICOD=2
  86.             ELSEIF (TYPCHE(ICOMP).EQ.'POINTEURPOINT   ') THEN
  87.                ICOD=3
  88.             ELSE
  89.                MOTERR(1:4)=NOMCHE(ICOMP)
  90.                CALL ERREUR(197)
  91.                IRET=0
  92.                IF (ISOM.EQ.0) THEN
  93.                   SEGSUP MCHAML,MCHELM
  94.                ENDIF
  95.                RETURN
  96.             ENDIF
  97. *
  98.             N1PTEL=VELCHE(/1)
  99.             N1EL  =VELCHE(/2)
  100.             N2PTEL=IELCHE(/1)
  101.             N2EL  =IELCHE(/2)
  102. *           cas EXIS : on force a etre REEL
  103.             IF(ICLE.EQ.8) THEN
  104.               TYPCHE(ICOMP)='REAL*8'
  105.               N1PTEL=MAX(N1PTEL,N2PTEL)
  106.               N1EL=MAX(N1EL,N2EL)
  107.               N2PTEL=0
  108.               N2EL=0
  109.             ENDIF
  110. *
  111.             IF (ISOM.EQ.1) GOTO 10
  112. *
  113. *           SOIT ON VEUT UN MASQUE ELEMENT PAR ELEMENT...
  114. *           =============================================
  115.             SEGINI MELVA1
  116.             IELVAL(ICOMP)=MELVA1
  117. *
  118. *       --- MOT-CLE "SUPE" ---
  119.             IF (ICLE.EQ.1) THEN
  120.  
  121. *             -REAL*8
  122.                IF (ICOD.EQ.1) THEN
  123.                   DO 21 J=1,N1EL
  124.                   DO 201 L=1,N1PTEL
  125.                      IF (VELCHE(L,J).GT.X1) MELVA1.VELCHE(L,J)=1.D0
  126.  201              CONTINUE
  127.  21               CONTINUE
  128.  
  129. *             -POINTEURLISTREEL
  130.                ELSEIF (ICOD.EQ.2) THEN
  131.                   DO 22 J=1,N2EL
  132.                   DO 202 L=1,N2PTEL
  133.                      MLREEL=IELCHE(L,J)
  134.                      IF(MLREEL.LE.0) THEN
  135.                        MOTERR(1:8)=NOMCHE(ICOMP)
  136.                        CALL ERREUR(679)
  137.                        RETURN
  138.                      ENDIF
  139.                      JG=PROG(/1)
  140.                      SEGINI MLREE1
  141.                      DO 211 IPROG=1,JG
  142.                         IF (PROG(IPROG).GT.X1) MLREE1.PROG(IPROG)=1.D0
  143.  211                 CONTINUE
  144.                      MELVA1.IELCHE(L,J)=MLREE1
  145.  202              CONTINUE
  146.  22               CONTINUE
  147.  
  148. *             -POINTEURPOINT
  149.                ELSEIF (ICOD.EQ.3) THEN
  150.                   DO 23 J=1,N2EL
  151.                   DO 203 L=1,N2PTEL
  152.                      IP=IELCHE(L,J)
  153.                      IREF=(IP-1)*(IDIM+1)
  154. *                    ON CREE UN NVX POINTS :NOEUD NBNO+1
  155.                      SEGACT MCOORD*mod
  156.                      NBNO=nbpts
  157.                      NBNOI=NBNO
  158.                      NBPTS=NBNO+1
  159.                      SEGADJ MCOORD
  160.                      DO 231 IC=1,IDIM
  161.                         IF (XCOOR(IREF+IC).GT.X1) THEN
  162.                            XCOOR(NBNOI*(IDIM+1)+IC)=1.D0
  163.                         ELSE
  164.                            XCOOR(NBNOI*(IDIM+1)+IC)=0.D0
  165.                         ENDIF
  166.  231                 CONTINUE
  167.                      XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=XCOOR(IREF+(IDIM+1))
  168.                      IELCHE(L,J)=NBPTS
  169.  203              CONTINUE
  170.  23               CONTINUE
  171.                ENDIF
  172. *
  173. *       --- MOT-CLE "EGSU" ---
  174.             ELSEIF (ICLE.EQ.2) THEN
  175.  
  176.                IF (ICOD.EQ.1) THEN
  177.                   DO 31 J=1,N1EL
  178.                   DO 301 L=1,N1PTEL
  179.                      IF (VELCHE(L,J).GE.X1) MELVA1.VELCHE(L,J)=1.D0
  180.  301              CONTINUE
  181.  31               CONTINUE
  182.  
  183.                ELSEIF (ICOD.EQ.2) THEN
  184.                   DO 32 J=1,N2EL
  185.                   DO 302 L=1,N2PTEL
  186.                      MLREEL=IELCHE(L,J)
  187.                      IF(MLREEL.LE.0) THEN
  188.                        MOTERR(1:8)=NOMCHE(ICOMP)
  189.                        CALL ERREUR(679)
  190.                        RETURN
  191.                      ENDIF
  192.                      JG=PROG(/1)
  193.                      SEGINI MLREE1
  194.                      DO 311 IPROG=1,JG
  195.                         IF (PROG(IPROG).GE.X1) MLREE1.PROG(IPROG)=1.D0
  196.  311                 CONTINUE
  197.                      MELVA1.IELCHE(L,J)=MLREE1
  198.  302              CONTINUE
  199.  32               CONTINUE
  200.  
  201.                ELSEIF (ICOD.EQ.3) THEN
  202.                   DO 33 J=1,N2EL
  203.                   DO 303 L=1,N2PTEL
  204.                      IP=IELCHE(L,J)
  205.                      IREF=(IP-1)*(IDIM+1)
  206. *                    ON CREE UN NVX POINTS :NOEUD NBNO+1
  207.                      SEGACT MCOORD*mod
  208.                      NBNO=nbpts
  209.                      NBNOI=NBNO
  210.                      NBPTS=NBNO+1
  211.                      SEGADJ MCOORD
  212.                      DO 331 IC=1,IDIM
  213.                         IF (XCOOR(IREF+IC).GE.X1) THEN
  214.                            XCOOR(NBNOI*(IDIM+1)+IC)=1.D0
  215.                         ELSE
  216.                            XCOOR(NBNOI*(IDIM+1)+IC)=0.D0
  217.                         ENDIF
  218.  331                 CONTINUE
  219.                      XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=XCOOR(IREF+(IDIM+1))
  220.                      IELCHE(L,J)=NBPTS
  221.  303              CONTINUE
  222.  33               CONTINUE
  223.                ENDIF
  224. *
  225. *       --- MOT-CLE "EGAL" ---
  226.             ELSEIF (ICLE.EQ.3) THEN
  227.  
  228.                IF (ICOD.EQ.1) THEN
  229.                   DO 41 J=1,N1EL
  230.                   DO 401 L=1,N1PTEL
  231.                      IF (VELCHE(L,J).EQ.X1) MELVA1.VELCHE(L,J)=1.D0
  232.  401              CONTINUE
  233.  41               CONTINUE
  234.  
  235.                ELSEIF (ICOD.EQ.2) THEN
  236.                   DO 42 J=1,N2EL
  237.                   DO 402 L=1,N2PTEL
  238.                      MLREEL=IELCHE(L,J)
  239.                      IF(MLREEL.LE.0) THEN
  240.                        MOTERR(1:8)=NOMCHE(ICOMP)
  241.                        CALL ERREUR(679)
  242.                        RETURN
  243.                      ENDIF
  244.                      JG=PROG(/1)
  245.                      SEGINI MLREE1
  246.                      DO 411 IPROG=1,JG
  247.                         IF (PROG(IPROG).EQ.X1) MLREE1.PROG(IPROG)=1.D0
  248.  411                 CONTINUE
  249.                      MELVA1.IELCHE(L,J)=MLREE1
  250.  402              CONTINUE
  251.  42               CONTINUE
  252.  
  253.                ELSEIF (ICOD.EQ.3) THEN
  254.                   DO 43 J=1,N2EL
  255.                   DO 403 L=1,N2PTEL
  256.                      IP=IELCHE(L,J)
  257.                      IREF=(IP-1)*(IDIM+1)
  258. *                    ON CREE UN NVX POINTS :NOEUD NBNO+1
  259.                      SEGACT MCOORD*mod
  260.                      NBNO=nbpts
  261.                      NBNOI=NBNO
  262.                      NBPTS=NBNO+1
  263.                      SEGADJ MCOORD
  264.                      DO 431 IC=1,IDIM
  265.                         IF (XCOOR(IREF+IC).EQ.X1) THEN
  266.                            XCOOR(NBNOI*(IDIM+1)+IC)=1.D0
  267.                         ELSE
  268.                            XCOOR(NBNOI*(IDIM+1)+IC)=0.D0
  269.                         ENDIF
  270.  431                 CONTINUE
  271.                      XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=XCOOR(IREF+(IDIM+1))
  272.                      IELCHE(L,J)=NBPTS
  273.  403              CONTINUE
  274.  43               CONTINUE
  275.                ENDIF
  276. *
  277. *       --- MOT-CLE "EGIN" ---
  278.             ELSEIF (ICLE.EQ.4) THEN
  279.  
  280.                IF (ICOD.EQ.1) THEN
  281.                   DO 51 J=1,N1EL
  282.                   DO 501 L=1,N1PTEL
  283.                      IF (VELCHE(L,J).LE.X1) MELVA1.VELCHE(L,J)=1.D0
  284.  501              CONTINUE
  285.  51               CONTINUE
  286.  
  287.                ELSEIF (ICOD.EQ.2) THEN
  288.                   DO 52 J=1,N2EL
  289.                   DO 502 L=1,N2PTEL
  290.                      MLREEL=IELCHE(L,J)
  291.                      IF(MLREEL.LE.0) THEN
  292.                        MOTERR(1:8)=NOMCHE(ICOMP)
  293.                        CALL ERREUR(679)
  294.                        RETURN
  295.                      ENDIF
  296.                      JG=PROG(/1)
  297.                      SEGINI MLREE1
  298.                      DO 511 IPROG=1,JG
  299.                         IF (PROG(IPROG).LE.X1) MLREE1.PROG(IPROG)=1.D0
  300.  511                 CONTINUE
  301.                      MELVA1.IELCHE(L,J)=MLREE1
  302.  502              CONTINUE
  303.  52               CONTINUE
  304.  
  305.                ELSEIF (ICOD.EQ.3) THEN
  306.                   DO 53 J=1,N2EL
  307.                   DO 503 L=1,N2PTEL
  308.                      IP=IELCHE(L,J)
  309.                      IREF=(IP-1)*(IDIM+1)
  310. *                    ON CREE UN NVX POINTS :NOEUD NBNO+1
  311.                      SEGACT MCOORD*mod
  312.                      NBNO=nbpts
  313.                      NBNOI=NBNO
  314.                      NBPTS=NBNO+1
  315.                      SEGADJ MCOORD
  316.                      DO 531 IC=1,IDIM
  317.                         IF (XCOOR(IREF+IC).LE.X1) THEN
  318.                            XCOOR(NBNOI*(IDIM+1)+IC)=1.D0
  319.                         ELSE
  320.                            XCOOR(NBNOI*(IDIM+1)+IC)=0.D0
  321.                         ENDIF
  322.  531                 CONTINUE
  323.                      XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=XCOOR(IREF+(IDIM+1))
  324.                      IELCHE(L,J)=NBPTS
  325.  503              CONTINUE
  326.  53               CONTINUE
  327.                ENDIF
  328. *
  329. *       --- MOT-CLE "INFE" ---
  330.             ELSEIF (ICLE.EQ.5) THEN
  331.  
  332.                IF (ICOD.EQ.1) THEN
  333.                   DO 61 J=1,N1EL
  334.                   DO 601 L=1,N1PTEL
  335.                      IF (VELCHE(L,J).LT.X1) MELVA1.VELCHE(L,J)=1.D0
  336.  601              CONTINUE
  337.  61               CONTINUE
  338.  
  339.                ELSEIF (ICOD.EQ.2) THEN
  340.                   DO 62 J=1,N2EL
  341.                   DO 602 L=1,N2PTEL
  342.                      MLREEL=IELCHE(L,J)
  343.                      IF(MLREEL.LE.0) THEN
  344.                        MOTERR(1:8)=NOMCHE(ICOMP)
  345.                        CALL ERREUR(679)
  346.                        RETURN
  347.                      ENDIF
  348.                      JG=PROG(/1)
  349.                      SEGINI MLREE1
  350.                      DO 611 IPROG=1,JG
  351.                         IF (PROG(IPROG).LT.X1) MLREE1.PROG(IPROG)=1.D0
  352.  611                 CONTINUE
  353.                      MELVA1.IELCHE(L,J)=MLREE1
  354.  602              CONTINUE
  355.  62               CONTINUE
  356.  
  357.                ELSEIF (ICOD.EQ.3) THEN
  358.                   DO 63 J=1,N2EL
  359.                   DO 603 L=1,N2PTEL
  360.                      IP=IELCHE(L,J)
  361.                      IREF=(IP-1)*(IDIM+1)
  362. *                    ON CREE UN NVX POINTS :NOEUD NBNO+1
  363.                      SEGACT MCOORD*mod
  364.                      NBNO=nbpts
  365.                      NBNOI=NBNO
  366.                      NBPTS=NBNO+1
  367.                      SEGADJ MCOORD
  368.                      DO 631 IC=1,IDIM
  369.                         IF (XCOOR(IREF+IC).LT.X1) THEN
  370.                            XCOOR(NBNOI*(IDIM+1)+IC)=1.D0
  371.                         ELSE
  372.                            XCOOR(NBNOI*(IDIM+1)+IC)=0.D0
  373.                         ENDIF
  374.  631                 CONTINUE
  375.                      XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=XCOOR(IREF+(IDIM+1))
  376.                      IELCHE(L,J)=NBPTS
  377.  603              CONTINUE
  378.  63               CONTINUE
  379.                ENDIF
  380. *
  381. *       --- MOT-CLE "DIFF" ---
  382.             ELSEIF (ICLE.EQ.6) THEN
  383.  
  384.                IF (ICOD.EQ.1) THEN
  385.                   DO 71 J=1,N1EL
  386.                   DO 701 L=1,N1PTEL
  387.                      IF (VELCHE(L,J).NE.X1) MELVA1.VELCHE(L,J)=1.D0
  388.  701              CONTINUE
  389.  71               CONTINUE
  390.  
  391.                ELSEIF (ICOD.EQ.2) THEN
  392.                   DO 72 J=1,N2EL
  393.                   DO 702 L=1,N2PTEL
  394.                      MLREEL=IELCHE(L,J)
  395.                      IF(MLREEL.LE.0) THEN
  396.                        MOTERR(1:8)=NOMCHE(ICOMP)
  397.                        CALL ERREUR(679)
  398.                        RETURN
  399.                      ENDIF
  400.                      JG=PROG(/1)
  401.                      SEGINI MLREE1
  402.                      DO 711 IPROG=1,JG
  403.                         IF (PROG(IPROG).NE.X1) MLREE1.PROG(IPROG)=1.D0
  404.  711                 CONTINUE
  405.                      MELVA1.IELCHE(L,J)=MLREE1
  406.  702              CONTINUE
  407.  72               CONTINUE
  408.  
  409.                ELSEIF (ICOD.EQ.3) THEN
  410.                   DO 73 J=1,N2EL
  411.                   DO 703 L=1,N2PTEL
  412.                      IP=IELCHE(L,J)
  413.                      IREF=(IP-1)*(IDIM+1)
  414. *                    ON CREE UN NVX POINTS :NOEUD NBNO+1
  415.                      SEGACT MCOORD*mod
  416.                      NBNO=nbpts
  417.                      NBNOI=NBNO
  418.                      NBPTS=NBNO+1
  419.                      SEGADJ MCOORD
  420.                      DO 731 IC=1,IDIM
  421.                         IF (XCOOR(IREF+IC).NE.X1) THEN
  422.                            XCOOR(NBNOI*(IDIM+1)+IC)=1.D0
  423.                         ELSE
  424.                            XCOOR(NBNOI*(IDIM+1)+IC)=0.D0
  425.                         ENDIF
  426.  731                 CONTINUE
  427.                      XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=XCOOR(IREF+(IDIM+1))
  428.                      IELCHE(L,J)=NBPTS
  429.  703              CONTINUE
  430.  73               CONTINUE
  431.                ENDIF
  432. *
  433. *       --- MOT-CLE "COMP" ---
  434.             ELSEIF (ICLE.EQ.7) THEN
  435.  
  436.                IF (ICOD.EQ.1) THEN
  437.                   DO 81 J=1,N1EL
  438.                   DO 801 L=1,N1PTEL
  439.                      IF (VELCHE(L,J).GE.X1.AND.VELCHE(L,J).LE.X2)
  440.      &                  MELVA1.VELCHE(L,J)=1.D0
  441.  801              CONTINUE
  442.  81               CONTINUE
  443.  
  444.                ELSEIF (ICOD.EQ.2) THEN
  445.                   DO 82 J=1,N2EL
  446.                   DO 802 L=1,N2PTEL
  447.                      MLREEL=IELCHE(L,J)
  448.                      IF(MLREEL.LE.0) THEN
  449.                        MOTERR(1:8)=NOMCHE(ICOMP)
  450.                        CALL ERREUR(679)
  451.                        RETURN
  452.                      ENDIF
  453.                      JG=PROG(/1)
  454.                      SEGINI MLREE1
  455.                      DO 811 IPROG=1,JG
  456.                         IF (PROG(IPROG).GE.X1.AND.PROG(IPROG).LE.X2)
  457.      &                     MLREE1.PROG(IPROG)=1.D0
  458.  811                 CONTINUE
  459.                      MELVA1.IELCHE(L,J)=MLREE1
  460.  802              CONTINUE
  461.  82               CONTINUE
  462.  
  463.                ELSEIF (ICOD.EQ.3) THEN
  464.                   DO 83 J=1,N2EL
  465.                   DO 803 L=1,N2PTEL
  466.                      IP=IELCHE(L,J)
  467.                      IREF=(IP-1)*(IDIM+1)
  468. *                    ON CREE UN NVX POINTS :NOEUD NBNO+1
  469.                      SEGACT MCOORD*mod
  470.                      NBNO=nbpts
  471.                      NBNOI=NBNO
  472.                      NBPTS=NBNO+1
  473.                      SEGADJ MCOORD
  474.                      DO 831 IC=1,IDIM
  475.                         X3=XCOOR(IREF+IC)
  476.                         IF (X3.GE.X1.AND.X3.LE.X2) THEN
  477.                            XCOOR(NBNOI*(IDIM+1)+IC)=1.D0
  478.                         ELSE
  479.                            XCOOR(NBNOI*(IDIM+1)+IC)=0.D0
  480.                         ENDIF
  481.  831                 CONTINUE
  482.                      XCOOR(NBNOI*(IDIM+1)+(IDIM+1))=XCOOR(IREF+(IDIM+1))
  483.                      IELCHE(L,J)=NBPTS
  484.  803              CONTINUE
  485.  83               CONTINUE
  486.                ENDIF
  487. *
  488. *       --- MOT-CLE "EXIS" ---
  489.             ELSEIF (ICLE.EQ.8) THEN
  490.  
  491. *             -REAL*8
  492.                IF (ICOD.EQ.1) THEN
  493.                   DO 91 J=1,N1EL
  494.                   DO 901 L=1,N1PTEL
  495.                      MELVA1.VELCHE(L,J)=1.D0
  496.  901              CONTINUE
  497.  91               CONTINUE
  498.  
  499. *             -POINTEURLISTREEL
  500.                ELSEIF (ICOD.EQ.2) THEN
  501.                   DO 92 J=1,N1EL
  502.                   DO 902 L=1,N1PTEL
  503.                      MLREEL=IELCHE(L,J)
  504.                      IF(MLREEL.GT.0) MELVA1.VELCHE(L,J)=1.D0
  505.  902              CONTINUE
  506.  92               CONTINUE
  507.  
  508. *             -POINTEURPOINT
  509.                ELSEIF (ICOD.EQ.3) THEN
  510.                   DO 93 J=1,N1EL
  511.                   DO 903 L=1,N1PTEL
  512.                      IP=IELCHE(L,J)
  513.                      IF(IP.GT.0) MELVA1.VELCHE(L,J)=1.D0
  514.  903              CONTINUE
  515.  93               CONTINUE
  516.                ENDIF
  517. *
  518.             ENDIF
  519.             GO TO 20
  520. *
  521. *           SOIT ON CHERCHE SEULEMENT LA SOMME...
  522. *           =====================================
  523.  10         CONTINUE
  524.             meleme = imache(isous)
  525.             nnel = num(/2)
  526.             if (infche(isous,4).eq.0) then
  527.               nnptel = num(/1)
  528.             else
  529.               minte = infche(isous,4)
  530.               nnptel = qsigau(/1)
  531.             endif
  532.             NSOM1 = 0
  533. *
  534. *       --- MOT-CLE "SUPE"
  535.             IF (ICLE.EQ.1) THEN
  536.  
  537.                IF (ICOD.EQ.1) THEN
  538.                   DO 121 J=1,N1EL
  539.                      DO 1201 L=1,N1PTEL
  540.                         IF (VELCHE(L,J).GT.X1) NSOM1=NSOM1+1
  541.  1201             CONTINUE
  542.  121              CONTINUE
  543.  
  544.                ELSEIF (ICOD.EQ.2) THEN
  545.                   DO 122 J=1,N2EL
  546.                      DO 1202 L=1,N2PTEL
  547.                         MLREEL=IELCHE(L,J)
  548.                         JG=PROG(/1)
  549.                         DO 1122 IPROG=1,JG
  550.                           IF (PROG(IPROG).GT.X1) NSOM1=IPCHAM+1
  551.  1122                   CONTINUE
  552.  1202             CONTINUE
  553.  122              CONTINUE
  554.  
  555.                ELSEIF (ICOD.EQ.3) THEN
  556.                   DO 123 J=1,N2EL
  557.                      DO 1203 L=1,N2PTEL
  558.                         IP=IELCHE(L,J)
  559.                         IREF=(IP-1)*(IDIM+1)
  560.                         DO 1123 IC=1,IDIM
  561.                            IF (XCOOR(IREF+IC).GT.X1) NSOM1=IPCHAM+1
  562.  1123                   CONTINUE
  563.  1203             CONTINUE
  564.  123              CONTINUE
  565.                ENDIF
  566. *
  567. *       --- MOT-CLE "EGSU"
  568.             ELSEIF (ICLE.EQ.2) THEN
  569.  
  570.                IF (ICOD.EQ.1) THEN
  571.                   DO 131 J=1,N1EL
  572.                      DO 1301 L=1,N1PTEL
  573.                         IF (VELCHE(L,J).GE.X1) NSOM1=NSOM1+1
  574.  1301             CONTINUE
  575.  131              CONTINUE
  576.  
  577.                ELSEIF (ICOD.EQ.2) THEN
  578.                   DO 132 J=1,N2EL
  579.                      DO 1302 L=1,N2PTEL
  580.                         MLREEL=IELCHE(L,J)
  581.                         JG=PROG(/1)
  582.                         DO 1132 IPROG=1,JG
  583.                           IF (PROG(IPROG).GE.X1) NSOM1=NSOM1+1
  584.  1132                   CONTINUE
  585.  1302             CONTINUE
  586.  132              CONTINUE
  587.  
  588.                ELSEIF (ICOD.EQ.3) THEN
  589.                   DO 133 J=1,N2EL
  590.                      DO 1303 L=1,N2PTEL
  591.                         IP=IELCHE(L,J)
  592.                         IREF=(IP-1)*(IDIM+1)
  593.                         DO 1133 IC=1,IDIM
  594.                            IF (XCOOR(IREF+IC).GE.X1) NSOM1=NSOM1+1
  595.  1133                   CONTINUE
  596.  1303             CONTINUE
  597.  133              CONTINUE
  598.                ENDIF
  599. *
  600. *       --- MOT-CLE "EGAL"
  601.             ELSEIF (ICLE.EQ.3) THEN
  602.  
  603.                IF (ICOD.EQ.1) THEN
  604.                   DO 141 J=1,N1EL
  605.                      DO 1401 L=1,N1PTEL
  606.                         IF (VELCHE(L,J).EQ.X1) NSOM1=NSOM1+1
  607.  1401             CONTINUE
  608.  141              CONTINUE
  609.  
  610.                ELSEIF (ICOD.EQ.2) THEN
  611.                   DO 142 J=1,N2EL
  612.                      DO 1402 L=1,N2PTEL
  613.                         MLREEL=IELCHE(L,J)
  614.                         JG=PROG(/1)
  615.                         DO 1142 IPROG=1,JG
  616.                           IF (PROG(IPROG).EQ.X1) NSOM1=NSOM1+1
  617.  1142                   CONTINUE
  618.  1402             CONTINUE
  619.  142              CONTINUE
  620.  
  621.                ELSEIF (ICOD.EQ.3) THEN
  622.                   DO 143 J=1,N2EL
  623.                      DO 1403 L=1,N2PTEL
  624.                         IP=IELCHE(L,J)
  625.                         IREF=(IP-1)*(IDIM+1)
  626.                         DO 1143 IC=1,IDIM
  627.                            IF (XCOOR(IREF+IC).EQ.X1) NSOM1=NSOM1+1
  628.  1143                   CONTINUE
  629.  1403             CONTINUE
  630.  143              CONTINUE
  631.                ENDIF
  632. *
  633. *       --- MOT-CLE "EGIN"
  634.             ELSEIF (ICLE.EQ.4) THEN
  635.  
  636.                IF (ICOD.EQ.1) THEN
  637.                   DO 151 J=1,N1EL
  638.                      DO 1501 L=1,N1PTEL
  639.                         IF (VELCHE(L,J).LE.X1) NSOM1=NSOM1+1
  640.  1501             CONTINUE
  641.  151              CONTINUE
  642.  
  643.                ELSEIF (ICOD.EQ.2) THEN
  644.                   DO 152 J=1,N2EL
  645.                      DO 1502 L=1,N2PTEL
  646.                         MLREEL=IELCHE(L,J)
  647.                         JG=PROG(/1)
  648.                         DO 1152 IPROG=1,JG
  649.                           IF (PROG(IPROG).LE.X1) NSOM1=NSOM1+1
  650.  1152                   CONTINUE
  651.  1502             CONTINUE
  652.  152              CONTINUE
  653.  
  654.                ELSEIF (ICOD.EQ.3) THEN
  655.                   DO 153 J=1,N2EL
  656.                      DO 1503 L=1,N2PTEL
  657.                         IP=IELCHE(L,J)
  658.                         IREF=(IP-1)*(IDIM+1)
  659.                         DO 1153 IC=1,IDIM
  660.                            IF (XCOOR(IREF+IC).LE.X1) NSOM1=NSOM1+1
  661.  1153                   CONTINUE
  662.  1503             CONTINUE
  663.  153              CONTINUE
  664.                ENDIF
  665. *
  666. *       --- MOT-CLE "INFE"
  667.             ELSEIF (ICLE.EQ.5) THEN
  668.  
  669.                IF (ICOD.EQ.1) THEN
  670.                   DO 161 J=1,N1EL
  671.                      DO 1601 L=1,N1PTEL
  672.                         IF (VELCHE(L,J).LT.X1) NSOM1=NSOM1+1
  673.  1601             CONTINUE
  674.  161              CONTINUE
  675.  
  676.                ELSEIF (ICOD.EQ.2) THEN
  677.                   DO 162 J=1,N2EL
  678.                      DO 1602 L=1,N2PTEL
  679.                         MLREEL=IELCHE(L,J)
  680.                         JG=PROG(/1)
  681.                         DO 1162 IPROG=1,JG
  682.                           IF (PROG(IPROG).LT.X1) NSOM1=NSOM1+1
  683.  1162                   CONTINUE
  684.  1602             CONTINUE
  685.  162              CONTINUE
  686.  
  687.                ELSEIF (ICOD.EQ.3) THEN
  688.                   DO 163 J=1,N2EL
  689.                      DO 1603 L=1,N2PTEL
  690.                         IP=IELCHE(L,J)
  691.                         IREF=(IP-1)*(IDIM+1)
  692.                         DO 1163 IC=1,IDIM
  693.                            IF (XCOOR(IREF+IC).LT.X1) NSOM1=NSOM1+1
  694.  1163                   CONTINUE
  695.  1603             CONTINUE
  696.  163              CONTINUE
  697.                ENDIF
  698. *
  699. *       --- MOT-CLE "DIFF"
  700.             ELSEIF (ICLE.EQ.6) THEN
  701.  
  702.                IF (ICOD.EQ.1) THEN
  703.                   DO 171 J=1,N1EL
  704.                      DO 1701 L=1,N1PTEL
  705.                         IF (VELCHE(L,J).NE.X1) NSOM1=NSOM1+1
  706.  1701             CONTINUE
  707.  171              CONTINUE
  708.  
  709.                ELSEIF (ICOD.EQ.2) THEN
  710.                   DO 172 J=1,N2EL
  711.                      DO 1702 L=1,N2PTEL
  712.                         MLREEL=IELCHE(L,J)
  713.                         JG=PROG(/1)
  714.                         DO 1172 IPROG=1,JG
  715.                           IF (PROG(IPROG).NE.X1) NSOM1=NSOM1+1
  716.  1172                   CONTINUE
  717.  1702             CONTINUE
  718.  172              CONTINUE
  719.  
  720.                ELSEIF (ICOD.EQ.3) THEN
  721.                   DO 173 J=1,N2EL
  722.                      DO 1703 L=1,N2PTEL
  723.                         IP=IELCHE(L,J)
  724.                         IREF=(IP-1)*(IDIM+1)
  725.                         DO 1173 IC=1,IDIM
  726.                            IF (XCOOR(IREF+IC).NE.X1) NSOM1=NSOM1+1
  727.  1173                   CONTINUE
  728.  1703             CONTINUE
  729.  173              CONTINUE
  730.                ENDIF
  731. *
  732. *       --- MOT-CLE "COMP"
  733.             ELSEIF (ICLE.EQ.7) THEN
  734.  
  735.                IF (ICOD.EQ.1) THEN
  736.                   DO 181 J=1,N1EL
  737.                      DO 1801 L=1,N1PTEL
  738.                         IF (VELCHE(L,J).GE.X1.AND.VELCHE(L,J).LE.X2)
  739.      &                     NSOM1=NSOM1+1
  740.  1801             CONTINUE
  741.  181              CONTINUE
  742.  
  743.                ELSEIF (ICOD.EQ.2) THEN
  744.                   DO 182 J=1,N2EL
  745.                      DO 1802 L=1,N2PTEL
  746.                         MLREEL=IELCHE(L,J)
  747.                         JG=PROG(/1)
  748.                         DO 1182 IPROG=1,JG
  749.                            IF (PROG(IPROG).GE.X1.AND.PROG(IPROG).LE.X2)
  750.      &                        NSOM1=NSOM1+1
  751.  1182                   CONTINUE
  752.  1802             CONTINUE
  753.  182              CONTINUE
  754.  
  755.                ELSEIF (ICOD.EQ.3) THEN
  756.                   DO 183 J=1,N2EL
  757.                      DO 1803 L=1,N2PTEL
  758.                         IP=IELCHE(L,J)
  759.                         IREF=(IP-1)*(IDIM+1)
  760.                         DO 1183 IC=1,IDIM
  761.                            X3=XCOOR(IREF+IC)
  762.                            IF (X3.GE.X1.OR.X3.LE.X2) NSOM1=NSOM1+1
  763.  1183                   CONTINUE
  764.  1803             CONTINUE
  765.  183              CONTINUE
  766.                ENDIF
  767. *
  768. *       --- MOT-CLE "EXIS" : INCOMPATIBLE AVEC SOMM!!! ---
  769.             ELSEIF (ICLE.EQ.8) THEN
  770.                CALL ERREUR(34)
  771.                RETURN
  772.  
  773.             ENDIF
  774. * cas des champs constants par element ou maillage elementaire
  775. C       write(6,*) ' icod,n1ptel,nnptel,n1el,nnel',
  776. C    &               icod,n1ptel,nnptel,n1el,nnel
  777.             if (icod.eq.1) then
  778.              if(n1ptel.lt.nnptel) NSOM1 = NSOM1 * nnptel
  779.              if(n1el.lt.nnel) NSOM1 = NSOM1 * nnel
  780.             else
  781.              if(n2ptel.lt.nnptel) NSOM1 = NSOM1 * nnptel
  782.              if(n2el.lt.nnel) NSOM1 = NSOM1 * nnel
  783.             endif
  784.  
  785. C           Somme globale :
  786. C       write(6,*) ' nsom1=',NSOM1
  787.             IPCHMA = IPCHMA + NSOM1
  788.  
  789.   20        CONTINUE
  790.  
  791.   30     CONTINUE
  792. *   ==== FIN DE BOUCLE SUR LES COMPOSANTES =====
  793.  
  794.  
  795.    1  CONTINUE
  796. *==== FIN DE BOUCLE SUR LES ZONES ===================================
  797. *
  798.       IF (ISOM.EQ.0) THEN
  799.          IPCHMA=MCHELM
  800.       ENDIF
  801.       END
  802.  
  803.  
  804.  
  805.  
  806.  
  807.  
  808.  
  809.  

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