Télécharger borner.eso

Retour à la liste

Numérotation des lignes :

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

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