[updated 24.Jun.2000]
Librairie prsd > Fichier prptbm.f |
SUBROUTINE PRPTBM (BMORSE,ITYSYM,NCPINC,NCPINL,MCA,IST
& ,NIVIMP,IMPFCH)
Auteur : O.DeBayser (Avril 1994)
Derniere modification (D.Martin) le 19 Juin 1997
Version 1.0.1
Impression des pointeurs pour l'assemblage d'une matrice stockee
sous forme 'Bimorse' dans une autre.
-- Arguments --
BMORSE Structure definissant le stockage de la matrice
ITYSYM Indicateur de matrice symetrique (=1) ou non
NCPINC Nombre de d.l. par noeud en colonne
NCPINL Nombre de d.l. par noeud en ligne
MCA Adresse des pointeurs dans le super-tableau d'entier
NIVIMP Niveau d'impression du terme
NIVIMP = I, 0 < I < 10 ==> impression de la diagonale et
des NIVIMP premieres et dernieres lignes et colonnes
NIVIMP > 9 ==> impression de la diagonale et des parties
sous- et sur-diagonale en totalite
IMPFCH numero d'unite logique du fichier d'impression
INTEGER BMORSE(*),ITYSYM,NCPINC,NCPINL,MCA,IST(*),NIVIMP,IMPFCH
INTEGER NBLIGN,NBPLAL,MCPLAL,MCPLIL,LGL,MCL
& ,NBCOLO,NBPLAU,MCPLAU,MCPLIU,LGU,MCU,NCFSSD,NBPRL1,NBPRL2
& ,NUDRPL,MCAFIN
IF (IMPFCH.LE.0.OR.NIVIMP.LE.0) RETURN
CALL EXBMOR (1,BMORSE,NBLIGN,NBPLAL,MCPLAL,MCPLIL,LGL
& ,NBCOLO,NBPLAU,MCPLAU,MCPLIU,LGU) !Sdexplo
IF (NCPINC*NCPINL.LE.1) THEN
MCL=MCA+MIN (NBLIGN,NBCOLO)
MCU=MCL+LGL
ELSE
MCL=MCA+MIN (NBLIGN*NCPINL,NBCOLO*NCPINC)
NCFSSD=MAX(1,MIN(NCPINC,NCPINL))
IF (NCFSSD.LT.3) NCFSSD=NCFSSD-1
MCU=MCL+LGL*NCPINC*NCPINL+NCFSSD*MIN (NBLIGN,NBCOLO)
ENDIF
WRITE (IMPFCH,200) '-> *PrPtBm* Pointeurs d''assemblage'
NBPRL1=MIN (NIVIMP,NBLIGN)
IF (NIVIMP.GT.10) NBPRL1=NBLIGN
WRITE (IMPFCH,200) 'Lig. 1 Diagonale'
WRITE (IMPFCH,201) IST(MCA)
NUDRPL=0
MCAFIN=-1
CALL PRLIPT ('Lig.',2,NBPRL1,NBCOLO,NUDRPL,MCAFIN,NCPINC,NCPINL
& ,BMORSE(MCPLAL),BMORSE(MCPLIL),MCA,MCL,IST,IMPFCH)
NBPRL2=MAX (NBPRL1,NBLIGN-NBPRL1)
IF (NBPRL1.LT.NBLIGN.AND.NBPRL2.GT.NBPRL1+1)
& WRITE(IMPFCH,200) '..........'
NUDRPL=BMORSE(MCPLAL+NBPRL2-2)
MCAFIN=BMORSE(MCPLIL+2*NUDRPL-1)-1
CALL PRLIPT ('Lig.',NBPRL2+1,NBLIGN,NBCOLO,NUDRPL,MCAFIN,NCPINC
& ,NCPINL,BMORSE(MCPLAL),BMORSE(MCPLIL),MCA,MCL,IST
& ,IMPFCH)
IF (ITYSYM.EQ.0) THEN
NBPRL1=MIN (NIVIMP,NBCOLO)
IF (NIVIMP.GT.10) NBPRL1=NBCOLO
WRITE (IMPFCH,200) 'Col. 1 Diagonale'
WRITE (IMPFCH,201) IST(MCA)
NUDRPL=0
MCAFIN=-1
CALL PRLIPT ('Col.',2,NBPRL1,NBLIGN,NUDRPL,MCAFIN,NCPINC,NCPINL
& ,BMORSE(MCPLAU),BMORSE(MCPLIU),MCA,MCU,IST,IMPFCH)
NBPRL2=MAX (NBPRL1,NBCOLO-NBPRL1)
IF (NBPRL1.LT.NBCOLO.AND.NBPRL2.GT.NBPRL1+1)
& WRITE (IMPFCH,200) '..........'
NUDRPL=BMORSE(MCPLAU+NBPRL2-2)
MCAFIN=BMORSE(MCPLIU+2*NUDRPL-1)-1
CALL PRLIPT ('Col.',NBPRL2+1,NBCOLO,NBLIGN,NUDRPL,MCAFIN,NCPINC
& ,NCPINL,BMORSE(MCPLAU),BMORSE(MCPLIU),MCA,MCU,IST
& ,IMPFCH)
ENDIF
200 FORMAT(/T5,A)
201 FORMAT((T5,10(I10,' ')))
END !PrptBm
prptbm est appelé dans