[updated 19.Jun.2003]

Exemple A_z_mevisu > Fichier mevisu.f

Qui appelle mevisu ?

line
      PROGRAM  MEVISU
line
* Auteur : G. Vial (2001)
* Derniere modification : G. Vial (19 juin 2003)
* Version 2.0.0
*
* Visualiseur de maillages au format melina
*
line
      INTEGER MAXAST,MAXIST,IST
      PARAMETER    (MAXAST=80000, MAXIST=4000000)
      CHARACTER     AST 
      COMMON/      /IST(MAXIST) /STCHAR/AST(MAXAST)  
      REAL          RST(1)
      COMPLEX       CST(1)
      EQUIVALENCE  (IST(1),RST(1),CST(1))
      INTEGER NUMELI,NUMAIL,NDMDOM,NDMDOE,I
*
      INCLUDE 'CONTEX'
*   
line
* VARIABLES LOCALES
      CHARACTER*80  NOMELI
      CHARACTER*20 CODE
      CHARACTER*25 CHAINE
      CHARACTER*8 ITEMS(6)
      INTEGER ADRBLK,ADRNGN,ADRCOR,ADRLIS,ADRNOM,NBITEM,NCHDOM
     &,NCOL,NCOL01,NCOL2,LONG,PGOPEN,Ind,FENMEN,FENGRA
      REAL MINX,MAXX,MINY,MAXY,MAXG,LGRA,HGRA,LMENU,HMENU
      LOGICAL ACTIFS(6),GIFPS,OK
      DATA ITEMS / 'MAILLAGE', 'POINTS  ', 'ELEMENTS', 'DOMAINES', 
     &'SAUVER  ', 'QUITTER ' /
      INTEGER*4 CSTATU
      CHARACTER HOME*80
      CHARACTER*80  STRF2C
line
      LOGICAL EXISTE
* Lecture d'un Žventuel fichier .mevisu
      CALL CSYSTM (STRF2C ('echo $HOME/.mevisu > "tmp'),CSTATU) 
      OPEN  (UNIT=99,FILE='"tmp',STATUS='UNKNOWN')
      READ  (UNIT=99,FMT='(A)') HOME
      CLOSE (UNIT=99,STATUS='DELETE')
      DO 71 I=1,LEN(HOME)
        IF (HOME(I:I).EQ.' ') THEN
          LONG=I-1
          GOTO 72
        ENDIF     
71     CONTINUE      
72     INQUIRE (FILE=HOME(1:LONG), EXIST=EXISTE)
      IF (.NOT.EXISTE) THEN
         WRITE (*,*)'No .mevisu file, using defaults.'
         LGRA=10.
         HGRA=8.
         LMENU=2.
         HMENU=6.
      ELSE
         WRITE (*,*)'Reading preferences in .mevisu file.'
         OPEN (21,FILE=HOME(1:LONG))
         READ(21,*) LGRA,HGRA,LMENU,HMENU
         CLOSE (21)     
      ENDIF
* Initialisation de paramtres           
      NBITEM=6
      NIVESP=0
      CALL PRFXMJ (1,'$mevisu$')
      NUMELI=46
      NUMAIL=48
* Lecture du fichier de maillage
30    CALL RDFICH (NUMELI,'le maillage Melina en entree','OLD'
     &,'FORMATTED',NOMELI)
      CALL LECTSD (IST,RST,CST,MAXIST,AST,MAXAST,NUMELI)
* Test de dimension
      IF (NDIM.GE.3) THEN
        CALL BAISE ('MEVISU NE FONCTIONNE QU''EN DIMENSION 2 !')
      GOTO 999
      ENDIF
     
* Determination des adresses des structures de donnees
      IF (NBBBLK.GT.1) THEN
        CALL TBAR1 (CODE,'#LOKEL',1,ADRBLK)
      ENDIF
      CALL TBAR1 (CODE,'#GNEEL',NIVENG,ADRNGN)
      CALL TBAR1 (CODE,'#ORPTL',0,ADRCOR)
      CALL TBAR1 (CODE,'#TERDO',1,I)
      NCHDOM=IST(I+3)
      CALL TBAR1 (CODE,'#OMDOM',1,ADRNOM)
* Calcul des points extremaux du maillage
      CALL MAXCOR (RST(ADRCOR),NBTEL,NBPTEX,MINX,MAXX,MINY,MAXY)
line
*        DEFINITION DE LA FENETRE GRAPHIQUE POUR LE TRACE DU MAILLAGE
line       
* Initialisation de la fenetre graphique et du tableau ACTIFS
      CALL INIGRA('/XWINDOW',8,FENGRA,MINX,MAXX,MINY,MAXY,LGRA,HGRA)
      DO 1 I=2,6
1       ACTIFS(I)=.false.
      ACTIFS(1)=.true. 
* Preparation de la fenetre graphique consacree au menu
      FENMEN=PGOPEN('/XWINDOW')
      CALL PGPAP (LMENU,HMENU/LMENU)
      CALL PGENV(0.0,8.0,-1.0,25.,2,-2)
111   CALL PGSLCT (FENGRA)
      CALL PGSCI (0)
line
*        TRACƒ
line
      CALL PGSCI (0)
      CALL PGSFS (1)
      CALL PGSCLP (0)
      CALL PGRECT (MINX-1.,MAXX+1.,MINY-1.,MAXY+1.)
      CALL DESSIN (ACTIFS,NBDOMG,ADRLIS,NDMDOE
     &,NCOL,AST,ADRNOM,NCHDOM,IST,RST,ADRBLK
     &,ADRCOR,NBBBLK,NU1BLK,NDIM,NBPTEX,ADRNGN
     &,NBTEL)
line
*        ECRITURE DU MENU
line
112   CALL INFOS(FENMEN,NBTEL,NBTPTG,INTRPG,NBDOMG)
      CALL MENU (FENMEN,NBITEM,ITEMS,ACTIFS) 
* Test si on quitte ou si on sauve      
      IF (ACTIFS(NBITEM)) THEN
        GOTO 999
      ELSEIF (ACTIFS(NBITEM-1)) THEN
        CALL SAUVE (CHAINE,LONG,OK,GIFPS)
        ACTIFS(NBITEM-1)=.false.
        GOTO 222
      ELSE
        GOTO 111
      ENDIF         
*    
line
*        IMPRESSION DANS UN FICHIER
line       
* On ouvre le device 'fichier/GIF' ou 'fichier/PS'      
222   IF ((OK.EQV..FALSE.).OR.(LONG.EQ.0)) GOTO 223
      IF (GIFPS) THEN
          CALL INIGRA(CHAINE(1:LONG)//'/gif',5+LONG,Ind,MINX
     &,MAXX,MINY,MAXY,LGRA,HGRA) 
      ELSE
         CALL INIGRA(CHAINE(1:LONG)//'/cps',3+LONG,Ind,MINX
     &,MAXX,MINY,MAXY,LGRA,HGRA)
      ENDIF 
* TracŽ
      CALL PGSLCT (Ind) 
      CALL PGSCI (0)
      CALL PGSFS (1)
*      CALL PGSCLP (0)
      CALL PGRECT (MINX-1.,MAXX+1.,MINY-1.,MAXY+1.)
      CALL DESSIN (ACTIFS,NBDOMG,ADRLIS,NDMDOE
     &,NCOL,AST,ADRNOM,NCHDOM,IST,RST,ADRBLK
     &,ADRCOR,NBBBLK,NU1BLK,NDIM,NBPTEX,ADRNGN
     &,NBTEL)
      CALL PGCLOS ()
223   GOTO 112
line
line
999   END
line
top

mevisu est appelé dans (3 procédures)

ALIRE inigra.f (A_z_mevisu) link.sh

top