Télécharger nouins.eso

Retour à la liste

Numérotation des lignes :

  1. C NOUINS SOURCE PV 20/04/09 21:15:16 10576
  2. C SERT A DONNER LES NOMS INDIQUES AUX OBJETS SE TROUVANT DANS LA PILE
  3. C
  4. SUBROUTINE NOUINS
  5.  
  6. IMPLICIT INTEGER(I-N)
  7.  
  8. -INC PPARAM
  9. -INC CCNOYAU
  10. -INC CCOPTIO
  11. -INC SMBLOC
  12. -INC SMLMOTS
  13. -INC SMLENTI
  14. -INC CCASSIS
  15. C
  16. CHARACTER*(8) ITBNO,ITCH,ITCH2
  17. CHARACTER*(LONOM) CNOM
  18. LOGICAL LLLERR , LOPREM , LOERAS, BOOL1
  19.  
  20.  
  21. C On positionne JERR au MAXI entre l'erreur par ASSISTANT et l'erreur GLOBALE
  22. jerr=MAX(IERR,IERGLB)
  23.  
  24. IF (INTEMP.EQ.0)GO TO 10
  25. IF(jerr.GT.1) GO TO 20
  26. C ON AFFECTE UN OBJET TEMPORAIRE EVENTUEL
  27. IRETTP=0
  28. CALL QUETYP(ITCH,0,IRETTP)
  29. IF(IRETTP.EQ.0) THEN
  30. ITBNOM=ITANO1(1)
  31. INOOB2(ITBNOM)=' '
  32. IOUEP2(ITBNOM)=0
  33. GO TO 20
  34. ENDIF
  35. CALL LIROBJ(ITCH,IRET,1,IRETTP)
  36. IF (IRETTP.EQ.0) THEN
  37. CALL ERREUR(5)
  38. ENDIF
  39. ITBNOM=ITANO1(1)
  40. INOOB2(ITBNOM)=JTYOBJ(IMOTLU)
  41. IOUEP2(ITBNOM)=JPOOB4(IMOTLU)
  42. ISSPOT=ISPOTE
  43. IIPOTE=IIPOTE+1
  44. IF ( IIPOTE.GT. IPOTEM(/1)) THEN
  45. C write (6,*)'**************************************'
  46. C write (6,*) 'necessite dagrandir iipote ' , iipote
  47. C write (6,*)'**************************************'
  48. NVQTEM=IPOTEM(/1)+20
  49. SEGADJ ISSPOT
  50. ENDIF
  51. IPOTEM(IIPOTE) = ITBNOM
  52. GOTO 100
  53. 10 CONTINUE
  54. C ON PREND LES NOMS LES UNS APRES LES AUTRES
  55. INOM=0
  56.  
  57. 11 CONTINUE
  58. INOM=INOM+1
  59. IF (INOM.GT.NBNOM) GOTO 100
  60. if(nbesc.ne.0) segact ipiloc
  61. IRET=0
  62. ITBNOM=ITANO1(INOM)
  63. ITCHA=INOOB1(ITBNOM)
  64. IDEBCH=IPCHAR(ITCHA)
  65. IFINCH=IPCHAR(ITCHA+1)-1
  66. MOTERR(1:8)=ICHARA(IDEBCH:IFINCH)
  67. CALL MESLIR(-183)
  68. ITCH=ITANOM(INOM)
  69. if(nbesc.ne.0)SEGDES,IPILOC
  70. call lirabj('PROCEDUR',iret,0,iretou)
  71. if(Iretou.ne.0) then
  72. itch='PROCEDUR'
  73. else
  74. CALL LIRABJ(ITCH,IRET,1,IRETOU)
  75. endif
  76. C write(6,*) ' itch iret ' , itch , iret
  77. IF (INOM.NE.NBNOM) THEN
  78. IF (INOOB2(ITBNOM).EQ.'TABLE '.OR.INOOB2(ITBNOM).EQ.
  79. $ 'METHODOL' ) THEN
  80. IF(INOOB2(ITBNOM).EQ.'METHODOL') ISUCC=1
  81. C VEUT-ON REMPLIR UN ELEMENT D'UNE TABLE?
  82.  
  83. CALL NTATAB ( INOM,ITCH,IRET,ISUCC)
  84. if(nbesc.ne.0) segact ipiloc
  85. IF(ISUCC.EQ.1)GOTO 11
  86. ENDIF
  87. ENDIF
  88. 12 CONTINUE
  89. if(nbesc.ne.0) segact ipiloc
  90. IF (ITBNOM.LE.0) CALL ERREUR(315)
  91. IDEBCH=IPCHAR(ITCHA)
  92. IFINCH=IPCHAR(ITCHA+1)-1
  93. ITCH=ICHARA(IDEBCH:IFINCH)
  94. if(nbesc.ne.0)SEGDES,IPILOC
  95. IF (jerr.LE.1) THEN
  96. IF( ITCH .EQ.' ') THEN
  97. CALL ERREUR(315)
  98. GO TO 20
  99. ENDIF
  100. IF( ITCH .EQ.'.') THEN
  101. CALL ERREUR(315)
  102. GO TO 20
  103. ENDIF
  104. IF(ITCH(1:1).EQ.'#') THEN
  105. CALL ERREUR(315)
  106. GO TO 20
  107. ENDIF
  108. INOOB2(ITBNOM)=JTYOBJ(IMOTLU)
  109. IOUEP2(ITBNOM)=JPOOB4(IMOTLU)
  110. ELSE
  111. IF(ITCH .NE.'.'.AND.ITCH.NE.
  112. $ ' ') INOOB2(ITBNOM)='ANNULE '
  113. ENDIF
  114. GOTO 11
  115. 100 CONTINUE
  116.  
  117. C VERIFIER QU'IL N'Y A PAS D'OBJET DANS LA PILE
  118. IF(jerr.NE.0) GOTO 20
  119. CALL QUETYP(ITCH,0,IRETOU)
  120. IF (IRETOU.EQ.0) GOTO 20
  121. MOTERR(1:8)=ITCH
  122. IF (ITCH .EQ. 'MOT ') THEN
  123. CALL LIRCHA(ITCH,1,IRETOU)
  124. ITCH2=ITCH
  125. CALL QUENOM(CNOM)
  126. IF (CNOM.EQ.' ') THEN
  127. CNOM=ITCH2
  128. ENDIF
  129. ELSEIF (ITCH .EQ. 'ENTIER ') THEN
  130. CALL LIRENT(IVAL,1,IRETOU)
  131. WRITE(ITCH, '(i8)') IVAL
  132. ITCH2=ITCH
  133. CALL QUENOM(CNOM)
  134. IF (CNOM.EQ.' ') THEN
  135. CNOM=ITCH2
  136. ENDIF
  137. ELSEIF (ITCH .EQ. 'FLOTTANT') THEN
  138. CALL LIRREE(XVAL,1,IRETOU)
  139. WRITE(ITCH, '(F8.2)') XVAL
  140. ITCH2=ITCH
  141. CALL QUENOM(CNOM)
  142. IF (CNOM.EQ.' ') THEN
  143. CNOM=ITCH2
  144. ENDIF
  145. ELSEIF (ITCH .EQ. 'LOGIQUE ') THEN
  146. CALL LIRLOG(BOOL1,1,IRETOU)
  147. IF (BOOL1) THEN
  148. ITCH2='VRAI '
  149. ELSE
  150. ITCH2='FAUX '
  151. ENDIF
  152. CALL QUENOM(CNOM)
  153. IF (CNOM.EQ.' ') THEN
  154. CNOM=ITCH2
  155. ENDIF
  156. ELSE
  157. CALL LIRABJ(ITCH,IRET,1,IRETOU)
  158. CALL QUENOM(CNOM)
  159. ENDIF
  160. MOTERR(9:8+LONOM)=CNOM
  161. CALL ERREUR(11)
  162.  
  163. 20 CONTINUE
  164. C IF( jerr.NE.0 .AND. MBFONC.EQ.0) THEN
  165. IF( jerr.NE.0 .AND. IERPER.LE.2) THEN
  166. IF(MBFONC.EQ.0) THEN
  167. CALL TRBACK
  168. ELSE
  169. CALL ANABAC
  170. ENDIF
  171. ENDIF
  172. NOMLU=0
  173. IF ( IRAZ .LE. -1 .OR. jerr.NE.0) THEN
  174. IPTEM=-(IRAZ + 1)
  175. if(jerr.ne.0) iptem=0
  176. CALL RAZPIL
  177. ENDIF
  178. LECTAB=0
  179. C RETASSER LA PILE DES REELS (TOUTES LES 30 FOIS)
  180. C ICTAS=ICTAS+1
  181. C IF (ICTAS.GT.10) THEN
  182. CALL TASREE
  183. C ICTAS=0
  184. C ENDIF
  185. C y a t -il une erreur sur les assistants ?
  186. if (LODEFE) then
  187. merres = ierres
  188. segact merres
  189. LLLERR = LOSIER
  190. segdes merres
  191. if ( LLLERR ) THEN
  192. C il faut que les assistants vident les listes d'instructions
  193. JG = nbesc
  194. SEGINI MLENTI
  195. DO i = 1 , nbesc
  196. LECT(i) = 1
  197. END DO
  198. LOPREM = .TRUE.
  199. 9876 continue
  200. NBINSS = 0
  201. DO i = 1 , nbesc
  202. if ( LECT(I) .EQ. 1 ) then
  203. MESINS = MESCL(I)
  204. if ( LOPREM ) then
  205. SEGACT MESINS*MOD
  206. else
  207. SEGACT MESINS*(MOD,ECR=1)
  208. end if
  209. if ( NBINS .EQ. 0 .AND. INSCOU .EQ. 0 ) THEN
  210. LECT(I) = 0
  211. else
  212. NBINSS = NBINSS + 1
  213. end if
  214. SEGDES MESINS*RECORD
  215. end if
  216. END DO
  217. LOPREM = .FALSE.
  218. IF ( NBINSS .NE. 0 ) GOTO 9876
  219. SEGSUP MLENTI
  220. C les assistants ont vide leur pile d'instructions
  221. segact merres*mod
  222. do jerr = 1, NBERR
  223. if(liserr(1,jerr).ne.0) then
  224. write(ioimp,*) ' ------------------------------'
  225. write(ioimp,*) ' assistant :',liserr(3,jerr)
  226. write(ioimp,*) ' erreur :',liserr(1,jerr)
  227. MLMOTS = liserr(2,jerr)
  228. segact MLMOTS
  229. write(ioimp,*) MOTS(1) (1:MOTS(/1))
  230. write(ioimp,*) MOTS(2) (1:MOTS(/1))
  231. segdes MLMOTS
  232. write(ioimp,*) ' ------------------------------'
  233. endif
  234. end do
  235. NBERR = 0
  236. LOSIER = .FALSE.
  237. segdes merres
  238. IERR =0
  239. IERGLB=0
  240. CALL ERREUR (915)
  241. RETURN
  242. end if
  243. if (LOTRMA) then
  244. mesins = mescl(0)
  245. segact mesins*mod
  246. call nouins2
  247. end if
  248. end if
  249. RETURN
  250. END
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  

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