1 : C MASCHP SOURCE CHAT 05/01/13 01:31:29 5004 2 : SUBROUTINE MASCHP( X1,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 valeur à comparer 10 : * iret pointeur sur le nouveau chpo ou valeur de la somme 11 : * 12 : IMPLICIT INTEGER(I-N) 13 : REAL*8 X1 14 : -INC CCOPTIO 15 : -INC SMCHPOI 16 : -INC SMELEME 17 : MCHPOI =IPCH 18 : IRET=0 19 : SEGACT MCHPOI 20 : IF (ISOM.EQ.0) THEN 21 : SEGINI,MCHPO1=MCHPOI 22 : ENDIF 23 : DO 1 I=1,IPCHP(/1) 24 : MSOUPO=IPCHP(I) 25 : SEGACT MSOUPO 26 : IF(ISOM.EQ.0) THEN 27 : SEGINI,MSOUP1=MSOUPO 28 : MCHPO1.IPCHP(I)=MSOUP1 29 : ENDIF 30 : MELEME=IGEOC 31 : SEGACT MELEME 32 : IF(ISOM.EQ.0) THEN 33 : SEGINI,IPT1=MELEME 34 : SEGDES IPT1,MELEME 35 : MSOUP1.IGEOC=IPT1 36 : ENDIF 37 : MPOVAL=IPOVAL 38 : SEGACT MPOVAL 39 : N= VPOCHA(/1) 40 : NC=VPOCHA(/2) 41 : IF(ISOM.EQ.1) GO TO 10 42 : SEGINI MPOVA1 43 : MSOUP1.IPOVAL=MPOVA1 44 : SEGDES MSOUP1,MSOUPO 45 : IF(ICLE.EQ.1) THEN 46 : DO 2 K=1,NC 47 : DO 2 L=1,N 48 : IF(VPOCHA(L,K).GT.X1) MPOVA1.VPOCHA(L,K)=1.D0 49 : 2 CONTINUE 50 : ELSEIF ( ICLE.EQ.2) THEN 51 : DO 3 K=1,NC 52 : DO 3 L=1,N 53 : IF(VPOCHA(L,K).GE.X1) MPOVA1.VPOCHA(L,K)=1.D0 54 : 3 CONTINUE 55 : ELSEIF ( ICLE.EQ.3) THEN 56 : DO 4 K=1,NC 57 : DO 4 L=1,N 58 : IF(VPOCHA(L,K).EQ.X1) MPOVA1.VPOCHA(L,K)=1.D0 59 : 4 CONTINUE 60 : ELSEIF ( ICLE.EQ.4) THEN 61 : DO 5 K=1,NC 62 : DO 5 L=1,N 63 : IF(VPOCHA(L,K).LE.X1) MPOVA1.VPOCHA(L,K)=1.D0 64 : 5 CONTINUE 65 : ELSEIF ( ICLE.EQ.5) THEN 66 : DO 6 K=1,NC 67 : DO 6 L=1,N 68 : IF(VPOCHA(L,K).LT.X1) MPOVA1.VPOCHA(L,K)=1.D0 69 : 6 CONTINUE 70 : ELSEIF ( ICLE.EQ.6) THEN 71 : DO 7 K=1,NC 72 : DO 7 L=1,N 73 : IF(VPOCHA(L,K).NE.X1) MPOVA1.VPOCHA(L,K)=1.D0 74 : 7 CONTINUE 75 : ENDIF 76 : SEGDES MPOVA1 77 : GO TO 20 78 : * 79 : * on cherche suelement la somme 80 : 10 CONTINUE 81 : IF(ICLE.EQ.1) THEN 82 : DO 12 K=1,NC 83 : DO 12 L=1,N 84 : IF(VPOCHA(L,K).GT.X1) IRET=IRET+1 85 : 12 CONTINUE 86 : ELSEIF ( ICLE.EQ.2) THEN 87 : DO 13 K=1,NC 88 : DO 13 L=1,N 89 : IF(VPOCHA(L,K).GE.X1) IRET=IRET+1 90 : 13 CONTINUE 91 : ELSEIF ( ICLE.EQ.3) THEN 92 : DO 14 K=1,NC 93 : DO 14 L=1,N 94 : IF(VPOCHA(L,K).EQ.X1) IRET=IRET+1 95 : 14 CONTINUE 96 : ELSEIF ( ICLE.EQ.4) THEN 97 : DO 15 K=1,NC 98 : DO 15 L=1,N 99 : IF(VPOCHA(L,K).LE.X1) IRET=IRET+1 100 : 15 CONTINUE 101 : ELSEIF ( ICLE.EQ.5) THEN 102 : DO 16 K=1,NC 103 : DO 16 L=1,N 104 : IF(VPOCHA(L,K).LT.X1) IRET =IRET+1 105 : 16 CONTINUE 106 : ELSEIF ( ICLE.EQ.6) THEN 107 : DO 17 K=1,NC 108 : DO 17 L=1,N 109 : IF(VPOCHA(L,K).NE.X1) IRET=IRET+1 110 : 17 CONTINUE 111 : ENDIF 112 : 20 CONTINUE 113 : SEGDES MPOVAL 114 : 1 CONTINUE 115 : SEGDES MCHPOI 116 : IF(ISOM.EQ.0) THEN 117 : SEGDES MCHPO1 118 : IRET=MCHPO1 119 : ENDIF 120 : RETURN 121 : END 122 :
© Cast3M 2003 - All rights reserved.
Disclaimer