[updated 30.Sep.2001]
Librairie cesse > Fichier ceelim.f |
SUBROUTINE CEELIM (MULTIM,NCPICE,NUKACE,NUINCE
& ,NBESSE,NGESSE,TYESSE,NCESSE,MCESSE
& ,NUINCC,NCPINC,NBNEMC,NGNUMC,NEAVCE,NBCONE
& ,NUINCL,NCPINL,NBNEML,NGNUML,NEAVLE,NBLINE
& ,IDNUME,ITYSYM,TYMATR,MCMATR,NMSTOK,MCSTOK
& ,TYVECT,MCVECT,NBVECT,NLVECT
& ,IST,RST,CST,NIVIMP,IMPFCH,IRCODE)
Auteur : D.Martin (Juin 1997)
Derniere modification : D.Martin (24 Aout 2000)
Version 1.0.1
Prise en compte d'une condition essentielle (blocage des d.l. Dirichlet)
sur un couple (matrice A ,vecteur V) dans un systeme lineaire A x = V
ou pour le calcul de valeurs propres A V = Lambda V
-- Arguments d'entree --
MULTIM indicateur du caractere multi-inconnue
NCPICE nombre de composantes par noeud de l'inconnue de la cond. essentielle
NUKACE numero de type de condition essentielle
NUINCE numero de l'inconnue portant la condition essentielle
NBESSE nombre de noeuds ou d.l. portant la condition essentielle
NGESSE tableau de numerotation des noeuds ou d.l. portant la cond. essentielle
TYESSE type (REEL ou COMPLEXE) de la donnee de condition essentielle
NCESSE nombre de valeurs par noeud de la donnee de `Condition Essentielle'
MCESSE adresse absolue du tableau contenant les valeurs de cette donnee
NUINCC numero de l'inconnue en colonne de la matrice
NCPINC nombre de composantes par noeud de l'inconnue en colonne
NBNEMC nombre de noeuds/d.l. en colonne
NGNUMC numerotation des noeuds/d.l. en colonne
NEAVCE nombre de colonnes des blocs precedents dans le cas multi-inconnue
NBCONE nombre de noeuds en colonne de la matrice (cas uni-inconnue)
nombre de colonnes de la matrice (cas multi-inconnues)
NUINCL numero de l'inconnue en ligne de la matrice
NCPINL nombre de composantes par noeud de l'inconnue en ligne
NBNEMC nombre de noeuds/d.l. en colonne
NGNUML numerotation des noeuds/d.l. en ligne
NEAVLE nombre de lignes des blocs precedents dans le cas multi-inconnue
NBLINE nombre de noeuds en ligne de la matrice (cas uni-inconnue)
nombre de lignes de la matrice (cas multi-inconnues)
ITYSYM indicateur de symetrie de la matrice
TYMATR type REEL ou COMPLEXE de la matrice
MCMATR adresse absolue de la matrice
NMSTOK nom du tableau de stockage de la matrice
MCSTOK adresse absolue du tableau de stockage de la matrice
TYVECT type REEL ou COMPLEXE du vecteur
MCVECT adresse du vecteur (0 si pas de vecteur)
NBVECT nombre de (colonnes du) vecteur(s)
NLVECT nombre de lignes de vecteur
IST,RST,CST super-tableau, version ENTIERE, REELLE, COMPLEXE
NIVIMP niveau d'impression du terme condition essentielle
IMPFCH numero du fichier pour impression
IRCODE code de retour en cas de bug
CHARACTER*(*) MULTIM,TYESSE,TYMATR,NMSTOK,TYVECT
INTEGER NCPICE,NUKACE,NUINCE,NBESSE,NGESSE(*),NCESSE,MCESSE
& ,NUINCC,NCPINC,NBNEMC,NGNUMC(*),NEAVCE,NBCONE
& ,NUINCL,NCPINL,NBNEML,NGNUML(*),NEAVLE,NBLINE
& ,ITYSYM,MCMATR,MCSTOK,MCVECT,NBVECT,NLVECT
& ,NIVIMP,IMPFCH,IRCODE,IST(*)
REAL RST(*)
COMPLEX CST(*)
LOGICAL IDNUME
INTEGER INDSYM
INTEGER NUELI1,NUELI2,NDESS1,ITYSNO,MCMATL,MCMATU,NCFSSD
& ,NBL,NBPLAL,MCPLAL,MCPLIL,LGL
& ,NBC,NBPLAU,MCPLAU,MCPLIU,LGU
CHARACTER PRFXAS*8,LIGCOL*7
CALL PRFXMJ (1,'*CeElim*')
IRCODE=0
ITYSNO=INDSYM (' ')
NUELI1 numero de la premiere composante par noeud dans le repere local
sur laquelle porte l'elimination
NUELI2 numero de la derniere composante par noeud ...
NDESS1 numero de la premiere composante par noeud utile dans la donnee
de la condition essentielle
Remarque : L'algorithme utilise ici ne fonctionne que si les
d.l. Dirichlet d'un noeud sont consecutif
(c'est le cas pour les 3 cas envisages pour le moment)
NDESS1=1
IF (NUKACE.EQ.1) THEN
Condition u = g
elimination sur toutes les composantes
NUELI1=1
NUELI2=NCPINC
ELSEIF (NUKACE.EQ.2) THEN
Condition u.n = g
elimination sur la composante normale
(la premiere dans le repere local)
NUELI1=1
NUELI2=1
ELSEIF (NUKACE.EQ.3) THEN
Condition u^n = g
elimination de la (des) composante(s) tangentielle
(la 2de ou les 2 dernieres dans le repere local)
NUELI1=2
NUELI2=NCPINC
IF (NCESSE.EQ.NCPINC) NDESS1=2
ELSE
GOTO 99991
ENDIF
IF (NMSTOK(1:4).EQ.'&BMO') THEN
Cas d'une matrice stockee sous forme BiMorse
--------------------------------------------
CALL EXBMOR (MCSTOK,IST(MCSTOK),NBL,NBPLAL,MCPLAL,MCPLIL,LGL
& ,NBC,NBPLAU,MCPLAU,MCPLIU,LGU) !sdexplo
IF (NCPICE.EQ.1.OR.MULTIM(1:1).EQ.'Y') THEN
Systeme uni-inconnue a inconnue scalaire ou multi-inconnues
NUELI1=1
NUELI2=1
NDESS1=1
MCMATL=MCMATR+MIN (NBL,NBC)
MCMATU=MCMATL
IF (ITYSYM.EQ.ITYSNO) THEN
MCMATU=MCMATL+LGL
ELSEIF (ITYSYM.NE.INDSYM ('SYMETRIQUE')) THEN
GOTO 90005
ENDIF
IF (NUINCE.EQ.NUINCC) THEN
Elimination des colonnes des d.l. 'Dirichlet' dans
la partie triangulaire superieure apres report
au second membre (de -Aij x Uj)
LIGCOL='Ligne'
IF (ITYSYM.EQ.ITYSNO) LIGCOL='Colonne'
IF (NIVIMP.GT.1.AND.IMPFCH.GT.0) THEN
IF (ITYSYM.EQ.ITYSNO) THEN
WRITE (IMPFCH,10001) PRFXAS (2),'*CeeBl *'
& ,'colonnes','sup.'
ELSE
WRITE (IMPFCH,10001) PRFXAS (2),'*CeeBl *'
& ,'lignes','inf.'
ENDIF
ENDIF
CALL CEEBL (NBNEMC,NGNUMC,NEAVCE
& ,IST(MCPLAU),IST(MCPLIU),TYMATR,MCMATU
& ,TYVECT,MCVECT
& ,NBESSE,NGESSE,TYESSE,MCESSE
& ,RST,CST,LIGCOL,NIVIMP,IMPFCH)
Elimination des colonnes des d.l. 'Dirichlet' dans
la partie triangulaire inferieure apres report
au second membre (de -Aij x Uj)
IF (NIVIMP.GT.1.AND.IMPFCH.GT.0) THEN
WRITE (IMPFCH,10001) PRFXAS (2),'*CeeBc *'
& ,'colonnes','inf.'
ENDIF
CALL CEEBC (NBNEMC,NGNUMC,NEAVCE,NBNEML,NGNUML,NEAVLE
& ,NBLINE,IDNUME
& ,IST(MCPLAL),IST(MCPLIL),TYMATR,MCMATL
& ,TYVECT,MCVECT
& ,NBESSE,NGESSE,TYESSE,MCESSE
& ,RST,CST,'Colonne',NIVIMP,IMPFCH)
ENDIF
IF (NUINCE.EQ.NUINCL) THEN
IF (ITYSYM.EQ.ITYSNO) THEN
Matrice non symetrique
Elimination des lignes des d.l. 'Dirichlet' dans
la partie triangulaire inferieure
IF (NIVIMP.GT.1.AND.IMPFCH.GT.0) THEN
WRITE (IMPFCH,10001) PRFXAS (2),'*CeeBl *'
& ,'lignes','inf.'
ENDIF
CALL CEEBL (NBNEML,NGNUML,NEAVLE
& ,IST(MCPLAL),IST(MCPLIL),TYMATR,MCMATL
& ,TYVECT,MCVECT
& ,NBESSE,NGESSE,TYESSE,0
& ,RST,CST,'Ligne',NIVIMP,IMPFCH)
Elimination des lignes des d.l. 'Dirichlet' dans
la partie triangulaire superieure
IF (NIVIMP.GT.1.AND.IMPFCH.GT.0) THEN
WRITE (IMPFCH,10001) PRFXAS (2),'*CeeBc *'
& ,'lignes','sup.'
ENDIF
CALL CEEBC (NBNEML,NGNUML,NEAVLE,NBNEMC,NGNUMC,NEAVCE
& ,NBCONE,IDNUME
& ,IST(MCPLAU),IST(MCPLIU),TYMATR,MCMATU
& ,TYVECT,MCVECT
& ,NBESSE,NGESSE,TYESSE,0
& ,RST,CST,'Ligne',NIVIMP,IMPFCH)
ENDIF
Modification du vecteur sur les lignes Dirichlet
(apres report de Aii x Ui) dans le cas non-homogene
IF (MCVECT.GT.0) THEN
CALL CEEBV (1,NUELI1,NUELI2,NBNEML,NGNUML,NEAVLE
& ,TYMATR,MCMATR,TYVECT,MCVECT,NBVECT
& ,NLVECT,NBESSE,NGESSE,TYESSE,1,MCESSE
& ,NDESS1,RST,CST)
ENDIF
ENDIF
ELSE
Systeme uni-inconnue a inconnue vectorielle
NCFSSD=NCPINC
IF (NCFSSD.LT.3) NCFSSD=NCFSSD-1
MCMATL=MCMATR+MIN(NBL,NBC)*NCPINC
MCMATU=MCMATL
IF (ITYSYM.EQ.ITYSNO) THEN
MCMATU=MCMATL+LGL*NCPINC*NCPINC+NCFSSD*MIN(NBL,NBC)
ELSEIF (ITYSYM.NE.INDSYM ('SYMETRIQUE')) THEN
GOTO 90005
ENDIF
IF (NUINCE.EQ.NUINCC) THEN
Elimination des colonnes des d.l. 'Dirichlet' dans
la partie triangulaire superieure apres report
au 2nd membre (de -Aij x Uj)
IF (NIVIMP.GT.1.AND.IMPFCH.GT.0) THEN
IF (ITYSYM.EQ.ITYSNO) THEN
WRITE (IMPFCH,10001) PRFXAS (2),'*CeeBlv*'
& ,'colonnes','sup.'
ELSE
WRITE (IMPFCH,10001) PRFXAS (2),'*CeeBlv*'
& ,'lignes','inf.'
ENDIF
ENDIF
CALL CEEBLV (NCPINC,NUELI1,NUELI2,NBNEMC,NGNUMC,NEAVCE
& ,IST(MCPLAU),IST(MCPLIU),TYMATR,MCMATU
& ,NCFSSD,TYVECT,MCVECT,NBVECT,NLVECT
& ,NBESSE,NGESSE,TYESSE,NCESSE,MCESSE,NDESS1
& ,RST,CST)
Elimination des colonnes des d.l. 'Dirichlet' dans
la partie triangulaire inferieure avec report
au 2nd membre(de -Aij x Uj)
IF (NIVIMP.GT.1.AND.IMPFCH.GT.0) THEN
WRITE (IMPFCH,10001) PRFXAS (2),'*CeeBcv*'
& ,'colonnes','inf.'
ENDIF
CALL CEEBCV (NCPINC,NUELI1,NUELI2,NBNEMC,NGNUMC,NEAVCE
& ,NBNEML,NGNUML,NEAVLE,NBLINE,IDNUME
& ,IST(MCPLAL),IST(MCPLIL),TYMATR,MCMATL
& ,NCFSSD,TYVECT,MCVECT,NBVECT,NLVECT
& ,NBESSE,NGESSE,TYESSE,NCESSE,MCESSE,NDESS1
& ,RST,CST)
ENDIF
IF (NUINCE.EQ.NUINCL) THEN
IF (ITYSYM.EQ.ITYSNO) THEN
Matrice non symetrique
Elimination des lignes des d.l. 'Dirichlet' dans
la partie triangulaire inferieure
IF (NIVIMP.GT.1.AND.IMPFCH.GT.0) THEN
WRITE (IMPFCH,10001) PRFXAS (2),'*CeeBlv*'
& ,'lignes','inf.'
ENDIF
CALL CEEBLV (NCPINL,NUELI1,NUELI2,NBNEML,NGNUML
& ,NEAVCE,IST(MCPLAL),IST(MCPLIL),TYMATR
& ,MCMATL,NCFSSD,TYVECT,MCVECT,NBVECT
& ,NLVECT,NBESSE,NGESSE,TYESSE,0,0,0
& ,RST,CST)
Elimination des lignes des d.l. 'Dirichlet' dans
la partie triangulaire superieure
IF (NIVIMP.GT.1.AND.IMPFCH.GT.0) THEN
WRITE (IMPFCH,10001) PRFXAS (2),'*CeeBcv*'
& ,'lignes','sup.'
ENDIF
CALL CEEBCV (NCPINL,NUELI1,NUELI2,NBNEML,NGNUML
& ,NEAVLE,NBNEMC,NGNUMC,NEAVCE,NBCONE
& ,IDNUME,IST(MCPLAU),IST(MCPLIU),TYMATR
& ,MCMATU,NCFSSD,TYVECT,MCVECT,NBVECT
& ,NLVECT,NBESSE,NGESSE,TYESSE,0,0,0
& ,RST,CST)
ENDIF
Modification du vecteur sur les lignes Dirichlet
(report de Aii x Ui) dans le cas non-homogene
IF (MCVECT.GT.0) THEN
CALL CEEBV (NCPINL,NUELI1,NUELI2,NBNEML,NGNUML,NEAVLE
& ,TYMATR,MCMATR,TYVECT,MCVECT,NBVECT,NLVECT
& ,NBESSE,NGESSE,TYESSE,NCESSE,MCESSE,NDESS1
& ,RST,CST)
ENDIF
ENDIF
ENDIF
ELSEIF (NMSTOK(1:4).EQ.'&PLA') THEN
Cas d'une matrice stockee sous forme Morse-Ligne
------------------------------------------------
CALL EXMORS (MCSTOK,IST(MCSTOK)
& ,NBL,NBC,NBPLAL,MCPLAL,MCPLIL,LGL) !sdexplo
IF (NCPICE.EQ.1) THEN
Elimination des lignes des d.l. 'Dirichlet'
IF (NUINCE.EQ.NUINCL)
& CALL CDMODL (IDNUME,NGNUML,NBNEMC,NGNUMC,IST(MCPLAL)
& ,IST(MCPLIL),TYMATR,MCMATR,TYVECT,MCVECT
& ,NBESSE,NGESSE,TYESSE,MCESSE
& ,RST,CST)
Elimination des colonnes des d.l. 'Dirichlet'
IF (NUINCE.EQ.NUINCC)
& CALL CDMODC (NBNEML,NGNUML,NBNEMC,NGNUMC,IST(MCPLAL)
& ,IST(MCPLIL),TYMATR,MCMATR,TYVECT,MCVECT
& ,NBESSE,NGESSE,TYESSE,MCESSE
& ,RST,CST)
ELSE
Elimination des lignes des d.l. 'Dirichlet'
IF (NUINCE.EQ.NUINCL)
& CALL CDMOVL (NUKACE,NCPICE,IDNUME,NGNUML,NBNEMC,NGNUMC
& ,IST(MCPLAL),IST(MCPLIL),TYMATR,MCMATR
& ,TYVECT,MCVECT,NBESSE,NGESSE,TYESSE,MCESSE
& ,RST,CST)
Elimination des colonnes des d.l. 'Dirichlet'
IF (NUINCE.EQ.NUINCC)
& CALL CDMOVC (NUKACE,NCPICE,NBNEML,NGNUML,NBNEMC,NGNUMC
& ,IST(MCPLAL),IST(MCPLIL),TYMATR,MCMATR
& ,TYVECT,MCVECT,NBESSE,NGESSE,TYESSE,MCESSE
& ,RST,CST)
ENDIF
ELSEIF (NMSTOK(1:4).EQ.'&EGA') THEN
Cas d'une matrice stockee sous forme Morse-Colonne
--------------------------------------------------
CALL EXMORS (MCSTOK,IST(MCSTOK)
& ,NBC,NBL,NBPLAL,MCPLAL,MCPLIL,LGL) !sdexplo
IF (NCPICE.EQ.1) THEN
Elimination des lignes des d.l. 'Dirichlet'
IF (NUINCE.EQ.NUINCL)
& CALL CDMODL (IDNUME,NGNUML,NBNEMC,NGNUMC,IST(MCPLAL)
& ,IST(MCPLIL),TYMATR,MCMATR,TYVECT,MCVECT
& ,NBESSE,NGESSE,TYESSE,MCESSE
& ,RST,CST)
Elimination des colonnes des d.l. 'Dirichlet'
IF (NUINCE.EQ.NUINCC)
& CALL CDMODC (NBNEML,NGNUML,NBNEMC,NGNUMC,IST(MCPLAL)
& ,IST(MCPLIL),TYMATR,MCMATR,TYVECT,MCVECT
& ,NBESSE,NGESSE,TYESSE,MCESSE
& ,RST,CST)
ELSE
Elimination des lignes des d.l. 'Dirichlet'
IF (NUINCE.EQ.NUINCL)
& CALL CDMOVL (NUKACE,NCPICE,IDNUME,NGNUML,NBNEMC,NGNUMC
& ,IST(MCPLAL),IST(MCPLIL),TYMATR,MCMATR
& ,TYVECT,MCVECT,NBESSE,NGESSE,TYESSE,MCESSE
& ,RST,CST)
Elimination des colonnes des d.l. 'Dirichlet'
IF (NUINCE.EQ.NUINCC)
& CALL CDMOVC (NUKACE,NCPICE,NBNEML,NGNUML,NBNEMC,NGNUMC
& ,IST(MCPLAL),IST(MCPLIL),TYMATR,MCMATR
& ,TYVECT,MCVECT,NBESSE,NGESSE,TYESSE,MCESSE
& ,RST,CST)
ENDIF
ENDIF
CALL PRFXMJ (-1,'*CeElim*')
RETURN
10001 FORMAT (T2,A,'>*CeRelr*>*CeElim*>',A,' Elimination dans les '
&,A,' de la partie triang. ',A)
90005 IRCODE=1
RETURN
99991 CALL BAISE ('No. de condition essentielle inconnue')
END !CeElim
ceelim est appelé dans (2 procédures)