[updated 8.Sep.2008]

Qui appelle prdtab ?

      SUBROUTINE PRDTAB (TYPCST,IMPFCH) 

  Auteur : D.Martin (Decembre 1990)
  Derniere modification : D.Martin (3 Mars 2000)
  Version 1.0.1
   
  Impression des contenus des donnees de type tableau
   
 -- Argument d'entree --  
  TYPCST type des tableaux a imprimer (tous si TYPCST(1:1)=' ')
  IMPFCH numero d'unite logique du fichier d'impression

      CHARACTER*(*) TYPCST
      INTEGER       IMPFCH
   
      INCLUDE 'ALLOC'
 
      INTEGER       INTDON
      INTEGER       MCDONN,MCMDON,LGEDON,NBDONN,INCDON,NCHDON,NUDONN
     &             ,ITYDON,NIVDON,ITYPDO,LGTAB,MCTAB,NBCTAB
     &             ,I,J,NB,ITYDOT,NCATR1
      CHARACTER     ERCODE*120,TYPINT*12,PRFXAS*8,TYPTAB*12
     &             ,NOMTAB*16,CHAINE*120
      COMMON/FORMAH/ERCODE
      COMMON/ONSEPA/CHAINE

      CALL TBAR2  (ERCODE,'$DONNE',1,MCDONN,'#OMDON',1,MCMDON)
      CALL SDEXDB (IST(MCDONN),LGEDON,NBDONN,INCDON,NCHDON)             !sdexplo
 
      ITYDOT=INTDON ('TABLEAU')                                         !utilite
      TYPTAB=TYPCST
      WRITE (IMPFCH,10000) PRFXAS (0),TYPTAB
      DO 10 NUDONN=1,NBDONN
         CALL SDEXCO (NUDONN,IST(MCDONN),ITYDON,NIVDON,ITYPDO)          !sdexplo
         IF (ITYDON.EQ.ITYDOT) THEN
            TYPTAB=TYPINT (ITYPDO)                                      !utilite
            CALL GETCHN (AST(MCMDON),NCHDON,NUDONN,NOMTAB)              !utilite
            CALL PRNTRM (NOMTAB(1:NBCHNT),NIVDON,CHAINE,NCATR1)         !utilite
            ERCODE='!'
            CALL TBRR1  (ERCODE,NOMTAB(1:NBCHNT),NIVDON,LGTAB)
            IF (ERCODE(1:1).NE.'C') THEN
               CALL TBAR1  (ERCODE,NOMTAB(1:NBCHNT),NIVDON,MCTAB)
 
               IF ((TYPCST(1:2).EQ.'CA'.OR.TYPCST(1:1).EQ.' ')
     &         .AND.TYPTAB(1:2).EQ.'CA') THEN
                  NBCTAB=ITYPDO-10
                  NB=80/(NBCTAB+2)
                  CHAINE='((T20,!!(!!A1,:,'', '')))' 
                  CALL ENCLER (NB,CHAINE(7:8))                          !utilite
                  CALL ENCLER (NBCTAB,CHAINE(10:11))                    !utilite
                  WRITE (IMPFCH,10010) CHAINE(1:NCATR1)
                  WRITE (IMPFCH,CHAINE) 
     &               ((AST(MCTAB+I*NBCTAB+J),J=0,NBCTAB-1),I=0,LGTAB-1)
               ENDIF
               IF ((TYPCST(1:1).EQ.'E'.OR.TYPCST(1:1).EQ.' ') 
     &         .AND.TYPTAB(1:1).EQ.'E') THEN
                  WRITE (IMPFCH,10010) CHAINE(1:NCATR1)
                  WRITE (IMPFCH,10001) (IST(MCTAB+I),I=0,LGTAB-1)
               ENDIF
               IF ((TYPCST(1:1).EQ.'R'.OR.TYPCST(1:1).EQ.' ')
     &         .AND.TYPTAB(1:1).EQ.'R') THEN
                  WRITE (IMPFCH,10010) CHAINE(1:NCATR1)
                  WRITE (IMPFCH,10002) (RST(MCTAB+I),I=0,LGTAB-1)
               ENDIF
               IF ((TYPCST(1:1).EQ.'D'.OR.TYPCST(1:1).EQ.' ')
     &         .AND.TYPTAB(1:1).EQ.'D') THEN
                  WRITE (IMPFCH,10010) CHAINE(1:NCATR1)
                  WRITE (IMPFCH,10003) (DST(MCTAB+I),I=0,LGTAB-1)
               ENDIF
               IF ((TYPCST(1:2).EQ.'CO'.OR.TYPCST(1:1).EQ.' ')
     &         .AND.TYPTAB(1:2).EQ.'CO') THEN
                  WRITE (IMPFCH,10010) CHAINE(1:NCATR1)
                  WRITE (IMPFCH,10004) (CST(MCTAB+I),I=0,LGTAB-1)
               ENDIF
               CALL TBSAVE (NOMTAB(1:NBCHNT),NIVDON)
            ELSE
               WRITE (IMPFCH,10010) CHAINE(1:NCATR1)
               WRITE (IMPFCH,10011) 'non encore cree'
            ENDIF
         ENDIF
         CALL TBAR2  (ERCODE,'$DONNE',1,MCDONN,'#OMDON',1,MCMDON)
10    CONTINUE
  
10000 FORMAT(T2,A8,'>*PrDtab* Valeurs des donnees de type TABLEAU, ',A)
10010 FORMAT(T12,'tableau ',A)
10011 FORMAT(T21,A)
10001 FORMAT((T21,5I12))
10002 FORMAT((T21,5E12.4))
10003 FORMAT((T21,5D15.7))
10004 FORMAT((T21,3(SS,E12.4,SP,E11.4,'*i')))
                                                                    END !PrDtab

prdtab est appelé dans

• lcdonn.f (lecdire)