Télécharger cretar.eso

Retour à la liste

Numérotation des lignes :

  1. C CRETAR SOURCE GF238795 15/04/23 21:15:37 8502
  2. subroutine cretar(argume,pilLoc)
  3. C=======================================================================
  4. C Sous-programme COLlaborateur RETourner ARgument
  5. C=======================================================================
  6. integer iArgu
  7. integer nArg
  8. integer iPile
  9. integer iPoint
  10. real*8 xval
  11. character*512 chaval
  12. logical logval
  13. integer iobval,iretp,ival
  14. character*8 typNom
  15. integer debmot,finmot
  16. -INC CCOPTIO
  17. segment LISARG
  18. character*8 nom(nArg)
  19. integer adress(nArg)
  20. endsegment
  21. segment PILOC
  22. real*8 reel(nbRee)
  23. character*(nbCha) chara
  24. integer motdeb(nbMot+1)
  25. endsegment
  26. pointeur pilLoc.PILOC
  27. pointeur argume.LISARG
  28. nArg = argume.adress(/1)
  29. C write(ioimp,*) 'Entre dans MRETAR'
  30. C write(ioimp,*) 'Nombre d argu',nArg
  31. C pour chaque argument
  32. do iArgu =nArg,1,-1
  33. C recuperer son type
  34. typNom = argume.nom(iArgu)
  35. if(iimpi.ge.7) then
  36. write(ioimp,*) 'type ',typNom
  37. write(ioimp,*) 'addr ',argume.adress(iArgu)
  38. endif
  39. C recuper le numero de pile associe
  40. iPile=0
  41. call typfil (typNom,iPile)
  42. C write(ioimp,*) 'pile',iPile
  43. iPoint = argume.adress(iArgu)
  44. C write(ioimp,*)'iPoint',iPoint
  45. if(iPile.eq.24) then
  46. logval=iPoint.ne.0
  47. C write(ioimp,*) 'on retourne le logique',logval
  48. call ecrlog(logval)
  49. else if(iPile.eq.25) then
  50. C write(ioimp,*) 'on retourne le reel',pilLoc.reel(iPoint)
  51. xval = pilLoc.reel(iPoint)
  52. call ecrree(xval)
  53. else if(iPile.eq.26) then
  54. C write(ioimp,*)'Sortie d un entier',iPoint
  55. C call queval(iPoint,'ENTIER ', iretp, ival, xval, chaval,
  56. C & logval, iobval)
  57. C write(ioimp,*) 'on retourne l entier',iPoint
  58. call ecrent(iPoint)
  59. else if(iPile.eq.27) then
  60. call queval(iPoint,'MOT ', iretp, ival, xval, chaval,
  61. & logval, iobval)
  62. C write(ioimp,*) 'on retourne ',pilLoc.chara(debmot:finmot)
  63. debmot=pilLoc.motDeb(iPoint)
  64. finmot=pilLoc.motDeb(iPoint+1)-1
  65. chaval(1:finmot+1-debmot) = pilLoc.chara(debmot:finmot)
  66. call ecrcha(chaval(1:finmot+1-debmot))
  67. else
  68. call ecrobj(typnom,iPoint)
  69. endif
  70. enddo
  71. C write(ioimp,*) 'Sortie de MRETAR'
  72. end
  73.  
  74.  
  75.  

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