Télécharger la plaquette Cast3M


fr en

Télécharger maschp.eso

Retour à la liste

Numérotation des lignes : 

maschp

  1. C MASCHP    SOURCE    CB215821  26/08/24    21:17:16     12622          
  2.       SUBROUTINE MASCHP(X1,X2,IPCH,ICLE,IRET,ISOM)
  3. *
  4. *  sous routine pour l'opérateur masque: chpo et reel en argument
  5. *
  6. *  ipch pointeur sur le champ par point argument
  7. *  isom doit on sommer les 0 et les 1
  8. *  icle type de comparaison
  9. *  x1,x2 valeur(s) à comparer
  10. *  iret pointeur sur le nouveau chpo ou valeur de la somme
  11. *
  12.       IMPLICIT INTEGER(I-N)
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. -INC SMCHPOI
  17. -INC SMELEME
  18.       REAL*8 X1,X2
  19. *
  20.       MCHPOI=IPCH
  21.       IRET=0
  22.       IF (ISOM.EQ.0) THEN
  23.          SEGINI,MCHPO1=MCHPOI
  24.       ENDIF
  25.       DO 1 I=1,IPCHP(/1)
  26.          MSOUPO=IPCHP(I)
  27.          IF (ISOM.EQ.0) THEN
  28.             SEGINI,MSOUP1=MSOUPO
  29.             MCHPO1.IPCHP(I)=MSOUP1
  30.             MSOUP1.IGEOC=IGEOC
  31.          ENDIF
  32.          MPOVAL=IPOVAL
  33.          N= VPOCHA(/1)
  34.          NC=VPOCHA(/2)
  35.          IF (ISOM.EQ.1) GOTO 10
  36. *
  37. *        SOIT ON VEUT UN MASQUE POINT PAR POINT...
  38. *        =========================================
  39.          SEGINI MPOVA1
  40.          MSOUP1.IPOVAL=MPOVA1
  41. *
  42. *        MOT-CLE "SUPE"
  43.          IF (ICLE.EQ.1) THEN
  44.             DO 21 K=1,NC
  45.             DO 2 L=1,N
  46.                IF (VPOCHA(L,K).GT.X1) MPOVA1.VPOCHA(L,K)=1.D0
  47.    2        CONTINUE
  48.    21       CONTINUE
  49. *
  50. *        MOT-CLE "EGSU"
  51.          ELSEIF (ICLE.EQ.2) THEN
  52.             DO 22 K=1,NC
  53.             DO 3 L=1,N
  54.                IF (VPOCHA(L,K).GE.X1) MPOVA1.VPOCHA(L,K)=1.D0
  55.    3        CONTINUE
  56.    22       CONTINUE
  57. *
  58. *        MOT-CLE "EGAL"
  59.          ELSEIF (ICLE.EQ.3) THEN
  60.             DO 23 K=1,NC
  61.             DO 4 L=1,N
  62.                IF (VPOCHA(L,K).EQ.X1) MPOVA1.VPOCHA(L,K)=1.D0
  63.    4        CONTINUE
  64.    23       CONTINUE
  65. *
  66. *        MOT-CLE "EGIN"
  67.          ELSEIF (ICLE.EQ.4) THEN
  68.             DO 24 K=1,NC
  69.             DO 5 L=1,N
  70.                IF (VPOCHA(L,K).LE.X1) MPOVA1.VPOCHA(L,K)=1.D0
  71.    5        CONTINUE
  72.    24       CONTINUE
  73. *
  74. *        MOT-CLE "INFE"
  75.          ELSEIF (ICLE.EQ.5) THEN
  76.             DO 25 K=1,NC
  77.             DO 6 L=1,N
  78.                IF (VPOCHA(L,K).LT.X1) MPOVA1.VPOCHA(L,K)=1.D0
  79.    6        CONTINUE
  80.    25       CONTINUE
  81. *
  82. *        MOT-CLE "DIFF"
  83.          ELSEIF (ICLE.EQ.6) THEN
  84.             DO 26 K=1,NC
  85.             DO 7 L=1,N
  86.                IF (VPOCHA(L,K).NE.X1) MPOVA1.VPOCHA(L,K)=1.D0
  87.    7        CONTINUE
  88.    26       CONTINUE
  89. *
  90. *        MOT-CLE "COMP"
  91.          ELSEIF (ICLE.EQ.7) THEN
  92.             DO 27 K=1,NC
  93.             DO 8 L=1,N
  94.                IF (VPOCHA(L,K).GE.X1.AND.VPOCHA(L,K).LE.X2)
  95.      &            MPOVA1.VPOCHA(L,K)=1.D0
  96.    8        CONTINUE
  97.    27       CONTINUE
  98.          ENDIF
  99.          GOTO 20
  100. *
  101. *        SOIT ON CHERCHE SEULEMENT LA SOMME...
  102. *        =====================================
  103.   10     CONTINUE
  104. *
  105. *        MOT-CLE "SUPE"
  106.          IF (ICLE.EQ.1) THEN
  107.             DO 28 K=1,NC
  108.             DO 12 L=1,N
  109.                IF (VPOCHA(L,K).GT.X1) IRET=IRET+1
  110.   12        CONTINUE
  111.    28       CONTINUE
  112. *
  113. *        MOT-CLE "EGSU"
  114.          ELSEIF (ICLE.EQ.2) THEN
  115.             DO 29 K=1,NC
  116.             DO 13 L=1,N
  117.                IF (VPOCHA(L,K).GE.X1) IRET=IRET+1
  118.   13        CONTINUE
  119.    29       CONTINUE
  120. *
  121. *        MOT-CLE "EGAL"
  122.          ELSEIF (ICLE.EQ.3) THEN
  123.             DO 30 K=1,NC
  124.             DO 14 L=1,N
  125.                IF (VPOCHA(L,K).EQ.X1) IRET=IRET+1
  126.   14        CONTINUE
  127.    30       CONTINUE
  128. *
  129. *        MOT-CLE "EGIN"
  130.          ELSEIF (ICLE.EQ.4) THEN
  131.             DO 31 K=1,NC
  132.             DO 15 L=1,N
  133.                IF (VPOCHA(L,K).LE.X1) IRET=IRET+1
  134.   15        CONTINUE
  135.    31       CONTINUE
  136. *
  137. *        MOT-CLE "INFE"
  138.          ELSEIF (ICLE.EQ.5) THEN
  139.             DO 32 K=1,NC
  140.             DO 16 L=1,N
  141.                IF (VPOCHA(L,K).LT.X1) IRET =IRET+1
  142.   16        CONTINUE
  143.    32       CONTINUE
  144. *
  145. *        MOT-CLE "DIFF"
  146.          ELSEIF (ICLE.EQ.6) THEN
  147.             DO 33 K=1,NC
  148.             DO 17 L=1,N
  149.                IF (VPOCHA(L,K).NE.X1) IRET=IRET+1
  150.   17        CONTINUE
  151.    33       CONTINUE
  152. *
  153. *        MOT-CLE "COMP"
  154.          ELSEIF (ICLE.EQ.7) THEN
  155.             DO 34 K=1,NC
  156.             DO 18 L=1,N
  157.                IF (VPOCHA(L,K).GE.X1.AND.VPOCHA(L,K).LE.X2) IRET=IRET+1
  158.   18        CONTINUE
  159.    34       CONTINUE
  160.          ENDIF
  161.  
  162.   20     CONTINUE
  163.   1   CONTINUE
  164.       IF (ISOM.EQ.0) IRET=MCHPO1
  165.       END
  166.  
  167.  
  168.  
  169.  

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