Télécharger poscha.eso

Retour à la liste

Numérotation des lignes :

  1. C POSCHA SOURCE PV 15/10/07 21:15:09 8664
  2. SUBROUTINE POSCHA(NAM,IPOSCH)
  3. IMPLICIT INTEGER(I-N)
  4. -INC CCOPTIO
  5. -INC CCNOYAU
  6. -INC CCASSIS
  7. CHARACTER*(*)NAM
  8. segact ipiloc*mod
  9. IL=LEN(NAM)
  10. IO=IPCHAR(/1)
  11. IA=0
  12. DO 56 I=1,IL
  13. IA = IA + ICHAR(NAM(I:I))
  14. 56 CONTINUE
  15. * write(6,fmt='(''nam io lmncha ia'',a8,3i6)')nam,io,LMNCHA,ia
  16. DO 1 II=LMNCHA,1,-1
  17. IF( IPHCOD(II).NE.IA) GO TO 1
  18. ID=IPCHAR(II)
  19. IFI=IPCHAR(II+1)
  20. IF(IFI-ID.NE.IL) GO TO 1
  21. IF(NAM.NE.ICHARA(ID:IFI-1)) GO TO 1
  22. GO TO 2
  23. 1 CONTINUE
  24. 10 CONTINUE
  25. LMNCHA=LMNCHA+1
  26. M1=IPCHAR(LMNCHA)
  27. M=M1+IL
  28. * write(6,*) ' lmncha ' , lmncha , ' ipchar(/1))' , ipchar(/1)
  29. IF(LMNCHA+1.GT.IPCHAR(/1) .or. M.GT.ICHARA(/1)) THEN
  30. lmxx=xiflot(/1)
  31. lmll=iplogi(/1)
  32. lmmm=ichara(/1)
  33. if(M.gt.ichara(/1)) lmmm= m+1000
  34. lmcc= ipchar(/1)
  35. if(LMNCHA+1.GT.lmcc) LMcc=LMNCHA+200
  36. * write(6,*) ' lmxx,lmcc,lmmm,lmll',lmxx,lmcc,lmmm,lmll
  37. SEGADJ IPILOC
  38. ENDIF
  39. * write(6,*) ' lmncha ' , lmncha,' m ',m
  40. IPCHAR(LMNCHA+1)=M
  41. ICHARA(M1:M1+IL-1)=NAM
  42. IPHCOD(LMNCHA)=IA
  43. II=LMNCHA
  44. 2 CONTINUE
  45. IPOSCH=II
  46. if(nbesc.ne.0) segdes ipiloc
  47. * write(6,fmt='('' sortie poscha '',i8)') iposch
  48. RETURN
  49. END
  50.  
  51.  
  52.  

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