[updated 1.Oct.2001]
SUBROUTINE WATBAL (ERRNUM,ALPROC,NMTABL,NVTABL)
Auteur : D.Martin (6 Juin 2000)
Derniere modification : D.Martin (6 Juin 2000)
Version 1.0.0
Warnings pour un tableau gere par l'allocation dynamique
-- Arguments d'entree --
ERRNUM code du warning
ALPROC nom de la procedure d'allocation dynamique ou survient le probleme
NMTABL nom du tableau
NVTABL niveau du tableau
-- Messages d'erreurs --
1 tableau inexistant
3 tableau inexistant ne peut etre sauvegarde
3 tableau inexistant ne peut etre tue
-- Procedures utilisees --
ENCLER/Utiliter, WARNNG/Utiliter
CHARACTER*(*) ALPROC,NMTABL
INTEGER ERRNUM,NVTABL
INTEGER DIXN,NBCARE,NCATRM,NBCHAL
CHARACTER ERCODE*120
COMMON/FORMAH/ERCODE
CALL PRNTRA (NMTABL,NVTABL,ERCODE,NCATRM)
DIXN=10
DO 3 NBCARE=1,9
IF (ABS(ERRNUM).LT.DIXN) GOTO 4
DIXN=10*DIXN
3 CONTINUE
4 IF (ERRNUM.LT.0) NBCARE=NBCARE+1
CALL ENCLER (ERRNUM,ERCODE(NCATRM+1:NCATRM+NBCARE))
NBCHAL=LEN(ALPROC)
ERCODE(NCATRM+NBCARE+1:NCATRM+NBCARE+NBCHAL)=ALPROC
IF (ERRNUM.EQ.1) THEN
CALL WARNNG ('<WaTbAL> Code '//ERCODE(NCATRM+1:NCATRM+NBCARE)
& //ERCODE(NCATRM+NBCARE+1:NCATRM+NBCARE+NBCHAL)
& //'- Le tableau '//ERCODE(1:NCATRM)
& //' n''existe pas dans les tables d''allocation ?')
ELSEIF (ERRNUM.EQ.2) THEN
CALL WARNNG ('<WaTbAL> Code '//ERCODE(NCATRM+1:NCATRM+NBCARE)
& //ERCODE(NCATRM+NBCARE+1:NCATRM+NBCARE+NBCHAL)
& //'- Le tableau '//ERCODE(1:NCATRM)
& //' n''existe pas. Il ne peut etre sauvegarde.')
ELSEIF (ERRNUM.EQ.3) THEN
CALL WARNNG ('<WaTbAL> Code '//ERCODE(NCATRM+1:NCATRM+NBCARE)
& //ERCODE(NCATRM+NBCARE+1:NCATRM+NBCARE+NBCHAL)
& //'- Le tableau '//ERCODE(1:NCATRM)
& //' n''existe pas. Le crime n''a pas eu lieu.')
ELSE
CALL WARNNG ('<WaTbAl> Code '//ERCODE(NCATRM+1:NCATRM+NBCARE)
& //ERCODE(NCATRM+NBCARE+1:NCATRM+NBCARE+NBCHAL)
& //' non prevu - Tableau '
& //ERCODE(1:NCATRM))
ENDIF
END !WaTbAl
watbal est appelé dans (2 procédures)