[updated 8.Sep.2008]
Librairie cesse > Fichier cerotl.f |
SUBROUTINE CEROTL (NPAS ,NUINCE,NCPICE,NBNECE,NVNUCE,NVDUCE
& ,NMRGDL,NVRGDL,NDPLOC,NMPLOC,NVPLOC,TYPLOC
& ,MULTIM,NVDSMA,NVNUMC,NVNUML,NBCOLO,NBLIGN
& ,NMSTOK,NVSTOK,INSTOK,ITYSYM,NMMATR,NVMATR
& ,TYMATR,NMSCMB,NVSCMB,TYSCMB,NBVECT
& ,ROTACE,NMESSE,NVESSE,TYESSE,NIVICE,IMPFCH)
Auteurs : D.Martin & O.DeBayser (Janvier 1995)
Derniere modification : D.Martin (26 Aout 2000)
Version 1.0.1
Changement de repere dans une matrice et un vecteur (2nd membre ou
vecteurs propres)
-- Arguments d'entree --
NPAS pas de parcours du tableau des rotations
si NPAS=1 ordre naturel, si NPAS=NDPLOC ordre transpose
NUINCE numero de l'inconnue de la condition essentielle
NCPICE nombre de composantes de l'inconnue de la condtion essentielle
NBNECE nombre de noeuds portant la condtion essentielle
NVNUCE niveau de numerotation en noeuds de la condtion essentielle
NVDUCE niveau de numerotation de la c. esse. pour inconnue vectorielle
NMRGDL tableau de travail
NVRGDL son niveau
NDPLOC dimension (=NCPICE pour l'instant)
NMPLOC nom du tableau contenant les matrices de changement de repere/noeud
NVPLOC niveau des tableaux de normales ou de reperes locaux
TYPLOC type de declaration (REEL ou COMPLEXE) du tableau de changt. de repere
MULTIM indicateur de systeme lineaire 'multi-inconnues'
NVDSMA niveau de la structure 'multi-inconnues' de la matrice
NVNUMC niveau de numerotation des noeuds en colonne de la matrice
dans le cas 'uni-inconnue'
NVNUML niveau de numerotation des noeuds en ligne de la matrice
dans le cas 'uni-inconnue'
NBCOLO nombre de colonnes de la matrice
NBLIGN nombre de lignes de la matrice
NMSTOK nom du tableau de stockage de la matrice
NVSTOK niveau du tableau de stockage de la matrice
INSTOK indice de type de stockage de la matrice
ITYSYM indicateur de symetrie de la matrice
NMMATR nom de la matrice sur lequel porte l'elimination
NVMATR niveau de ce terme
TYMATR type de declaration (REEL ou COMPLEXE) de la matrice
NMSCMB nom du vecteur second membre sur lequel est reportee l'elimination
NVSCMB niveau de ce terme
TYSCMB type de declaration (REEL ou COMPLEXE) du second membre
NBVECT nombre de colonnes du vecteur
ROTACE indicateur de rotation pour la donnee de condition essentielle
NMESSE nom de la condition essentielle et le cas echeant du tableau
contenant les valeurs de blocage.
NVESSE niveau de ce terme
TYESSE type de declaration de la condition essentielle
NIVICE niveau d'impression de la condition essentielle
IMPFCH numero du fichier pour impression
CHARACTER*(*) NMRGDL,NMPLOC,TYPLOC,NMSTOK,NMMATR,TYMATR
& ,NMSCMB,TYSCMB,NMESSE,TYESSE,MULTIM,ROTACE
INTEGER NPAS ,NUINCE,NCPICE,NBNECE,NVNUCE,NVDUCE,NDPLOC
& ,NVRGDL,NVPLOC,NVDSMA,NVNUMC,NVNUML,NBCOLO,NBLIGN
& ,MCNECE,NVSTOK,INSTOK,ITYSYM,NVMATR,NVSCMB,NBVECT
& ,NVESSE,NIVICE,IMPFCH
INCLUDE 'ALLOC'
CHARACTER PRFXAS*8
INTEGER INDSYM,INDSTO
INTEGER MCPLOC,MCNUCE,MCSTOK,MCRGDL,MCRGDC,NBL,NBC
& ,NBPLAL,MCPLAL,MCPLIL,LGL,NBPLAU,MCPLAU,MCPLIU,LGU
& ,MCMATR,MCMATL,MCMATU,MCSCMB,MCSCM1,MCNUME,MCESSE
& ,NCFSSD,ITYSNO,NEOUDL,DLOUNE,NUVECT,I
CHARACTER ERCODE*120
COMMON/FORMAH/ERCODE
CALL PRFXMJ (1,'*CeRotl*')
ITYSNO=INDSYM (' ') !utilite
IF (TYPLOC(1:1).NE.'R')
& CALL BAISE ('Matrice de changement repere local complexe!')
IF (MULTIM(1:1).EQ.'Y') THEN
Preparation des tableaux des rangs des noeuds de la condition
essentielle dans la matrice 'multi-inconnues'.
Les tableau de numerotations sont en d.l.
NEOUDL=NCPICE
DLOUNE=1
CALL TBRR1 (ERCODE,'#GNEDO',NVDUCE,MCNECE)
CALL CERONM (NUINCE,NCPICE,NVDUCE,'Colonnes',MULTIM,NVDSMA
& ,NMRGDL,NVRGDL,NBLIGN,NBCOLO,NIVICE,IMPFCH) !cdesse
CALL CERONM (NUINCE,NCPICE,NVDUCE,'Lignes',MULTIM,NVDSMA
& ,NMRGDL,NVRGDL,0 ,NBLIGN,NIVICE,IMPFCH) !cdesse
CALL TBSAVE ('#GNEDO',NVDUCE)
ELSE
Preparation des tableaux des rangs des noeuds de la condition
essentielle dans la matrice 'uni-inconnue'.
Les tableau de numerotations sont en noeuds.
NEOUDL=1
DLOUNE=NCPICE
CALL TBRR1 (ERCODE,'#GNEDO',NVNUMC,MCNUME)
CALL CERONM (NUINCE,NCPICE,NVNUCE,'Colonnes',MULTIM,NVNUMC
& ,NMRGDL,NVRGDL,NBLIGN,NBCOLO,NIVICE,IMPFCH) !cdesse
IF (NVNUMC.NE.NVNUML)
& CALL TBRR1 (ERCODE,'#GNEDO',NVNUML,MCNUME)
CALL CERONM (NUINCE,NCPICE,NVNUCE,'Lignes',MULTIM,NVNUML
& ,NMRGDL,NVRGDL,0 ,NBLIGN,NIVICE,IMPFCH) !cdesse
ENDIF
CALL TBAR4 (ERCODE,NMRGDL,NVRGDL,MCRGDL,NMSTOK,NVSTOK,MCSTOK
& ,NMPLOC,NVPLOC,MCPLOC,NMMATR,NVMATR,MCMATR)
MCRGDC=MCRGDL+NBLIGN
Passage au repere local dans la matrice
IF (INSTOK.EQ.INDSTO ('BIMORSE')) THEN
CALL EXBMOR (MCSTOK,IST(MCSTOK),NBL,NBPLAL,MCPLAL,MCPLIL
& ,LGL,NBC,NBPLAU,MCPLAU,MCPLIU,LGU) !sdexplo
MCMATL=MCMATR+DLOUNE*MIN (NBL,NBC)
MCMATU=MCMATL
NCFSSD=DLOUNE
IF (DLOUNE.LT.3) NCFSSD=DLOUNE-1
IF (ITYSYM.EQ.ITYSNO) MCMATU=MCMATL+LGL*DLOUNE*DLOUNE
& +NCFSSD*MIN (NBL,NBC)
... dans la partie triangulaire inferieure stricte
IF (IMPFCH.GT.0.AND.NIVICE.GT.2)
& WRITE (IMPFCH,10000) (PRFXAS(I),I=2,0,-1),'inf'
CALL CEROMM (NPAS,NDPLOC,1,NCPICE,MULTIM,NBL
& ,IST(MCRGDL),IST(MCRGDC),IST(MCPLAL),IST(MCPLIL)
& ,TYMATR,MCMATL,MCPLOC,'inf',RST,CST) !cdesse
... pour les coeff. diagonaux
IF (IMPFCH.GT.0.AND.NIVICE.GT.2)
& WRITE (IMPFCH,10000) (PRFXAS(I),I=2,0,-1),'coeff. diagonaux'
CALL CERODM (NPAS,NDPLOC,1,NCPICE,MULTIM,NBL,IST(MCRGDL)
& ,IST(MCPLAL),IST(MCPLIL),IST(MCPLAU),IST(MCPLIU)
& ,TYMATR,MCMATR,MCMATL,MCMATU,MCPLOC,RST,CST) !cdesse
IF (ITYSYM.EQ.ITYSNO) THEN
... dans la partie triangulaire superieure stricte
IF (IMPFCH.GT.0.AND.NIVICE.GT.2)
& WRITE (IMPFCH,10000) (PRFXAS(I),I=2,0,-1),'sup'
CALL CEROMM (NPAS,NDPLOC,1,NCPICE,MULTIM,NBC
& ,IST(MCRGDC),IST(MCRGDL),IST(MCPLAU),IST(MCPLIU)
& ,TYMATR,MCMATU,MCPLOC,'sup',RST,CST) !cdesse
ENDIF
ELSEIF (INSTOK.EQ.INDSTO ('MORSE-L')) THEN
CALL EXMORS (MCSTOK,IST(MCSTOK)
& ,NBL,NBC,NBPLAL,MCPLAL,MCPLIL,LGL) !sdexplo
CALL CEROMM (NPAS,NDPLOC,0,NCPICE,MULTIM,NBL
& ,IST(MCRGDL),IST(MCRGDC),IST(MCPLAL),IST(MCPLIL)
& ,TYMATR,MCMATR,MCPLOC,' ',RST,CST) !cdesse
ELSEIF (INSTOK.EQ.INDSTO ('MORSE-C')) THEN
CALL EXMORS (MCSTOK,IST(MCSTOK)
& ,NBC,NBL,NBPLAU,MCPLAU,MCPLIU,LGU) !sdexplo
CALL CEROMM (NPAS,NDPLOC,0,NCPICE,MULTIM,NBC
& ,IST(MCRGDC),IST(MCRGDL),IST(MCPLAU),IST(MCPLIU)
& ,TYMATR,MCMATR,MCPLOC,' ',RST,CST) !cdesse
ENDIF
Passage au repere local dans le second membre
IF (NMSCMB.NE.' ') THEN
CALL TBAR1 (ERCODE,NMSCMB,NVSCMB,MCSCMB)
MCSCM1=MCSCMB
DO 10 NUVECT=1,NBVECT
CALL CEROTV (NPAS,NDPLOC,NCPICE,NEOUDL,IST(MCRGDL)
& ,TYSCMB,NBL,MCSCM1,MCPLOC,RST,CST) !cdesse
MCSCM1=MCSCMB+NBL
10 CONTINUE
ENDIF
Passage au repere local dans le vecteur "valeur nodale" de donnee de
la condition essentielle (cas non homogene)
IF (ROTACE(1:1).EQ.'Y') THEN
CALL TBAR2 (ERCODE,NMESSE,NVESSE,MCESSE
& ,'#GNEDO',NVNUCE,MCNUCE)
CALL CEROTV (NPAS,NDPLOC,NCPICE,1,IST(MCNUCE+2)
& ,TYESSE,NBNECE,MCESSE,MCPLOC,RST,CST) !cdesse
ENDIF
CALL PRFXMJ (-1,'*CeRotl*')
10000 FORMAT(T2,A,'>',A,'>',A,' Changement de repere dans la partie '
&,'triangulaire ',A)
END !CeRotl
cerotl est appelé dans