[updated 8.Sep.2008]

Librairie grafxout > Fichier gprsd.f 

line
      SUBROUTINE GPRSD (IMPFCH)
line
  Auteur : F.Mahe (Fevrier 1992), D.Martin (Mars 2002)
  Derniere modification : D.Martin (21 Mars 2002)
  Version 1.0.1
   
  Impression de la S.D. "dessin", tableaux: '$NomDS', '$InfDS'
      
 -- Arguments d'entree -- 
  IMPFCH numero d'unite sur laquelle, on veut ecrire (6 pour l'ecran)
 -- Structure $NomDS
  Entete : Vide
  Corps  : Nom, Dimension, Format de fichier pour chaque dessin
 -- Structure $InfDS
  Entete : longueur entete, nombre de dessins, longueur max dans $NomDS
    puis, pour chaque dessin
  Corps     : nombre de domaines, nombre de resultats
    puis, pour chaque domaine
  Corps bis : NUDOMG,NUDOMK,NXLIST,NVNUME,NBELDO,NBNETR,INTRPC,NDMDOM
              pour chaque domaine
line
      INTEGER IMPFCH
 
      INCLUDE 'ALLOC'
      INCLUDE 'CONTEX'
 
      CHARACTER PRFXAS*8
      INTEGER   LGENDS,NBDESS,LGCHAR,NBCARD,INCNDS,INCNDO
     &         ,MCINDS,MCNMDS,MC1DOM,MCNDOM,NUDESS,NUDOMD,K,NBDOM,ADNOMD
      REAL      RBID
      COMPLEX   CBID
      CHARACTER NOMINT*20,NOMEXT*72,ERCODE*120
      COMMON/FORMAH/ERCODE
line
      CALL PRFXMJ (1,'<GPrSd >')
   
      CALL TBAR4  (ERCODE,'$InfDS',1,MCINDS,'$NomDS',1,MCNMDS
     &                   ,'#OMDOM',1,MCDOMG,'#TERDO',1,MCTRDO)
      CALL SDEXDB (IST(MCTRDO),LGERDO,NBDOMK,LGCANO,NCHDOM)             !utilite
 
      LGENDS=IST(MCINDS)
      NBDESS=IST(MCINDS+1)
      LGCHAR=IST(MCINDS+2)
      NBCARD=IST(MCINDS+3)
      INCNDS=IST(MCINDS+4)
      INCNDO=IST(MCINDS+5)
      ADNOMD=1
 
      WRITE (IMPFCH,10000) PRFXAS(1),PRFXAS(0),IST(MCINDS),NBDESS,LGCHAR
      Nombre de domaines et de resultats par dessins
      WRITE (IMPFCH,10001)
      MCNDOM=MCINDS+LGENDS
      MC1DOM=MCNDOM+INCNDS*NBDESS
      MCNMD1=MCNMDS
      DO 3 NUDESS=1,NBDESS
         NBDOM=IST(MCNDOM)
         NBRES=IST(MCNDOM+1)
         CALL GETCHN (AST(MCNMDS),LGCHAR,ADNOMD,NOMINT)                 !utilite
         NOMEXT=' '
         CALL GETCST (NOMINT(1:LGCHAR),ERCODE,NLONG,RBID,CBID,NOMEXT)   !sdexplo
         NLONG=INDEX (NOMEXT,' ')-1
         WRITE (IMPFCH,*) '    Dessin ',NUDESS,' : ',NOMEXT(1:NLONG)
     &  ,' - Dim    = ',(AST(K),K=MCNMD1+LGCHAR,MCNMD1+2*LGCHAR-1)
     &  ,' - Format = ',(AST(K),K=MCNMD1+2*LGCHAR,MCNMD1+3*LGCHAR-1)
     &  ,' - NbDom  =',NBDOM,' - NbRes  =',NBRES
         ADNOMD=ADNOMD+NBCARD
         MCNMD1=MCNMD1+NBCARD*LGCHAR
         DO 2 NUDOMD=1,NBDOM
            NUDOMG=IST(MC1DOM)
            MCDOMA=MCDOMG+NCHDOM*(NUDOMG-1)
            WRITE (IMPFCH,10002) NUDOMD
     &                          ,(AST(K),K=MCDOMA,MCDOMA+NCHDOM-1)
            WRITE (IMPFCH,10003) (IST(K),K=MC1DOM,MC1DOM+3)
     &                          ,(IST(K),K=MC1DOM+INCNDO-1,MC1DOM+4,-1)
            MC1DOM=MC1DOM+INCNDO
2        CONTINUE
         MCNDOM=MCNDOM+INCNDS
3     CONTINUE
      CALL PRFXMJ (-1,'<GPrSd >')
line
10000 FORMAT(/,A8,'>',A8,' -> $InfDS',/,T5,'Longueur de l''entete =',I3
     &,' - NbDess =',I3,' - NbChar =',I3)
10001 FORMAT(/T5,'Informations sur les domaines pour chaque dessin :')
10002 FORMAT(T8,'Domaine',I3,' : ',50(A1))
10003 FORMAT(T8,'NuDomg =',I3,' - NuDomk =',I3,' - NxList =',I3/
     &,T8,'NvNume =',I3,' - NdmDom =',I3,' - Intrpc =',I3/
     &,T8,'NbNedo =',I6,' - NbEldo = ',I6
     &)
                                                                    END !GPrSd
line
top