Télécharger la plaquette Cast3M


fr en

Télécharger cretar.eso

Retour à la liste

Numérotation des lignes : 

cretar

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

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