# 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 - 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 * How to create an unstructured mesh
    00020 C * Use case 1 : a 2D unstructured mesh with 15 nodes,
    00021 C *              8 triangular cells, 4 quadrangular cells
    00022 C *
    00023 C *****************************************************************************
    00024       program UsesCase_MEDmesh_1
    00025 C
    00026       implicit none
    00027       include 'med.hf77'
    00028 C
    00029 C
    00030 C
    00031       integer cret
    00032       integer fid
    00033       integer sdim, mdim, stype, mtype, atype, nnode
    00034       integer ntria, nquad
    00035       integer fnum, ngro
    00036       character*200 cmt1,mdesc
    00037       character*64  fname
    00038       character*64 mname
    00039       character*16 nomcoo(2)
    00040       character*16 unicoo(2)
    00041       character*16 dtunit
    00042       real*8 dt
    00043       parameter (fname = "UsesCase_MEDmesh_1.med")
    00044       parameter (mdesc = "A 2D unstructured mesh")
    00045       parameter (cmt1 = "A 2D unstructured mesh : 15 nodes, 12 cells")
    00046       parameter (mname = "2D unstructured mesh")
    00047       parameter (sdim = 2, mdim = 2, nnode=15)
    00048       parameter (stype=MED_SORT_DTIT, mtype=MED_UNSTRUCTURED_MESH)
    00049       parameter (atype=MED_CARTESIAN)
    00050       parameter (dt=0.0d0)
    00051       parameter (ntria =  8, nquad = 4)
    00052       parameter (fnum = 0, ngro = 0)
    00053       data  dtunit /" "/
    00054       data  nomcoo /"x" ,"y" /
    00055       data  unicoo /"cm","cm"/
    00056       real*8 coo(30)
    00057       data  coo /2.,1.,7.,1.,12.,1.,17.,1.,22.,1.,
    00058      &           2.,6.,  7.,6.,  12.,6.,  17.,6.,  22.,6.,
    00059      &           2.,11., 7.,11., 12.,11., 17.,11., 22.,11./
    00060       integer tricon(24)
    00061       data tricon /1,7,6,   2,7,1,  3,7,2,   8,7,3,
    00062      &             13,7,8, 12,7,13, 11,7,12, 6,7,11/
    00063       integer quacon(16)
    00064       data quacon /3,4,9,8,    4,5,10,9,
    00065      &             15,14,9,10, 13,8,9,14 /
    00066 C
    00067 C
    00068 C     file creation
    00069       call mfiope(fid,fname,MED_ACC_CREAT,cret)
    00070       if (cret .ne. 0 ) then
    00071          print *,'ERROR : file creation'
    00072          call efexit(-1)
    00073       endif
    00074 C
    00075 C
    00076 C     write a comment in the file
    00077       call mficow(fid,cmt1,cret)
    00078       if (cret .ne. 0 ) then
    00079          print *,'ERROR : write file description'
    00080          call efexit(-1)
    00081       endif
    00082 C
    00083 C
    00084 C     mesh creation
    00085       call mmhcre(fid, mname, sdim, mdim, mtype,mdesc,
    00086      &            dtunit, stype, atype, nomcoo, unicoo, cret)
    00087       if (cret .ne. 0 ) then
    00088          print *,'ERROR : mesh creation'
    00089          call efexit(-1)
    00090       endif
    00091 C
    00092 C
    00093 C     write nodes coordinates
    00094       call mmhcow(fid,mname,MED_NO_DT,MED_NO_IT,dt,
    00095      &            MED_FULL_INTERLACE,nnode,coo,cret)
    00096       if (cret .ne. 0 ) then
    00097          print *,'ERROR : write nodes coordinates description'
    00098          call efexit(-1)
    00099       endif
    00100 C
    00101 C
    00102 C     cells connectiviy is defined in nodal mode with
    00103 C     no iteration and computation step
    00104       call mmhcyw(fid,mname,MED_NO_DT,MED_NO_IT,dt,MED_CELL,
    00105      &            MED_TRIA3,MED_NODAL,MED_FULL_INTERLACE,
    00106      &            ntria,tricon,cret)
    00107       print *,cret
    00108       if (cret .ne. 0 ) then
    00109          print *,'ERROR : triangular cells connectivity'
    00110          call efexit(-1)
    00111       endif
    00112 C
    00113       call mmhcyw(fid,mname,MED_NO_DT,MED_NO_IT,dt,MED_CELL,
    00114      &            MED_QUAD4,MED_NODAL,MED_FULL_INTERLACE,
    00115      &            nquad,quacon,cret)
    00116       print *,cret
    00117       if (cret .ne. 0 ) then
    00118          print *,'ERROR : quadrangular cells connectivity'
    00119          call efexit(-1)
    00120       endif
    00121 C
    00122 C
    00123 C     create family 0 : by default, all mesh entities family number is 0
    00124       call mfacre(fid,mname,MED_NO_NAME,fnum,ngro,MED_NO_GROUP,cret)
    00125       print *,cret
    00126       if (cret .ne. 0 ) then
    00127          print *,'ERROR : family 0 creation'
    00128          call efexit(-1)
    00129       endif
    00130 C
    00131 C
    00132 C     close file
    00133       call mficlo(fid,cret)
    00134       if (cret .ne. 0 ) then
    00135          print *,'ERROR :  close file'
    00136          call efexit(-1)
    00137       endif
    00138 C
    00139 C
    00140 C
    00141       end
    00142 C