[updated 8.Sep.2008]

Exemple E_6efl_ana > Fichier ppefl_ana.f 

line
      PROGRAM HELMTA
line  
* Auteur : D.Martin (15 Juin 2003) 
* Derniere modification : D.Martin (1er Juillet 2003)
*
* Programme principal pour la resolution de l'equation de Helmholtz
* dans une bande (Elements Finis Localises avec integration analytique)
line
      IMPLICIT NONE
      CHARACTER  AST,RST
      INTEGER    MAXRST,MAXAST
      PARAMETER (MAXRST=50000000,MAXAST=1000000)
      COMMON/  /RST(MAXRST)    /STCHAR/AST(MAXAST)
*
      CHARACTER TYPE,CRAC
      INTEGER   KI,NINC,NIVEFL,NIVASS,NIVRES,NIVSOL
      REAL      PI,K,H,BETA,KR
      COMPLEX   KC
line
*     Initialisation de l'allocation dynamique
      CALL INITIE (MAXAST,MAXRST)
*     Lecture du maillage
      CALL LCGEOM
*     Lecture des donnees : Definition des calculs a effectuer
      CALL LCDIRE
      CALL LCDONN       
*     Numerotation globale des noeuds et ...etc
      CALL NUMNEU
      CALL CPTDOM
*     Recuperation des parametres du problemes
      CALL GETCST ('H',TYPE,KI,H,KC,CRAC)
      CALL GETCST ('K',TYPE,KI,K,KC,CRAC)
      CALL GETCST ('NINC',TYPE,NINC,KR,KC,CRAC)
*     Nouvelles constantes
      CALL PUTCST ('-K^2','REEL',KI,-K*K,KC,CRAC)
*
*     Remplissage des tableaux pour transmission a FCTRM, FCTPRO 
*       TbSigm contient dans l'ordre ( K, H, NINC )
      CALL PUTTAB ('TbSigm',1,1,'REEL',KI,K,KC,CRAC)
      CALL PUTTAB ('TbSigm',1,2,'REEL',KI,H,KC,CRAC)
      CALL PUTTAB ('TbSigm',1,3,'REEL',KI,REAL(NINC),KC,CRAC)
*       TbGamm contient dans l'ordre ( K, Rayon, Xc, Yc)
      CALL PUTTAB ('TbGamm',1,1,'REEL',KI,K,KC,CRAC)
      CALL GETCST ('Rayon',TYPE,KI,KR,KC,CRAC)
      CALL PUTTAB ('TbGamm',1,2,'REEL',KI,KR,KC,CRAC)
      CALL GETCST ('Xc',TYPE,KI,KR,KC,CRAC)
      CALL PUTTAB ('TbGamm',1,3,'REEL',KI,KR,KC,CRAC)
      CALL GETCST ('Yc',TYPE,KI,KR,KC,CRAC)
      CALL PUTTAB ('TbGamm',1,4,'REEL',KI,KR,KC,CRAC)
*     Constantes pour impression
      CALL GETCST ('NivEFL',TYPE,NIVEFL,KR,KC,CRAC)
      CALL GETCST ('NivRES',TYPE,NIVRES,KR,KC,CRAC)
      CALL GETCST ('NivASS',TYPE,NIVASS,KR,KC,CRAC)
      CALL GETCST ('NivSOL',TYPE,NIVSOL,KR,KC,CRAC)
*
*     Calcul elements finis sur tous les domaines
*     -------------------------------------------
      CALL CALKEF
* 
*     Calcul des termes elements finis localises de facon analytique               
*     --------------------------------------------------------------                         
      CALL ASSOSM ('TabS-','BaseSi','TbSigm',1) 
      CALL ASSOSP ('TabS+','BaseSi','TbSigm',1)
      CALL ASSOGC ('TabGC','BaseGa','TbGamm',1) 
      CALL ASSOGS ('TabGS','BaseGa','TbGamm',1)
*            
      CALL CALEFL
*     Calcul des termes elements finis localises assembles 
*     ----------------------------------------------------
*      sur SIGMA+/-
      CALL EFLOCO ('ELAS-',1,'ELAS-',1,'MELAS-',1,NIVEFL)
      CALL EFLOCO ('ELAS+',1,'ELAS+',1,'MELAS+',1,NIVEFL)  
*      sur GAMMA
      CALL EFLOCO ('EFLGC',1,'EFLGC',1,'MEFLGC',1,NIVEFL)
      CALL EFLOCO ('EFLGS',1,'EFLGS',1,'MEFLGS',1,NIVEFL)
*
*     Le systeme a resoudre est : MATRIS * SOLANA = SECMB
*     ---------------------------------------------------
*     Assemblage de la matrice
      CALL ASMTRM ('MATRIS',1,NIVASS)
      CALL TBTUER ('RIGID',1)
      CALL TBTUER ('MASSE',1)
*     Calcul du second membre
      CALL MATVEC ('MASSIG',1,'DNPHI',1,'SECMB',1,NIVASS)
      CALL TBTUER ('MASSIG',1)

*     Factorisation LU et resolution
      CALL FALU   ('MATRIS',1,' ','MATFAC',1,NIVRES)
      CALL FASV   ('MATFAC',1,'SECMB',1,'SOLANA',1,NIVRES)
      CALL TBTUER ('MATRIS',1)
      CALL TBTUER ('MATFAC',1)
*
*     Calcul du champ erreur :
      CALL DFTERM ('SOLANA',1,'PHIEXA',1,NIVSOL)
*
*     Traitement graphique :
      CALL GBEGIN ('DessinA','2D','grame')
      CALL GHEADR ('DessinA',' ',' ')
      CALL GBODYR ('DessinA','SOLANA',1,'OMEGA')
      CALL GEND   () 

      CALL BYE    (' Game Over ')
      END
line
top