      1 C*************************************************************************
      2 C COPYRIGHT (C) 1999 - 2007  EDF R&D, CEA/DEN
      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 d'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_LECTURE_ECRITURE, cret)
     61         print *,cret
     62         if (cret .ne. 0 ) then
     63            print *,'Erreur creation du fichier'
     64            call efexit(-1)
     65         endif
     66
     67 C       ** Creation du maillage maa de dimension 2 **
     68 C       **  et de type MED_NON_STRUCTURE           **
     69         call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
     70      &                 'un maillage pour test4',cret)
     71         print *,cret
     72         if (cret .ne. 0 ) then
     73            print *,'Erreur creation du maillage'
     74            call efexit(-1)
     75         endif
     76
     77 C       ** Ecriture des coordonnees en mode MED_FULL_INTERLACE : **
     78 C       ** (X1,Y1, X2,Y2, X3,Y3, ...)  dans un repere cartesien **
     79         call efcooe(fid,maa,mdim,coo,MED_FULL_INTERLACE,
     80      &     nnoe,MED_CART,nomcoo,unicoo,cret)
     81         print *,cret
     82         if (cret .ne. 0 ) then
     83            print *,'Erreur ecriture des coordonnees des noeuds'
     84            call efexit(-1)
     85         endif
     86
     87 C       ** Ecriture des noms des noeuds (optionnel dans un maillage MED) **
     88         call efnome(fid,maa,nomnoe,nnoe,MED_NOEUD,0,cret)
     89         print *,cret
     90         if (cret .ne. 0 ) then
     91            print *,'Erreur ecriture des noms des noeuds'
     92            call efexit(-1)
     93         endif
     94
     95 C       ** Ecriture des numeros des noeuds (optionnel dans un maillage MED) **
     96         call efnume(fid,maa,numnoe,nnoe,MED_NOEUD,0,cret)
     97         print *,cret
     98         if (cret .ne. 0 ) then
     99            print *,'Erreur ecriture des numeros des noeuds'
    100          call efexit(-1)
    101         endif
    102
    103
    104 C       ** Ecriture des numeros de familles des noeuds **
    105         call effame(fid,maa,nufano,nnoe,MED_NOEUD,0,cret)
    106         print *,cret
    107         if (cret .ne. 0 ) then
    108            print *,'Erreur ecriture des numeros de famille'
    109            call efexit(-1)
    110         endif
    111
    112 C       ** Fermeture du fichier **
    113         call efferm (fid,cret)
    114         print *,cret
    115         if (cret .ne. 0 ) then
    116            print *,'Erreur fermeture du fichier'
    117            call efexit(-1)
    118         endif
    119
    120         end
    121
    122
    123
    124