[updated 8.Sep.2008]

Qui appelle ecgeom ?

      SUBROUTINE ECGEOM (NOMFIC,TITRE)

  Auteur : D.Martin (Avril 1993)
  Derniere modification : D.Martin (23 Janvier 2001)
  Version 1.0.2
 
  Creer un fichier de maillage au format Melina
 
 -- Arguments --
  NOMFIC nom du fichier de sortie
  TITRE  chaine de caracteres contenant le titre

      IMPLICIT NONE
      CHARACTER*(*) NOMFIC,TITRE
 
      INCLUDE 'ALLOC'
      INCLUDE 'CONTEX'
 
      CHARACTER     FORMAC*8,FORMAN*6,AVESAN*4,QUOTE
      CHARACTER     ERCODE *120
      INTEGER       KLUNIT
      INTEGER       NIVGEO,NUMFIC,LG,NTITRE,NXT,I
     &             ,MCCORP,MCNUMG,MCVARE,MCBLOK,MCTRDO,MCMDOM,MCDOMG
     &             ,MCLIST,LGERDO,NBDOMK,LGCANO,NCHDOM,IADOMG,NUDOMG
     &             ,NBCARE,NXLIST,NDMDOM,NDMDOE,NBELDO
     &             ,NBNEEZ,NBDLEZ,NBNEFZ,NBDLFZ
      LOGICAL       OPEN
      COMMON/FORMAH/ERCODE
      DATA FORMAC/'(5E16.9)'/,FORMAN/'(10I8)'/,NIVGEO/0/,AVESAN/'SANS'/
     &    ,QUOTE/''''/

      CALL PRFXMJ (1,'*EcGeom*')
 
      Ouverture du fichier de sortie du maillage
 
      INQUIRE (FILE=NOMFIC,OPENED=OPEN,NUMBER=NUMFIC)
      IF (.NOT.OPEN) THEN
         NUMFIC=KLUNIT ()                                              !sdexplo
         OPEN  (UNIT=NUMFIC,FILE=NOMFIC,ACCESS='SEQUENTIAL'
     &         ,FORM='FORMATTED',STATUS='UNKNOWN',ERR=90001)
      ENDIF
 
      Tableau des coordonnees et de la numerotation globale
 
      CALL TBRR2 (ERCODE,'#ORPTL',NIVGEO,MCCORP,'#GNEEL',NIVENG,MCNUMG)
 
      Ecriture du titre : Il est ecrit sur autant de lignes que necessaire
                          d'au plus 80 caracteres
 
      LG=LEN (TITRE)
      NTITRE=1+(LG-1)/80
      WRITE (NUMFIC,*) 'TITRE',NTITRE
      NXT=0
      DO 1 I=1,NTITRE
         WRITE (NUMFIC,*) TITRE(NXT+1:MIN(LG,NXT+80))
         NXT=NXT+80
1     CONTINUE
 
      Format de lecture des coordonnees et de la numerotation globale
 
      CALL ECFORM (NUMFIC,FORMAC,FORMAN,AVESAN)                         !lecgeom
 
      Description globale du maillage
 
      CALL TBAR1  (ERCODE,'#ARIAB',1,MCVARE)                     
      CALL ECDESG (NUMFIC,NDIM,AST(MCVARE),NBCNVE,NBTEL)                !lecgeom
 
      Description des blocs d'elements
 
      MCBLOK=1
      IF (NBBBLK.GT.1) CALL TBAR1  (ERCODE,'#LOKEL',1,MCBLOK)
      CALL ECDESL (NUMFIC,IST(MCBLOK),NBBBLK,NU1BLK,NBTEL)              !lecgeom
 
      Coordonnees et numeros globaux element par element
 
      CALL TBAR2  (ERCODE,'#ORPTL',NIVGEO,MCCORP,'#GNEEL',NIVENG,MCNUMG)
 
      CALL ECELEM (NUMFIC,IST(MCBLOK),NDIM,NBBBLK,NU1BLK,NBTEL
     &            ,IST(MCCORP),FORMAC,IST(MCNUMG),FORMAN,NBPTEX)        !lecgeom
 
      CALL TBSAVE ('#ORPTL',NIVGEO)
      CALL TBSAVE ('#GNEEL',NIVENG)
 
      Domaines geometriques
 
      CALL TBAR1  (ERCODE,'#TERDO',1,MCTRDO)                     
      CALL SDEXDB (IST(MCTRDO),LGERDO,NBDOMK,LGCANO,NCHDOM)             !utilite
 
      IADOMG=0
      DO 10 NUDOMG=1,NBDOMG
 
         CALL TBAR1  (ERCODE,'#OMDOM',1,MCMDOM)
         MCDOMG=MCMDOM+IADOMG
         IADOMG=IADOMG+NCHDOM
 
         Nom du domaine (on elimine les caracteres blancs terminaux)
 
         DO 8 NBCARE=MCDOMG-1+NCHDOM,MCDOMG,-1
            IF (AST(NBCARE).NE.' ') GOTO 9
8        CONTINUE
         GOTO 10
9        WRITE (NUMFIC,*)'DOMAINE ',QUOTE,(AST(I),I=MCDOMG,NBCARE),QUOTE
 
         Tableau #ISTEL pour le domaine
 
         CALL TBRR1  (ERCODE,'#ISTEL',NUDOMG,MCLIST)
         CALL TBAR1  (ERCODE,'#ISTEL',NUDOMG,MCLIST)
         CALL EXLIST (IST(MCLIST),NXLIST,NDMDOM,NDMDOE,NBELDO
     &               ,NBNEEZ,NBDLEZ,NBNEFZ,NBDLFZ)                      !sdexplo
 
         CALL ECDOMA (NUMFIC,NDMDOM,NDMDOE,NBELDO,IST(MCLIST+NXLIST))   !lecgeom
 
         CALL TBSAVE ('#ISTEL',NUDOMG)
 
10    CONTINUE
 
      Fin du fichier de maillage
 
      WRITE (NUMFIC,*) 'FIN'
      ERCODE=NOMFIC
      WRITE (IMPPAL,10001) '*EcGeom*',ERCODE(1:LEN(NOMFIC))
 
      CALL PRFXMJ (-1,'*EcGeom*')
      RETURN

10000 FORMAT(A80)
10001 FORMAT(/T2,A8,' Creation du fichier de maillage sur le fichier '
     &,A)

90001 ERCODE=NOMFIC
      LG=LEN(NOMFIC)
      CALL BAISE  (' Probleme a l''ouverture du fichier de sortie du '
     &//'maillage : '//ERCODE(:LG))                                     !utilite
                                                                    END !EcGeom
      

ecgeom est appelé dans (3 procédures)