      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 : test4.f
     21  C       *
     22  C       * - Description : ecriture des noeuds pour un maillage MED.
     23  C       *
     24  C       *****************************************************************************
     25      program test4
     26  C
     27      implicit none
     28      include 'med.hf'
     29  C
     30  C
     31      integer cret, fid
     32
     33  C       ** la dimension du maillage                         **
     34      integer      mdim
     35  C       ** nom du maillage de longueur maxi MED_TAILLE_NOM  **
     36      character*32 maa
     37  C       ** le nombre de noeuds                              **
     38      integer      nnoe
     39  C       ** table des coordonnees                            **
     40  C       profil : (dimension * nombre de noeuds) ici 8       **
     41          real*8       coo(8)
     42  C       ** tables des noms et des unites des coordonnees    **
     43  C           profil : (dimension)                            **
     44      character*16 nomcoo(2)
     45      character*16 unicoo(2)
     46  C       ** tables des noms, numeros, numeros de familles des noeuds
     47  C         autant d elements que de noeuds - les noms ont pout longueur
     48  C         MED_TAILLE_PNOM
     49      character*16 nomnoe(4)
     50      integer     numnoe(4)
     51      integer     nufano(4)
     52
     53      parameter    ( mdim = 2, maa = "maa1",nnoe = 4 )
     54      data  coo    /0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0/
     55      data  nomcoo /"x","y"/, unicoo /"cm","cm"/
     56      data  nomnoe /"nom1","nom2","nom3","nom4"/
     57      data  numnoe /1,2,3,4/, nufano /0,1,2,2/
     58
     59  C       ** Creation du fichier test4.med          **
     60          call efouvr(fid,'test4.med',MED_CREATION, cret)
     61          print *,cret
     62
     63  C       ** Creation du maillage maa de dimension 2 **
     64  C       **  et de type MED_NON_STRUCTURE           **
     65          if (cret .eq. 0) then
     66             call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
     67        &                 'un maillage pour test4',cret)
     68          endif
     69          print *,cret
     70
     71  C       ** Ecriture des coordonnees en mode MED_FULL_INTERLACE : **
     72  C       ** (X1,Y1, X2,Y2, X3,Y3, ...)  dans un repere cartesien **
     73          if (cret .eq. 0) then
     74             call efcooe(fid,maa,mdim,coo,MED_FULL_INTERLACE,
     75       &     nnoe,MED_CART,nomcoo,unicoo,cret)
     76          endif
     77          print *,cret
     78
     79  C       ** Ecriture des noms des noeuds (optionnel dans un maillage MED) **
     80          if (cret .eq.  0) then
     81             call efnome(fid,maa,nomnoe,nnoe,MED_NOEUD,0,cret)
     82           endif
     83           print *,cret
     84
     85  C       ** Ecriture des numeros des noeuds (optionnel dans un maillage MED) **
     86           if (cret .eq. 0) then
     87              call efnume(fid,maa,numnoe,nnoe,MED_NOEUD,0,cret)
     88           endif
     89           print *,cret
     90
     91
     92  C       ** Ecriture des numeros de familles des noeuds **
     93          if (cret .eq. 0) then
     94             call effame(fid,maa,nufano,nnoe,MED_NOEUD,0,cret)
     95          endif
     96          print *,cret
     97
     98  C       ** Fermeture du fichier **
     99          call efferm (fid,cret)
    100           print *,cret
    101
    102          end
    103
    104
    105
    106