Télécharger maschp.eso

Retour à la liste

Numérotation des lignes :

  1. C MASCHP SOURCE JC220346 16/12/14 21:15:28 9262
  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. -INC CCOPTIO
  14. -INC SMCHPOI
  15. -INC SMELEME
  16. REAL*8 X1,X2
  17. *
  18. MCHPOI=IPCH
  19. IRET=0
  20. SEGACT MCHPOI
  21. IF (ISOM.EQ.0) THEN
  22. SEGINI,MCHPO1=MCHPOI
  23. ENDIF
  24. DO 1 I=1,IPCHP(/1)
  25. MSOUPO=IPCHP(I)
  26. SEGACT MSOUPO
  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. SEGACT MPOVAL
  34. N= VPOCHA(/1)
  35. NC=VPOCHA(/2)
  36. IF (ISOM.EQ.1) GOTO 10
  37. *
  38. * SOIT ON VEUT UN MASQUE POINT PAR POINT...
  39. * =========================================
  40. SEGINI MPOVA1
  41. MSOUP1.IPOVAL=MPOVA1
  42. SEGDES MSOUP1,MSOUPO
  43. *
  44. * MOT-CLE "SUPE"
  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. *
  51. * MOT-CLE "EGSU"
  52. ELSEIF (ICLE.EQ.2) THEN
  53. DO 3 K=1,NC
  54. DO 3 L=1,N
  55. IF (VPOCHA(L,K).GE.X1) MPOVA1.VPOCHA(L,K)=1.D0
  56. 3 CONTINUE
  57. *
  58. * MOT-CLE "EGAL"
  59. ELSEIF (ICLE.EQ.3) THEN
  60. DO 4 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. *
  65. * MOT-CLE "EGIN"
  66. ELSEIF (ICLE.EQ.4) THEN
  67. DO 5 K=1,NC
  68. DO 5 L=1,N
  69. IF (VPOCHA(L,K).LE.X1) MPOVA1.VPOCHA(L,K)=1.D0
  70. 5 CONTINUE
  71. *
  72. * MOT-CLE "INFE"
  73. ELSEIF (ICLE.EQ.5) THEN
  74. DO 6 K=1,NC
  75. DO 6 L=1,N
  76. IF (VPOCHA(L,K).LT.X1) MPOVA1.VPOCHA(L,K)=1.D0
  77. 6 CONTINUE
  78. *
  79. * MOT-CLE "DIFF"
  80. ELSEIF (ICLE.EQ.6) THEN
  81. DO 7 K=1,NC
  82. DO 7 L=1,N
  83. IF (VPOCHA(L,K).NE.X1) MPOVA1.VPOCHA(L,K)=1.D0
  84. 7 CONTINUE
  85. *
  86. * MOT-CLE "COMP"
  87. ELSEIF (ICLE.EQ.7) THEN
  88. DO 8 K=1,NC
  89. DO 8 L=1,N
  90. IF (VPOCHA(L,K).GE.X1.AND.VPOCHA(L,K).LE.X2)
  91. & MPOVA1.VPOCHA(L,K)=1.D0
  92. 8 CONTINUE
  93. ENDIF
  94. SEGDES MPOVA1
  95. GOTO 20
  96. *
  97. * SOIT ON CHERCHE SEULEMENT LA SOMME...
  98. * =====================================
  99. 10 CONTINUE
  100. *
  101. * MOT-CLE "SUPE"
  102. IF (ICLE.EQ.1) THEN
  103. DO 12 K=1,NC
  104. DO 12 L=1,N
  105. IF (VPOCHA(L,K).GT.X1) IRET=IRET+1
  106. 12 CONTINUE
  107. *
  108. * MOT-CLE "EGSU"
  109. ELSEIF (ICLE.EQ.2) THEN
  110. DO 13 K=1,NC
  111. DO 13 L=1,N
  112. IF (VPOCHA(L,K).GE.X1) IRET=IRET+1
  113. 13 CONTINUE
  114. *
  115. * MOT-CLE "EGAL"
  116. ELSEIF (ICLE.EQ.3) THEN
  117. DO 14 K=1,NC
  118. DO 14 L=1,N
  119. IF (VPOCHA(L,K).EQ.X1) IRET=IRET+1
  120. 14 CONTINUE
  121. *
  122. * MOT-CLE "EGIN"
  123. ELSEIF (ICLE.EQ.4) THEN
  124. DO 15 K=1,NC
  125. DO 15 L=1,N
  126. IF (VPOCHA(L,K).LE.X1) IRET=IRET+1
  127. 15 CONTINUE
  128. *
  129. * MOT-CLE "INFE"
  130. ELSEIF (ICLE.EQ.5) THEN
  131. DO 16 K=1,NC
  132. DO 16 L=1,N
  133. IF (VPOCHA(L,K).LT.X1) IRET =IRET+1
  134. 16 CONTINUE
  135. *
  136. * MOT-CLE "DIFF"
  137. ELSEIF (ICLE.EQ.6) THEN
  138. DO 17 K=1,NC
  139. DO 17 L=1,N
  140. IF (VPOCHA(L,K).NE.X1) IRET=IRET+1
  141. 17 CONTINUE
  142. *
  143. * MOT-CLE "COMP"
  144. ELSEIF (ICLE.EQ.7) THEN
  145. DO 18 K=1,NC
  146. DO 18 L=1,N
  147. IF (VPOCHA(L,K).GE.X1.AND.VPOCHA(L,K).LE.X2) IRET=IRET+1
  148. 18 CONTINUE
  149. ENDIF
  150.  
  151. 20 CONTINUE
  152. SEGDES MPOVAL
  153. 1 CONTINUE
  154. SEGDES MCHPOI
  155. IF (ISOM.EQ.0) THEN
  156. SEGDES MCHPO1
  157. IRET=MCHPO1
  158. ENDIF
  159. *
  160. RETURN
  161. END
  162.  
  163.  
  164.  
  165.  

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