Télécharger nouins.eso

Retour à la liste

Numérotation des lignes :

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

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