[updated 30.May.2000]
Librairie redlib > Fichier redout.f |
SUBROUTINE REDOUT (*)
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
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)
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,'''')
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
redout est appelé dans