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

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