      1  C*************************************************************************
      2  C COPYRIGHT (C) 1999 - 2003  EDF R&D
      3  C THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY
      4  C IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE
      5  C AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION;
      6  C EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.
      7  C
      8  C THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT
      9  C WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF
     10  C MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU
     11  C LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS.
     12  C
     13  C YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE
     14  C ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION,
     15  C INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA
     16  C
     17  C**************************************************************************
     18
     19  C ******************************************************************************
     20  C * - Nom du fichier : test8.f
     21  C *
     22  C * - Description : exemple d'ecriture des familles d'un maillage MED
     23  C *
     24  C *****************************************************************************
     25          program test8
     26  C
     27          implicit none
     28          include 'med.hf'
     29  C
     30          integer cret, fid
     31
     32          character*32  maa
     33          integer       mdim
     34          character*32  nomfam
     35          integer       numfam
     36          character*200 attdes
     37          integer       natt, attide, attval
     38          integer       ngro
     39          character*80  gro
     40          integer       nfame, nfamn
     41          character*16   str
     42
     43          parameter  ( mdim = 2, nfame = 3, nfamn = 2 )
     44          data       maa /"maa1"/
     45
     46  C       ** Creation du fichier test8.med                       **
     47          call efouvr(fid,'test8.med',MED_CREATION, cret)
     48          print *,cret
     49
     50  C       ** Creation du maillage maa de dimension 2         **
     51          if (cret .eq. 0) then
     52         call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
     53       &                 'un maillage pour test8',cret)
     54          endif
     55          print *,cret
     56
     57  C       ** Ecriture des familles                           **
     58  C           ** Conventions :
     59  C           - Toujours creer une famille de numero 0 ne comportant aucun attribut
     60  C           ni groupe (famille de reference pour les noeuds ou les elements
     61  C           qui ne sont rattaches a aucun groupe ni attribut)
     62  C           - Les numeros de familles de noeuds sont > 0
     63  C           - Les numeros de familles des elements sont < 0
     64  C           - Rien d imposer sur les noms de familles
     65  C        **                                                 **
     66
     67  C       ** Creation de la famille 0
     68          if (cret .eq. 0) then
     69             numfam = 0
     70             nomfam="FAMILLE_0"
     71             call effamc(fid,maa,nomfam,numfam,attide,attval,attdes,
     72       &          0,gro,0,cret)
     73          endif
     74          print *,cret
     75
     76  C       ** Creation pour correspondre aux cas tests precedents, 3 familles  *
     77  C       **  d elements (-1,-2,-3) et deux familles de noeuds (1,2)         *
     78          if (cret .eq. 0) then
     79             do numfam=-1,-3,-1
     80                if (cret .eq. 0) then
     81                   write(str,'(I1.0)') (-numfam)
     82                   nomfam = "FAMILLE_ELEMENT_"//str
     83                   attide = 1
     84                   attval = numfam*100
     85                   natt = 1
     86                   attdes="description attribut"
     87                   gro="groupe1"
     88                   ngro = 1
     89                   print *, nomfam," - ",numfam," - ",attide," - ",
     90       &                attval," - ",ngro
     91
     92                   call effamc(fid,maa,nomfam,numfam,attide,attval,attdes,
     93       &                natt,gro,ngro,cret)
     94                   print *,"MEDfamCr : ",cret
     95                endif
     96             end do
     97          end if
     98
     99          if (cret .eq. 0) then
    100             do numfam=1,nfamn
    101                if (cret .eq. 0) then
    102                   write(str,'(I1.0)') numfam
    103                   nomfam = "FAMILLE_NOEUD_"//str
    104                   attide = 1
    105                   attval = numfam*100
    106                   natt = 1
    107                   attdes="description attribut"
    108                   gro="groupe1"
    109                   ngro = 1
    110                   print *, nomfam," - ",numfam," - ",attide," - ",
    111       &                attval," - ",ngro
    112                   call effamc(fid,maa,nomfam,numfam,attide,attval,attdes,
    113       &                natt,gro,ngro,cret)
    114                   print *,"MEDfamCr : ",cret
    115
    116                endif
    117             end do
    118           end if
    119
    120
    121  C     ** Fermeture du fichier *
    122        call efferm (fid,cret)
    123        print *,cret
    124
    125
    126        end
    127
    128
    129
    130
    131
    132