[updated 8.Sep.2008]
Librairie couplag > Fichier coumat.f |
SUBROUTINE COUMAT (NMGDEL,NVGDEL,NMGREN,NVGREN,NBGREN,SAVGRE
& ,NMPDEL,NVPDEL,NMCOUP,NVCOUP,NBCOUP,NIVIMP)
Auteurs : O.DeBayser & D.Martin (Juin 1989)
Derniere modification : D.Martin (13 Fevrier 1998)
Calcul d'un terme matriciel de couplage Elements Finis/Repres. Integrale
-- Arguments d'entree --
NMGDEL nom de la matrice GDELTA
NVGDEL son niveau
NMGREN nom des sous-matrices Noyaux de GREEN
NVGREN niveau de la premiere de telles sous-matrices
NBGREN leur nombre
SAVGRE indicateur de sauvegarde ou de massacre des noyaux de Green
NMPDEL nom de la matrice PDELTA compactee "morse" par colonne
NVPDEL son niveau
NMCOUP nom des sous-matrices resultats
NVCOUP niveau de la premiere matrice de couplage
les autres matrices ont un niveau incremente de 1
NBCOUP leur nombre
NIVIMP niveau d'impression des termes de couplage
-- Remarques --
Les operations sont effectuees sur des sous-matrices a ligne ou
colonne incomplete (ou les deux).
Dans les commentaires, l'indice "1" indique si c'est la ligne ou la
colonne qui est complete.
CHARACTER*(*) NMGDEL,NMGREN,SAVGRE,NMPDEL,NMCOUP
INTEGER NVGDEL,NVGREN,NBGREN,NVPDEL,NVCOUP,NBCOUP,NIVIMP
INCLUDE 'CONTEX'
INCLUDE 'ALLOC'
LOGICAL CRETRM
CHARACTER*4 TYGDNO,TYCOUP
CHARACTER ERCODE*120,TYPINT*4 !utilite
INTEGER INDSTO,INTTYP,KLTERM,KLNIVE,INTYKL !utilite
COMMON/FORMAH/ERCODE
CALL PRFXMJ (1,'*Coumat*')
Type (REEL ou COMPLEXE des noyaux de Green)
CALL TBTYPE (NMGREN,NVGREN,ITNOYO)
ITCOMP=INTTYP ('COMPLEXE') !utilite
Agrandissement prealable des structures $SDTRM et #OMTRM
CALL TBRR2 (ERCODE,'#OMTRM',1,LGMTRM,'$SDTRM',1,LGDTRM)
CALL TBAR2 (ERCODE,'#OMTRM',1,MCMTRM,'$SDTRM',1,MCDTRM)
CALL SDEXDB (IST(MCDTRM),LGETRM,NBTERM,INCTRM,NCHTRM) !sdexplo
CALL SDAJST ('$SDTRM',1,LGDTRM,LGETRM,INCTRM,NBTERM,NBCOUP) !sdexplo
CALL SDAJST ('#OMTRM',1,LGMTRM,0,NCHTRM,NBTERM,NBCOUP) !sdexplo
CALL TBAR2 (ERCODE,'#OMTRM',1,MCMTRM,'$SDTRM',1,MCDTRM)
-- Recherche des attributs du terme NMGDEL (Gdelta)
NUTERM=KLTERM (NMGDEL,NVGDEL,AST(MCMTRM),IST(MCDTRM)) !sdexplo
IF (NUTERM.LE.0) CALL ERTERM (1,NMGDEL,NVGDEL) !utilite
IADTRM=MCDTRM+LGETRM+INCTRM*(NUTERM-1)
CALL GETTRM (IST(IADTRM),NIVEAU,ITGDEL,ITYCAL,NUKALE,NUDONN
& ,ITYSYG,IPTDIR,INCOGC,NVDUCG,KOGDEL,NVNUCG,INCOGL
& ,NVDULG,LIGDEL,NVNULG,INSTOG,NVSTOG,NVCORC
& ,IATRDO,NIVIMQ) !sdexplo
-- Attributs du terme NMPDEL,NVPDEL (Pdelta)
NUTERM=KLTERM (NMPDEL,NVPDEL,AST(MCMTRM),IST(MCDTRM)) !sdexplo
IF (NUTERM.LE.0) CALL ERTERM (1,NMPDEL,NVPDEL) !utilite
IADTRM=MCDTRM+LGETRM+INCTRM*(NUTERM-1)
CALL GETTRM (IST(IADTRM),NIVEAU,ITPDEL,ITYCAL,NUKALE,NUDONN
& ,ITYSYP,IPTDIR,INCOPC,NVDUCP,KOPDEL,NVNUCP,INCOPL
& ,NVDULP,LIPDEL,NVNULP,INSTOP,NVSTOP,NVCORC
& ,IATRDO,NIVIMQ) !sdexplo
-- Type de la matrice de couplage et du tableau de travail
ITGDNO=ITNOYO
IF (ITGDEL.EQ.ITCOMP) ITGDNO=ITGDEL
TYGDNO=TYPINT (ITGDNO) !utilite
ITCOUP=ITGDNO
IF (ITPDEL.EQ.ITCOMP) ITCOUP=ITPDEL
TYCOUP=TYPINT (ITCOUP) !utilite
-- Type de stockage de la matrice de couplage
IF (INCOGL.GE.INCOPC) THEN
Stockage du terme sous forme Plein-Ligne
INDSTK=INDSTO ('PLEIN-L') !utilite
Increment lors d'un changement dans la ligne / colonne
INCREL=KOPDEL
INCREC=1
ELSE
Stockage du terme sous forme Plein-Colonne
INDSTK=INDSTO ('PLEIN-C') !utilite
Increment lors d'un changement dans la ligne / colonne
INCREL=1
INCREC=LIGDEL
ENDIF
Nombre de colonnes d'un morceau de noyau (colonnes completes)
NBCOGR=(LIPDEL-1)/NBGREN+1
Nombre de lignes d'un morceau de resultat (lignes completes)
NBLICM=(LIGDEL-1)/NBCOUP+1
Creation d'un tableau temporaire pour le resultat intermediaire
LGWORK=NBCOGR*NBLICM
CALL TBCREE ('$WORK$',1,ITGDNO,LGWORK,'c')
IDRLIG=0
NWCOUP=NVCOUP-1
DO 20 NUCOUP=1,NBCOUP
NWCOUP=NWCOUP+1
IPRLIG=IDRLIG+1
IDRLIG=MIN (LIGDEL,IDRLIG+NBLICM)
NBLIGN=IDRLIG-IPRLIG+1
LGCOUP=NBLIGN*KOPDEL
NVNULI=NVNULG
IF (NBCOUP.GT.1) THEN
Numerotation en ligne du terme de couplage lorsqu'elle
ne coincide pas avec la numerotation en ligne de Gdelta
NVNULI=KLNIVE () !sdexplo
CALL TBRR1 (ERCODE,'#GNEDO',NVNULG,LGNELC)
CALL TBAR1 (ERCODE,'#GNEDO',NVNULG,MCNULG)
CALL TBCREE ('#GNEDO',NVNULI,1,(1+IST(MCNULG))*NBLIGN,'c')
CALL TBAR2 (ERCODE,'#GNEDO',NVNULI,MCNULC
& ,'#GNEDO',NVNULG,MCNULG)
IST(MCNULC) =IST(MCNULG)
IST(MCNULC+1)=IDRLIG-IPRLIG+1
MCNULC=MCNULC+2
DO 1 K=MCNULG+IPRLIG-1,MCNULG+IDRLIG
IST(MCNULC)=IST(K)
MCNULC=MCNULC+1
1 CONTINUE
CALL TBSAVE ('#GNEDO',NVNULI)
CALL TBSAVE ('#GNEDO',NVNULG)
ENDIF
-- Calcul proprement dit d'un terme de couplage (ENFIN!)
ITYCAL = INTYKL('COUPLA') !utilite
NUKALE = 1
CALL CRTERM (NMCOUP,NWCOUP,LGCOUP,ITCOUP,INTYKL('COUPLA'),1
& ,NDFDON,NDFSYM,NDFDSM,INCOPC,NVNUCP,KOPDEL,NVNUCP
& ,INCOGL,NVNULI,LIGDEL,NVNULI,INDSTK,NDFSTO,NVCORC
& ,NDFNDF,NIVIMP,.FALSE.,CRETRM) !utilite
CALL TBAR1 (ERCODE,NMCOUP,NWCOUP,MCCOUP)
CALL TAZERO (LGCOUP,TYCOUP,MCCOUP,AST,IST,RST,CST) !utilite
IDRCOL=0
NWGREN=NVGREN-1
DO 10 NUGREN=1,NBGREN
NWGREN=NWGREN+1
IPRCOL=IDRCOL+1
IDRCOL=MIN (IDRCOL+NBCOGR,LIPDEL)
(GDELTA)nucoum,1*(NOYAU)1,nugren --> (WORK)nucoum,nugren
Matrice pleine resultat rangee par ligne:
Increment lors d'un changement dans la ligne / colonne
JNCREL=1
JNCREC=IDRCOL-IPRCOL+1
CALL TBAR1 (ERCODE,'$WORK$',1,MCWORK)
CALL TAZERO (LGWORK,TYGDNO,MCWORK,AST,IST,RST,CST) !utilite
CALL COMOPL ('MOPL',NMGDEL,NVGDEL,ITGDEL,ITYSYG,INSTOG
& ,NVSTOG,IPRLIG,IDRLIG,NMGREN,NWGREN,ITNOYO
& ,1,KOGDEL,IPRCOL,IDRCOL
& ,'$WORK$',1,ITGDNO,JNCREL,JNCREC
& ,NCHTRM,NIVIMP) !couplag
IF (NIVIMP.GT.5) THEN
CALL PRTERM ('$WORK$',1,NIVIMP,IMPSDR) !prsd
CALL TBRR1 (ERCODE,'$WORK$',1,MCWORK)
ENDIF
IF (NUCOUP.GE.NBCOUP.AND.SAVGRE(:6).EQ.'A MORT')
& CALL TBTUER (NMGREN,NWGREN)
(COUPLA)nugren,1 + (WORK)nugren,nucoum*(PDELTA)nucoum,1
CALL COMOPL ('PLMO',NMPDEL,NVPDEL,ITPDEL,ITYSYP,INSTOP
& ,NVSTOP,1,KOPDEL,'$WORK$',1,ITGDNO
& ,IPRCOL,IDRCOL,IPRLIG,IDRLIG
& ,NMCOUP,NWCOUP,ITCOUP,INCREL,INCREC
& ,NCHTRM,NIVIMP) !couplag
10 CONTINUE
IF (NIVIMP.GT.0) CALL PRTERM (NMCOUP,NWCOUP,NIVIMP,IMPSDR) !prsd
CALL TBSAVE (NMCOUP,NWCOUP)
IF (NIVIMP.GE.0.AND.IMPPAL.GT.0) THEN
CALL PRNTRM (NMCOUP,NWCOUP,ERCODE,NCATR1)
WRITE (IMPPAL,10000) ERCODE(1:NCATR1)
ENDIF
20 CONTINUE
CALL TBTUER ('$WORK$',1)
CALL PRFXMJ (-1,'*Coumat*')
RETURN
10000 FORMAT(/' *CouMat* Calcul de la matrice de couplage ',A)
END !Coumat
coumat est appelé dans (3 procédures)