[updated 8.Sep.2008]
Librairie lecdire > Fichier lcautr.f |
SUBROUTINE LCAUTR (NIVIMP)
Auteur : D.Martin (Janvier 1995)
Derniere modification : D.Martin (19 mars 2008)
Version 2
Lecture du nom et des caracteristiques de termes definis par 'AUTRE CALCUL'
-- Arguments d'entree --
NIVIMP niveau d'impression des messages
-- Mots-cles de la directive AUTRE CALCUL --
AUTRE CALCUL
TERME &C6 [ [DE] NIVEAU &I
[ [DE TYPE] < REEL / COMPLEXE > ]
Inconnue [de nom] &C EN COLONNE
Inconnue [de nom] &C EN LIGNE
IMPLICIT NONE
INTEGER NIVIMP
INCLUDE 'ALLOC'
INCLUDE 'CONTEX'
INTEGER INTTYP,INTYKL,INDSTO,KLNIVE,KLTERM
INTEGER NFIX,IRE,NER,NCAR,ILU,IOP,MCMTRM,MCDTRM
& ,MCMINC,MCINCO,LGETRM,NBTERM,INCTRM,NCHTRM,LGEINC
& ,NBINCO,INCINC,NCHINC,NCTERM,NVTERM,NIVIMT,ITYPTR,ITYCAL
& ,NUINCL,NCPINL,INTINL,NBTNEL,NUINCC,NCPINC,INTINC,NBTNEC
& ,NVNUMC,NVNUML,INSTOK,NVSTOK,NUTERM,MCTERM,LGTERM,MCNEDO
DOUBLE PRECISION FLOT
LOGICAL CRETRM
CHARACTER TEXTE*80,TYPCAL*6,TYPINT*4,STKCHN*7
COMMON/REDCO1/ FLOT,NFIX,IRE,NER,NCAR,ILU,IOP(5)
COMMON/REDCOM/ TEXTE
CHARACTER ERCODE*120,NMTERM*6
COMMON/FORMAH/ERCODE
EQUIVALENCE (ERCODE(113:113),NMTERM)
CALL PRFXMJ (1,'*LcAutr*')
CALL TBAR4 (ERCODE,'#OMTRM',1,MCMTRM,'$SDTRM',1,MCDTRM
& ,'#OMINC',1,MCMINC,'#NCONU',1,MCINCO)
CALL SDEXDB (IST(MCDTRM),LGETRM,NBTERM,INCTRM,NCHTRM) !utilite
CALL SDEXDB (IST(MCINCO),LGEINC,NBINCO,INCINC,NCHINC) !utilite
1 CALL REDLE
IF (IRE.EQ.3) THEN
IF (IMPMES.GT.0.AND.NIVIMP.GT.1)
& WRITE (IMPMES,10000) '*LcAutr*',TEXTE(1:NCAR)
GOTO 1
ENDIF
IF (IRE.NE.4) CALL REDERR (14,'le nom d''un terme ')
On a lu le nom d'un terme
NCTERM=NCAR
NMTERM=TEXTE(1:NCAR)
NVTERM=1
CALL REDLE
Lecture eventuelle du niveau du terme
IF (IRE.EQ.3.AND.(TEXTE(1:NCAR).EQ.'NIVEAU'
& .OR.TEXTE(1:NCAR).EQ.'LEVEL')) THEN
IF (IMPMES.GT.0.AND.NIVIMP.GT.1)
& WRITE (IMPMES,10003) '*LcAutr*',TEXTE(1:NCAR)
CALL REDLE
ENDIF
IF (IRE.EQ.1) THEN
IF (IMPMES.GT.0.AND.NIVIMP.GT.1)
& WRITE (IMPMES,10001) '*LcAutr*',NFIX
NVTERM=NFIX
CALL REDLE
ENDIF
Lecture du type du terme, du niveau d'impression et des inconnues
NIVIMT=0
ITYPTR=INTTYP('REEL') !utilite
TYPCAL='NONDEF'
10 IF (IRE.NE.3) CALL REDERR (13,'TERME')
IF (IMPMES.GT.0.AND.NIVIMP.GT.1)
& WRITE (IMPMES,10000) '*LcAutr*',TEXTE(1:NCAR)
IF (TEXTE(1:10).EQ.'IMPRESSION'.OR.TEXTE(1:5).EQ.'PRINT') THEN
CALL REDLE
IF (IRE.EQ.1) GOTO 11
IF (IRE.EQ.3) THEN
CALL REDLE
IF (IRE.NE.1) CALL REDERR (11,'NIVEAU')
ENDIF
11 NIVIMT=NFIX
CALL REDLE
GOTO 10
ELSEIF (TEXTE(1:7).EQ.'COMPLEX') THEN
ITYPTR=INTTYP ('COMPLEXE') !utilite
CALL REDLE
GOTO 10
ELSEIF (TEXTE(1:8).EQ.'INCONNUE'.OR.TEXTE(1:7).EQ.'UNKNOWN') THEN
CALL LCINCT (TYPCAL,AST(MCMINC),IST(MCINCO)
& ,NUINCC,NUINCL,NIVIMP,IMPMES) !lecdire
GOTO 10
ELSEIF (TEXTE(1:4).EQ.'TYPE'.OR.TEXTE(1:4).EQ.'REEL'
& .OR.TEXTE(1:4).EQ.'REAL') THEN
CALL REDLE
GOTO 10
ENDIF
Attributs et numerotation pour l'inconnue en colonne
NCPINC=1
NBTNEC=1
NVNUMC=NDFNUM
IF (NUINCC.NE.NDFINC) THEN
CALL SDEXCO (NUINCC,IST(MCINCO),NCPINC,INTINC,NBTNEC) !utilite
IF (INTINC.NE.-1) CALL ERTERM (45,NMTERM(1:NCTERM),NVTERM) !utilite
NVNUMC=-NCPINC
ENDIF
Attributs et numerotation pour l'inconnue en ligne
NCPINL=1
NBTNEL=1
NVNUML=NDFNUM
IF (NUINCC.NE.NDFINC.AND.NUINCL.EQ.NUINCC) THEN
NCPINL=NCPINC
NVNUML=NVNUMC
ELSEIF (NUINCL.NE.NDFINC) THEN
CALL SDEXCO (NUINCL,IST(MCINCO),NCPINL,INTINL,NBTNEL) !utilite
IF (INTINL.NE.-1) CALL ERTERM (46,NMTERM(1:NCTERM),NVTERM) !utilite
NVNUML=-NCPINL
ENDIF
ITYCAL=INTYKL (TYPCAL) !utilite
Type de stockage du terme et niveau du tableau de stockage
STKCHN=' '
NVSTOK=NDFSTO
IF ( NUINCC.NE.NDFINC.AND.NUINCC.NE.NDFINC) THEN
Lorsque les inconnues sont les mêmes en Ligne et Colonne
le terme bien que PLEIN est stocke sous forme BIMORSE
IF (NUINCC.EQ.NUINCL) THEN
STKCHN='BIMORSE'
NVSTOK = -NCPINC
ELSEIF (NUINCC.LT.NUINCL) THEN
STKCHN='PLEIN-L'
ELSEIF (NUINCC.GT.NUINCL) THEN
STKCHN='PLEIN-C'
ENDIF
ENDIF
Creation du terme
LGTERM=NCPINC*NCPINL
INSTOK=INDSTO (STKCHN) !utilite
CALL CRTERM (NMTERM(1:NCTERM),NVTERM,LGTERM
& ,ITYPTR,ITYCAL,-1,NDFDON,NDFSYM,NDFDSM
& ,NUINCC,NDFDUM,NCPINC,NVNUMC
& ,NUINCL,NDFDUM,NCPINL,NVNUML
& ,INSTOK,NVSTOK,NDFCOR,0,NIVIMT,.FALSE.,CRETRM) !sdexplo
Mise a zero du terme
CALL TBAR1 (ERCODE,NMTERM(1:NCTERM),NVTERM,MCTERM)
CALL TAZERO (LGTERM,TYPINT(ITYPTR),MCTERM,AST,IST,RST,CST) !utilite
CALL TBSAVE (NMTERM(1:NCTERM),NVTERM)
Creation des numerotations triviales #GNEDO
IF (NVNUMC.NE.NDFNUM) CALL CRNEDO (NVNUMC,NCPINC,IST) !sdexplo
IF (NVNUML.NE.NDFNUM.AND.NVNUML.NE.NVNUMC)
& CALL CRNEDO (NVNUML,NCPINL,IST) !sdexplo
Creation du tableau de stockage trivial, le cas echeant
IF (STKCHN.EQ.'BIMORSE') CALL CRBMOP(NVSTOK,NCPINL,NCPINC,IST) !sdexplo
IF (IMPSDR.GT.0.AND.NIVIMP.GT.9) THEN
CALL TBAR2 (ERCODE,'#OMTRM',1,MCMTRM,'$SDTRM',1,MCDTRM)
NUTERM=KLTERM (NMTERM(1:NCTERM),NVTERM
& ,AST(MCMTRM),IST(MCDTRM)) !sdexplo
CALL PRSDTR (NUTERM,IST(MCDTRM),AST(MCMTRM),IMPSDR) !prsd
ENDIF
CALL PRFXMJ (-1,'*LcAutr*')
RETURN
10000 FORMAT(T6,A8,' Lecture de la Sous-Directive : ',A)
10001 FORMAT(T6,A8,T56,' , suivi de nombre : ',I12)
10003 FORMAT(T6,A8,T56,' , suivi du mot : ',A)
10004 FORMAT(T6,A8,T56,' , suivi de la chaine (*',I2,') : ',A)
-- File history
Version 2 : D.Martin (19 mars 2008)
Les termes avec meme inconnue en ligne / colonne sont stockes BIMORSE
Version 1.0.4 : D.Martin (12 decembre 2002)
END !LcAutr
lcautr est appelé dans