[updated 8.Sep.2008]
Librairie cesse > Fichier ctrgdl.f |
SUBROUTINE CTRGDL (LIOUCO,NCPICE,NVNUCE,NVNUM1,NEAVA1
& ,NVNUM2,NEAVA2,NMRGDL,NVRGDL,NIVIMP,IMPFCH)
Auteur : D.Martin (Mars 1995)
Derniere modification : D.Martin (27 Juin 2000)
Version 1.0.1
Tableau des numeros de lignes/colonnes d'une matrice correspondant
aux 1ers degres de liberte des noeuds portant la condition de transmission
-- Arguments d'entree --
LIOUCO "Ligne" ou "Colon"
NCPICE nb. de composantes par noeud des inconnues de la cond. de transmission
NVNUCE niveau de numerotation des noeuds de transmission
NVNUM1 niveau de numerotation des d.l. pour le bloc colonne/ligne
pour l'inconnue 1 (de plus petit numero)
NEAVA1 nombre de colonnes/lignes avant le bloc "a droite" en cours
NVNUM2 niveau de numerotation des d.l. pour le bloc colonne/ligne
pour l'inconnue 2 (de plus grand numero)
NEAVA2 nombre de colonnes/lignes avant le bloc "a gauche" en cours
NMRGDL tableau des rangs des 1er d.l. des noeuds dans les colonnes/lignes
NVRGDL son niveau
CHARACTER*(*) LIOUCO,NMRGDL
INTEGER NCPICE,NVNUCE,NVNUM1,NEAVA1,NVNUM2,NEAVA2,NVRGDL
& ,NIVIMP,IMPFCH
INCLUDE 'ALLOC'
CHARACTER PRFXAS*8
INTEGER MCNUCE,MCNUM1,MCNUM2,NBNECE,MCRGDL,NUDLCE,ADDLCE,I
& ,NBNUM1,NEXT1,RANG1,MCRAN1,NBNUM2,NEXT2,RANG2,MCRAN2
CHARACTER ERCODE*120
COMMON/FORMAH/ERCODE
CALL PRFXMJ (1,'*Ctrgdl*') !utilite
CALL TBRR2 (ERCODE,'#GNEDO',NVNUM1,MCNUM1,'#GNEDO',NVNUM2,MCNUM2)
CALL TBAR4 (ERCODE,'#GNEDO',NVNUM1,MCNUM1,'#GNEDO',NVNUM2,MCNUM2
& ,'#GNEDO',NVNUCE,MCNUCE, NMRGDL ,NVRGDL,MCRGDL)
NBNECE=IST(MCNUCE+1)
IF (LIOUCO(1:1).EQ.'C') MCRGDL=MCRGDL+2*NBNECE
NEXT1=1
NBNUM1=IST(MCNUM1+1)
MCRAN1=MCRGDL
NEXT2=1
NBNUM2=IST(MCNUM2+1)
MCRAN2=MCRGDL+NBNECE
ADDLCE=MCNUCE+2
DO 10 I=1,NBNECE
Numero du 1er d.l. de transmission du I-eme noeud de transmission
NUDLCE=1+NCPICE*(IST(ADDLCE)-1)
Rang de ce d.l. dans la numerotation en colonne/ligne a droite
dans le bloc matriciel en cours
CALL DICOTO (NEXT1,NBNUM1,IST(MCNUM1+2),NUDLCE,RANG1,*10) !utilite
NEXT1=RANG1+NCPICE
Numeros de colonne/ligne du 1er d.l. du I-eme noeud de transmission
IST(MCRAN1)=RANG1+NEAVA1
MCRAN1 =MCRAN1+1
Rang de ce d.l. dans la numerotation en colonne/ligne a gauche
dans le bloc matriciel en cours
CALL DICOTO (NEXT2,NBNUM2,IST(MCNUM2+2),NUDLCE,RANG2,*10) !utilite
NEXT2=RANG2+NCPICE
IST(MCRAN2)=RANG2+NEAVA2
MCRAN2 =MCRAN2+1
Le choix des inconnues "Droite" et "Gauche" a ete fait pour que
ce test ne provoque pas d'erreur ...
IF (IST(MCRAN2-1).LE.IST(MCRAN1-1)) GOTO 99991
ADDLCE=ADDLCE+1
10 CONTINUE
IF (IMPFCH.GT.0.AND.NIVIMP.GT.0) THEN
WRITE (IMPFCH,10001) PRFXAS(1),LIOUCO,1,NBNECE
& ,(IST(I),I=MCRGDL,MCRGDL+NBNECE-1)
WRITE (IMPFCH,10001) PRFXAS(1),LIOUCO,2,NBNECE
& ,(IST(I),I=MCRGDL+NBNECE,MCRGDL+2*NBNECE-1)
ENDIF
Bug si le 1er d.l. de transmission a gauche correspond a
l'une des 2 premieres colonne/ligne
(les inconnues a droite et a gauche ont ete choisies pour...
sauf si la premiere inconnue n' a qu'un seul d.l.)
IF (IST(MCRGDL+NBNECE).LE.2) GOTO 99992
CALL TBSAVE ('#GNEDO',NVNUM1)
CALL TBSAVE ('#GNEDO',NVNUM2)
CALL PRFXMJ (-1,'*Ctrgdl*')
RETURN
10001 FORMAT(T2,A,'>*CtRgdl* Rangs des (1er d.l.) des noeuds de '
&,'transmission (',A,') inconnue',I2,',',I6,' articles :'
&/(T22,10I6))
99991 IF (LIOUCO(1:1).EQ.'C') THEN
CALL BAISE ('Bug interne ? Dans les tableaux des rang des d.l.'
&//' en colonne, les rangs de d.l. pour l''inconnue de plus grand'
&//' numero doivent etre superieurs aux rangs des d.l. pour'
&//' l''inconnue de plus petit numero.')
ELSE
CALL BAISE ('Bug interne ? Dans les tableaux des rang des d.l.'
&//' en ligne, les rangs de d.l. pour l''inconnue de plus grand'
&//' numero doivent etre superieurs aux rangs des d.l. pour'
&//' l''inconnue de plus petit numero.')
ENDIF
99992 IF (LIOUCO(1:1).EQ.'C') THEN
CALL BAISE ('Bug de numerotation ? Dans le tableau des rangs des'
&//' d.l. en colonne pour l''inconnue de plus grand numero,'
&//' le premier d.l. doit avoir un rang > 2.')
ELSE
CALL BAISE ('Bug de numerotation ? Dans le tableau des rangs des'
&//' d.l. en ligne pour l''inconnue de plus grand numero,'
&//' le premier d.l. doit avoir un rang > 2.')
ENDIF
END !Ctrgdl
ctrgdl est appelé dans