Télécharger prenom.eso

Retour à la liste

Numérotation des lignes :

prenom
  1. C PRENOM SOURCE CB215821 19/11/15 21:15:56 10378
  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.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC CCNOYAU
  28. -INC CCREDLE
  29. -INC SMTEXTE
  30. -INC SMBLOC
  31. -INC CCASSIS
  32.  
  33. CHARACTER*(8) MOBLO
  34. CHARACTER*(LOCHAI) MOTBUF
  35. SAVE INSEPA,INMETH
  36. DATA MOBLO/'BLOC '/
  37. DATA INSEPA/0/,INMETH/0/
  38. LOGICAL BOOLIR
  39.  
  40. SREDLE=JREDLE
  41. IPLAMO=0
  42. ILON=INOOB1(/1)
  43. * If(insepa.eq.0) then
  44. * CALL POSCHA('.',INCHA)
  45. * LMNNOM=LMNNOM+1
  46. ** INSEPA=LMNNOM
  47. * INOOB2(LMNNOM)='SEPARATE'
  48. * INOOB1(LMNNOM)=INCHA
  49. * IOUEP2(LMNNOM)= INCHA
  50. * ENDIF
  51. 100 continue
  52. * if(ire.eq.7) write(6,*) ' ire inmeth ' , ire , inmeth
  53. * IF(IRE.EQ.7.AND.INMETH.NE.0) THEN
  54. * IPLAMO=INMETH
  55. * RETURN
  56. * ENDIF
  57. * write(6,*) ' sredle ire ', sredle,ire
  58. IF(IRE.EQ.7)THEN
  59. IF(INMETH.EQ.0) THEN
  60. CALL POSCHA('%',INCHA)
  61. LMNNOM=LMNNOM+1
  62. IF( LMNNOM.GT.ILON) THEN
  63. N=LMNNOM+50
  64. SEGADJ ITABOB,ITABOC,ITABOD
  65. ENDIF
  66. INMETH=LMNNOM
  67. INOOB2(LMNNOM)='METHODOL'
  68. INOOB1(LMNNOM)=INCHA
  69. IOUEP2(LMNNOM)= INCHA
  70. iplamo=lmnnom
  71. ENDIF
  72. IPLAMO=INMETH
  73. RETURN
  74. ENDIF
  75. IF(IRE.EQ.6)THEN
  76. IF(INSEPA.EQ.0) THEN
  77. CALL POSCHA('.',INCHA)
  78. LMNNOM=LMNNOM+1
  79. IF( LMNNOM.GT.ILON) THEN
  80. N=LMNNOM+50
  81. SEGADJ ITABOB,ITABOC,ITABOD
  82. ENDIF
  83. INSEPA=LMNNOM
  84. INOOB2(LMNNOM)='SEPARATE'
  85. INOOB1(LMNNOM)=INCHA
  86. IOUEP2(LMNNOM)= INCHA
  87. iplamo=lmnnom
  88. ENDIF
  89. IPLAMO=INSEPA
  90. RETURN
  91. ENDIF
  92. IF(IRE.NE.3.AND.IRE.NE.4) GO TO 30
  93. MOTBUF(1:NCAR)=MOT(1:NCAR)
  94. NCAS=NCAR
  95. CALL POSCHA(MOTBUF(1:NCAS),INCHA)
  96. 96 CONTINUE
  97. C
  98. C la chaine est en incha ieme position dans la pile des chaines
  99. C
  100. IF(IRE.EQ.3.AND.NCAR.LE.LONOM) THEN
  101. MAA = MDEOBJ
  102. IF(MFIOBJ.NE.0) MAA = 1
  103. DO 1 J =LMNNOM,MAA,-1
  104. IF(INCHA.NE.INOOB1(J)) GOTO 1
  105. IPLAMO = J
  106. return
  107. 1 CONTINUE
  108. ELSE
  109. DO 72 J=LMNNOM,MDEOBJ,-1
  110. IF(INOOB1(J).NE.1) GO TO 72
  111. IF(INOOB2(J).NE.'MOT ') GO TO 72
  112. IF(IOUEP2(J).NE.INCHA) GO TO 72
  113. IPLAMO=J
  114. * if(ire.eq.7)write(6,*) 'on a trouve la methodol ',iplamo,INOOB2(J)
  115. RETURN
  116. 72 CONTINUE
  117. ENDIF
  118. 98 CONTINUE
  119. LMNNOM=LMNNOM+1
  120. IPLAMO=LMNNOM
  121. IF( LMNNOM.GT.ILON) THEN
  122. N=LMNNOM+50
  123. SEGADJ ITABOB,ITABOC,ITABOD
  124. ENDIF
  125. INOOB1(LMNNOM)=INCHA
  126. IF(IRE.EQ.4) INOOB1(LMNNOM)=1
  127. *
  128. * CORRECTION : UN MOT DE PLUS DE LONOM CARACTERES NE PEUT PAS ETRE UN NOM
  129. IF (NCAR.GT.LONOM) INOOB1(LMNNOM)=1
  130. *
  131. INOOB2(LMNNOM)='MOT'
  132. IOUEP2(LMNNOM)= INCHA
  133. * IF(IRE.EQ.7) THEN
  134. * write(6,*) ' prenom creation d une methodol ',iplamo
  135. * INOOB2(LMNNOM)='METHODOL'
  136. * INMETH=IPLAMO
  137. * ENDIF
  138. RETURN
  139. 30 CONTINUE
  140. C
  141. C CAS DES AUTRES CHOSE QUE MOT
  142. C
  143. IF(IRE.EQ.1) THEN
  144. DO 1501 K=lmnnom,mdeobj,-1
  145. IF(IOUEP2(K).NE.NFIX) GO TO 1501
  146. IF(INOOB2(K).NE.'ENTIER ') GO TO 1501
  147. IF(INOOB1(K).NE.1) GO TO 1501
  148. IPLAMO=K
  149. RETURN
  150. 1501 CONTINUE
  151. LMNNOM=LMNNOM+1
  152. IF(LMNNOM.GT.INOOB1(/1)) THEN
  153. N = LMNNOM + 50
  154. SEGADJ ITABOB,ITABOC,ITABOD
  155. ENDIF
  156. N=LMNNOM
  157. INOOB1(N)=1
  158. INOOB2(N)='ENTIER '
  159. IOUEP2(N)=NFIX
  160. IPLAMO=N
  161. RETURN
  162. ELSEIF(IRE.EQ.2) THEN
  163. if(nbesc.ne.0) segact ipiloc
  164. IO=XIFLOT(/1)
  165. if(nbesc.ne.0) SEGDES,IPILOC
  166. xxfl= flot
  167. call posree(xxfl,j)
  168. IF(j.le.io) then
  169. DO 1503 K=MDEOBJ,LMNNOM
  170. IF(IOUEP2(K).NE.J) GO TO 1503
  171. IF(INOOB2(K).NE.'FLOTTANT') GO TO 1503
  172. IF(INOOB1(K).NE.1) GO TO 1503
  173. IPLAMO=K
  174. RETURN
  175. 1503 CONTINUE
  176. endif
  177. IIP=J
  178. LMNNOM=LMNNOM+1
  179. IF(LMNNOM.GT.INOOB1(/1)) THEN
  180. N = LMNNOM+ 50
  181. SEGADJ ITABOB,ITABOC,ITABOD
  182. ENDIF
  183. N=LMNNOM
  184. INOOB1(N)=1
  185. INOOB2(N)='FLOTTANT'
  186. IOUEP2(N)=IIP
  187. IPLAMO=N
  188. RETURN
  189. ELSEIF (IRE.EQ.5) THEN
  190. * write(6,*) ' on traite un logique' , bool
  191. boolir=bool
  192. call poslog(boolir,j)
  193. * write(6,*) j , iouep2(13),inoob2(13), inoob1(13)
  194. DO 1505 K=1,LMNNOM
  195. IF(IOUEP2(K).NE.J) GO TO 1505
  196. IF(INOOB2(K).NE.'LOGIQUE ') GO TO 1505
  197. IF(INOOB1(K).NE.1) GO TO 1505
  198. IPLAMO=K
  199. * write(6,*) ' on a trouve un logique ioplamo ' , iplamo
  200. RETURN
  201. 1505 CONTINUE
  202. IIP=J
  203. LMNNOM=LMNNOM+1
  204. IF(LMNNOM.GT.INOOB1(/1)) THEN
  205. N=LMNNOM+50
  206. SEGADJ ITABOB,ITABOC,ITABOD
  207. ENDIF
  208. N=LMNNOM
  209. INOOB1(N)=1
  210. INOOB2(N)='LOGIQUE '
  211. IOUEP2(N)=IIP
  212. IPLAMO=N
  213. RETURN
  214. ENDIF
  215. RETURN
  216. END
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  
  224.  
  225.  
  226.  
  227.  

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