# 2.3.6/test27.f

Aller à la documentation de ce fichier.

    00001 C*  This file is part of MED.
    00002 C*
    00003 C*  COPYRIGHT (C) 1999 - 2012  EDF R&D, CEA/DEN
    00004 C*  MED is free software: you can redistribute it and/or modify
    00005 C*  it under the terms of the GNU Lesser General Public License as published by
    00006 C*  the Free Software Foundation, either version 3 of the License, or
    00007 C*  (at your option) any later version.
    00008 C*
    00009 C*  MED is distributed in the hope that it will be useful,
    00010 C*  but WITHOUT ANY WARRANTY; without even the implied warranty of
    00011 C*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    00012 C*  GNU Lesser General Public License for more details.
    00013 C*
    00014 C*  You should have received a copy of the GNU Lesser General Public License
    00015 C*  along with MED.  If not, see <http://www.gnu.org/licenses/>.
    00016 C*
    00017
    00018 C       ******************************************************************************
    00019 C       * - Nom du fichier : test27.f
    00020 C       *
    00021 C       * - Description : creation de maillages structures (grille cartesienne |
    00022 C       *                 grille standard ) dans le fichier test27.med
    00023 C       *
    00024 C       *****************************************************************************
    00025         program test27
    00026 C
    00027         implicit none
    00028         include 'med.hf'
    00029 C
    00030 C
    00031         integer       cret, fid
    00032 C       ** la dimension du maillage                         **
    00033         integer       mdim
    00034 C       ** nom du maillage de longueur maxi MED_TAILLE_NOM  **
    00035         character*32  maa
    00036 C       ** le nombre de noeuds                              **
    00037         integer       nnoe
    00038 C       ** table des coordonnees                            **
    00039         real*8        coo(8)
    00040         character*16  comp, comp2(2)
    00041         character*16  unit, unit2(2)
    00042         character*200 desc
    00043         integer       strgri(2)
    00044 C       ** grille cartesienne                               **
    00045         integer       axe,nind
    00046         real*8        indice(4)
    00047
    00048 C
    00049 C
    00050         data  coo    /0.0,0.0,1.0,0.0,0.0,1.0,1.0,1.0/
    00051         data  comp2  /"x","y"/, unit2 /"cm","cm"/
    00052 C
    00053 C       Creation du fichier test27.med
    00054         call efouvr(fid,'test27.med',MED_LECTURE_ECRITURE, cret)
    00055         print *,cret
    00056         if (cret .ne. 0 ) then
    00057            print *,'Erreur creation du fichier'
    00058            call efexit(-1)
    00059         endif
    00060         print *,'Creation du fichier test27.med'
    00061 C
    00062 C       Creation d'un maillage MED_NON_STRUCTURE
    00063         mdim = 3
    00064         maa = 'maillage vide'
    00065         desc = 'un maillage vide'
    00066         call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,desc,cret)
    00067         print *,cret
    00068         if (cret .ne. 0 ) then
    00069            print *,'Erreur creation du maillage'
    00070            call efexit(-1)
    00071         endif
    00072 C
    00073 C       Creation d'une grille cartesienne
    00074         mdim = 2
    00075         maa = 'grille cartesienne'
    00076         desc = 'un exemple de grille cartesienne'
    00077         call efmaac(fid,maa,mdim,MED_STRUCTURE,desc,cret)
    00078         print *,cret
    00079         if (cret .ne. 0 ) then
    00080            print *,'Erreur creation du maillage'
    00081            call efexit(-1)
    00082         endif
    00083         print *,'Creation d un maillage MED_STRUCTURE'
    00084
    00085 C
    00086 C       On specifie la nature du maillage structure
    00087         call efnage(fid,maa,MED_GRILLE_CARTESIENNE,cret)
    00088         print *,cret
    00089         print *,
    00090 'On definit la nature de la grille :     & MED_GRILLE_CARTESIENNE'
    00091         if (cret .ne. 0 ) then
    00092            print *,'Erreur ecriture de la nature de la grille'
    00093            call efexit(-1)
    00094         endif
    00095 C
    00096 C       On definit les indices de la grille selon chaque dimension
    00097         indice(1) = 1.1D0
    00098         indice(2) = 1.2D0
    00099         indice(3) = 1.3D0
    00100         indice(4) = 1.4D0
    00101         nind = 4
    00102         axe = 1
    00103         comp = 'X'
    00104         unit = 'cm'
    00105         call eficoe(fid,maa,mdim,indice,nind,axe,comp,unit,cret)
    00106         print *,cret
    00107         if (cret .ne. 0 ) then
    00108            print *,'Erreur ecriture des indices'
    00109            call efexit(-1)
    00110         endif
    00111         print *,'Ecriture des indices des coordonnees selon axe X'
    00112 C
    00113         indice(1) = 2.1D0
    00114         indice(2) = 2.2D0
    00115         indice(3) = 2.3D0
    00116         indice(4) = 2.4D0
    00117         nind = 4
    00118         axe = 2
    00119         comp = 'Y'
    00120         unit = 'cm'
    00121         call eficoe(fid,maa,mdim,indice,nind,axe,comp,unit,cret)
    00122         print *,cret
    00123         if (cret .ne. 0 ) then
    00124            print *,'Erreur ecriture des indices'
    00125            call efexit(-1)
    00126         endif
    00127         print *,'Ecriture des indices des coordonnees selon axe Y'
    00128 C
    00129 C       Creation d'une grille MED_GRILLE_STANDARD de dimension 2
    00130         maa = 'grille standard'
    00131         mdim = 2
    00132         desc = 'un exemple de grille standard'
    00133         call efmaac(fid,maa,mdim,MED_STRUCTURE,desc,cret)
    00134         print *,cret
    00135         if (cret .ne. 0 ) then
    00136            print *,'Erreur creation de maillage'
    00137            call efexit(-1)
    00138         endif
    00139         print *,'Nouveau maillage MED_STRUCTURE'
    00140 C
    00141         call efnage(fid,maa,MED_GRILLE_STANDARD,cret)
    00142         print *,cret
    00143         if (cret .ne. 0 ) then
    00144            print *,'Erreur ecriture de la nature de la grille'
    00145            call efexit(-1)
    00146         endif
    00147         print *,'On definit la nature du maillage : MED_GRILLE_STANDARD'
    00148 C
    00149 C       On ecrit les coordonnes de la grille
    00150         nnoe = 4
    00151         call efcooe(fid,maa,mdim,coo,MED_FULL_INTERLACE,nnoe,MED_CART,
    00152      &                 comp2,unit2,cret)
    00153         print *,cret
    00154         if (cret .ne. 0 ) then
    00155            print *,'Erreur ecriture des coordonnees des noeuds'
    00156            call efexit(-1)
    00157         endif
    00158         print *,'Ecriture des coordonnees de la grille'
    00159 C
    00160 C       On definit la structure des coordonnees de la grille
    00161         strgri(1) = 2
    00162         strgri(2) = 2
    00163         call efscoe(fid,maa,mdim,strgri,cret)
    00164         print *,cret
    00165         if (cret .ne. 0 ) then
    00166            print *,'Erreur ecriture de la structure'
    00167            call efexit(-1)
    00168         endif
    00169         print *,'Ecriture de la structure de la grille : / 2,2 /'
    00170 C
    00171 C       On ferme le fichier
    00172         call efferm (fid,cret)
    00173         print *,cret
    00174         if (cret .ne. 0 ) then
    00175            print *,'Erreur fermeture du fichier'
    00176            call efexit(-1)
    00177         endif
    00178         print *,'Fermeture du fichier'
    00179 C
    00180          end
    00181
    00182
    00183
    00184
    00185
    00186