Télécharger nouins2.eso

Retour à la liste

Numérotation des lignes :

  1. C NOUINS2 SOURCE CB215821 19/11/15 21:15:51 10378
  2. C nouins version esclave
  3. C
  4. SUBROUTINE NOUINS2
  5. IMPLICIT INTEGER(I-N)
  6. -INC CCASSIS
  7. -INC CCOPTIO
  8. -INC CCNOYAU
  9. -INC SMCOORD
  10. -INC SMLMOTS
  11. -INC SMBLOC
  12. logical ilog , LLLERR
  13. real*8 reel
  14. character*72 chaine
  15. character*8 ityp
  16. *
  17. call ooonsf(0)
  18. *
  19. * initialisation de lotesc
  20. ith=0
  21. ith=oothrd
  22. call ooohor(0)
  23. * write (6,*) ' dans nouins2 ',ith
  24. if ((ith.eq.0) .and. lotrma) then
  25. call erreur(5)
  26. * le maitre travaille comme un assistant
  27. mesins = mescl(ith)
  28. mestra = imestr
  29. lotrma = .false.
  30. lotesc = .true.
  31. goto 3457
  32. end if
  33. *
  34. mescla = imescl(ith)
  35. mestra = imestr
  36. mesins = mescl(ith)
  37. * est on en situation d'erreur????
  38. merres = ierres
  39. segact merres
  40. LLLERR = LOSIER
  41. segdes merres
  42. * mettre les resultats dans la pile de l'esclave
  43. IIRES = 0
  44. do 10 iop=1,90
  45. call quetyp(ityp,0,iretou)
  46. if (iretou.eq.0) goto 11
  47. IIRES = IIRES + 1
  48. mesres=esrees(iop)
  49. if (mesres.eq.0) then
  50. moterr(1:8) = ityp
  51. moterr(9:16) = ' '
  52. call erreur(11)
  53. goto 11
  54. end if
  55. * Il faut activer mesres avant nesres pour eviter des problemes
  56. * d'interferences et de validiter de LOREMP
  57. if (iimpi .eq. 1234) write(ioimp,*) 'mise a jour de',mesres
  58. segact mesres*mod
  59. LOREMP = .TRUE.
  60. esrety=ityp
  61. if (ityp.eq.'LOGIQUE ') then
  62. call lirlog(ilog,1,iretou)
  63. esrelo=ilog
  64. elseif(ityp.eq.'FLOTTANT') then
  65. call lirree(reel,1,iretou)
  66. esrere=reel
  67. elseif (ityp.eq.'MOT ') then
  68. call lircha(chaine,1,iretou)
  69. esrech=chaine
  70. else
  71. call lirobj(ityp,iob,1,iretou)
  72. esreva=iob
  73. endif
  74. ****** CJY
  75. if (ith.ne.0) then
  76. segdes mesres*record
  77. else
  78. segdes mesres
  79. endif
  80. 10 continue
  81. 11 continue
  82. * en situation d'erreur on genere des objets de type ANNULE
  83. IF ( LLLERR ) IIRES = 0
  84. C -
  85. C - il faut verifier si il ne reste pas d'objets ESCLAVE dans la pile
  86. DO II = IIRES+1 , 90
  87. MESRES = esrees(II)
  88. IF ( MESRES .EQ. 0 ) THEN
  89. GO TO 4321
  90. ELSE
  91. SEGACT MESRES*MOD
  92. LOREMP = .TRUE.
  93. ESRETY = 'ANNULE '
  94.  
  95. C Gestion du SOUCI dans le BLOC (COMMENTE ACTUELLEMENT)
  96. C ESISOU = MBSOUC
  97.  
  98. if (ith.ne.0) then
  99. SEGDES MESRES*RECORD
  100. else
  101. SEGDES MESRES
  102. endif
  103. END IF
  104. END DO
  105. 4321 CONTINUE
  106. * Y a t il eu une erreur ?
  107. MLMOT1 = jpcar1
  108. IF ( JJJERR .NE. 0 .OR. LLLERR ) THEN
  109. C JYYY segact mesins
  110. merres = ierres
  111. segact merres*mod
  112. NERR = liserr(/2)
  113. IF ( NBERR .eq. NERR) then
  114. NERR = NERR + 2
  115. segadj merres
  116. END IF
  117. NBERR = NBERR + 1
  118. LISERR(1,NBERR) = JJJERR
  119. LISERR(2,NBERR) = MLMOT1
  120. LISERR(3,NBERR) = ith
  121. segdes mlmot1
  122. C JYYY segdes mesins*record
  123. segdes merres
  124. ELSE
  125. SEGSUP MLMOT1
  126. END IF
  127. ** plus utile menage travaille correctement sur les mescla
  128. *** CALL LIBSEG ( mescla )
  129. SEGSUP mescla
  130. segdes mcoord
  131. * recherche d une nouvelle instruction
  132. segact mesins*mod
  133. INSCOU = 0
  134. 3456 CONTINUE
  135.  
  136. * write (6,*) ' ith nbins dans nouins2 ',ith,nbins
  137. IF ( NBINS .EQ. 0 ) THEN
  138. if (inass .eq. 0) then
  139. * write(6,*) 'nouins2, on ne doit pas passer la '
  140. lotesc = .false.
  141. * write (6,*) ' desactivation mesins ith ',mesins,ith
  142. segdes mestra
  143. segdes mesins*record
  144. return
  145. else
  146. if (iospi .ne. 0)
  147. & write(ioimp,*) ' il faut attendre une instruction'
  148. SEGDES MESINS*RECORD
  149. * write (6,*) ' activation mesins ith ',mesins,ith
  150. segdes mestra
  151. SEGACT MESINS*(MOD,ECR=1)
  152. segact mestra
  153. * menage a peut-etre desactive mesins le temps que mestra soit accessible
  154. SEGACT MESINS*(MOD,ECR=1)
  155. GOTO 3456
  156. endif
  157. END IF
  158. *------------
  159. 3457 continue
  160. * est on en situation d'erreur????
  161. merres = ierres
  162. segact merres
  163. LLLERR = LOSIER
  164. segdes merres
  165. ** print*, ' il y a du travail a faire, NBINS =', NBINS
  166. mescla = LISMES(1)
  167. imescl(ith) = mescla
  168. INSCOU = MESCLA
  169. NBINS = NBINS - 1
  170. IF ( NBINS .NE. 0 ) THEN
  171. do i = 1 , NBINS
  172. lismes(i) = lismes(i+1)
  173. end do
  174. END IF
  175. lismes (NBINS+1) = 0
  176. SEGDES MESINS*RECORD
  177. ** segact mescla*(mod)
  178. ** ierr=0
  179. segdes mescla
  180. ***** segact mestra
  181. segact mescla*(mod)
  182. call ooonsf(1)
  183.  
  184. end
  185.  
  186.  
  187.  
  188.  
  189.  

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