[updated 16.Mar.2008]
Librairie assembl > Fichier dsmcdi.f |
SUBROUTINE DSMCDI (MCPLAR,MCPLIR,MCLICO,NBPLAX,LPLAGS,LGCUSV
& ,NBPLAR,NBLICV,NUBOEX,NXLIGN,NUDRPL,LGCUAV
& ,MCNELI,MCNECO,MCPLAL,MCPLIL,MCCOLI
& ,IRCODE,IST)
Auteurs : D.Martin & O.DeBayser (Janvier 92)
Derniere modification : D.Martin (16 mars 2008)
Version 2
Modifications anterieures
D.Martin (17 avril 1997)
Concatenation de compactage morse en ligne pour des matrices rapportees
a la meme numerotation en ligne.
-- Arguments d'entree --
MCPLAR adresse de la table des numeros de plages du resultat BIMORSE
MCPLIR adresse de la table de description des plages correspondantes
MCLICO adresse de la numerotation commune en ligne
NBPLAX nombre max. de plages possibles
LPLAGS pointeur pour la table des plages
LGCUSV longueur cumule dans le resultat
NBPLAR nombre de plages mis a jour
NBLICV nombre de lignes avant l'inconnue en cours
NUBOEX numero de ligne du bloc externe en cours
NXLIGN tableau des numeros de premiere colonne a parcourir
NUDRPL tableau des numeros de derniere plage de la ligne
LGCUAV tableau des longueurs cumulees avant la ligne en cours
MCNELI tableau des adresses de la numerotation en ligne du terme
MCNECO tableau des adresses de la numerotation en colonne du terme
MCPLAL tableau des adresses du tableau de derniere plage de la ligne
MCPLIL tableau des adresses du tableau de debut et longueur de plage
MCCOLI tableau des adresses de la numerotation en colonne du bloc
IRCODE code de retour en cas de depassement du nombre de plage max.
IMPLICIT NONE
INTEGER MCPLAR,MCPLIR,MCLICO,NBPLAX,LPLAGS,LGCUSV,NBPLAR
& ,NBLICV,NUBOEX,NXLIGN(*),NUDRPL(*),LGCUAV(*),MCNELI(*)
& ,MCNECO(*),MCPLAL(*),MCPLIL(*),MCCOLI(*),IRCODE,IST(*)
INTEGER ADKOLD,NUCSAV,NBLICO,ADLICO,MCPLAS,LIGNE,NUGLOL,NBCOAV
& ,NUBOIN,ADCOLI,NBCOLI,ADNELI,ADNECO,NULIG,NXNUCS,MOOUBM
& ,NUPRPL,NUMPLA,KOLDEI,LGCUAP,KOLONE,NUGLOC,MCCCCC,NUCS
CHARACTER ERCODE*120
COMMON/FORMAH/ERCODE
NUCSAV=-1
NBLICO=IST(MCLICO+1)
ADLICO=MCLICO+1
MCPLAS=MCPLAR+NBLICV-1
Boucles sur le nombre de lignes de la ligne de blocs
DO 10 LIGNE=1,NBLICO
ADLICO=ADLICO+1
NUGLOL=IST(ADLICO)
MCPLAS=MCPLAS+1
NBCOAV=0
Boucle interne sur les blocs en colonne sur la ligne de blocs
DO 8 NUBOIN=1,NUBOEX
Adresse du tableau #GNEDO en ligne du terme occupant le bloc courant
ADNELI=MCNELI(NUBOIN)
Adresse du tableau #GNEDO en colonne du terme occupant le bloc courant
ADNECO=MCNECO(NUBOIN)
Adresse du tableau #GNEDO en ligne et Nombre de colonnes du bloc
ADCOLI=MCCOLI(NUBOIN)
NBCOLI=IST(ADCOLI+1)
En cas d'absence de terme dans le bloc courant
IF (ADNELI.LE.0.OR.ADNECO.LE.0) GOTO 7
Recherche de la ligne du terme courant dans les lignes du bloc
CALL DICOTO (NXLIGN(NUBOIN),IST(ADNELI+1),IST(ADNELI+2)
& ,NUGLOL,NULIG,*7) !Utilite
NXLIGN(NUBOIN)=NULIG+1
NXNUCS=1
MOOUBM=0
IF (NUBOIN.EQ.NUBOEX) THEN
Attention le terme diagonal est BiMorse
MOOUBM=1
IF (NULIG.EQ.1) THEN
NUCSAV=-1
IF (NUBOIN.NE.1) IST(MCPLAS)=NBPLAR
GOTO 10
ENDIF
ENDIF
Numero des premiere et derniere plages dans la ligne courante du terme courant
NUPRPL=NUDRPL(NUBOIN)+1
NUDRPL(NUBOIN)=IST(MCPLAL(NUBOIN)-1+NULIG-MOOUBM)
ADKOLD=MCPLIL(NUBOIN)+2*NUPRPL-2
DO 5 NUMPLA=NUPRPL,NUDRPL(NUBOIN)
KOLDEI = IST(ADKOLD)
LGCUAP = IST(ADKOLD+1)
ADKOLD = ADKOLD+2
MCCCCC = ADNECO+1+KOLDEI
Boucle sur les colonnes de la plage courante du terme
DO 1 KOLONE=KOLDEI,KOLDEI+LGCUAP-LGCUAV(NUBOIN)-1
NUGLOC=IST(MCCCCC)
MCCCCC=MCCCCC+1
Recherche de la colonne du terme courant dans les colonnes du bloc
CALL DICOTO (NXNUCS,NBCOLI,IST(ADCOLI+2),NUGLOC
& ,NUCS,*99001) !Utilite
NXNUCS=NUCS+1
IF (NUCS.EQ.NUCSAV+1) THEN
Ajout du coefficient courant dans la plage courante
LGCUSV = LGCUSV+1
IST(MCPLIR+LPLAGS-1)= LGCUSV
ELSEIF (NUCS.GT.NUCSAV+1) THEN
Cas d'un changement de ligne ou de plage dans la somme
NBPLAR=NBPLAR+1
IF (NBPLAR.GT.NBPLAX) GOTO 98001
IST(MCPLIR+LPLAGS) = NUCS+NBCOAV
LGCUSV = LGCUSV+1
IST(MCPLIR+LPLAGS+1)= LGCUSV
LPLAGS = LPLAGS+2
ELSE
CALL BAISE ('*Dsmcdi* Incoherence de l''avancement'
& //' dans les lignes des matrices compactees')!Utilite
ENDIF
NUCSAV=NUCS
1 CONTINUE
LGCUAV(NUBOIN)=LGCUAP
5 CONTINUE
Pour le recollement des plages entre inconnues en colonne,
on regarde si, pour l'inconnue courante NUBOIN
la derniere colonne est au bout de la ligne ou non.
NUCSAV=-1
IF (IST(ADCOLI+1+NBCOLI).EQ.NUGLOC.AND.
& NUBOIN.LT.NUBOEX.AND.MCNECO(NUBOIN+1).GT.0) NUCSAV=0
IST(MCPLAS)=NBPLAR
Increment du numero de colonne meme en absence de terme
7 NBCOAV=NBCOAV+NBCOLI
8 CONTINUE
10 CONTINUE
NBLICV=NBLICV+NBLICO
RETURN
99001 CALL ENCLER (LIGNE,ERCODE(1:6))
CALL ENCLER (NUGLOC,ERCODE(7:12))
CALL ENCLER (NUBOIN,ERCODE(13:16))
CALL BAISE ('*Dsmcdi* On ne retrouve pas la colonne '
&//ERCODE(7:12)//' sur la ligne '//ERCODE(1:6)//' pour la
&'//ERCODE(13:16)//'-eme inconnue.')
98001 IRCODE=NUBOIN
-- File history
Version 2 : D.Martin (16 mars 2008)
Correction d'un bug lorsque qu'un terme vide n'est pas diagonal
(Calcul de NBCOLI exterieur au test GOTO 7)
END !Dsmcdi
dsmcdi est appelé dans