Sources Esope | Cast3M

maschp
C MASCHP    SOURCE    CB215821  20/11/25    13:34:03     10792          
      SUBROUTINE MASCHP(X1,X2,IPCH,ICLE,IRET,ISOM)
*
*  sous routine pour l'opérateur masque: chpo et reel en argument
*
*  ipch pointeur sur le champ par point argument
*  isom doit on sommer les 0 et les 1
*  icle type de comparaison
*  x1,x2 valeur(s) à comparer
*  iret pointeur sur le nouveau chpo ou valeur de la somme
*
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMELEME
      REAL*8 X1,X2
*
      MCHPOI=IPCH
      IRET=0
      IF (ISOM.EQ.0) THEN
         SEGINI,MCHPO1=MCHPOI
      ENDIF
      DO 1 I=1,IPCHP(/1)
         MSOUPO=IPCHP(I)
         IF (ISOM.EQ.0) THEN
            SEGINI,MSOUP1=MSOUPO
            MCHPO1.IPCHP(I)=MSOUP1
            MSOUP1.IGEOC=IGEOC
         ENDIF
         MPOVAL=IPOVAL
         N= VPOCHA(/1)
         NC=VPOCHA(/2)
         IF (ISOM.EQ.1) GOTO 10
*
*        SOIT ON VEUT UN MASQUE POINT PAR POINT...
*        =========================================
         SEGINI MPOVA1
         MSOUP1.IPOVAL=MPOVA1
*
*        MOT-CLE "SUPE"
         IF (ICLE.EQ.1) THEN
            DO 2 K=1,NC
            DO 2 L=1,N
               IF (VPOCHA(L,K).GT.X1) MPOVA1.VPOCHA(L,K)=1.D0
   2        CONTINUE
*
*        MOT-CLE "EGSU"
         ELSEIF (ICLE.EQ.2) THEN
            DO 3 K=1,NC
            DO 3 L=1,N
               IF (VPOCHA(L,K).GE.X1) MPOVA1.VPOCHA(L,K)=1.D0
   3        CONTINUE
*
*        MOT-CLE "EGAL"
         ELSEIF (ICLE.EQ.3) THEN
            DO 4 K=1,NC
            DO 4 L=1,N
               IF (VPOCHA(L,K).EQ.X1) MPOVA1.VPOCHA(L,K)=1.D0
   4        CONTINUE
*
*        MOT-CLE "EGIN"
         ELSEIF (ICLE.EQ.4) THEN
            DO 5 K=1,NC
            DO 5 L=1,N
               IF (VPOCHA(L,K).LE.X1) MPOVA1.VPOCHA(L,K)=1.D0
   5        CONTINUE
*
*        MOT-CLE "INFE"
         ELSEIF (ICLE.EQ.5) THEN
            DO 6 K=1,NC
            DO 6 L=1,N
               IF (VPOCHA(L,K).LT.X1) MPOVA1.VPOCHA(L,K)=1.D0
   6        CONTINUE
*
*        MOT-CLE "DIFF"
         ELSEIF (ICLE.EQ.6) THEN
            DO 7 K=1,NC
            DO 7 L=1,N
               IF (VPOCHA(L,K).NE.X1) MPOVA1.VPOCHA(L,K)=1.D0
   7        CONTINUE
*
*        MOT-CLE "COMP"
         ELSEIF (ICLE.EQ.7) THEN
            DO 8 K=1,NC
            DO 8 L=1,N
               IF (VPOCHA(L,K).GE.X1.AND.VPOCHA(L,K).LE.X2)
     &            MPOVA1.VPOCHA(L,K)=1.D0
   8        CONTINUE
         ENDIF
         GOTO 20
*
*        SOIT ON CHERCHE SEULEMENT LA SOMME...
*        =====================================
  10     CONTINUE
*
*        MOT-CLE "SUPE"
         IF (ICLE.EQ.1) THEN
            DO 12 K=1,NC
            DO 12 L=1,N
               IF (VPOCHA(L,K).GT.X1) IRET=IRET+1
  12        CONTINUE
*
*        MOT-CLE "EGSU"
         ELSEIF (ICLE.EQ.2) THEN
            DO 13 K=1,NC
            DO 13 L=1,N
               IF (VPOCHA(L,K).GE.X1) IRET=IRET+1
  13        CONTINUE
*
*        MOT-CLE "EGAL"
         ELSEIF (ICLE.EQ.3) THEN
            DO 14 K=1,NC
            DO 14 L=1,N
               IF (VPOCHA(L,K).EQ.X1) IRET=IRET+1
  14        CONTINUE
*
*        MOT-CLE "EGIN"
         ELSEIF (ICLE.EQ.4) THEN
            DO 15 K=1,NC
            DO 15 L=1,N
               IF (VPOCHA(L,K).LE.X1) IRET=IRET+1
  15        CONTINUE
*
*        MOT-CLE "INFE"
         ELSEIF (ICLE.EQ.5) THEN
            DO 16 K=1,NC
            DO 16 L=1,N
               IF (VPOCHA(L,K).LT.X1) IRET =IRET+1
  16        CONTINUE
*
*        MOT-CLE "DIFF"
         ELSEIF (ICLE.EQ.6) THEN
            DO 17 K=1,NC
            DO 17 L=1,N
               IF (VPOCHA(L,K).NE.X1) IRET=IRET+1
  17        CONTINUE
*
*        MOT-CLE "COMP"
         ELSEIF (ICLE.EQ.7) THEN
            DO 18 K=1,NC
            DO 18 L=1,N
               IF (VPOCHA(L,K).GE.X1.AND.VPOCHA(L,K).LE.X2) IRET=IRET+1
  18        CONTINUE
         ENDIF
 
  20     CONTINUE
  1   CONTINUE
      IF (ISOM.EQ.0) IRET=MCHPO1
      END