[updated 30.Oct.2008]
Librairie couplag > Fichier calrid.f |
SUBROUTINE CALRID (SIGMA ,GAMMA ,TYNOYO,NBCSTG,NMCSTG,NMLAMB
& ,NMCST1,NMVEC1,NVVEC1,NMCST2,NMVEC2,NVVEC2
& ,NMVEC3,NVVEC3,TYPDER,NIVIMP)
Auteur: O.DeBayser (Juin 1991)
Derniere modification : D.Martin (12 juin 2004)
Version 2
Calcul de representation integrale en des points d'un domaine de calcul(SIGMA)
avec prise en compte des eventuelles symetries, version complexe,
sous la forme
V3(M) = C1 * Int_Gamma V1(p).dNG/dn(M,p) dp + C2 * Int_Gamma V2(P).NG(M,p) dp
ou NG(M,p)=G(M,p) pour un type de noyau Dirichlet
=dG/dnM(M,p) pour un type de noyau Neuman
=dG/dnM(M,p)+Lambda G(M,p) pour un type de noyau Fourier
-- Arguments d'entree --
SIGMA nom du domaine de calcul
GAMMA nom du domaine portant la representation integrale
TYNOYO type de noyau ('DIRichlet', 'NEUmann' ou 'FOUrier')
NBCSTG nombre de constantes pour le calcul de la fonction de Green
NMCSTG tableau des noms des constantes de la fonction de Green
NMLAMB nom de la constante associee au calcul du noyau
NMCST1 nom de la constante relative au vecteur "densite de double couche" V1
NMVEC1 nom du (tableau contenant le) vecteur "densite de double couche" V1
NVVEC1 son niveau
NMCST2 nom de la constante relative a vecteur "densite de simple couche" V2
NMVEC2 nom du (tableau contenant le) vecteur "densite de simple couche" V2
NVVEC2 son niveau
NMVEC3 nom du (tableau contenant le) vecteur resultat
NVVEC3 son niveau
NIVIMP niveau d'impression
-- Routines utilisees --
GREEN : Calcul de green et de ses derivees
SYMGRE: Calcul de green et de ses derivees avec prise en compte
des eventuelles symetries.
NOYDIR,NOYNEU,NOYFOU ; Calcul des noyaux de simple et double couche pour
les couplages de type Dirichlet,Neumann ou Fourier.
IMPLICIT NONE
CHARACTER*(*) SIGMA,GAMMA,TYNOYO,NMLAMB,NMCSTG(*),TYPDER
& ,NMCST1,NMVEC1,NMCST2,NMVEC2,NMVEC3
INTEGER NBCSTG,NVVEC1,NVVEC2,NVVEC3,NIVIMP
INCLUDE 'ALLOC'
INCLUDE 'CONTEX'
CHARACTER ERCODE*120,TYPINT*4
CHARACTER*4 TYGREE,TYVEC1,TYVEC2
INTEGER INDASS,INDSTO,INTDON,INTTYP,INTYKL,KELCHN,KLTERM
INTEGER INTCON,ITENTI,ITREEL,ITCOMP,ITGREE,NIVEAU,LGMORE
& ,MCMDOM,MCTRDO,LGERDO,NBDOMK,INCRDO,NCHDOM
& ,MCMTRM,MCDTRM,LGETRM,NBTERM,INCTRM,NCHTRM,NUTERM
& ,LGDTRM,LGMTRM,MCINCO,ITYINC,NBTNEU
& ,MCMDON,MCDONN,LGEDON,NBDONN,INCDON,NCHDON,ITYDON
& ,NIVDON,ITDONN,MCESTE,MCRSTE,MCCSTE
& ,ITYDO1,NIV1,ITDON1,ITYDO2,NIV2,ITDON2
& ,ITYCAL,NUKALE,NUDONN,NVDSMB,NVDUCV,NVNUCV,NVDULV
& ,NVNULV,INSTOK,NVSTOK,NIVIVC,NVALNE
& ,ITVEC1,LGVEC1,NVALN1,NUINC1,NNVEC1,NUINL1,NNVEL1
& ,INTER1,MCVEC1,NIVIM1,NUCST1
& ,ITVEC2,LGVEC2,NVALN2,NUINC2,NNVEC2,NUINL2,NNVEL2
& ,INTERP,MCVEC2,NIVIM2,NUCST2,ITVEC3,MCVEC3,MCCORN
& ,ADCOGA,MCNOGA,ADNOGA,NBNOGA,MCNUGA,ADNUGA,IDLGAM
& ,IATRGA,NUDOGA,NUDGGA,NVCOGA,NVNUGA,NIVIGA
& ,ADCOSI,MCNOSI,ADNOSI,NBNOSI,MCNUSI,ADNUSI,IDLSIG
& ,IATRSI,NUDOSI,NUDGSI,NVCOSI,NVNUSI,NIVISI
& ,IGEOME,INDMIX,INDEXC,IDLHRC,INDEXL,IDLHRL,INUTIL
& ,NBTRDO,NVNUSL,NVNUGC,NVCOOO,NVVOLD,IPTDIR
& ,LGFGRE,MCGREN,IAGREN,MCDGRE,IADGRE,MCFGRE,MCFGRN
& ,MCEGRE,MCCSTG,LAMBDE,ITLAMB,NCATR1,NCATR2,I,NIVOLD
& ,ITYOLD,NUKOLD,NUCOLD,NDCOLD,NBCOLD,NNCOLD,NULOLD
& ,NDLOLD,NBLOLD,NNLOLD,INDSTK,NVSOLD,NCOOLD,IATOLD
& ,MCTBAS,MCWORK,IDECAL,NUCSTE
REAL LAMBDR,RCST1,RCST2,RESUL1,RESUL2
COMPLEX LAMBDC,CCST1,CCST2,CESUL1,CESUL2
EQUIVALENCE (RCST1,CCST1),(RCST2,CCST2)
EQUIVALENCE (RESUL1,CESUL1),(RESUL2,CESUL2)
COMMON/FORMAH/ERCODE
EQUIVALENCE (ERCODE(73:73),TYVEC1),(ERCODE(81:81),TYVEC2)
& ,(ERCODE(89:89),TYGREE)
EQUIVALENCE (LAMBDE,LAMBDR,LAMBDC)
Tableaux pour les symetries dans le calcul de la fonction de Green
de dimension 3 quelle que soit la dimension d'espace
INTEGER TBISYM(3)
REAL TBPSYM(3)
CALL PRFXMJ (1,'*CalRID*')
INTCON=INTDON ('CONSTANTE') !utilite
ITENTI=INTTYP ('ENTIER') !utilite
ITREEL=INTTYP ('REEL') !utilite
ITCOMP=INTTYP ('COMPLEXE') !utilite
ITGREE=ITCOMP
ITVEC3=ITGREE
CALL TBRR2 (ERCODE,NMVEC1,NVVEC1,LGVEC1,NMVEC2,NVVEC2,LGVEC2)
CALL TBAR5 (ERCODE,'#OMDOM',1,MCMDOM,'#TERDO',1,MCTRDO
& ,'$SDTRM',1,MCDTRM,'#OMTRM',1,MCMTRM
& ,'#NCONU',1,MCINCO)
CALL SDEXDB (IST(MCTRDO),LGERDO,NBDOMK,INCRDO,NCHDOM) !sdexplo
CALL SDEXDB (IST(MCDTRM),LGETRM,NBTERM,INCTRM,NCHTRM) !sdexplo
Caracteristiques du domaine de couplage (SIGMA)
CALL KLDOMN (SIGMA,0,-1,IST(MCTRDO),AST(MCMDOM),NBDOMG
& ,NUDOSI,IATRSI) !sdexplo
IATRSI=MCTRDO+IATRSI
CALL GETDOR (IST(IATRSI),NUDGSI,NUDOSI,IGEOME,INDMIX
& ,INDEXC,IDLHRC,NVNUSI,INDEXL,IDLHRL,NVNUSL
& ,NVCOSI,INUTIL,NBTRDO,NIVISI) !sdexplo
-- Caracteristiques du domaine de representation integrale (GAMMA)
CALL KLDOMN (GAMMA,0,-1,IST(MCTRDO),AST(MCMDOM),NBDOMG
& ,NUDOGA,IATRGA) !sdexplo
IATRGA=MCTRDO+IATRGA
CALL GETDOR (IST(IATRGA),NUDGGA,NUDOGA,IGEOME,INDMIX
& ,INDEXC,IDLHRC,NVNUGC,INDEXL,IDLHRL,NVNUGA
& ,NVCOGA,INUTIL,NBTRDO,NIVIGA) !sdexplo
-- Attributs du terme de densite de double couche V1 (NMVEC1)
NUTERM=KLTERM (NMVEC1,NVVEC1,AST(MCMTRM),IST(MCDTRM)) !sdexplo
IF (NUTERM.LE.0) CALL ERTERM (1,NMVEC1,NVVEC1) !utilite
CALL GETTRM (IST(MCDTRM+LGETRM+INCTRM*(NUTERM-1)),NIVEAU
& ,ITVEC1,ITYCAL,NUKALE,NUDONN,NVALNE,NVDSMB
& ,NUINC1,NVDUCV,NNVEC1,NVNUCV
& ,NUINL1,NVDULV,NNVEL1,NVNULV
& ,INSTOK,NVSTOK,NVCOOO,IATRGA,NIVIVC) !sdexplo
IF (NUINC1.NE.NDFINC) THEN
NUINL1=NUINC1
NNVEL1=NNVEC1
ENDIF
CALL SDEXCO (NUINL1,IST(MCINCO),ITYINC,INTER1,NBTNEU) !sdexplo
TYVEC1=TYPINT (ITVEC1) !utilite
IF (ITVEC1.EQ.ITCOMP) ITVEC3=ITVEC1
-- Attributs du terme de densite de simple couche V2 (NMVEC2)
NUTERM=KLTERM (NMVEC2,NVVEC2,AST(MCMTRM),IST(MCDTRM)) !sdexplo
IF (NUTERM.LE.0) CALL ERTERM (1,NMVEC2,NVVEC2) !utilite
CALL GETTRM (IST(MCDTRM+LGETRM+INCTRM*(NUTERM-1)),NIVEAU
& ,ITVEC2,ITYCAL,NUKALE,NUDONN,NVALNE,NVDSMB
& ,NUINC2,NVDUCV,NNVEC2,NVNUCV
& ,NUINL2,NVDULV,NNVEL2,NVNULV
& ,INSTOK,NVSTOK,NVCOOO,IATRGA,NIVIVC) !sdexplo
IF (NUINC2.NE.NDFINC) THEN
NUINL2=NUINC2
NNVEL2=NNVEC2
ENDIF
CALL SDEXCO (NUINL2,IST(MCINCO),ITYINC,INTERP,NBTNEU) !sdexplo
TYVEC2=TYPINT (ITVEC2) !utilite
IF (ITVEC2.EQ.ITCOMP) ITVEC3=ITVEC2
IF (INTER1.NE.INTERP) GOTO 99992
IF (NNVEL1.NE.NNVEL2.OR.LGVEC1.NE.LGVEC2) GOTO 99993
NBNOGA=NNVEL1
-- Tableaux de coordonnees et des normales
CALL TBRR3 (ERCODE,'#ORNOE',INTERP,MCCORN,'#GNEDO',NVNUGA,MCNUGA
& ,'#GNEDO',NVNUSI,MCNUSI)
IF (TYNOYO(:3).NE.'DIR') THEN
CALL TBRR1 (ERCODE,'&NORMA',NVCOSI,MCNOSI)
ENDIF
CALL TBAR1 (ERCODE,'#GNEDO',NVNUSI,MCNUSI)
NBNOSI=IST(MCNUSI+1)
Creation des termes resultat NMVEC3
Vecteur resultat
Mise a jour des structures de description pour le vecteur resultat
CALL TBAR2 (ERCODE,'#OMTRM',1,MCMTRM,'$SDTRM',1,MCDTRM)
NUTERM=KLTERM (NMVEC3,NVVEC3,AST(MCMTRM),IST(MCDTRM)) !sdexplo
IF (NUTERM.LE.0) THEN
CALL ALFANU (NBCHNT,NMVEC3) !utilite
CALL SDAJST ('$SDTRM',1,LGDTRM,LGETRM,INCTRM,NBTERM,1) !sdexplo
CALL SDAJST ('#OMTRM',1,LGMTRM,0,NCHTRM,NBTERM,1) !sdexplo
CALL TBAR2 (ERCODE,'$SDTRM',1,MCDTRM,'#OMTRM',1,MCMTRM)
CALL RIPCHN (AST(MCMTRM),NBTERM,NCHTRM,NMVEC3) !sdexplo
CALL SDMKDB (IST(MCDTRM),LGETRM,NBTERM,INCTRM,NCHTRM) !sdexplo
NUTERM=NBTERM
IATOLD=0
NVSOLD=0
NUDONN=0
ELSE
CALL GETTRM (IST(MCDTRM+LGETRM+INCTRM*(NUTERM-1)),NVVOLD
& ,ITYOLD,ITYCAL,NUKOLD,NUDONN,NVALNE,IPTDIR
& ,NUCOLD,NDCOLD,NBCOLD,NNCOLD
& ,NULOLD,NDLOLD,NBLOLD,NNLOLD
& ,INDSTK,NVSOLD,NCOOLD,IATOLD,NIVOLD) !sdexplo
ENDIF
ITYCAL=INTYKL ('ASSEMB') !utilite
NUKALE=-INDASS (' ') !utilite
INDSTK=INDSTO ('PLEIN-L') !utilite
IF (NVCOSI.LE.0) NVCOSI=NCOOLD
CALL PUTTRM (IST(MCDTRM+LGETRM+INCTRM*(NUTERM-1)) ,NVVEC3
& ,ITVEC3,ITYCAL,NUKALE,NUDONN,NVALNE,NDFDSM
& ,NDFINC,NDFDUM,1 ,NDFNUM
& ,NUINL1,NDFDUM,NBNOSI,NVNUSI
& ,INDSTK,NVSOLD,NVCOSI,IATOLD,NIVIMP) !sdexplo
-- Creation du tableau local des valeurs de green et ses derivees
TYGREE=TYPINT (ITGREE) !utilite
LGFGRE=1+NDIM+NDIM+NDIM*NDIM+NDIM*NDIM
LGMORE=NBCSTG
IF (ISYMGR.GT.0) LGMORE=LGMORE+LGFGRE
CALL TBCREE ('&GREEN',1,ITGREE,2*NBNOGA+LGFGRE+LGMORE,'c')
CALL TBAR6 (ERCODE,'&GREEN',1,MCFGRN,'#OMDON',1,MCMDON
& ,'$DONNE',1,MCDONN,'$ECSTE',1,MCESTE
& ,'$RCSTE',1,MCRSTE,'$CCSTE',1,MCCSTE)
CALL SDEXDB (IST(MCDONN),LGEDON,NBDONN,INCDON,NCHDON) !sdexplo
-- Recherche de la constante de couplage Lambda (cas KLNOYO='FOUrier')
Sa valeur est placee dans la variable LAMBDC complexe quelque soit
le type de la donnee constante LAMBDA
LAMBDC = 0.
IF (TYNOYO(:3).EQ.'FOU') THEN
NUDONN=KELCHN (NMLAMB,AST(MCMDON),NBDONN,NCHDON) !utilite
IF (NUDONN.LE.0) CALL ERDONN (1,NMLAMB) !utilite
CALL SDEXCO (NUDONN,IST(MCDONN),ITYDON,NIVDON,ITDONN) !sdexplo
IF (ITYDON.NE.INTCON) CALL ERDONN (2,NMLAMB) !utilite
CALL OUTCST (NUCSTE,ITLAMB,LAMBDE,LAMBDR,LAMBDC,ERCODE) !sdexplo
ENDIF
Recherche de la valeur des constantes associees a la fonction de Green
Adresse de la premiere constante associee a la fonction de Green
MCCSTG=MCFGRN+2*NBNOGA+LGFGRE
DO 10 I=1,NBCSTG
NUDONN=KELCHN (NMCSTG(I),AST(MCMDON),NBDONN,NCHDON) !utilite
IF (NUDONN.LE.0) CALL ERDONN (1,NMCSTG(I)) !utilite
CALL SDEXCO (NUDONN,IST(MCDONN),ITYDON,NIVDON,ITDONN) !sdexplo
IF (ITYDON.EQ.INTCON) THEN
IF (ITDONN.EQ.ITCOMP) THEN
CST(MCCSTG-1+I)=CST(MCCSTE+NIVDON)
ELSEIF (ITDONN.EQ.ITREEL) THEN
CST(MCCSTG-1+I)=CMPLX (RST(MCRSTE+NIVDON),0.)
ELSEIF (ITDONN.EQ.ITENTI) THEN
CST(MCCSTG-1+I)=CMPLX (REAL (IST(MCESTE+NIVDON)),0.)
ENDIF
ENDIF
10 CONTINUE
-- Recherche des constantes multiplicatives
CALL TBAR5 (ERCODE,'#OMDON',1,MCMDON
& ,'$DONNE',1,MCDONN,'$ECSTE',1,MCESTE
& ,'$RCSTE',1,MCRSTE,'$CCSTE',1,MCCSTE)
CALL SDEXDB (IST(MCDONN),LGEDON,NBDONN,INCDON,NCHDON) !sdexplo
NUCST1=KELCHN (NMCST1,AST(MCMDON),NBDONN,NCHDON) !utilite
NUCST2=KELCHN (NMCST2,AST(MCMDON),NBDONN,NCHDON) !utilite
CALL SDEXCO (NUCST1,IST(MCDONN),ITYDO1,NIV1,ITDON1) !sdexplo
IF (ITDON1.EQ.ITCOMP) ITVEC3=ITDON1
CALL SDEXCO (NUCST2,IST(MCDONN),ITYDO2,NIV2,ITDON2) !sdexplo
IF (ITDON2.EQ.ITCOMP) ITVEC3=ITDON2
IF (ITYDO1.NE.INTCON) CALL ERDONN (2,NMCST1) !utilite
IF (ITYDO2.NE.INTCON) CALL ERDONN (2,NMCST2) !utilite
IF (ITDON1.EQ.ITCOMP) THEN
CCST1=CST(MCCSTE+NIV1)
ELSEIF (ITDON1.EQ.ITREEL) THEN
CCST1=CMPLX (RST(MCRSTE+NIV1),0.)
ELSEIF (ITDON1.EQ.ITENTI) THEN
CCST1=CMPLX (REAL (IST(MCESTE+NIV1)),0.)
ENDIF
IF (ITDON2.EQ.ITCOMP) THEN
CCST2=CST(MCCSTE+NIV2)
ELSEIF (ITDON2.EQ.ITREEL) THEN
CCST2=CMPLX (RST(MCRSTE+NIV2),0.)
ELSEIF (ITDON2.EQ.ITENTI) THEN
CCST2=CMPLX (REAL (IST(MCESTE+NIV2)),0.)
ENDIF
-- Symetries pour la fonction de Green
IF (ISYMGR.GT.0) CALL KLSYME (NDIM,ISYMGR,TBISYM) !sdexplo
Rappel des vecteurs sur GAMMA
CALL TBRR1 (ERCODE,'#GNEDO',NVNUGA,MCNUGA)
Creation du resultat
CALL TBCREE (NMVEC3,NVVEC3,ITVEC3,NBNOSI,'c')
CALL TBCREE('$WORK$',1,ITGREE,7,'c')
ERCODE(1:1)='!'
CALL TBAR10 (ERCODE
& ,'&NORMA',NVCOGA,MCNOGA, NMVEC3 ,NVVEC3,MCVEC3
& ,'&GREEN', 1 ,MCFGRN,'$WORK$',1 ,MCWORK
& ,'#GNEDO',NVNUGA,MCNUGA,'#GNEDO',NVNUSI,MCNUSI
& , NMVEC1 ,NVVEC1,MCVEC1, NMVEC2 ,NVVEC2,MCVEC2
& ,'&NORMA',NVCOSI,MCNOSI,'#ORNOE',INTERP,MCCORN)
Adresses du noyau de double couche, simple couche et fonction GREEN
MCGREN=MCFGRN
MCDGRE=MCGREN+NBNOGA
MCFGRE=MCDGRE+NBNOGA
Adresse de la premiere constante associee a la fonction de Green
MCCSTG=MCFGRE+LGFGRE
Adresse du tableau de travail pour le fonction de Green
(n'est utile qu'en cas de symetries)
MCEGRE=MCCSTG+NBCSTG
Boucle sur les points de SIGMA
ADNUSI=MCNUSI+2
ADNOSI=MCNOSI
DO 30 IDLSIG=1,NBNOSI
ADCOSI=MCCORN+NDIM*(IST(ADNUSI)-1)
ADNUGA=MCNUGA+2
ADNOGA=MCNOGA
IAGREN=MCGREN
IADGRE=MCDGRE
Boucle sur les points de GAMMA (Representation integrale)
NIVIM1=NIVIGA
DO 20 IDLGAM=1,NBNOGA
ADCOGA=MCCORN+NDIM*(IST(ADNUGA)-1)
IF (NIVIGA.LT.IDLGAM) NIVIM1=0
IF (NIVIM1.GT.2) WRITE (IMPSDR,10010) IDLGAM
& ,(RST(I),I=ADNOGA,ADNOGA+NDIM-1)
Calcul au point ou l'on veut la R.I.
NIVIM2=NIVIMP
IF (NIVIM2.LT.1) NIVIM2=0
Remise a zero du tableau '&GREEN' (Partie 'FGREEN')
CALL TAZERO (LGFGRE,TYGREE,MCFGRE,AST,IST,RST,CST) !utilite
Calcul des valeurs de la fct. de Green et de ses derivees
MCTBAS=MCCSTG
IF (ISYMGR.LE.0) THEN
CALL GREEN (TYNOYO,CST(MCCSTG),RST(ADCOGA),RST(ADCOSI)
& ,CST(MCFGRE),CST(MCTBAS)) !appl-
ELSE
CALL SYMGRE (TYNOYO,NDIM,CST(MCCSTG),RST(ADCOGA)
& ,RST(ADCOSI),TBPSYM,TBISYM,LGFGRE
& ,CST(MCFGRE),CST(MCEGRE),CST(MCTBAS)) !calgre
ENDIF
Copie des valeurs de G et des derivees par rapport a xp,yp,zp
IF (NDIM.EQ.3) THEN
IDECAL=NDIM+1
CST(MCWORK)=CST(MCFGRE)
IF (TYPDER(1:5).EQ.'GRADX') THEN
IDECAL=2*NDIM+1
CST(MCWORK)=CST(MCFGRE+1)
ELSEIF (TYPDER(1:5).EQ.'GRADY') THEN
IDECAL=3*NDIM+1
CST(MCWORK)=CST(MCFGRE+2)
ELSEIF (TYPDER(1:5).EQ.'LAPLX') THEN
IDECAL=2*NDIM+NDIM*NDIM+1
CST(MCWORK)=-CST(MCFGRE+2*NDIM+1)
ELSEIF (TYPDER(1:5).EQ.'LAPLY') THEN
IDECAL=3*NDIM+NDIM*NDIM+1
CST(MCWORK)=-CST(MCFGRE+3*NDIM+2)
ENDIF
CST(MCWORK+4)=CST(MCFGRE+IDECAL)
CST(MCWORK+5)=CST(MCFGRE+IDECAL+1)
CST(MCWORK+6)=CST(MCFGRE+IDECAL+2)
ELSE
IF (TYPDER(1:5).NE.'NODER')
& CALL BAISE ('TYPDER inactif en 2d')
IDECAL=NDIM+1
CST(MCWORK)=CST(MCFGRE)
CST(MCWORK+IDECAL)=CST(MCFGRE+IDECAL)
CST(MCWORK+IDECAL+1)=CST(MCFGRE+IDECAL+1)
MCWORK=MCFGRE
ENDIF
Calcul proprement dit des noyaux
IF (TYNOYO(1:3).EQ.'FOU') THEN
noyaux pour le couplage 'FOURIER'
CALL NOYFOU (NDIM,RST(ADNOGA),RST(ADNOSI),LAMBDC
& ,CST(MCFGRE),CST(IAGREN),CST(IADGRE)
& ,NIVIM2,IMPSDR) !calgre
ELSEIF (TYNOYO(1:3).EQ.'NEU') THEN
noyaux pour le couplage 'NEUMANN'
CALL NOYNEU (NDIM,RST(ADNOGA),RST(ADNOSI)
& ,CST(MCFGRE),CST(IAGREN),CST(IADGRE)
& ,NIVIM2,IMPSDR) !calgre
ELSE
noyaux pour le couplage 'DIRICHLET'
CALL NOYDIR (NDIM,RST(ADNOGA)
& ,CST(MCWORK),CST(IAGREN),CST(IADGRE)
& ,NIVIM2,IMPSDR) !calgre
ENDIF
IAGREN=IAGREN+1
IADGRE=IADGRE+1
ADNUGA=ADNUGA+1
ADNOGA=ADNOGA+NDIM
20 CONTINUE
CALL TSCALT (NBNOGA,TYGREE,MCDGRE,RST,CST,TYVEC1,MCVEC1,RST,CST
& ,CESUL1) !utilite
CALL TSCALT (NBNOGA,TYGREE,MCGREN,RST,CST,TYVEC2,MCVEC2,RST,CST
& ,CESUL2) !utilite
IF (ITVEC3.EQ.ITREEL) THEN
RST(MCVEC3)=RCST1*RESUL1+RCST2*RESUL2
ELSE
CST(MCVEC3)=CCST1*CESUL1+CCST2*CESUL2
ENDIF
MCVEC3=MCVEC3+1
ADNUSI=ADNUSI+1
ADNOSI=ADNOSI+NDIM
30 CONTINUE
IF (TYNOYO(:3).NE.'DIR') THEN
CALL TBSAVE ('&NORMA',NVCOGA)
CALL TBSAVE ('&NORMA',NVCOSI)
ELSE
CALL TBSAVE ('&NORMA',NVCOGA)
ENDIF
CALL TBSAVE ( NMVEC1 ,NVVEC1)
CALL TBSAVE ( NMVEC2 ,NVVEC2)
CALL TBSAVE ( NMVEC3 ,NVVEC3)
CALL TBSAVE ('#GNEDO',NVNUSI)
CALL TBSAVE ('#GNEDO',NVNUGA)
CALL TBSAVE ('#ORNOE',INTERP)
CALL TBTUER ('&GREEN',1)
CALL PRFXMJ (-1,'*CalRID*')
RETURN
10010 FORMAT (T3,' (d.l. de Gamma no',I4,' Normale : ',3E10.4,')')
99992 CALL ERTERS (4,NMVEC1,NVVEC1,NMVEC2,NVVEC2)
99993 CALL ERTERS (7,NMVEC1,NVVEC1,NMVEC2,NVVEC2)
99994 CALL PRNTRM (NMVEC1,NVVEC1,ERCODE,NCATR1)
CALL PRNTRM (NMVEC2,NVVEC2,ERCODE(NCATR1+1:),NCATR2)
ERCODE(NCATR1+NCATR2+1:)=GAMMA
CALL BAISE ('Interpolations incoherentes pour les termes '
&//ERCODE(1:NCATR1)//', '//ERCODE(NCATR1+1:NCATR1+NCATR2)
&//' et le domaine '//ERCODE(NCATR1+NCATR2+1:NCATR1+NCATR2+NCHDOM))
END !CalRID
