[updated 10.Nov.2009]
Librairie caltrm > Fichier trmdom.f |
SUBROUTINE TRMDOM (NBTRDO,INCRDO,NXDODO,NBNECO,NBNELI,NVNUMC
& ,NVNUML,NIVALL,NVCORC,DIMOBL,DIMOBU,DIMORL
& ,DIMORC,DIMATE,DIVECC,DIVECL
& ,KALTEF,KALTME,KALTQU,KALTIT,KALTPC,KALTVN
& ,KALTCE)
Auteurs : D.Martin & O.deBayser (Avril 1988)
Derniere modification : D.Martin (10 novembre 2009)
Version 5
Creation des tableaux des termes
'ELements FINIs',
'MATrice ELeMentaire',
'ELements Finis Localises calcules par QUadrature',
'VALeurs NODales',
'Conditions ESSEntielles' (de Dirichlet) ou de TRANsmission',
'Forme lineaire ponctuelle',
'Interpolation'.
sur un domaine de calcul.
Mise a jour de la structure $SDTRM pour ces termes.
-- Arguments d'entree --
NBTRDO nombre de choses a faire sur le domaine (vachement clair)
en fait NBTRDO est la somme des nombres de matrices E.F.,
de conditions essentielles, de conditions de transmission,
i.e. le nombre de "termes primaires"
INCRDO nombre de descripteurs pour un domaine de calcul
NXDODO adresse relative de depart dans la structure #TERDO pour le domaine
NBNECO nombre de noeud en colonne d'un terme matriciel 'elements finis'
NBNELI - - lignes - - - -
NVNUMC niveau du tableau de numerotation des noeuds #GNEDO en colonne
NVNUML niveau du tableau de numerotation des noeuds #GNEDO en ligne
NIVALL niveau des tableaux de stockage BiMorse, Morse-Ligne, Morse-colonne
NVCORC niveau du tableau &NORMA sur le domaine
DIMOBL taille de la partie triangulaire inferieure d'une matrice 'BiMorse'
DIMOBU taille de la partie triangulaire superieure d'une matrice 'BiMorse'
DIMORL taille d'une matrice 'Morse-Ligne'
DIMORC taille d'une matrice 'Morse-colonne'
DIMATE taille d'une 'Matrice Elementaire' non assemblee
DIVECC taille d'un 'Vecteur Elementaire en colonne' non assemble
DIVECL taille d'un 'Vecteur Elementaire en ligne' non assemble
-- Arguments en sortie --
KALTEF indicateur de calculs de termes 'Element Finis' standards
KALTME '' 'Matrice Elementaire' non assemble
KALTQU '' 'elements finis loc. par QUadrature
KALTVN '' 'Valeurs Nodales'
KALTCE '' 'Cond. Essentielle ou de Transmisssion'
KALTIT '' 'Interpolation'
KALTPC '' 'Forme lineaire ponctuelle'
IMPLICIT NONE
INCLUDE 'ALLOC'
INCLUDE 'CONTEX'
CHARACTER STOIND*7,TYPINT*9,YKLINT*6
CHARACTER KALTEF,KALTME,KALTQU,KALTIT,KALTVN,KALTCE,KALTPC
CHARACTER STKCHN*7,YKLCHN*6
INTEGER INDSTO,INDSYM,INTDON,INTYKL,INTTYP,KLNIVE
INTEGER NBTRDO,INCRDO,NXDODO,NBNECO,NBNELI,NVNUMC,NVNUML,NIVALL
& ,NVCORC,DIMOBL,DIMOBU,DIMORL,DIMORC,DIMATE,DIVECC,DIVECL
INTEGER TAYTRM,LIGNES,COLONS,MIXTE
& ,INTYCO,INTDOC,INTDOT,INTDOF,NXTRDO,MCTRDO
& ,MCDTRM,LGETRM,NBTERM,INCTRM,NCHTRM,MCMTRM,ADTERM
& ,MCDONN,LGEDON,NBDONN,INCDON,NCHDON,MCMDON
& ,MCNEDO,MCINCO,NCPINL,INTINL,NBTNEL,NCPINC,INTINC,NBTNEC
& ,NIVTRM,ITYPTR,ITYCAL,NUKALE,NUDONN,KTYSYM,NVDSMB
& ,NUINCC,KVDUMC,KBCOLO,KVNUMC,NUINCL,KVDUML,KBLIGN
& ,KVNUML,INDSTK,KVNUMS,KVCORC,IATRDO,NIVIMP,ITYSYM
& ,NVSTOK,NWCORC,NWKALE,ITYDON,NIVDON,ITYPDO,NIVASS
& ,NUTERM,NWDODO,KC,IC,KL,IL,IT,LGTAB,NVTAB,LGBMOR,MCBMOR
CHARACTER ERCODE*120,NOMDON*16,NOMTRM*16,READRE,CRSTOK
COMMON/FORMAH/ERCODE
EQUIVALENCE (ERCODE(89:89),NOMDON),(ERCODE(105:105),NOMTRM)
CALL PRFXMJ (1,'*Trmdom*')
KALTEF='N'
KALTVN='N'
KALTQU='N'
KALTCE='N'
KALTIT='N'
KALTME='N'
KALTPC='N'
READRE='Y'
CALL TBAR2 (ERCODE,'$SDTRM',1,MCDTRM,'$DONNE',1,MCDONN)
CALL SDEXDB (IST(MCDTRM),LGETRM,NBTERM,INCTRM,NCHTRM) !utilite
CALL SDEXDB (IST(MCDONN),LGEDON,NBDONN,INCDON,NCHDON) !utilite
INTDOC=INTDON ('CONSTANTE') !utilite
INTDOT=INTDON ('TABLEAU') !utilite
INTDOF=INTDON ('FONCTION') !utilite
INTYCO=INTTYP ('COMPLEXE') !utilite
NXTRDO=NXDODO+INCRDO
DO 1 IT=1,NBTRDO
IF (READRE.EQ.'Y')
& CALL TBAR6 (ERCODE,'#TERDO',1,MCTRDO,'#NCONU',1,MCINCO
& ,'$DONNE',1,MCDONN,'#OMTRM',1,MCMTRM
& ,'#OMDON',1,MCMDON,'$SDTRM',1,MCDTRM)
READRE='N'
NUTERM=IST(MCTRDO+NXTRDO)
Adresse dans $SDTRM des caracteristiques du terme courant
ADTERM=LGETRM+(NUTERM-1)*INCTRM
Caracteristiques predefinies du terme courant
CALL GETTRM (IST(MCDTRM+ADTERM),NIVTRM
& ,ITYPTR,ITYCAL,NUKALE,NUDONN,KTYSYM,NVDSMB
& ,NUINCC,KVDUMC,KBCOLO,KVNUMC
& ,NUINCL,KVDUML,KBLIGN,KVNUML
& ,INDSTK,KVNUMS,KVCORC,IATRDO,NIVIMP) !sdexplo
YKLCHN=YKLINT (ITYCAL) !utilite
CRSTOK='N'
Si le terme a deja ete calcule et que son calcul n'a pas ete
redemande , on saute ...
IF (NUKALE.GT.0) THEN
Nom du terme
CALL GETCHN (AST(MCMTRM),NCHTRM,NUTERM,NOMTRM(1:NCHTRM)) !utilite
NWDODO=NXDODO+1
NWKALE=NUKALE
IF (KVNUMC.EQ.NDFNUM) THEN
KVNUMC=NVNUMC
KBCOLO=NBNECO
ENDIF
IF (KVNUML.EQ.NDFNUM) THEN
KVNUML=NVNUML
KBLIGN=NBNELI
ENDIF
TAYTRM=0
NVSTOK = NDFSTO
NWCORC = NVCORC
NCPINL = 1
INTINL = 99999
NCPINC = 1
INTINC = 99999
STKCHN=' '
IF (NUINCL.GT.0)
& CALL SDEXCO (NUINCL,IST(MCINCO),NCPINL,INTINL,NBTNEL) !utilite
IF (NUINCC.GT.0)
& CALL SDEXCO (NUINCC,IST(MCINCO),NCPINC,INTINC,NBTNEC) !utilite
IF (YKLCHN.EQ.'ELFINI'.OR.YKLCHN.EQ.'MATELM') THEN
Termes 'Elements Finis' standard ou 'Matrice Elementaire'
MIXTE=0
IF (INTINL.NE.INTINC) MIXTE=1
CALL INTCHK (NUKALE,MIXTE,NDIM,NCPINC,NCPINL) !integra
CALL INTATR (NUKALE,KC,IC,KL,IL,ITYSYM) !integra
IF (YKLCHN.EQ.'ELFINI') THEN
LIGNES=NBNELI
COLONS=NBNECO
KALTEF='Y'
ELSE
LIGNES=DIVECL
COLONS=DIVECC
KALTME='Y'
ENDIF
IF (INTINC.GE.0.AND.INTINL.GE.0) THEN
Termes 'EF' : Inconnues NODALES en ligne et colonne
IF (KC.EQ.-1) THEN
Termes vectoriels (e.g. second membre)
NCPINC=1
NUINCC=NDFINC
KVNUMC=NDFNUM
KBCOLO=1
ITYSYM designe pour ces termes le nombre de valeurs/noeud
ITYSYM=NCPINL
TAYTRM=NCPINL*LIGNES
ELSE
Termes matriciels
IF (NUINCC.EQ.NUINCL) THEN
Si le type de symetrie est deja connu (par exemple
donne explicitement par l'utilisateur,
evitons de l'ecraser)
IF (KTYSYM.NE.NDFSYM) ITYSYM=KTYSYM
Stockage du terme sous forme BiMorse
NCPINC=NCPINL
TAYTRM=MIN (COLONS,LIGNES)*NCPINL*(NCPINL+1)/2
& +DIMOBL*NCPINC*NCPINC
IF (ITYSYM.EQ.NDFSYM)
& TAYTRM=TAYTRM+DIMOBU*NCPINL*NCPINC
& +MIN (COLONS,LIGNES)*NCPINL*(NCPINL-1)/2
STKCHN='BIMORSE'
ELSEIF (NUINCL.GT.NUINCC) THEN
Stockage du terme sous forme Morse-Ligne
TAYTRM=DIMORL*NCPINL*NCPINC
ITYSYM=NDFSYM
STKCHN='MORSE-L'
ELSE
Stockage du terme sous forme Morse-colonne
TAYTRM=DIMORC*NCPINL*NCPINC
ITYSYM=NDFSYM
STKCHN='MORSE-C'
ENDIF
IF (YKLCHN.EQ.'ELFINI') THEN
NVSTOK=NIVALL
IF (KVNUMS.GT.0) NVSTOK=KVNUMS
ELSE
TAYTRM=DIMATE*NCPINL*NCPINC
ITYSYM=NDFSYM
INDSTK=0
ENDIF
ENDIF
ELSE
IF (INTINC.LT.0) THEN
Termes 'EF' : Inconnue non NODALE en colonne
KBCOLO=1
KVNUMC=-NCPINC
TAYTRM=LIGNES*NCPINL*NCPINC
ELSEIF (INTINL.LT.0) THEN
Termes 'EF' : Inconnue non NODALE en ligne
KBLIGN=1
KVNUML=-NCPINL
TAYTRM=COLONS*NCPINL*NCPINC
ENDIF
IF (NUINCL.GT.NUINCC) THEN
STKCHN='PLEIN-L'
ELSEIF (NUINCL.LT.NUINCC) THEN
STKCHN='PLEIN-C'
ENDIF
ENDIF
ELSEIF (YKLCHN.EQ.'ELFLQU') THEN
Cas des elements finis localises calcules
par integration numerique
KALTQU='Y'
ITYSYM=NDFSYM
IF (INTINC.EQ.-1.AND.INTINL.EQ.-1) THEN
Inconnues spectrales en colonne et en ligne
KVNUMC=-NBTNEC
KBCOLO=NBTNEC
IF (NBTNEC.EQ.NBTNEL) THEN
KVNUML=KVNUMC
KBLIGN=KBCOLO
ELSE
KVNUML=-NBTNEL
KBLIGN=NBTNEL
ENDIF
TAYTRM=NCPINL*NBTNEL*NCPINC*NBTNEC
ELSE IF (INTINC.EQ.-1) THEN
Inconnue spectrale en colonne
KVNUMC=-NBTNEC
KBCOLO=NBTNEC
TAYTRM=NCPINL*NBNELI*NCPINC*NBTNEC
ELSEIF (INTINL.EQ.-1) THEN
Inconnue spectrale en ligne
KVNUML=-NBTNEL
KBLIGN=NBTNEL
TAYTRM=NCPINC*NBNECO*NCPINL*NBTNEL
ENDIF
IF (NUINCL.EQ.NUINCC) THEN
STKCHN='BIMORSE'
NVSTOK=-NBTNEC
CRSTOK='B'
ELSEIF (NUINCL.GT.NUINCC) THEN
STKCHN='PLEIN-L'
ELSEIF (NUINCL.LT.NUINCC) THEN
STKCHN='PLEIN-C'
ENDIF
ELSEIF (YKLCHN.EQ.'ELFLOC') THEN
Termes 'Elements Finis localises' (voir librairie Calefl)
GOTO 1
ELSEIF (YKLCHN.EQ.'VALNOD') THEN
Termes 'Valeur Nodales'
ITYSYM designe pour ces termes le nombre de valeurs/noeud
defini par directive (voir LcVano)
ITYSYM=KTYSYM
CALL VANOAT (NUKALE,NDIM,NCPINC,ITYSYM)
NUINCL=NDFINC
KVNUML=NDFNUM
KBLIGN=1
TAYTRM=NBNECO*ITYSYM
KALTVN='Y'
ELSEIF (YKLCHN.EQ.'C.ESSE') THEN
Terme 'donnee de Dirichlet' non homogene : 'G' dans 'U1=U2+G'
ITYSYM designe pour ces termes le nombre de valeurs/noeuds
ITYSYM=KTYSYM
NUINCL=NDFINC
KVNUML=NDFNUM
KBLIGN=1
IF (NUDONN.GT.0) TAYTRM=NBNECO*ITYSYM
KALTCE='Y'
ELSEIF (YKLCHN.EQ.'C.TRAN') THEN
Terme 'donnee de Condition de transmission' non homogene
ITYSYM designe pour ces termes le nombre de valeurs/noeuds
ITYSYM=KTYSYM
KVNUML=NDFNUM
KBLIGN=1
IF (NUDONN.GT.0) TAYTRM=NBNECO*ITYSYM
KALTCE='Y'
ELSEIF (YKLCHN.EQ.'FORMLI') THEN
Termes 'Forme lineaire ponctuelle' ??????????????????????
TAYTRM=KBCOLO*NCPINC*KBLIGN*NCPINL
IF (NUKALE.EQ.1) ITYSYM=INDSYM ('SYMETRIQUE') !utilite
STKCHN='BIMORSE'
NVSTOK=NIVALL
IF (KVNUMS.GT.0) NVSTOK=KVNUMS
KALTPC='Y'
ELSEIF (YKLCHN.EQ.'INTERP') THEN
Termes 'INTERPolation' ??????????????????????????????????
CALL ITRATR (NUKALE,NDIM,KC,IC,KL,IL) !calkit
NCPINL=1
NUINCL=NDFINC
KVNUML=NDFNUM
KBLIGN=1
KL=KC
IF (KL.GE.1) THEN
Termes vectoriels ("uni-ligne")
Le resultat sera discontinu range par rapport aux
elements du domaine lie au resultat (domaine D').
La taille du resultat est donnee par le nombre de d.l.
par element du domaine de calcul lie au resultat
(domaine D').
L'information (NBELDO et NBNECX de D') n'etant pas
disponible ici, la taille devra etre reajustee ...
TAYTRM=NBNECO*NCPINC
ELSE
La taille du resultat est donne par la numerotation
globale du domaine de calcul lie au resultat (domaine D').
TAYTRM=NBNECO*NCPINC
ENDIF
ITYSYM=NDFSYM
KALTIT='Y'
ELSE
Les termes relevant d'un autre type de calcul sont ignores ici
GOTO 1
ENDIF
Prise en compte de la donnee affectee au terme courant
IF (NUDONN.GT.0) THEN
CALL GETCHN (AST(MCMDON),NCHDON,NUDONN,NOMDON) !utilite
CALL SDEXCO (NUDONN,IST(MCDONN),ITYDON,NIVDON,ITYPDO) !utilite
IF (ITYPDO.GE.INTTYP ('CARACTERE')) THEN
Donnee de type CARACTERE pour les conditions essentielles
IF (YKLCHN.NE.'C.ESSE'.AND.YKLCHN.NE.'C.TRAN')
& CALL ERTERM (24,NOMTRM(1:NCHTRM),NIVTRM)
IF (ITYDON.EQ.INTDOF)
& CALL ERTERM (26,NOMTRM(1:NCHTRM),NIVTRM)
Terme de type 'CARACTERE' si donnee associee 'CARACTERE'
ITYPTR=ITYPDO
Tableau non cree pour les termes 'CARACTERE'
TAYTRM=0
ELSE
IF (ITYDON.EQ.INTDOC) THEN
Donnee CONSTANTE affectee au terme
IF (ITYPTR.NE.INTYCO) THEN
IF (YKLCHN.EQ.'VALNOD'.OR.YKLCHN.EQ.'C.ESSE'
& .OR.YKLCHN.EQ.'C.TRAN') ITYPTR=ITYPDO
ENDIF
LGTAB=0
ELSEIF (ITYDON.EQ.INTDOT) THEN
Donnee TABLEAU affectee au terme
IF (ITYPTR.NE.INTYCO) ITYPTR=ITYPDO
LGTAB=1
NVTAB=NIVDON
ELSEIF (ITYDON.EQ.INTDOF) THEN
Donnee FONCTION affectee au terme
IF (ITYPTR.NE.INTYCO) ITYPTR=ITYPDO
IF (NIVDON.GT.0) THEN
CALL SDEXCO (NIVDON,IST(MCDONN)
& ,ITYDON,NIVASS,ITYPDO) !utilite
IF (ITYDON.EQ.INTDOT) THEN
Donnee TABLEAU associe a une donnee FONCTION
CALL GETCHN (AST(MCMDON),NCHDON,NIVDON
& ,NOMDON) !utilite
LGTAB=1
NVTAB=NIVASS
ENDIF
ENDIF
ENDIF
IF (LGTAB.EQ.1) THEN
Si la donnee TABLEAU existe, il est reintroduit en M.C.
Sinon il sera
soit cree dans cette boucle
soit il n'a pas ete defini et ... baise dans EfAdrs
Ceci permet de definir les termes Valeurs Nodales
avant ou apres les termes Elements Finis
ERCODE(1:1)='!'
CALL TBRR1 (ERCODE,NOMDON(1:NCHDON),NVTAB,LGTAB)
READRE='Y'
ENDIF
ENDIF
ENDIF
Creation des tableau de numerotation triviale pour le cas
d'une inconnue non nodale
IF (KVNUMC.LT.0.AND.KVNUMC.NE.NDFNUM)
& CALL CRNEDO(KVNUMC,-KVNUMC,IST) !sdexplo
IF (KVNUML.LT.0.AND.KVNUML.NE.KVNUMC.AND.KVNUML.NE.NDFNUM)
& CALL CRNEDO(KVNUMC,-KVNUMC,IST) !sdexplo
Structure BIMORSE du terme (differente de la structure &BMORS
definie pour les inconnues EF sur le domaine)
IF (CRSTOK.EQ.'B') CALL CRBMOP (NVSTOK,KBLIGN,KBCOLO,IST) !sdexplo
Creation du terme
(la mise a zero des termes du domaine est faite dans EFadrs)
IF (READRE.EQ.'Y') CALL TBAR1 (ERCODE,'$SDTRM',1,MCDTRM)
ITYCAL=INTYKL (YKLCHN) !utilite
INDSTK=INDSTO (STKCHN) !utilite
CALL PUTTRM (IST(MCDTRM+ADTERM),NIVTRM
& ,ITYPTR,ITYCAL,NWKALE,NUDONN,ITYSYM,NVDSMB
& ,NUINCC,KVDUMC,KBCOLO,KVNUMC
& ,NUINCL,KVDUML,KBLIGN,KVNUML
& ,INDSTK,NVSTOK,NWCORC,NWDODO,NIVIMP) !sdexplo
IF (NIVIMP.GT.3) THEN
IF (READRE.EQ.'Y') CALL TBAR1 (ERCODE,'#OMTRM',1,MCMTRM)
CALL PRSDTR (NUTERM,IST(MCDTRM),AST(MCMTRM),IMPSDR) !prsd
ENDIF
IF (TAYTRM.GT.0) THEN
CALL TBCREE (NOMTRM(1:NCHTRM),NIVTRM,ITYPTR,TAYTRM,'c')
READRE='Y'
ENDIF
ENDIF
1 NXTRDO=NXTRDO+1
CALL PRFXMJ (-1,'*Trmdom*')
-- File history --
Version 5 : D.Martin (10 novembre 2008)
initialisation de l'indice de sym pour une matrice spectrale x spectrale
Version 4 : D.Martin (14 mars 2008)
- Bug pour les termes elements finis avec une inconnue non NODALE en ligne ou
en colonne (niveau tableau de numerotation incorrecte : KVNUMC/L)
Ajout de creation des tableaux de numerotation triviale (CRNEDO)
Version 3 : D.Martin (16 janvier 2007)
- initialisation STKCHN=' ' oubliee et rajoutee !
Version 2 : D.Martin (16 octobre 2006)
- Creation du tableau &BMORS pour un terme spectral x spectral
- Suppression de la creation des numerotations pour inconnues non nodales
Voir Lc_kSpe et Lc_Autr
- Ajout des termes 'ELFLQU' elements finis localises pour un couple
d'inconnues spectrales
- Bug dans la creation de tableaux de numerotation pour inconnue non 'NODALE'
Version 1.1 : C.Chambeyron (12 novembre 2002)
- Ajout de termes de type 'ELFLQU' elements finis localises calcules par
integration numerique
Version 1.0.3 : D.Martin (14 mai 2001)
-
Version 0 : D.Martin & O.deBayser (avril 1988)
END !Trmdom
trmdom est appelé dans (3 procédures)