[updated 8.Sep.2008]
Librairie initial > Fichier lcaldy.f |
SUBROUTINE LCALDY (NBTBMX,LGBUF,NBENRX,NBBUF,IMPALO,NIVIMP,IMPMES)
Auteur : O.DeBayser (Avril 1988)
Derniere modification : D.Martin (9 Novembre 2001)
Version 1.0.2
Modification des valeurs par defaut des parametres de l'allocation dynamique.
-- Arguments de sortie --
NBTBMX nombre initial de tableaux
LGBUF longueur du tableau tampon 'BUFxxx'
NBENRX taille d'un fichier du systeme 'acces direct longueur variable'
en nombre d'enregistrement
NBBUF nombre de tableaux tampons presents en memoire centrale
(l'unique tampon de caracteres est du type *1)
IMPALO unite d'impression des messages courants
NIVIMP niveau d'impression
IMPMES unite d'impression des messages
-- Mots-cles de la directive 'ALLOCATION DYNAMIQUE' --
< ALLOCATION DYNAMIQUE
< Quantite de tableaux initiale &I >
< Tableaux tampons < en nombre &I1 >
< de longueur &I2 > >
< Systeme de fichiers nombre d''enregistrements &I1 >
< Mouchard < bavard/muet >
>
INTEGER NBTBMX,LGBUF,NBENRX,NBBUF,IMPALO,NIVIMP,IMPMES
CHARACTER TEXT*4,MOTLU*120,TEXTE*80
INTEGER NFIX,IRE,NER,NCAR,ILU,IOP,IMPNIV,IGNORD
DOUBLE PRECISION FLOT
COMMON/REDCO1/FLOT,NFIX,IRE,NER,NCAR,ILU,IOP(5) /REDCOM/TEXT(20)
COMMON/FORMAH/MOTLU
EQUIVALENCE (TEXTE,TEXT(1))
CALL PRFXMJ (1,'*LcAldy*')
IMPNIV=NIVIMP
IF (IMPMES.LE.0) IMPNIV=0
1 CALL REDLE
IF (IRE.NE.3) CALL REDERR (13,' ')
2 IF (TEXT(1).EQ.'TABL'.OR.TEXT(1).EQ.'SYST'.OR.TEXT(1).EQ.'DYNA')
& GOTO 1
IF (TEXT(1).EQ.'QUAN') GOTO 10
IF (TEXT(1).EQ.'TAMP') GOTO 20
IF (TEXT(1).EQ.'FICH') GOTO 30
IF (TEXT(1).EQ.'RUME') GOTO 40
IF (TEXT(1).EQ.'MOUC') GOTO 50
GOTO 999
On a lu INITIALE
10 IF (IMPNIV.NE.0) WRITE (IMPMES,10000) '*LcAldy*',TEXTE(1:NCAR)
11 CALL REDLE
IF (TEXT(1).EQ.'TABL') GOTO 11
IF (IRE.NE.3) CALL REDERR (13,' ')
IF (TEXT(1).NE.'INIT') CALL REDERR (4,'INITIALE')
IF (IMPNIV.NE.0) WRITE (IMPMES,10003) TEXTE(1:NCAR)
CALL REDLE
IF (IRE.NE.1) CALL REDERR (11,' ')
IF (IMPNIV.NE.0) WRITE (IMPMES,10001) NFIX
IF (NFIX.GT.NBTBMX) THEN
NBTBMX=NFIX
ENDIF
GOTO 1
On a lu TAMPON
20 IF (IMPNIV.NE.0) WRITE (IMPMES,10000) '*LcAldy*',TEXTE(1:NCAR)
21 CALL REDLE
IF (IRE.NE.3) CALL REDERR (13,' ')
MOTLU(1:4)=TEXT(1)
IF (MOTLU(1:4).NE.'NOMB'.AND.MOTLU(1:4).NE.'LONG') GOTO 2
IF (IMPNIV.NE.0) WRITE (IMPMES,10003) TEXTE(1:NCAR)
CALL REDLE
IF (IRE.NE.1) CALL REDERR (11,' ')
IF (IMPNIV.NE.0) WRITE (IMPMES,10001) NFIX
IF (MOTLU(1:4).EQ.'NOMB') NBBUF=NFIX
IF (MOTLU(1:4).EQ.'LONG') LGBUF=NFIX
GOTO 21
On a lu FICHIER
30 IF (IMPNIV.NE.0) WRITE (IMPMES,10000) '*LcAldy*',TEXTE(1:NCAR)
31 CALL REDLE
IF (IRE.NE.3) CALL REDERR(13,' ')
IF (TEXT(1).EQ.'NOMB') GOTO 31
IF (TEXT(1).NE.'ENRE') CALL REDERR (4,'ENREGISTREMENT')
IF (IMPNIV.NE.0) WRITE (IMPMES,10003) TEXTE(1:NCAR)
CALL REDLE
IF (IRE.NE.1) CALL REDERR (11,' ')
IF (IMPNIV.NE.0) WRITE (IMPMES,10001) NFIX
NBENRX=NFIX
GOTO 1
On a lu RUMEUR (obsolete & ignored)
40 CALL REDLE
IGNORD=99
IF (IRE.NE.3) CALL REDERR (13,' ')
IF (TEXT(1).EQ.'ACTI') IGNORD=1
IF (TEXT(1).EQ.'INAC') IGNORD=0
GOTO 1
On a lu MOUCHARD
50 IF (IMPNIV.NE.0) WRITE (IMPMES,10000) '*LcAldy*',TEXTE(1:NCAR)
CALL REDLE
IF (IRE.NE.3) CALL REDERR (13,' ')
IF (IMPNIV.NE.0) WRITE (IMPMES,10003) TEXTE(1:NCAR)
IF (TEXT(1).EQ.'BAVA') IMPALO=ABS (IMPALO)
GOTO 1
999 CALL PRFXMJ (-1,'*LcAldy*')
10000 FORMAT(T2,A8,'Lecture de la sous-directive : ',A)
10001 FORMAT(T6,A8,T56,' , suivi du nombre : ',I12)
10003 FORMAT(T6,A8,T56,' , suivi du mot : ',A)
END !LcAldy
lcaldy est appelé dans