[updated 8.Sep.2006]
Librairie assembl > Fichier asmptp.f |
SUBROUTINE ASMPTP (MOOUBM,INCREL,INCREC,NBNLIB,NGNLIB
& ,NBNCOB,NGNCOB,NBNLIS,NGNLIS,NBNCOS,NGNCOS
& ,NULAPS,IPLAGS,NMBPTR,IDBPTR,PTRB2S)
Auteur : D.Martin (Avril 1992)
Derniere modification : O.DeBayser (3 Avril 1996)
Version 1
Recherche dichotomique du tableau de pointeurs pour l'assemblage
d'une matrice Pleine dans une matrice Morse-Ligne ou Morse-Colonne ou
de la partie triangulaire inferieure ou superieure d'une matrice BiMorse
-- Arguments d'entree --
MOOUBM =0 pour le cas Morse-Ligne ou Morse-Colonne, =1 pour le cas BiMorse
INCREL increment de changement de ligne dans les pointeurs
INCREC increment de changement de colonne dans les pointeurs
NBNLIB nombre de lignes du terme matriciel a assembler (B)
NGNLIB numerotation en ligne du terme matriciel a assembler (B)
NBNCOB nombre de lignes du terme matriciel a assembler (B)
NGNCOB numerotation en colonne du terme matriciel a assembler (B)
NBNLIS nombre de lignes du terme matriciel resultat (S)
NGNLIS numerotation en ligne du terme matriciel resultat (S)
NBNCOS nombre de lignes du terme matriciel resultat (S)
NGNCOS numerotation en colonne du terme matriciel resultat (S)
NULAPS tableau des numeros de derniere plage des lignes de (S)
IPLAGS tableau de stockage Morse-Ligne de la matrice (S)
IDBPTR adresse relative des pointeurs dans (S)
-- Arguments de sortie --
NMBPTR nombre de coefficients de (B) a assembler dans (S)
PRTB2S tableau de pointeurs d'assemblage d'une matrice dans une autre.
Sa taille est celle de la matrice (B) a assembler dans (S)
IMPLICIT NONE
INTEGER NBNLIS,NGNLIS(*),NBNCOS,NGNCOS(*),NULAPS(*),IPLAGS(2,*)
INTEGER MOOUBM,INCREL,INCREC,NBNLIB,NGNLIB(*),NBNCOB,NGNCOB(*)
& ,NMBPTR,IDBPTR,PTRB2S(*)
INTEGER LBDEB,LGCUAS,NAVPTR,KS,LS,NEXTKS,NEXTLS,LB,KB
& ,NUPRPS,NUDRPS,NUPLS,KOLDES,NEXPTR
LBDEB=1
LGCUAS=0
NEXTLS=1
NAVPTR=0
IF (MOOUBM.EQ.1) THEN
dans la 1ere colonne de B
NEXTKS=1
CALL DICOTO (NEXTKS,NBNCOS,NGNCOS,NGNCOB(1),KS,*9) !utilite
Recherche 1ere ligne de B situe dans le triangle inferieur de S
DO 8 LB=1,NBNLIB
Ligne LS de S 'contenant' la ligne LB de B
CALL DICOTO (NEXTLS,NBNLIS,NGNLIS,NGNLIB(LB),LS,*8) !utilite
IF (LS.GE.KS) THEN
on est dans le triangle inferieur de S
LBDEB=LB
NAVPTR=(LB-1)*INCREL
IF (LS.EQ.KS) THEN
on est sur la diagonale de S
LBDEB=LB+1
NAVPTR=LB*INCREL
ENDIF
GOTO 10
ENDIF
NEXTLS=LS+1
on est dans le triangle superieur de S
8 CONTINUE
plus rien a faire
9 RETURN
ENDIF
Parcours des lignes LB de la matrice B a assembler dans S
10 DO 20 LB=LBDEB,NBNLIB
Recherche de la ligne LS de S 'contenant' la ligne LB de B
CALL DICOTO (NEXTLS,NBNLIS,NGNLIS,NGNLIB(LB),LS,*20) !utilite
NEXTLS=LS+1
Premiere et derniere plage de la ligne LS dans S
NUPRPS=1
IF (LS.GT.1+MOOUBM) NUPRPS=1+NULAPS(LS-1-MOOUBM)
KOLDES=IPLAGS(1,NUPRPS)
IF (NUPRPS.GT.1) LGCUAS=IPLAGS(2,NUPRPS-1)
NUDRPS=NULAPS(LS-MOOUBM)
NEXPTR=NAVPTR+1
Parcours des plages et des colonnes KB de la ligne LB de B
NEXTKS=1
DO 17 KB=1,NBNCOB
Recherche de la colonne KS dans S contenant la colonne KB de B
CALL DICOTO (NEXTKS,NBNCOS,NGNCOS,NGNCOB(KB),KS,*17) !utilite
NEXTKS=KS+1
Recherche de la plage dans la ligne de S contenant
la colonne KS
CALL DIKLPL (KS,NUPRPS,NUDRPS,LGCUAS,IPLAGS,NUPLS,*17) !morse
IF (NUPLS.GT.NUPRPS) THEN
Changement de plage sur la plage de la ligne LS de S
LGCUAS=IPLAGS(2,NUPLS-1)
NUPRPS=NUPLS
KOLDES=IPLAGS(1,NUPLS)
ENDIF
Pointeur du coefficient courant de B dans le tableau S
PTRB2S(NEXPTR)=IDBPTR+LGCUAS+NEXTKS-KOLDES
NEXPTR=NEXPTR+INCREC
NMBPTR=NMBPTR+1
17 CONTINUE
NAVPTR=NAVPTR+INCREL
20 CONTINUE
END !AsMPtP
asmptp est appelé dans