Télécharger borner.eso

Retour à la liste

Numérotation des lignes :

  1. C BORNER SOURCE FANDEUR 10/12/15 21:15:20 6808
  2.  
  3. ************************************************************************
  4. * *
  5. * OPERATEUR BORN(ER) *
  6. * *
  7. ************************************************************************
  8.  
  9. SUBROUTINE BORNER
  10.  
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT REAL*8(A-H,O-Z)
  13.  
  14. -INC CCOPTIO
  15. -INC SMLMOTS
  16. -INC SMLENTI
  17. -INC SMLREEL
  18.  
  19. PARAMETER (NMOT = 3)
  20. CHARACTER*4 LMOT(NMOT)
  21. CHARACTER*16 MOTC
  22.  
  23. DATA LMOT / 'MAXI','MINI','COMP' /
  24.  
  25. IPOBJ = 0
  26. ITOBJ = 0
  27.  
  28. * ===
  29. * 1 - Lecture de l'objet a borner
  30. * ===
  31. * LISTENTI
  32. 1 CONTINUE
  33. CALL LIROBJ('LISTENTI',IPOBJ,0,IRETOU)
  34. IF (IERR.NE.0) RETURN
  35. IF (IRETOU.EQ.0) GOTO 2
  36. ITOBJ = 1
  37. GOTO 100
  38. * LISTREEL
  39. 2 CONTINUE
  40. CALL LIROBJ('LISTREEL',IPOBJ,0,IRETOU)
  41. IF (IERR.NE.0) RETURN
  42. IF (IRETOU.EQ.0) GOTO 3
  43. ITOBJ = 2
  44. GOTO 100
  45. * EVOLUTION
  46. 3 CONTINUE
  47. CALL LIROBJ('EVOLUTIO',IPOBJ,0,IRETOU)
  48. IF (IERR.NE.0) RETURN
  49. IF (IRETOU.EQ.0) GOTO 4
  50. ITOBJ = 3
  51. GOTO 100
  52. * CHPOINT
  53. 4 CONTINUE
  54. CALL LIROBJ('CHPOINT ',IPOBJ,0,IRETOU)
  55. IF (IERR.NE.0) RETURN
  56. IF (IRETOU.EQ.0) GOTO 5
  57. ITOBJ = 4
  58. GOTO 100
  59. * MCHAML
  60. 5 CONTINUE
  61. CALL LIROBJ('MCHAML ',IPOBJ,0,IRETOU)
  62. IF (IERR.NE.0) RETURN
  63. IF (IRETOU.EQ.0) GOTO 6
  64. ITOBJ = 5
  65. GOTO 100
  66. * TYPE NON RECONNU ACTUELLEMENT
  67. 6 CONTINUE
  68. CALL QUETYP(MOTERR(1:8),0,IRETOU)
  69. IF (IRETOU.EQ.0) THEN
  70. CALL ERREUR(533)
  71. ELSE
  72. CALL ERREUR(39)
  73. ENDIF
  74. RETURN
  75. C* GOTO 100
  76.  
  77. * ===
  78. * 2 - Lecture de l'operation a realiser et la(les) borne(s) associee(s)
  79. * ===
  80. 100 CONTINUE
  81. * Quelques initialisations
  82. IF (ITOBJ.EQ.3 .OR. ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN
  83. JG = 10
  84. IF (ITOBJ.EQ.3) THEN
  85. SEGINI,MLENTI
  86. C* ELSE IF (ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN
  87. ELSE
  88. JGN = 4
  89. JGM = JG
  90. SEGINI,MLMOTS
  91. ENDIF
  92. SEGINI,MLENT1
  93. SEGINI,MLREE1,MLREE2
  94. ENDIF
  95. *
  96. ICOMP = 0
  97. ILCOND = 1
  98. 110 CONTINUE
  99. IF (ITOBJ.EQ.3) THEN
  100. CALL LIRENT(I1,ILCOND,IRETOU)
  101. IF (IERR.NE.0) GOTO 900
  102. IF (IRETOU.EQ.0) GOTO 200
  103. ICOMP = ICOMP + 1
  104. IF (ICOMP.GT.JG) THEN
  105. JG = JG + 10
  106. SEGADJ,MLENTI,MLENT1
  107. SEGADJ,MLREE1,MLREE2
  108. ENDIF
  109. LECT(ICOMP) = I1
  110. ELSE IF (ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN
  111. CALL LIRCHA(MOTC,ILCOND,IRETOU)
  112. IF (IERR.NE.0) GOTO 900
  113. IF (IRETOU.EQ.0) GOTO 200
  114. ICOMP = ICOMP + 1
  115. IF (ICOMP.GT.JG) THEN
  116. JG = JG + 10
  117. JGM = JG
  118. SEGADJ,MLMOTS
  119. SEGADJ,MLENT1
  120. SEGADJ,MLREE1,MLREE2
  121. ENDIF
  122. MOTS(ICOMP) = MOTC(1:4)
  123. ENDIF
  124.  
  125. CALL LIRMOT(LMOT,NMOT,IMOT,1)
  126. IF (IERR.NE.0) GOTO 900
  127.  
  128. IF (ITOBJ.EQ.1) THEN
  129. IMIN = 0
  130. IMAX = 0
  131. CALL LIRENT(I1,1,IRETOU)
  132. IF (IERR.NE.0) GOTO 900
  133. IF (IMOT.EQ.1) THEN
  134. IMAX = I1
  135. ELSE IF (IMOT.EQ.2) THEN
  136. IMIN = I1
  137. C* ELSE IF (IMOT.EQ.3) THEN
  138. ELSE
  139. IMIN = I1
  140. CALL LIRENT(IMAX,1,IRETOU)
  141. IF (IERR.NE.0) GOTO 900
  142. IF (IMAX.LT.IMIN) THEN
  143. IMIN = IMAX
  144. IMAX = I1
  145. ENDIF
  146. ENDIF
  147. ELSE
  148. XMIN = 0.
  149. XMAX = 0.
  150. CALL LIRREE(X1,1,IRETOU)
  151. IF (IERR.NE.0) GOTO 900
  152. IF (IMOT.EQ.1) THEN
  153. XMAX = X1
  154. ELSE IF (IMOT.EQ.2) THEN
  155. XMIN = X1
  156. C* ELSE IF (IMOT.EQ.3) THEN
  157. ELSE
  158. XMIN = X1
  159. CALL LIRREE(XMAX,1,IRETOU)
  160. IF (IERR.NE.0) GOTO 900
  161. IF (XMAX.LT.XMIN) THEN
  162. XMIN = XMAX
  163. XMAX = X1
  164. ENDIF
  165. ENDIF
  166. ENDIF
  167.  
  168. IF (ITOBJ.EQ.3 .OR. ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN
  169. MLENT1.LECT(ICOMP) = IMOT
  170. MLREE1.PROG(ICOMP) = XMIN
  171. MLREE2.PROG(ICOMP) = XMAX
  172. ILCOND = 0
  173. GOTO 110
  174. ENDIF
  175.  
  176. * ===
  177. * 3 - Realisation des operations demandees
  178. * ===
  179. 200 CONTINUE
  180. IPRES = 0
  181.  
  182. IF (ITOBJ.EQ.3 .OR. ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN
  183. IF (ICOMP.NE.JG) THEN
  184. JG = ICOMP
  185. SEGADJ,MLENT1
  186. SEGADJ,MLREE1,MLREE2
  187. IF (ITOBJ.EQ.3) THEN
  188. SEGADJ,MLENTI
  189. C* ELSE IF (ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN
  190. ELSE
  191. JGM = JG
  192. SEGADJ,MLMOTS
  193. ENDIF
  194. ENDIF
  195. ENDIF
  196.  
  197. IF (ITOBJ .EQ. 1) THEN
  198. CALL BORNE1(IPOBJ,IMOT,IMIN,IMAX,IPRES)
  199. IF (IPRES.NE.0) CALL ECROBJ('LISTENTI',IPRES)
  200. ELSE IF (ITOBJ .EQ. 2) THEN
  201. CALL BORNE2(IPOBJ,IMOT,XMIN,XMAX,IPRES)
  202. IF (IPRES.NE.0) CALL ECROBJ('LISTREEL',IPRES)
  203. ELSE IF (ITOBJ .EQ. 3) THEN
  204. CALL BORNE3(IPOBJ,MLENTI,MLENT1,MLREE1,MLREE2,IPRES)
  205. IF (IPRES.NE.0) CALL ECROBJ('EVOLUTIO',IPRES)
  206. ELSE IF (ITOBJ .EQ. 4) THEN
  207. CALL BORNE4(IPOBJ,MLMOTS,MLENT1,MLREE1,MLREE2,IPRES)
  208. IF (IPRES.NE.0) CALL ECROBJ('CHPOINT ',IPRES)
  209. C* ELSE IF (ITOBJ .EQ. 5) THEN
  210. ELSE
  211. CALL BORNE5(IPOBJ,MLMOTS,MLENT1,MLREE1,MLREE2,IPRES)
  212. IF (IPRES.NE.0) CALL ECROBJ('MCHAML ',IPRES)
  213. ENDIF
  214.  
  215. * ===
  216. * 4 - Menage des objets temporaires
  217. * ===
  218. 900 CONTINUE
  219. IF (ITOBJ.EQ.3 .OR. ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN
  220. IF (ITOBJ.EQ.3) THEN
  221. SEGSUP,MLENTI
  222. C* ELSE IF (ITOBJ.EQ.4 .OR. ITOBJ.EQ.5) THEN
  223. ELSE
  224. SEGSUP,MLMOTS
  225. ENDIF
  226. SEGSUP,MLENT1,MLREE1,MLREE2
  227. ENDIF
  228.  
  229. RETURN
  230. END
  231.  
  232.  
  233.  

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