[updated 10.Nov.2009]
Librairie assembl > Fichier t2term.f |
SUBROUTINE T2TERM (NMTRM1,NVTRM1,TRANS,NMTRM2,NVTRM2
& ,NMTRM3,NVTRM3,NIVIMP)
Auteur : D.Martin (Decembre 1998)
Derniere modification : D.Martin (30 octobre 2006)
Version 2
Creation d'un terme a partir de deux autres termes
-- Arguments d'entree --
NMTRM1 nom du 1er terme source
NVTRM1 niveau du 1er terme source
TRANS definition de l'operation
NMTRM2 nom du 2nd terme source
NVTRM2 niveau du 2nd terme source
NMTRM3 nom du terme resultat
NVTRM3 niveau du terme resultat
NIVIMP niveau d'impression du terme resultat
-- Operations prevues --
TRANS : operation
-- pour des termes matriciels ou vectoriels
'+' addition des termes
'-' soustraction du second terme au premier
'CL' combinaison lineaire
(avec comme coefficients les constantes associees aux termes)
-- de plus et seulement pour des termes vectoriels
'[PRODUIT] TENSORIEL' produit tensoriel des 2 termes :
T_{i,j} = T_{1,i}*T_{2,j}
'.*' ou
'[PRODUIT] COMPOSANTE [A COMPOSANTE]' produit composante a composante :
T_{i} = T_{1,i}*T_{2,i}
'./' ou
'DIVISION COMPOSANTE [A COMPOSANTE]' produit composante a composante :
T_{i} = T_{1,i}/T_{2,i}
'[PRODUIT] SCALAIRE produit scalaire par noeud pour des termes vectoriels
a inconnue vectorielle :
T_{i} = Sum_{i1} T_{1,i,i1}*T_{2,i,i1}
'[PRODUIT] VECTORIEL produit vectoriel par noeud pour des termes vectoriels
a inconnue vectorielle :
'[PRODUIT] NOEUD [A NOEUD]' produit noeud a noeud :
T_{i,i1} = T_{1,i,i1}*T_{2,i,1}, i1=1, nb valeurs/noeuds
'DIFFERENCE RELATIVE' difference relative (e.g. calcul d'erreur) :
T_{i} = 2* | T_{1,i}-T_{2,i} | / | T_{1,i}+T_{2,i} |
Remarques:
-- Le terme resultat ne peut coincider avec l'un des termes operandes que si
l'operation ne modifie pas le type (REEL ou COMPLEXE) ou la structure
du terme coincidant
-- Le terme resultat n'aura pas de constante associee, sauf s'il coincide
avec un des termes operandes
-- Si les trois termes different deux a deux, les attributs du terme resultat
sont ceux du plus petit des deux premiers et du 1er en cas d'egalite
-- Si les longueurs des termes 1 et 2 different, la combinaison porte sur la
longueur minimum et un Warning est emis
-- Si les inconnues des termes 1 et 2 ou leur type de stockage different,
un Warning est emis
Modifications anterieures
D.Martin, C. Chambeyron (21/10/2002) ajout 'Division' coeff. a coeff.
D.Martin (5/04/2002)
IMPLICIT NONE
CHARACTER*(*) NMTRM1,NMTRM2,NMTRM3,TRANS
INTEGER NVTRM1,NVTRM2,NVTRM3,NIVIMP
INCLUDE 'CONTEX'
INCLUDE 'ALLOC'
INTEGER INDASS,INDSTO,INTDON,INTTYP,INTYKL,KLTERM
INTEGER ITYPT1,ITYCA1,NUKAL1,NUDON1,NVALN1,NVDSM1,NUINC1,NVDUC1
& ,NBNEC1,NVNUC1,NUINL1,NVDUL1,NBNEL1,NVNUL1,INSTO1,NVSTO1
& ,NVCOO1,IATRD1,NUTER1,ITYDO1,NIVDO1,ITYPD1,MCCST1,LGTRM1
& ,NCATR1,MCTRM1
& ,ITYPT2,ITYCA2,NUKAL2,NUDON2,NVALN2,NVDSM2,NUINC2,NVDUC2
& ,NBNEC2,NVNUC2,NUINL2,NVDUL2,NBNEL2,NVNUL2,INSTO2,NVSTO2
& ,NVCOO2,IATRD2,NUTER2,ITYDO2,NIVDO2,ITYPD2,MCCST2,LGTRM2
& ,MCTRM2,NCATR2
& ,MCMTRM,MCDTRM,LGETRM,NBTERM,INCTRM,NCHTRM,LENTRA,INTCOM
& ,MCDONN,ADTERM,NCATR0,INSTOK,NIVIMR,NIVEAU
& ,ITYPTR,ITYCAL,NUKALE,NVALN3,LGTRM3,MCTRM3,NUMERR
REAL SEUIL,SOMME,VALMX1,VALMX2,EPSIL
COMPLEX CVAL
LOGICAL CRETRM,IDMTR1,IDMTR2,COMLIN
CHARACTER TYPINT*8,UPPERC*32,WTRANS*32,OPERA*2
CHARACTER*8 TYTRM1,TYTRM2,TYTRM3,TYDON1,TYDON2
CHARACTER ERCODE*120
COMMON/FORMAH/ERCODE
CALL PRFXMJ (1,'*T2Term*')
LENTRA=LEN (TRANS)
WTRANS=UPPERC (TRANS)
INTCOM=INTTYP ('COMPLEXE')
CRETRM=.FALSE.
IF (NIVIMP.GE.0.AND.IMPSDR.GT.0) THEN
CALL PRNTRM (NMTRM3,NVTRM3,ERCODE,NCATR1)
WRITE (IMPSDR,10000) ERCODE(1:NCATR1)
ENDIF
CALL TBAR2 (ERCODE,'#OMTRM',1,MCMTRM,'$SDTRM',1,MCDTRM)
CALL SDEXDB (IST(MCDTRM),LGETRM,NBTERM,INCTRM,NCHTRM) !utilite
Caracteristiques des termes source
NUTER1=KLTERM (NMTRM1,NVTRM1,AST(MCMTRM),IST(MCDTRM)) !sdexplo
IF (NUTER1.LE.0) CALL ERTERM (1,NMTRM1,NVTRM1) !utilite
ADTERM=MCDTRM+LGETRM+INCTRM*(NUTER1-1)
CALL GETTRM (IST(ADTERM) ,NIVEAU,ITYPT1,ITYCA1,NUKAL1,NUDON1
& ,NVALN1,NVDSM1,NUINC1,NVDUC1,NBNEC1,NVNUC1,NUINL1
& ,NVDUL1,NBNEL1,NVNUL1,INSTO1,NVSTO1,NVCOO1,IATRD1
& ,NIVIMR) !sdexplo
TYTRM1=TYPINT (ITYPT1)
NUTER2=KLTERM (NMTRM2,NVTRM2,AST(MCMTRM),IST(MCDTRM)) !sdexplo
IF (NUTER2.LE.0) CALL ERTERM (1,NMTRM2,NVTRM2) !utilite
ADTERM=MCDTRM+LGETRM+INCTRM*(NUTER2-1)
CALL GETTRM (IST(ADTERM) ,NIVEAU,ITYPT2,ITYCA2,NUKAL2,NUDON2
& ,NVALN2,NVDSM2,NUINC2,NVDUC2,NBNEC2,NVNUC2,NUINL2
& ,NVDUL2,NBNEL2,NVNUL2,INSTO2,NVSTO2,NVCOO2,IATRD2
& ,NIVIMR) !sdexplo
TYTRM2=TYPINT (ITYPT2)
CALL TBRR2 (ERCODE,NMTRM1,NVTRM1,LGTRM1,NMTRM2,NVTRM2,LGTRM2)
IDMTR1=NMTRM1.EQ.NMTRM3.AND.NVTRM1.EQ.NVTRM3
IDMTR2=NMTRM2.EQ.NMTRM3.AND.NVTRM2.EQ.NVTRM3
ITYCAL= INTYKL ('ASSEMB') !utilite
NUKALE=-INDASS (' ') !utilite
INSTOK=0
TYTRM3=TYTRM1
IF (TYTRM2(1:2).EQ.'CO') TYTRM3=TYTRM2
TYDON1=' '
TYDON2=' '
OPERA=' '
COMLIN=.FALSE.
IF (LENTRA.EQ.6.AND.WTRANS(1:LENTRA).EQ.'SOMME') THEN
WTRANS='+'
ELSEIF (LENTRA.EQ.10.AND.WTRANS(1:LENTRA).EQ.'DIFFERENCE') THEN
WTRANS='-'
ELSEIF (INDEX(WTRANS,'COMPOSANTE').GT.0) THEN
OPERA='.*'
IF (INDEX(WTRANS,'DIVISION').GT.0) OPERA='./'
WTRANS='COMPOSANTE'
ELSEIF (WTRANS.EQ.'.*'.OR.WTRANS.EQ.'./') THEN
OPERA=WTRANS
WTRANS='COMPOSANTE'
ENDIF
IF (WTRANS(1:1).EQ.'+'.OR.WTRANS(1:1).EQ.'-') THEN
CALL WATERS (NMTRM1,NVTRM1,NUINC1,NUINL1,NVALN1,INSTO1,LGTRM1
& ,NMTRM2,NVTRM2,NUINC2,NUINL2,NVALN2,INSTO2,LGTRM2)
COMLIN=.TRUE.
ELSEIF (WTRANS(1:2).EQ.'CL'.OR.INDEX(WTRANS,'LINEAIRE').GT.0) THEN
WTRANS='CL'
Compatibilite des attributs des termes combines
(meme(s) inconnue(s), meme type de stockage, meme longueur) ?
CALL WATERS (NMTRM1,NVTRM1,NUINC1,NUINL1,NVALN1,INSTO1,LGTRM1
& ,NMTRM2,NVTRM2,NUINC2,NUINL2,NVALN2,INSTO2,LGTRM2)
CALL TBAR1 (ERCODE,'$DONNE',1,MCDONN)
IF (NUDON1.GT.0) THEN
CALL SDEXCO (NUDON1,IST(MCDONN),ITYDO1,NIVDO1,ITYPD1) !utilite
IF (ITYDO1.EQ.INTDON ('CONSTANTE')) TYDON1=TYPINT (ITYPD1) !utilite
IF (TYDON1(1:2).EQ.'CO') TYTRM3=TYDON1
ENDIF
IF (NUDON2.GT.0) THEN
CALL SDEXCO (NUDON2,IST(MCDONN),ITYDO2,NIVDO2,ITYPD2) !utilite
IF (ITYDO2.EQ.INTDON ('CONSTANTE')) TYDON2=TYPINT (ITYPD2) !utilite
IF (TYDON2(1:2).EQ.'CO') TYTRM3=TYDON2
ENDIF
IF (TYDON1(1:1).EQ.' '.AND.TYDON2(1:1).EQ.' ') WTRANS='+'
COMLIN=.TRUE.
ELSEIF (WTRANS(1:19).EQ.'DIFFERENCE RELATIVE') THEN
NUMERR=6
IF (TYTRM1.NE.TYTRM2) GOTO 99990
CALL WATERS (NMTRM1,NVTRM1,NUINC1,NUINL1,NVALN1,INSTO1,LGTRM1
& ,NMTRM2,NVTRM2,NUINC2,NUINL2,NVALN2,INSTO2,LGTRM2) !utilite
TYTRM3='REEL'
COMLIN=.TRUE.
ELSEIF (INDEX(WTRANS,'COMPOSANTE').GT.0) THEN
NUMERR=9
IF (IDMTR1.OR.IDMTR2) GOTO 99990
CALL WATERS (NMTRM1,NVTRM1,NUINC1,NUINL1,NVALN1,INSTO1,LGTRM1
& ,NMTRM2,NVTRM2,NUINC2,NUINL2,NVALN2,INSTO2,LGTRM2)
NUMERR=7
IF (LGTRM1.NE.LGTRM2.AND.INSTO1.NE.INSTO2) GOTO 99990
IF (NUINC1.NE.NDFINC) THEN
NUINL1=NUINC1
NVDUL1=NVDUC1
NBNEL1=NBNEC1
NVNUL1=NVNUC1
ENDIF
ELSEIF (INDEX(WTRANS,'NOEUD').GT.0) THEN
WTRANS='NOEUD'
NUMERR=9
IF (IDMTR1.OR.IDMTR2) GOTO 99990
IF (NVALN1.EQ.NVALN2) THEN
WTRANS='COMPOSANTE'
OPERA='.*'
CALL WATERS (NMTRM1,NVTRM1,NUINL1,NUINC1,NVALN1,INSTO1,LGTRM1
& ,NMTRM2,NVTRM2,NUINL2,NUINC2,NVALN2,INSTO2,LGTRM2)!utilite
NUMERR=7
IF (LGTRM1.NE.LGTRM2.AND.INSTO1.NE.INSTO2) GOTO 99990
ELSE
CALL WATERS (NMTRM1,NVTRM1,NUINL1,NUINC1,NVALN1,INSTO1,LGTRM1
& ,NMTRM2,NVTRM2,NUINL2,NUINC2,NVALN1,INSTO2,LGTRM1)!utilite
ENDIF
IF (NUINC1.NE.NDFINC) THEN
NUINL1=NUINC1
NVDUL1=NVDUC1
NBNEL1=NBNEC1
NVNUL1=NVNUC1
ENDIF
IF (NUINC2.NE.NDFINC) THEN
NUINL2=NUINC2
NVDUL2=NVDUC2
NBNEL2=NBNEC2
NVNUL2=NVNUC2
ENDIF
ELSEIF (INDEX(WTRANS,'SCALAIRE').GT.0) THEN
WTRANS='SCALAIRE'
NUMERR=9
IF (IDMTR1.OR.IDMTR2) GOTO 99990
IF (NVALN1.LE.1) CALL ERTERM (31,NMTRM1,NVTRM1)
IF (NVALN2.LE.1) CALL ERTERM (31,NMTRM2,NVTRM2)
NUMERR=8
IF (NVALN1.NE.NVALN2) GOTO 99990
CALL WATERS (NMTRM1,NVTRM1,NUINL1,NUINL1,NVALN1,INSTO1,LGTRM1
& ,NMTRM2,NVTRM2,NUINC2,NUINC2,NVALN2,INSTO2,LGTRM2)
Les termes sont a priori des vecteurs colonne, mais ...
IF (NUINC1.NE.NDFINC) THEN
NUINL1=NUINC1
NVDUL1=NVDUC1
NBNEL1=NBNEC1
NVNUL1=NVNUC1
ENDIF
IF (NUINC2.NE.NDFINC) THEN
NUINL2=NUINC2
NVDUL2=NVDUC2
NBNEL2=NBNEC2
NVNUL2=NVNUC2
ENDIF
NUMERR=4
IF (LGTRM1.NE.LGTRM2.AND.INSTO1.NE.INSTO2) GOTO 99990
ELSEIF (INDEX(WTRANS,'TENSORIEL').GT.0) THEN
WTRANS='TENSORIEL'
NUMERR=9
IF (IDMTR1.OR.IDMTR2) GOTO 99990
Le 1er est a priori un vecteur colonne, mais ...
IF (NUINC1.NE.NDFINC) THEN
NUINL1=NUINC1
NVDUL1=NVDUC1
NBNEL1=NBNEC1
NVNUL1=NVNUC1
ENDIF
Le 2nd est a priori un vecteur ligne, mais ...
IF (NUINL2.NE.NDFINC) THEN
NUINC2=NUINL2
NVDUC2=NVDUL2
NBNEC2=NBNEL2
NVNUC2=NVNUL2
ENDIF
INSTOK=INDSTO ('PLEIN-L')
ELSEIF (INDEX(WTRANS,'VECTORIEL').GT.0) THEN
WTRANS='VECTORIEL'
NUMERR=9
IF (IDMTR1.OR.IDMTR2) GOTO 99990
NVALN3=0
IF (NVALN1.EQ.3.OR.NVALN2.EQ.3) THEN
NVALN3=3
ELSEIF (NVALN1.EQ.2.AND.NVALN2.EQ.2) THEN
NVALN3=1
ELSE
CALL BAISE ('Produit vectoriel : cas non prevu')
ENDIF
Les termes sont a priori des vecteurs colonne, mais ...
IF (NUINC1.NE.NDFINC) THEN
NUINL1=NUINC1
NVDUL1=NVDUC1
NBNEL1=NBNEC1
NVNUL1=NVNUC1
ENDIF
IF (NUINC2.NE.NDFINC) THEN
NUINL2=NUINC2
NVDUL2=NVDUC2
NBNEL2=NBNEC2
NVNUL2=NVNUC2
ENDIF
ELSE
GOTO 99991
ENDIF
Type du terme resultat
ITYPTR= INTTYP (TYTRM3) !utilite
CRETRM=.FALSE.
IF (COMLIN) THEN
Cas d'une combinaison lineaire
IF (.NOT.(IDMTR2)) THEN
IF (.NOT.(IDMTR1)) THEN
Creation (si necessaire) du vecteur resultat
IF (LGTRM1.LE.LGTRM2) THEN
LGTRM3=LGTRM1
CALL CRTERM (NMTRM3,NVTRM3,LGTRM1,ITYPTR,ITYCAL
& ,NUKALE,NDFDON,NVALN1,NVDSM1
& ,NUINC1,NVDUC1,NBNEC1,NVNUC1
& ,NUINL1,NVDUL1,NBNEL1,NVNUL1,INSTO1
& ,NVSTO1,NVCOO1,IATRD1,NIVIMP,IDMTR1,CRETRM)!sdexplo
ELSE
LGTRM3=LGTRM2
CALL CRTERM (NMTRM3,NVTRM3,LGTRM2,ITYPTR,ITYCAL
& ,NUKALE,NDFDON,NVALN2,NVDSM2
& ,NUINC2,NVDUC2,NBNEC2,NVNUC2
& ,NUINL2,NVDUL2,NBNEL2,NVNUL2,INSTO2
& ,NVSTO2,NVCOO2,IATRD2,NIVIMP,IDMTR2,CRETRM)!sdexplo
ENDIF
ELSE
Le Terme resultat coincide avec le premier terme
LGTRM3=LGTRM1
IF (ITYPT1.NE.ITYPTR) CALL ERTERM (3,NMTRM1,NVTRM1) !utilite
CALL TBAR1 (ERCODE,'$SDTRM',1,MCDTRM)
ADTERM=MCDTRM+LGETRM+INCTRM*(NUTER1-1)
CALL PUTTRM (IST(ADTERM),NVTRM3,ITYPTR,ITYCAL
& ,NUKALE,NUDON1,NVALN1,NVDSM1
& ,NUINC1,NVDUC1,NBNEC1,NVNUC1
& ,NUINL1,NVDUL1,NBNEL1,NVNUL1
& ,INSTO1,NVSTO1,NVCOO1,IATRD1,NIVIMP) !sdexplo
ENDIF
ELSE
LGTRM3=LGTRM2
Le Terme resultat coincide avec le second
IF (ITYPT2.NE.ITYPTR) CALL ERTERM (3,NMTRM1,NVTRM1) !utilite
CALL TBAR1 (ERCODE,'$SDTRM',1,MCDTRM)
ADTERM=MCDTRM+LGETRM+INCTRM*(NUTER2-1)
CALL PUTTRM (IST(ADTERM),NVTRM3,ITYPTR,ITYCAL
& ,NUKALE,NUDON2,NVALN2,NVDSM2
& ,NUINC2,NVDUC2,NBNEC2,NVNUC2
& ,NUINL2,NVDUL2,NBNEL2,NVNUL2
& ,INSTO2,NVSTO2,NVCOO2,IATRD2,NIVIMP) !sdexplo
ENDIF
ELSE
IF (WTRANS(1:9).EQ.'TENSORIEL') THEN
CALL CRTERM (NMTRM3,NVTRM3,LGTRM1*LGTRM2,ITYPTR,ITYCAL
& ,NUKALE,NDFDON,NDFSYM,NDFDSM
& ,NUINC2,NVDUC2,NBNEC2,NVNUC2
& ,NUINL1,NVDUL1,NBNEL1,NVNUL1,INSTOK,NDFSTO
& ,NDFCOR,0 ,NIVIMP,.FALSE.,CRETRM) !sdexplo
ELSEIF (WTRANS(1:10).EQ.'COMPOSANTE') THEN
CALL CRTERM (NMTRM3,NVTRM3,LGTRM1,ITYPTR,ITYCAL
& ,NUKALE,NDFDON,NVALN1,NDFDSM
& ,NDFINC,NDFDUM,1 ,NDFNUM
& ,NUINL1,NVDUL1,NBNEL1,NVNUL1,INSTOK,NDFSTO
& ,NDFCOR,0 ,NIVIMP,.FALSE.,CRETRM) !sdexplo
ELSEIF (WTRANS(1:5).EQ.'NOEUD') THEN
IF (NVALN2.LT.NVALN1) THEN
CALL CRTERM (NMTRM3,NVTRM3,LGTRM1,ITYPTR,ITYCAL
& ,NUKALE,NDFDON,NVALN1,NDFDSM
& ,NDFINC,NDFDUM,1 ,NDFNUM
& ,NUINL1,NVDUL1,NBNEL1,NVNUL1,INSTOK,NDFSTO
& ,NDFCOR,0 ,NIVIMP,.FALSE.,CRETRM) !sdexplo
ELSE
CALL CRTERM (NMTRM3,NVTRM3,LGTRM2,ITYPTR,ITYCAL
& ,NUKALE,NDFDON,NVALN2,NDFDSM
& ,NDFINC,NDFDUM,1 ,NDFNUM
& ,NUINL2,NVDUL2,NBNEL2,NVNUL2,INSTOK,NDFSTO
& ,NDFCOR,0 ,NIVIMP,.FALSE.,CRETRM) !sdexplo
ENDIF
ELSEIF (WTRANS(1:8).EQ.'SCALAIRE') THEN
CALL CRTERM (NMTRM3,NVTRM3,NBNEL1,ITYPTR,ITYCAL
& ,NUKALE,NDFDON,1 ,NDFDSM
& ,NDFINC,NDFDUM,1 ,NDFNUM
& ,NUINL1,NVDUL1,NBNEL1,NVNUL1,INSTOK,NDFSTO
& ,NDFCOR,0 ,NIVIMP,.FALSE.,CRETRM) !sdexplo
ELSEIF (WTRANS(1:9).EQ.'VECTORIEL') THEN
CALL CRTERM (NMTRM3,NVTRM3,NBNEL1*NVALN3,ITYPTR,ITYCAL
& ,NUKALE,NDFDON,NVALN3,NDFDSM
& ,NDFINC,NDFDUM,1 ,NDFNUM
& ,NUINL1,NVDUL1,NBNEL1,NVNUL1,INSTOK,NDFSTO
& ,NDFCOR,0 ,NIVIMP,.FALSE.,CRETRM) !sdexplo
ENDIF
ENDIF
Adresses des operandes de l'operation
CALL TBAR2 (ERCODE,NMTRM1,NVTRM1,MCTRM1,NMTRM2,NVTRM2,MCTRM2)
MCTRM3=MCTRM1
IF (IDMTR2) MCTRM3=MCTRM2
IF (.NOT.(IDMTR1.OR.IDMTR2))
& CALL TBAR1 (ERCODE,NMTRM3,NVTRM3,MCTRM3)
Operation proprement dite
IF (WTRANS(1:1).EQ.'+') THEN
+
ERCODE='somme'
NCATR0=5
CALL TPLUST (LGTRM3,TYTRM1,MCTRM1,RST,CST
& ,TYTRM2,MCTRM2,RST,CST,TYTRM3,MCTRM3,RST,CST) !utilite
ELSEIF (WTRANS(1:1).EQ.'-') THEN
-
ERCODE='difference'
NCATR0=10
CALL TMOINT (LGTRM3,TYTRM1,MCTRM1,RST,CST
& ,TYTRM2,MCTRM2,RST,CST,TYTRM3,MCTRM3,RST,CST) !utilite
ELSEIF (WTRANS(1:2).EQ.'CL') THEN
cl
ERCODE='combinaison lineaire'
NCATR0=20
MCCST1=0
IF (TYDON1(1:1).EQ.'R') THEN
CALL TBAR1 (ERCODE,'$RCSTE',1,MCCST1)
ELSEIF (TYDON1(1:1).EQ.'C') THEN
CALL TBAR1 (ERCODE,'$CCSTE',1,MCCST1)
ELSEIF (TYDON1(1:1).EQ.'E') THEN
CALL TBAR1 (ERCODE,'$ECSTE',1,MCCST1)
ENDIF
MCCST2=MCCST1
IF (TYDON2(1:1).NE.TYDON1(1:1)) THEN
IF (TYDON2(1:1).EQ.'R') THEN
CALL TBAR1 (ERCODE,'$RCSTE',1,MCCST2)
ELSEIF (TYDON2(1:1).EQ.'C') THEN
CALL TBAR1 (ERCODE,'$CCSTE',1,MCCST2)
ELSEIF (TYDON2(1:1).EQ.'E') THEN
CALL TBAR1 (ERCODE,'$ECSTE',1,MCCST2)
ENDIF
ENDIF
IF (IDMTR2) THEN
t2 = a2.t2 (si a2 existe)
IF (NUDON2.GT.0)
& CALL TEQAT (LGTRM3,TYTRM2,MCTRM2,RST,CST,TYDON2
& ,MCCST2+NIVDO2,IST,RST,CST
& ,TYTRM2,MCTRM2,RST,CST) !utilite
IF (NUDON1.GT.0) THEN
t2 = (a2.)t2 + a1.t1
CALL TPLUAT (LGTRM3,TYTRM2,MCTRM2,RST,CST
& ,TYDON1,MCCST1+NIVDO1,IST,RST,CST
& ,TYTRM1,MCTRM1,RST,CST
& ,TYTRM2,MCTRM2,RST,CST) !utilite
ELSE
t2 = (a2.)t2 + t1
CALL TPLUST (LGTRM3,TYTRM2,MCTRM2,RST,CST
& ,TYTRM1,MCTRM1,RST,CST
& ,TYTRM2,MCTRM2,RST,CST) !utilite
ENDIF
ELSE
IF (NUDON1.GT.0) THEN
t3 = a1.t1
CALL TEQAT (LGTRM3,TYTRM1,MCTRM1,RST,CST
& ,TYDON1,MCCST1+NIVDO1,IST,RST,CST
& ,TYTRM3,MCTRM3,RST,CST) !utilite
ELSEIF (.NOT.IDMTR1) THEN
t3 = t1
CALL TDANST (LGTRM3,TYTRM1,MCTRM1,IST,RST,CST
& ,TYTRM3,MCTRM3,IST,RST,CST) !utilite
ENDIF
IF (NUDON2.GT.0) THEN
t3 = (a1.)t1 + a2.t2
CALL TPLUAT (LGTRM3,TYTRM3,MCTRM3,RST,CST
& ,TYDON2,MCCST2+NIVDO2,IST,RST,CST
& ,TYTRM2,MCTRM2,RST,CST
& ,TYTRM3,MCTRM3,RST,CST) !utilite
ELSE
t3 = (a1.)t1 + t2
CALL TPLUST (LGTRM3,TYTRM3,MCTRM3,RST,CST
& ,TYTRM2,MCTRM2,RST,CST
& ,TYTRM3,MCTRM3,RST,CST) !utilite
ENDIF
ENDIF
ELSEIF (WTRANS(1:19).EQ.'DIFFERENCE RELATIVE') THEN
ERCODE='difference relative'
NCATR0=19
EPSIL=5.E-2
Module maximum dans les tableaux
CALL TNORMX (LGTRM3,TYTRM1,MCTRM1,IST,RST,CST,VALMX1) !utilite
CALL TNORMX (LGTRM3,TYTRM2,MCTRM2,IST,RST,CST,VALMX2) !utilite
IF (VALMX2.GT.VALMX1) VALMX1=VALMX2
SEUIL=EPSIL*VALMX1
IF (TYTRM1(1:4).EQ.'REEL') THEN
DO 112 ADTERM=MCTRM3,MCTRM3+LGTRM3-1
SOMME=ABS(RST(MCTRM1)+RST(MCTRM2))
RST(ADTERM)=ABS(RST(MCTRM1)-RST(MCTRM2))
IF (SOMME.GT.SEUIL) RST(ADTERM)=2.*RST(ADTERM)/SOMME
MCTRM1=MCTRM1+1
MCTRM2=MCTRM2+1
112 CONTINUE
ELSEIF (TYTRM1(1:4).EQ.'COMP') THEN
DO 114 ADTERM=MCTRM3,MCTRM3+LGTRM3-1
SOMME=ABS(CST(MCTRM1)+CST(MCTRM2))
RST(ADTERM)=ABS(CST(MCTRM1)-CST(MCTRM2))
IF (SOMME.GT.SEUIL) RST(ADTERM)=2.*RST(ADTERM)/SOMME
MCTRM1=MCTRM1+1
MCTRM2=MCTRM2+1
114 CONTINUE
ENDIF
ELSEIF (WTRANS(1:10).EQ.'COMPOSANTE') THEN
IF (OPERA(1:2).EQ.'.*') THEN
(Pour des raisons sans doute historiques, la procedure TCOCOT
cumule le resultat du produit dans le tableau cible (3)
d'ou la necessite de la mise a zero prealable ...)
CALL TAZERO (LGTRM1,TYTRM3,MCTRM3,AST,IST,RST,CST) !utilite
NCATR0=34
ERCODE='.* produit composante a composante'
CALL TCOCOT (LGTRM1,TYTRM1,MCTRM1,RST,CST
& ,TYTRM2,MCTRM2,RST,CST
& ,TYTRM3,MCTRM3,RST,CST) !utilite
ELSEIF (OPERA(1:2).EQ.'./') THEN
NCATR0=35
ERCODE='./ division composante a composante'
CALL TCOCOD (LGTRM1,TYTRM1,MCTRM1,RST,CST
& ,TYTRM2,MCTRM2,RST,CST
& ,TYTRM3,MCTRM3,RST,CST) !utilite
ENDIF
ELSEIF (WTRANS(1:5).EQ.'NOEUD') THEN
ERCODE='produit noeud a noeud'
NCATR0=2
(Pour des raisons sans doute historiques, la procedure TNENET
cumule le resultat du produit dans le tableau cible (3)
d'ou la necessite de la mise a zero prealable ...)
IF (NVALN2.LT.NVALN1) THEN
CALL TAZERO (LGTRM1,TYTRM3,MCTRM3,AST,IST,RST,CST) !utilite
CALL TNENET (NBNEL1,NVALN1,TYTRM1,MCTRM1,RST,CST
& ,NVALN2,TYTRM2,MCTRM2,RST,CST
& ,TYTRM3,MCTRM3,RST,CST) !utilite
ELSE
CALL TAZERO (LGTRM2,TYTRM3,MCTRM3,AST,IST,RST,CST) !utilite
CALL TNENET (NBNEL2,NVALN2,TYTRM2,MCTRM2,RST,CST
& ,NVALN1,TYTRM1,MCTRM1,RST,CST
& ,TYTRM3,MCTRM3,RST,CST) !utilite
ENDIF
ELSEIF (WTRANS(1:9).EQ.'TENSORIEL') THEN
ERCODE='produit tensoriel'
NCATR0=17
CALL TTENST (LGTRM1,TYTRM1,MCTRM1,RST,CST
& ,LGTRM2,TYTRM2,MCTRM2,RST,CST
& ,TYTRM3,MCTRM3,RST,CST) !utilite
ELSEIF (WTRANS(1:8).EQ.'SCALAIRE') THEN
ERCODE='produit scalaire par noeud'
NCATR0=26
IF (TYTRM3.EQ.'REEL') THEN
DO 222 ADTERM=MCTRM3,MCTRM3+NBNEL1-1
CALL TSCALT (NVALN1,TYTRM1,MCTRM1,RST,CST
& ,TYTRM2,MCTRM2,RST,CST,CVAL)
RST(ADTERM)=REAL(CVAL)
MCTRM1=MCTRM1+NVALN1
MCTRM2=MCTRM2+NVALN1
222 CONTINUE
ELSE
DO 224 ADTERM=MCTRM3,MCTRM3+NBNEL1-1
CALL TSCALT (NVALN1,TYTRM1,MCTRM1,RST,CST
& ,TYTRM2,MCTRM2,RST,CST,CST(ADTERM))
MCTRM1=MCTRM1+NVALN1
MCTRM2=MCTRM2+NVALN2
224 CONTINUE
ENDIF
ELSEIF (WTRANS(1:9).EQ.'VECTORIEL') THEN
ERCODE='produit vectoriel par noeud'
NCATR0=27
DO 234 ADTERM=MCTRM3,MCTRM3+NBNEL1*NVALN3-1,NVALN3
CALL TVECTT (NVALN1,TYTRM1,MCTRM1,RST,CST
& ,NVALN2,TYTRM2,MCTRM2,RST,CST
& ,TYTRM3,ADTERM,RST,CST)
MCTRM1=MCTRM1+NVALN1
MCTRM2=MCTRM2+NVALN2
234 CONTINUE
ENDIF
IF (NIVIMP.GE.0.AND.IMPSDR.GT.0) THEN
CALL PRNTRM (NMTRM1,NVTRM1,ERCODE(NCATR0+1:),NCATR1)
CALL PRNTRM (NMTRM2,NVTRM2,ERCODE(NCATR0+NCATR1+1:),NCATR2)
WRITE (IMPSDR,10010) ERCODE(1:NCATR0)
& ,ERCODE(NCATR0+1:NCATR0+NCATR1)
& ,ERCODE(NCATR0+NCATR1+1:NCATR0+NCATR1+NCATR2)
ENDIF
CALL TBSAVE (NMTRM1,NVTRM1)
CALL TBSAVE (NMTRM2,NVTRM2)
CALL TBSAVE (NMTRM3,NVTRM3)
CALL PRFXMJ (-1,'*T2Term*')
RETURN
10000 FORMAT(/T2,'*T2Term* Terme ',A)
10010 FORMAT(T11,A,' du terme ',A,' et du terme ',A)
99990 CALL PRNTRM (NMTRM1,NVTRM1,ERCODE,NCATR1)
CALL PRNTRM (NMTRM2,NVTRM2,ERCODE(NCATR1+1:),NCATR2)
WRITE (*,*) 'Operation ',ERCODE(1:NCATR1),', ',TRANS
&,', ',ERCODE(NCATR1+1:NCATR1+NCATR2)
CALL ERTERS (NUMERR,NMTRM1,NVTRM1,NMTRM2,NVTRM2)
99991 ERCODE=TRANS
CALL PRNTRM (NMTRM1,NVTRM1,ERCODE(LENTRA+1:),NCATR1)
CALL PRNTRM (NMTRM2,NVTRM2,ERCODE(LENTRA+NCATR1+1:),NCATR2)
CALL BAISE ('Operation non prevue : '
&//ERCODE (LENTRA+1:LENTRA+NCATR1)//','//ERCODE(1:LENTRA)//','
&//ERCODE (LENTRA+NCATR1+1:LENTRA+NCATR1+NCATR2)//'.')
-- File history
Version 2 : D.Martin (30 octobre 2006)
- oublie d'un CALL BAISE pour le cas du PRODUIT VECTORIEL
- correction de syntaxe : le mot PRODUIT est a nouveau optionnel dans
[PRODUIT] COMPOSANTE [A COMPOSANTE] comme indique en commentaire!
Version 1.0.8 : D.Martin (12 novembre 2002)
END !T2Term
t2term est appelé dans (11 procédures)