[updated 30.May.2000]

Librairie redlib > Fichier redout.f

Qui appelle redout ?

line
      SUBROUTINE REDOUT (*)
line
  Auteur : D.Martin (Mai 1993)
  Derniere modification : D.Martin (9 Juillet 1997)
   
  Changement de l'unite principale d'impression  
   
 -- Mots-cles --  
   
  ECRITURE SUR < FICHIER/UNITE > ||C  
line
   
      CHARACTER*4      TEXT,TEXTE*80,PRFXAF*8
      INTEGER          KLUNIT
      INTEGER          ECNEW,NFIX,IRE,NER,NCAR,ILU,IOP
     &                ,IMPPAL,IMPSDR,IMPMES,NBMESG
      DOUBLE PRECISION FLOT
      COMMON/REDCO1/   FLOT,NFIX,IRE,NER,NCAR,ILU,IOP(5)
      COMMON/REDCOM/   TEXT(20)
      COMMON/FICHIM/   IMPPAL,IMPSDR,IMPMES,NBMESG
      LOGICAL          OPNED
      EQUIVALENCE     (TEXTE,TEXT)
line
      CALL REDLEC (4)
      IF (TEXT(1).EQ.'SUR ') THEN
         CALL REDLEC (4)
         IF (TEXT(1).NE.'FICH'.AND.TEXT(1).NE.'UNIT')
     &      CALL REDERR (1,'FICHIER ou UNITE')
 --      Lecture du nom du fichier de lecture des directives
         CALL REDLEC (8)
         ECNEW=IMPPAL 
         IF (TEXTE(1:5).NE.'STDOUT'.AND.TEXTE(1:5).NE.'stdout') THEN
            INQUIRE (FILE=TEXTE(1:NCAR),NUMBER=ECNEW,OPENED=OPNED  
     &              ,ERR=90000)
            IF (.NOT.OPNED) THEN
               ECNEW=KLUNIT ()                                          !sdexplo
               OPEN (ECNEW,FILE=TEXTE(1:NCAR),ACCESS='SEQUENTIAL'  
     &              ,STATUS='UNKNOWN',ERR=90002)
               WRITE (IMPPAL,10000) PRFXAF ( ),TEXTE(1:NCAR)  
            ENDIF 
         ENDIF
   
         Reinitialisation du fichier d'impression principale
         IMPPAL=ECNEW
         RETURN 1  
      ENDIF
      RETURN
10000 FORMAT(/,T2,A8,' Ecriture sur le fichier ','''',A,'''')
line
90000 CALL BAISE  (' *RedOut* Probleme existenciel avec le fichier : '
     &//TEXTE(1:NCAR)) 
90002 CALL BAISE  (' *RedOut* Probleme d''ouverture du fichier : '
     &//TEXTE(1:NCAR))
                                                                    END !RedOut
line
top

redout est appelé dans

top