# f/test27.f

    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,sdim
    00034 C       ** nom du maillage de longueur maxi MED_TAILLE_NOM  **
    00035         character*64  maa
    00036 C       ** le nombre de noeuds                              **
    00037         integer       nnoe
    00038 C       ** table des coordonnees                            **
    00039         real*8        coo(8)
    00040         character*16  nomcoo(2), unicoo(2)
    00041         character*200 desc
    00042         integer       strgri(2)
    00043 C       ** grille cartesienne                               **
    00044         integer       axe,nind
    00045         real*8        indice(4)
    00046
    00047 C
    00048 C
    00049         data  coo    /0.0,0.0,1.0,0.0,0.0,1.0,1.0,1.0/
    00050         data  nomcoo /"x","y"/, unicoo  /"cm","cm"/
    00051 C
    00052 C       Creation du fichier test27.med
    00053         call mfiope(fid,'test27.med',MED_ACC_RDWR, cret)
    00054         print *,cret
    00055         if (cret .ne. 0 ) then
    00056            print *,'Erreur creation du fichier'
    00057            call efexit(-1)
    00058         endif
    00059         print *,'Creation du fichier test27.med'
    00060 C
    00061 C       Creation d'un maillage MED_NON_STRUCTURE
    00062         mdim = 2
    00063         sdim = 2
    00064         maa = 'maillage vide'
    00065         desc = 'un maillage vide'
    00066         call mmhcre(fid,maa,mdim,sdim,MED_UNSTRUCTURED_MESH,
    00067      &              desc,"",MED_SORT_DTIT,MED_CARTESIAN,
    00068      &              nomcoo,unicoo,cret)
    00069         print *,cret
    00070         if (cret .ne. 0 ) then
    00071            print *,'Erreur creation du maillage'
    00072            call efexit(-1)
    00073         endif
    00074 C
    00075 C       Creation d'une grille cartesienne
    00076         mdim = 2
    00077         maa = 'grille cartesienne'
    00078         desc = 'un exemple de grille cartesienne'
    00079         call mmhcre(fid,maa,mdim,sdim,MED_STRUCTURED_MESH,
    00080      &              desc,"",MED_SORT_DTIT,MED_CARTESIAN,
    00081      &              nomcoo,unicoo,cret)
    00082         print *,cret
    00083         if (cret .ne. 0 ) then
    00084            print *,'Erreur creation du maillage'
    00085            call efexit(-1)
    00086         endif
    00087         print *,'Creation d un maillage MED_STRUCTURE'
    00088
    00089 C
    00090 C       On specifie la nature du maillage structure
    00091         call mmhgtw(fid,maa,MED_CARTESIAN_GRID,cret)
    00092         print *,cret
    00093         print *,
    00094 'On definit la nature de la grille :     & MED_GRILLE_CARTESIENNE'
    00095         if (cret .ne. 0 ) then
    00096            print *,'Erreur ecriture de la nature de la grille'
    00097            call efexit(-1)
    00098         endif
    00099 C
    00100 C       On definit les indices de la grille selon chaque dimension
    00101         indice(1) = 1.1D0
    00102         indice(2) = 1.2D0
    00103         indice(3) = 1.3D0
    00104         indice(4) = 1.4D0
    00105         nind = 4
    00106         axe = 1
    00107         call mmhgcw(fid,maa,MED_NO_DT,MED_NO_IT,MED_UNDEF_DT,
    00108      &              axe,nind,indice,cret)
    00109         print *,cret
    00110         if (cret .ne. 0 ) then
    00111            print *,'Erreur ecriture des indices'
    00112            call efexit(-1)
    00113         endif
    00114         print *,'Ecriture des indices des coordonnees selon axe X'
    00115 C
    00116         indice(1) = 2.1D0
    00117         indice(2) = 2.2D0
    00118         indice(3) = 2.3D0
    00119         indice(4) = 2.4D0
    00120         nind = 4
    00121         axe = 2
    00122         call mmhgcw(fid,maa,MED_NO_DT,MED_NO_IT,MED_UNDEF_DT,
    00123      &              axe,nind,indice,cret)
    00124         print *,cret
    00125         if (cret .ne. 0 ) then
    00126            print *,'Erreur ecriture des indices'
    00127            call efexit(-1)
    00128         endif
    00129         print *,'Ecriture des indices des coordonnees selon axe Y'
    00130 C
    00131 C       Creation d'une grille MED_CURVILINEAR_GRID de dimension 2
    00132         maa = 'grille curviligne'
    00133         mdim = 2
    00134         desc = 'un exemple de grille curviligne'
    00135         call mmhcre(fid,maa,mdim,sdim,MED_STRUCTURED_MESH,
    00136      &              desc,"",MED_SORT_DTIT,MED_CARTESIAN,
    00137      &              nomcoo,unicoo,cret)
    00138         print *,cret
    00139         if (cret .ne. 0 ) then
    00140            print *,'Erreur creation de maillage'
    00141            call efexit(-1)
    00142         endif
    00143         print *,'Nouveau maillage MED_STRUCTURE'
    00144 C
    00145         call mmhgtw(fid,maa,MED_CURVILINEAR_GRID,cret)
    00146         print *,cret
    00147         if (cret .ne. 0 ) then
    00148            print *,'Erreur ecriture de la nature de la grille'
    00149            call efexit(-1)
    00150         endif
    00151         print *,'On definit la nature du maillage : MED_GRILLE_STANDARD'
    00152 C
    00153 C       On ecrit les coordonnes de la grille
    00154         nnoe = 4
    00155         call mmhcow(fid,maa,MED_NO_DT,MED_NO_IT,MED_UNDEF_DT,
    00156      &              MED_FULL_INTERLACE,nnoe,coo,cret)
    00157         print *,cret
    00158         if (cret .ne. 0 ) then
    00159            print *,'Erreur ecriture des coordonnees des noeuds'
    00160            call efexit(-1)
    00161         endif
    00162         print *,'Ecriture des coordonnees de la grille'
    00163 C
    00164 C       On definit la structure des coordonnees de la grille
    00165         strgri(1) = 2
    00166         strgri(2) = 2
    00167         call mmhgsw(fid,maa,MED_NO_DT,MED_NO_IT,MED_UNDEF_DT,
    00168      &              strgri,cret)
    00169         print *,cret
    00170         if (cret .ne. 0 ) then
    00171            print *,'Erreur ecriture de la structure'
    00172            call efexit(-1)
    00173         endif
    00174         print *,'Ecriture de la structure de la grille : / 2,2 /'
    00175 C
    00176 C       On ferme le fichier
    00177         call mficlo(fid,cret)
    00178         print *,cret
    00179         if (cret .ne. 0 ) then
    00180            print *,'Erreur fermeture du fichier'
    00181            call efexit(-1)
    00182         endif
    00183         print *,'Fermeture du fichier'
    00184 C
    00185          end
    00186
    00187
    00188
    00189
    00190
    00191