Télécharger nouins.eso

Retour à la liste

Numérotation des lignes :

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

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