     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 : test14.f
    21 C     *
    22 C     * - Description : ecriture des noeuds d'un maillage MED
    23 C     *                 a l'aide des routines de niveau 2
    24 C     *                 MED - equivalent a test4.f
    25 C     *
    26 C     ******************************************************************************
    27       program test14
    28 C
    29       implicit none
    30       include 'med.hf'
    31 C
    32       integer cret, fid
    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       parameter (mdim=2,maa="maa1",nnoe=4)
    40 C     ** table des coordonnees
    41       real*8 coo(mdim*nnoe)
    42 C     ** tables des noms et des unites des coordonnees
    43       character*16 nomcoo(mdim), unicoo(mdim)
    44 C     ** tables des noms, numeros, numeros de familles des noeuds
    45 C     autant d'elements que de noeuds - les noms ont pout longueur
    46 C     MED_TAILLE_PNOM : 8  **
    47       character*16 nomnoe(nnoe)
    48       integer numnoe(nnoe), nufano(nnoe)
    49
    50       data   coo /0.0, 0.0, 1.0, 0.0, 0.0, 1.0, 1.0, 1.0/
    51       data   nomcoo /"x","y"/, unicoo /"cm","cm"/
    52       data   nomnoe /"nom1","nom2","nom3","nom4"/
    53       data   numnoe /1,2,3,4/,nufano /0,1,2,2/
    54
    55 C  ** Creation du fichier test14.med  **
    56       call efouvr(fid,'test14.med',MED_LECTURE_ECRITURE, cret)
    57       print *,cret
    58       if (cret .ne. 0 ) then
    59          print *,'Erreur creation du fichier'
    60          call efexit(-1)
    61       endif
    62
    63 C  ** Creation du maillage  **
    64       call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
    65      &     'un maillage pour tes14',cret)
    66       print *,cret
    67       if (cret .ne. 0 ) then
    68          print *,'Erreur creation du maillage'
    69          call efexit(-1)
    70       endif
    71
    72 C     ** Ecriture des noeuds d'un maillage MED :
    73 C     - Des coordonnees en mode MED_FULL_INTERLACE : (X1,Y1,X2,Y2,X3,Y3,...)
    74 C     dans un repere cartesien
    75 C     - Des noms (optionnel dans un fichier MED)
    76 C     - Des numeros (optionnel dans un fichier MED)
    77 C     - Des numeros de familles des noeuds **
    78       call efnoee(fid,maa,mdim,coo,MED_FULL_INTERLACE,MED_CART,
    79      &     nomcoo,unicoo,nomnoe,MED_VRAI,numnoe,MED_VRAI,
    80      &     nufano,nnoe,cret)
    81       print *,cret
    82       if (cret .ne. 0 ) then
    83          print *,'Erreur ecriture des noeuds'
    84          call efexit(-1)
    85       endif
    86
    87 C     ** Fermeture du fichier **
    88       call efferm (fid,cret)
    89       print *,cret
    90       if (cret .ne. 0 ) then
    91          print *,'Erreur fermeture du fichier'
    92          call efexit(-1)
    93       endif
    94 C
    95       end
    96
    97
    98