Télécharger masq.eso

Retour à la liste

Numérotation des lignes :

  1. C MASQ SOURCE JC220346 16/12/14 21:15:30 9262
  2. SUBROUTINE MASQ
  3. ************************************************************************
  4. * *
  5. * OPERATEUR MASQUE *
  6. * *
  7. ************************************************************************
  8. *
  9. IMPLICIT INTEGER(I-N)
  10. IMPLICIT REAL*8(A-H,O-Z)
  11. *
  12. -INC CCOPTIO
  13. *
  14. PARAMETER (LMOT=7,LSOM=1,LTYP=4)
  15. CHARACTER*4 MMOT(LMOT),MSOM(LSOM)
  16. CHARACTER*8 MTYP(LTYP)
  17. CHARACTER*8 LETYP,CHA8
  18. *
  19. DATA MMOT/'SUPE','EGSU','EGAL','EGIN','INFE','DIFF','COMP'/
  20. DATA MSOM/'SOMM'/
  21. DATA MTYP/'MCHAML',
  22. & 'CHPOINT',
  23. & 'LISTREEL',
  24. & 'LISTENTI'/
  25. *
  26. *
  27. * ============================
  28. * LECTURE DES DONNEES D'ENTREE
  29. * ============================
  30. *
  31. * LECTURE OBLIGATOIRE DU MOT-CLE PRINCIPAL
  32. CALL LIRMOT(MMOT,LMOT,ICLE,1)
  33. IF (IERR.NE.0) RETURN
  34. *
  35. * LECTURE FACULTATIVE DU MOT-CLE "SOMM"
  36. ISOM=0
  37. CALL LIRMOT(MSOM,LSOM,ISOM,0)
  38. IF (IERR.NE.0) RETURN
  39. *
  40. * LECTURE DE L'OBJET PRINCIPAL
  41. CALL QUETYP(LETYP,1,IRET)
  42. IF (IERR.NE.0) RETURN
  43. CALL PLACE(MTYP,LTYP,ITYP,LETYP)
  44. IF (ITYP.EQ.0) THEN
  45. MOTERR(1:8)=LETYP
  46. CALL ERREUR(39)
  47. RETURN
  48. ENDIF
  49. CALL LIROBJ(LETYP,IOB,1,IRETOU)
  50. IF (IERR.NE.0) RETURN
  51. *
  52. * LECTURE DU CRITERE DU MASQUE
  53. IRET1=0
  54. CALL QUETYP(CHA8,1,IRETOU)
  55. IF (CHA8.EQ.'ENTIER') THEN
  56. CALL LIRENT(I1,1,IRET1)
  57. IF (IERR.NE.0) RETURN
  58. X1=I1
  59. ELSEIF (CHA8.EQ.'FLOTTANT'.AND.ITYP.NE.4) THEN
  60. CALL LIRREE(X1,1,IRET1)
  61. IF (IERR.NE.0) RETURN
  62. ELSEIF (CHA8.EQ.LETYP) THEN
  63. CALL LIROBJ(LETYP,IOB1,1,IRETOU)
  64. IF (IERR.NE.0) RETURN
  65. ELSE
  66. MOTERR(1:8)=CHA8
  67. CALL ERREUR(39)
  68. RETURN
  69. ENDIF
  70.  
  71. * LECTURE D'UN DEUXIEME CRITERE POUR LE MOT-CLE "COMPRIS"
  72. IRET2=0
  73. IF (ICLE.EQ.7) THEN
  74. CALL QUETYP(CHA8,1,IRETOU)
  75. IF (CHA8.EQ.'ENTIER') THEN
  76. CALL LIRENT(I2,1,IRET2)
  77. IF (IERR.NE.0) RETURN
  78. X2=I2
  79. ELSEIF (CHA8.EQ.'FLOTTANT'.AND.ITYP.NE.4) THEN
  80. CALL LIRREE(X2,1,IRET2)
  81. IF (IERR.NE.0) RETURN
  82. ELSEIF (CHA8.EQ.LETYP) THEN
  83. CALL LIROBJ(LETYP,IOB2,1,IRETOU)
  84. IF (IERR.NE.0) RETURN
  85. ELSE
  86. MOTERR(1:8)=CHA8
  87. CALL ERREUR(39)
  88. RETURN
  89. ENDIF
  90. ENDIF
  91.  
  92. * ==================
  93. * CREATION DU MASQUE
  94. * ==================
  95.  
  96. GOTO(100,200,300,300) ITYP
  97. *
  98. * CAS D'UN OBJET MCHAML
  99. 100 CONTINUE
  100. IF (IRET1.NE.0.AND.(ICLE.NE.7.OR.IRET2.NE.0)) THEN
  101. CALL MASCHE(X1,X2,IOB,ICLE,IRET,ISOM,IRETER)
  102. ELSEIF (IRET1.NE.0) THEN
  103. CALL MSCHE1(IOB2,0,X1,1,IOB,ICLE,IRET,ISOM,IRETER)
  104. ELSE
  105. CALL MSCHE1(IOB1,IOB2,X2,-IRET2,IOB,ICLE,IRET,ISOM,IRETER)
  106. ENDIF
  107. IF (IRETER.EQ.0.OR.IERR.NE.0) RETURN
  108. GOTO 1000
  109. *
  110. * CAS D'UN OBJET CHPOINT
  111. 200 CONTINUE
  112. IF (IRET1.NE.0.AND.(ICLE.NE.7.OR.IRET2.NE.0)) THEN
  113. CALL MASCHP(X1,X2,IOB,ICLE,IRET,ISOM)
  114. ELSEIF (IRET1.NE.0) THEN
  115. CALL MSCHP1(IOB2,0,X1,1,IOB,ICLE,IRET,ISOM)
  116. ELSE
  117. CALL MSCHP1(IOB1,IOB2,X2,-IRET2,IOB,ICLE,IRET,ISOM)
  118. ENDIF
  119. IF (IERR.NE.0) RETURN
  120. GOTO 1000
  121. *
  122. * CAS D'UN OBJET LISTENTI OU LISTREEL
  123. 300 CONTINUE
  124. IF (IRET1.NE.0.AND.(ICLE.NE.7.OR.IRET2.NE.0)) THEN
  125. CALL MASLIS(LETYP,IOB,ICLE,X1,I1,X2,I2,IRET,ISOM)
  126. ELSEIF (IRET1.NE.0) THEN
  127. CALL MSLIS1(LETYP,IOB,ICLE,IOB2,0,X1,I1,1,IRET,ISOM)
  128. ELSE
  129. CALL MSLIS1(LETYP,IOB,ICLE,IOB1,IOB2,X2,I2,-IRET2,IRET,ISOM)
  130. ENDIF
  131. IF (IERR.NE.0) RETURN
  132.  
  133.  
  134. * ====================
  135. * FIN DE LA SUBROUTINE
  136. * ====================
  137.  
  138. 1000 CONTINUE
  139. IF (ISOM.NE.0) THEN
  140. CALL ECRENT(IRET)
  141. ELSE
  142. CALL ECROBJ(LETYP,IRET)
  143. ENDIF
  144.  
  145.  
  146. RETURN
  147. END
  148.  
  149.  
  150.  
  151.  

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