Télécharger maschp.eso

Retour à la liste

Numérotation des lignes :

  1. C MASCHP SOURCE PV 20/04/28 21:15:12 10593
  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 2 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. *
  49. * MOT-CLE "EGSU"
  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. *
  56. * MOT-CLE "EGAL"
  57. ELSEIF (ICLE.EQ.3) THEN
  58. DO 4 K=1,NC
  59. DO 4 L=1,N
  60. IF (VPOCHA(L,K).EQ.X1) MPOVA1.VPOCHA(L,K)=1.D0
  61. 4 CONTINUE
  62. *
  63. * MOT-CLE "EGIN"
  64. ELSEIF (ICLE.EQ.4) THEN
  65. DO 5 K=1,NC
  66. DO 5 L=1,N
  67. IF (VPOCHA(L,K).LE.X1) MPOVA1.VPOCHA(L,K)=1.D0
  68. 5 CONTINUE
  69. *
  70. * MOT-CLE "INFE"
  71. ELSEIF (ICLE.EQ.5) THEN
  72. DO 6 K=1,NC
  73. DO 6 L=1,N
  74. IF (VPOCHA(L,K).LT.X1) MPOVA1.VPOCHA(L,K)=1.D0
  75. 6 CONTINUE
  76. *
  77. * MOT-CLE "DIFF"
  78. ELSEIF (ICLE.EQ.6) THEN
  79. DO 7 K=1,NC
  80. DO 7 L=1,N
  81. IF (VPOCHA(L,K).NE.X1) MPOVA1.VPOCHA(L,K)=1.D0
  82. 7 CONTINUE
  83. *
  84. * MOT-CLE "COMP"
  85. ELSEIF (ICLE.EQ.7) THEN
  86. DO 8 K=1,NC
  87. DO 8 L=1,N
  88. IF (VPOCHA(L,K).GE.X1.AND.VPOCHA(L,K).LE.X2)
  89. & MPOVA1.VPOCHA(L,K)=1.D0
  90. 8 CONTINUE
  91. ENDIF
  92. GOTO 20
  93. *
  94. * SOIT ON CHERCHE SEULEMENT LA SOMME...
  95. * =====================================
  96. 10 CONTINUE
  97. *
  98. * MOT-CLE "SUPE"
  99. IF (ICLE.EQ.1) THEN
  100. DO 12 K=1,NC
  101. DO 12 L=1,N
  102. IF (VPOCHA(L,K).GT.X1) IRET=IRET+1
  103. 12 CONTINUE
  104. *
  105. * MOT-CLE "EGSU"
  106. ELSEIF (ICLE.EQ.2) THEN
  107. DO 13 K=1,NC
  108. DO 13 L=1,N
  109. IF (VPOCHA(L,K).GE.X1) IRET=IRET+1
  110. 13 CONTINUE
  111. *
  112. * MOT-CLE "EGAL"
  113. ELSEIF (ICLE.EQ.3) THEN
  114. DO 14 K=1,NC
  115. DO 14 L=1,N
  116. IF (VPOCHA(L,K).EQ.X1) IRET=IRET+1
  117. 14 CONTINUE
  118. *
  119. * MOT-CLE "EGIN"
  120. ELSEIF (ICLE.EQ.4) THEN
  121. DO 15 K=1,NC
  122. DO 15 L=1,N
  123. IF (VPOCHA(L,K).LE.X1) IRET=IRET+1
  124. 15 CONTINUE
  125. *
  126. * MOT-CLE "INFE"
  127. ELSEIF (ICLE.EQ.5) THEN
  128. DO 16 K=1,NC
  129. DO 16 L=1,N
  130. IF (VPOCHA(L,K).LT.X1) IRET =IRET+1
  131. 16 CONTINUE
  132. *
  133. * MOT-CLE "DIFF"
  134. ELSEIF (ICLE.EQ.6) THEN
  135. DO 17 K=1,NC
  136. DO 17 L=1,N
  137. IF (VPOCHA(L,K).NE.X1) IRET=IRET+1
  138. 17 CONTINUE
  139. *
  140. * MOT-CLE "COMP"
  141. ELSEIF (ICLE.EQ.7) THEN
  142. DO 18 K=1,NC
  143. DO 18 L=1,N
  144. IF (VPOCHA(L,K).GE.X1.AND.VPOCHA(L,K).LE.X2) IRET=IRET+1
  145. 18 CONTINUE
  146. ENDIF
  147.  
  148. 20 CONTINUE
  149. 1 CONTINUE
  150. IF (ISOM.EQ.0) IRET=MCHPO1
  151. END
  152.  
  153.  

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