[updated 8.Sep.2008]
Librairie assembl > Fichier puterm.f |
SUBROUTINE PUTERM (NMTERM,NVTERM,KLADRS,VALEUR,VALEUC)
Auteur : D.Martin (Novembre 1991)
Derniere modification : D.Martin (1er Fevrier 2002)
Version 1.0.0
Introduction d'un coefficient dans un terme a une adresse relative donnee
-- Arguments d'entree --
NMTERM nom du terme a modifier
NVTERM son niveau
KLADRS adresse contenant le coefficient du terme a modifier
VALEUR nouvelle valeur du coefficient dans le cas reel
VALEUC nouvelle valeur du coefficient dans le cas complexe
CHARACTER*(*) NMTERM
INTEGER NVTERM,KLADRS
REAL VALEUR
COMPLEX VALEUC
INCLUDE 'ALLOC'
INTEGER KLTERM
INTEGER MCMTRM,MCDTRM,LGETRM,NBTERM,INCTRM,NCHTRM,NUTERM
& ,LGTERM,ITTERM,MCTERM,VALEUI
CHARACTER*4 TYPINT,TYTERM
CHARACTER ERCODE*120
COMMON/FORMAH/ERCODE
CALL PRFXMJ (1,'*PuTerm*')
CALL TBAR2 (ERCODE,'#OMTRM',1,MCMTRM,'$SDTRM',1,MCDTRM)
CALL SDEXDB (IST(MCDTRM),LGETRM,NBTERM,INCTRM,NCHTRM) !utilite
Recherche des caracteristiques du terme
NUTERM=KLTERM (NMTERM,NVTERM,AST(MCMTRM),IST(MCDTRM)) !sdexplo
IF (NUTERM.LE.0) CALL ERTERM (1,NMTERM,NVTERM) !utilite
CALL TBRR1 (ERCODE,NMTERM,NVTERM,LGTERM)
CALL TBTYPE (NMTERM,NVTERM,ITTERM)
TYTERM=TYPINT (ITTERM) !utilite
IF (TYTERM(1:1).NE.'R'.AND.TYTERM(1:1).NE.'C')
& CALL ERTERM (6,NMTERM,NVTERM) !utilite
CALL TBAR1 (ERCODE,NMTERM,NVTERM,MCTERM)
IF (KLADRS.LE.0.OR.KLADRS.GT.LGTERM) GOTO 99990
CALL TINPUT (KLADRS,VALEUI,VALEUR,VALEUC
& ,TYTERM,MCTERM,IST,RST,CST) !utilite
CALL TBSAVE (NMTERM,NVTERM)
CALL PRFXMJ (-1,'*PuTerm*')
RETURN
99990 WRITE (*,*) ' Adresse relative :',KLADRS,' pour un terme de '
&,'longueur ',LGTERM
CALL ERTERM (7,NMTERM,NVTERM) !Utilite
END !PuTerm
puterm est appelé dans