# UsesCase_MEDmesh_1.f

Aller à la documentation de ce fichier.

    00001 C*  This file is part of MED.
    00002 C*
    00003 C*  COPYRIGHT (C) 1999 - 2011  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 * How to create an unstructured mesh
    00020 C * Use case 1 : a 2D unstructured mesh with 15 nodes,
    00021 C *              8 triangular cells, 4 triangular cells
    00022 C *
    00023 C *****************************************************************************
    00024       program UsesCase_MEDmesh_1
    00025 C
    00026       implicit none
    00027       include 'med.hf'
    00028 C
    00029 C
    00030       integer cret
    00031       integer fid
    00032       integer sdim, mdim, stype, mtype, atype, nnode
    00033       character*200 cmt1,mdesc
    00034       character*64  fname
    00035       character*64 mname
    00036       character*16 nomcoo(2)
    00037       character*16 unicoo(2)
    00038       character*16 dtunit
    00039       real*8 dt
    00040       parameter (fname = "UsesCase_MEDmesh_1.med")
    00041       parameter (mdesc = "A 2D unstructured mesh")
    00042       parameter (cmt1 = "A 2D unstructured mesh : 15 nodes, 12 cells")
    00043       parameter (mname = "2D unstructured mesh")
    00044       parameter (sdim = 2, mdim = 2, nnode=15)
    00045       parameter (stype=MED_SORT_DTIT, mtype=MED_UNSTRUCTURED_MESH)
    00046       parameter (atype=MED_CARTESIAN)
    00047       parameter (dt=0.0)
    00048       data  dtunit /""/
    00049       data  nomcoo /"x               ","y               "/
    00050       data  unicoo /"cm              ","cm              "/
    00051       real*8 coo(30)
    00052       data  coo /2.,1.,7.,1.,12.,1.,17.,1.,22.,1.,
    00053      &           2.,6.,  7.,6.,  12.,6.,  17.,6.,  22.,6.,
    00054      &           2.,11., 7.,11., 12.,11., 17.,11., 22.,11./
    00055 C
    00056 C
    00057 C     file creation
    00058       call mfiope(fid,fname,MED_ACC_CREAT,cret)
    00059       print *,cret
    00060       print *,fid
    00061       if (cret .ne. 0 ) then
    00062          print *,'ERROR : file creation'
    00063          call efexit(-1)
    00064       endif
    00065 C
    00066 C
    00067 C     write a comment in the file
    00068       call mficow(fid,cmt1,cret)
    00069       print *,cret
    00070       if (cret .ne. 0 ) then
    00071          print *,'ERROR : write file description'
    00072          call efexit(-1)
    00073       endif
    00074 C
    00075 C
    00076 C     mesh creation
    00077       call mmhcre(fid, mname, sdim, mdim, mtype,mdesc,
    00078      &            dtunit, stype, atype, nomcoo, unicoo, cret)
    00079       print *,cret
    00080       if (cret .ne. 0 ) then
    00081          print *,'ERROR : mesh creation'
    00082          call efexit(-1)
    00083       endif
    00084 C
    00085 C
    00086 C     write nodes coordinates
    00087       call mmhcow(fid,mname,MED_NO_DT,MED_NO_IT,dt,
    00088      &            MED_FULL_INTERLACE,nnode,coo,cret)
    00089       print *,cret
    00090       if (cret .ne. 0 ) then
    00091          print *,'ERROR : write nodes coordinates description'
    00092          call efexit(-1)
    00093       endif
    00094 C
    00095 C
    00096 C     close file
    00097       call mficlo(fid,cret)
    00098       print *,cret
    00099       if (cret .ne. 0 ) then
    00100          print *,'ERROR :  close file'
    00101          call efexit(-1)
    00102       endif
    00103 C
    00104 C
    00105 C
    00106       end
    00107