Télécharger prenom.eso

Retour à la liste

Numérotation des lignes :

  1. C PRENOM SOURCE CHAT 11/05/04 21:17:50 6963
  2. SUBROUTINE PRENOM(IPLAMO,IAVA,JREDLE)
  3. C
  4. C SERT A RETOURNER LA PLACE DE MOT DANS LA TABLE DES OBJETS.
  5. C CELA A PARTIR DE MDEOBJ (DEBUT DE LA PILE OBJET AFFECTEE A LA
  6. C PROCEDURE . SI LE MOT EXISTAIT AVANT MDEOBJ IL INITIALISE LE
  7. C NOUVEAU EGAL AU DERNIER CREE ( SAUF POUR LE CAS DES BLOCS).
  8. C SI CE MOT N'EXISTE PAS ON LE MET EN DERNIER ET ON LUI AFFECTE
  9. C LE TYPE MOT .
  10. C CAS D'UNE CONSTANTE : (IRE=1 ENTIER;IRE=2 FLOTTANT;IRE=5 BOOLEEN
  11. C IDEM PRECEDEMENT DANS LA TABLE DES NOMS LE NOM EST BLANC
  12. C CAS D'UN TEXTE : IRE=4 ON LE STOCKE COMME UN OBJET MAIS
  13. C ON LUI ATTRIBUE UN SEGMENT ET ON STOCKE LE POINTEUR DANS LA TABLE
  14. C DES OBJETS.
  15. C CAS D'UN SEPARATEUR : (IRE = 6) ON TRAITE COMME UN MOT
  16. C IAVA=1 ON EST AVANT LE SIGNE =, ONINITIALISE PAS LA VALEUR AVEC
  17. C LES OBJETS DEFINIES AVANT LA PROCEDURE
  18. C
  19. C IAVA=0 ON EST APRES LE SIGNE =, ON INITIALISE LE TYPE ET LA VALEUR
  20. C
  21. C
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8(A-H,O-Z)
  24. -INC CCOPTIO
  25. -INC CCNOYAU
  26. -INC CCREDLE
  27. -INC SMTEXTE
  28. -INC SMBLOC
  29. -INC CCASSIS
  30. CHARACTER*(8) MOBLO
  31. CHARACTER*72 MOTBUF
  32. SAVE INSEPA,INMETH
  33. DATA MOBLO/'BLOC '/
  34. DATA INSEPA/0/,INMETH/0/
  35. LOGICAL BOOLIR
  36. SREDLE=JREDLE
  37. IPLAMO=0
  38. ILON=INOOB1(/1)
  39. * If(insepa.eq.0) then
  40. * CALL POSCHA('.',INCHA)
  41. * LMNNOM=LMNNOM+1
  42. ** INSEPA=LMNNOM
  43. * INOOB2(LMNNOM)='SEPARATE'
  44. * INOOB1(LMNNOM)=INCHA
  45. * IOUEP2(LMNNOM)= INCHA
  46. * ENDIF
  47. 100 continue
  48. * if(ire.eq.7) write(6,*) ' ire inmeth ' , ire , inmeth
  49. * IF(IRE.EQ.7.AND.INMETH.NE.0) THEN
  50. * IPLAMO=INMETH
  51. * RETURN
  52. * ENDIF
  53. * write(6,*) ' sredle ire ', sredle,ire
  54. IF(IRE.EQ.7)THEN
  55. IF(INMETH.EQ.0) THEN
  56. CALL POSCHA('%',INCHA)
  57. LMNNOM=LMNNOM+1
  58. IF( LMNNOM.GT.ILON) THEN
  59. N=LMNNOM+50
  60. SEGADJ ITABOB,ITABOC,ITABOD
  61. ENDIF
  62. INMETH=LMNNOM
  63. INOOB2(LMNNOM)='METHODOL'
  64. INOOB1(LMNNOM)=INCHA
  65. IOUEP2(LMNNOM)= INCHA
  66. iplamo=lmnnom
  67. ENDIF
  68. IPLAMO=INMETH
  69. RETURN
  70. ENDIF
  71. IF(IRE.EQ.6)THEN
  72. IF(INSEPA.EQ.0) THEN
  73. CALL POSCHA('.',INCHA)
  74. LMNNOM=LMNNOM+1
  75. IF( LMNNOM.GT.ILON) THEN
  76. N=LMNNOM+50
  77. SEGADJ ITABOB,ITABOC,ITABOD
  78. ENDIF
  79. INSEPA=LMNNOM
  80. INOOB2(LMNNOM)='SEPARATE'
  81. INOOB1(LMNNOM)=INCHA
  82. IOUEP2(LMNNOM)= INCHA
  83. iplamo=lmnnom
  84. ENDIF
  85. IPLAMO=INSEPA
  86. RETURN
  87. ENDIF
  88. IF(IRE.NE.3.AND.IRE.NE.4) GO TO 30
  89. MOTBUF(1:NCAR)=MOT(1:NCAR)
  90. NCAS=NCAR
  91. CALL POSCHA(MOTBUF(1:NCAS),INCHA)
  92. 96 CONTINUE
  93. C
  94. C la chaine est en incha ieme position dans la pile des chaines
  95. C
  96. IF(IRE.EQ.3.AND.NCAR.LT.9) THEN
  97. MAA = MDEOBJ
  98. IF(MFIOBJ.NE.0) MAA = 1
  99. DO 1 J =LMNNOM,MAA,-1
  100. IF(INCHA.NE.INOOB1(J)) GOTO 1
  101. IPLAMO = J
  102. return
  103. 1 CONTINUE
  104. ELSE
  105. DO 72 J=LMNNOM,MDEOBJ,-1
  106. IF(INOOB1(J).NE.1) GO TO 72
  107. IF(INOOB2(J).NE.'MOT ') GO TO 72
  108. IF(IOUEP2(J).NE.INCHA) GO TO 72
  109. IPLAMO=J
  110. * if(ire.eq.7)write(6,*) 'on a trouve la methodol ',iplamo,INOOB2(J)
  111. RETURN
  112. 72 CONTINUE
  113. ENDIF
  114. 98 CONTINUE
  115. LMNNOM=LMNNOM+1
  116. IPLAMO=LMNNOM
  117. IF( LMNNOM.GT.ILON) THEN
  118. N=LMNNOM+50
  119. SEGADJ ITABOB,ITABOC,ITABOD
  120. ENDIF
  121. INOOB1(LMNNOM)=INCHA
  122. IF(IRE.EQ.4) INOOB1(LMNNOM)=1
  123. *
  124. * CORRECTION PV UN MOT DE PLUS DE 8 CARACTERES NE PEUT PAS ETRE
  125. * UN NOM
  126. IF (NCAR.GT.8) INOOB1(LMNNOM)=1
  127. *
  128. INOOB2(LMNNOM)='MOT'
  129. IOUEP2(LMNNOM)= INCHA
  130. * IF(IRE.EQ.7) THEN
  131. * write(6,*) ' prenom creation d une methodol ',iplamo
  132. * INOOB2(LMNNOM)='METHODOL'
  133. * INMETH=IPLAMO
  134. * ENDIF
  135. RETURN
  136. 30 CONTINUE
  137. C
  138. C CAS DES AUTRES CHOSE QUE MOT
  139. C
  140. IF(IRE.EQ.1) THEN
  141. DO 1501 K=lmnnom,mdeobj,-1
  142. IF(IOUEP2(K).NE.NFIX) GO TO 1501
  143. IF(INOOB2(K).NE.'ENTIER ') GO TO 1501
  144. IF(INOOB1(K).NE.1) GO TO 1501
  145. IPLAMO=K
  146. RETURN
  147. 1501 CONTINUE
  148. LMNNOM=LMNNOM+1
  149. IF(LMNNOM.GT.INOOB1(/1)) THEN
  150. N = LMNNOM + 50
  151. SEGADJ ITABOB,ITABOC,ITABOD
  152. ENDIF
  153. N=LMNNOM
  154. INOOB1(N)=1
  155. INOOB2(N)='ENTIER '
  156. IOUEP2(N)=NFIX
  157. IPLAMO=N
  158. RETURN
  159. ELSEIF(IRE.EQ.2) THEN
  160. if(nbesc.ne.0) segact ipiloc
  161. IO=XIFLOT(/1)
  162. if(nbesc.ne.0) segdes ipiloc
  163. xxfl= flot
  164. call posree(xxfl,j)
  165. IF(j.le.io) then
  166. DO 1503 K=MDEOBJ,LMNNOM
  167. IF(IOUEP2(K).NE.J) GO TO 1503
  168. IF(INOOB2(K).NE.'FLOTTANT') GO TO 1503
  169. IF(INOOB1(K).NE.1) GO TO 1503
  170. IPLAMO=K
  171. RETURN
  172. 1503 CONTINUE
  173. endif
  174. IIP=J
  175. LMNNOM=LMNNOM+1
  176. IF(LMNNOM.GT.INOOB1(/1)) THEN
  177. N = LMNNOM+ 50
  178. SEGADJ ITABOB,ITABOC,ITABOD
  179. ENDIF
  180. N=LMNNOM
  181. INOOB1(N)=1
  182. INOOB2(N)='FLOTTANT'
  183. IOUEP2(N)=IIP
  184. IPLAMO=N
  185. RETURN
  186. ELSEIF (IRE.EQ.5) THEN
  187. * write(6,*) ' on traite un logique' , bool
  188. boolir=bool
  189. call poslog(boolir,j)
  190. * write(6,*) j , iouep2(13),inoob2(13), inoob1(13)
  191. DO 1505 K=1,LMNNOM
  192. IF(IOUEP2(K).NE.J) GO TO 1505
  193. IF(INOOB2(K).NE.'LOGIQUE ') GO TO 1505
  194. IF(INOOB1(K).NE.1) GO TO 1505
  195. IPLAMO=K
  196. * write(6,*) ' on a trouve un logique ioplamo ' , iplamo
  197. RETURN
  198. 1505 CONTINUE
  199. IIP=J
  200. LMNNOM=LMNNOM+1
  201. IF(LMNNOM.GT.INOOB1(/1)) THEN
  202. N=LMNNOM+50
  203. SEGADJ ITABOB,ITABOC,ITABOD
  204. ENDIF
  205. N=LMNNOM
  206. INOOB1(N)=1
  207. INOOB2(N)='LOGIQUE '
  208. IOUEP2(N)=IIP
  209. IPLAMO=N
  210. RETURN
  211. ENDIF
  212. RETURN
  213. END
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  

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