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