# usecases/f/UsesCase_MEDmesh_10.f

    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 10 : write a 2D unstructured mesh with 15 nodes, 8 triangular
    00021 C *               cells, 4 quadrangular cells, and families
    00022 C *
    00023 C *****************************************************************************
    00024       program UsesCase_MEDmesh_10
    00025 C
    00026       implicit none
    00027       include 'med.hf77'
    00028 C
    00029 C
    00030       integer cret
    00031       integer fid
    00032 C     space dim, mesh dim
    00033       integer sdim, mdim
    00034 C     axis name, unit name
    00035       character*16 axname(2), unname(2)
    00036 C     mesh name, family name, time step unit, file name
    00037       character*64 mname, fyname, dtunit, finame
    00038 C     mesh type, sorting type, grid type
    00039       integer mtype, stype, grtype
    00040 C     family number, number of group
    00041       integer fnum, ngro
    00042 C     group name
    00043       character*80 gname
    00044 C     coordinates, date
    00045       real*8 coords(30), dt
    00046       integer nnodes, ntria3, nquad4
    00047 C     triangular and quadrangular cells connectivity
    00048       integer tricon(24), quacon(16)
    00049 C     family numbers
    00050       integer fanbrs(15)
    00051 C     comment 1, mesh description
    00052       character*200 cmt1, mdesc
    00053 C
    00054       parameter (sdim = 2, mdim = 2)
    00055       parameter (mname = "2D unstructured mesh")
    00056       parameter (fyname = "BOUNDARY_VERTICES")
    00057       parameter (dtunit = " ")
    00058       parameter (dt = 0.0d0)
    00059       parameter (finame = "UsesCase_MEDmesh_10.med")
    00060       parameter (gname = "MESH_BOUNDARY_VERTICES")
    00061       parameter (nnodes = 15, ntria3 = 8, nquad4 = 4)
    00062       parameter (cmt1 ="A 2D unstructured mesh : 15 nodes, 12 cells")
    00063       parameter (mtype=MED_UNSTRUCTURED_MESH, stype=MED_SORT_DTIT )
    00064       parameter (mdesc = "A 2D unstructured mesh")
    00065       parameter (grtype=MED_CARTESIAN_GRID)
    00066 C
    00067       data axname  /"x" ,"y" /
    00068       data unname  /"cm","cm"/
    00069       data coords /2.,1.,  7.,1.,  12.,1.,  17.,1.,  22.,1.,
    00070      &             2.,6.,  7.,6.,  12.,6.,  17.,6.,  22.,6.,
    00071      &             2.,11., 7.,11., 12.,11., 17.,11., 22.,11./
    00072       data tricon /1,7,6,   2,7,1,  3,7,2,   8,7,3,
    00073      &             13,7,8, 12,7,13, 11,7,12, 6,7,11/
    00074       data quacon /3,4,9,8,    4,5,10,9,
    00075      &             15,14,9,10, 13,8,9,14/
    00076       data fanbrs /1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1/
    00077 C
    00078 C
    00079 C     file creation
    00080       call mfiope(fid,finame,MED_ACC_CREAT,cret)
    00081       if (cret .ne. 0 ) then
    00082          print *,'ERROR : file creation'
    00083          call efexit(-1)
    00084       endif
    00085 C
    00086 C
    00087 C     write a comment in the file
    00088       call mficow(fid,cmt1,cret)
    00089       if (cret .ne. 0 ) then
    00090          print *,'ERROR : write file description'
    00091          call efexit(-1)
    00092       endif
    00093 C
    00094 C
    00095 C     mesh creation : a 2D unstructured mesh
    00096       call mmhcre(fid, mname, sdim, mdim, mtype, mdesc, dtunit,
    00097      &            stype, grtype, axname, unname, cret)
    00098       if (cret .ne. 0 ) then
    00099          print *,'ERROR : mesh creation'
    00100          call efexit(-1)
    00101       endif
    00102 C
    00103 C
    00104 C     nodes coordinates in a cartesian axis in full interlace mode
    00105 C     (X1,Y1, X2,Y2, X3,Y3, ...) with no iteration and computation step
    00106       call mmhcow(fid,mname,MED_NO_DT,MED_NO_IT,dt,
    00107      &            MED_FULL_INTERLACE,nnodes,coords,cret)
    00108       if (cret .ne. 0 ) then
    00109          print *,'ERROR : write nodes coordinates description'
    00110          call efexit(-1)
    00111       endif
    00112 C
    00113 C
    00114 C     cells connectiviy is defined in nodal mode
    00115       call mmhcyw(fid,mname,MED_NO_DT,MED_NO_IT,dt,MED_CELL,
    00116      &            MED_TRIA3,MED_NODAL,MED_FULL_INTERLACE,
    00117      &            ntria3,tricon,cret)
    00118       if (cret .ne. 0 ) then
    00119          print *,'ERROR : triangular cells connectivity'
    00120          call efexit(-1)
    00121       endif
    00122       call mmhcyw(fid,mname,MED_NO_DT,MED_NO_IT,dt,MED_CELL,
    00123      &            MED_QUAD4,MED_NODAL,MED_FULL_INTERLACE,
    00124      &            nquad4,quacon,cret)
    00125       if (cret .ne. 0 ) then
    00126          print *,'ERROR : quadrangular cells connectivity'
    00127          call efexit(-1)
    00128       endif
    00129 C
    00130 C
    00131 C     create family 0 : by default, all mesh entities family number is 0
    00132       call mfacre(fid,mname,MED_NO_NAME,0,0,MED_NO_GROUP,cret)
    00133       if (cret .ne. 0 ) then
    00134          print *,'ERROR : create family 0'
    00135          call efexit(-1)
    00136       endif
    00137 C
    00138 C
    00139 C     create a family for boundary vertices : by convention a nodes family number is > 0,
    00140 C     and an element family number is < 0
    00141       fnum = 1
    00142       ngro = 1
    00143       call mfacre(fid, mname, fyname, fnum, ngro, gname, cret)
    00144       if (cret .ne. 0 ) then
    00145          print *,'ERROR : create family 0'
    00146          call efexit(-1)
    00147       endif
    00148 C
    00149 C
    00150 C     write family number for nodes
    00151       call mmhfnw(fid, mname, MED_NO_DT, MED_NO_IT, MED_NODE, MED_NONE,
    00152      &            nnodes, fanbrs, cret)
    00153       if (cret .ne. 0 ) then
    00154          print *,'ERROR : nodes family numbers ...'
    00155          call efexit(-1)
    00156       endif
    00157 C
    00158 C
    00159 C     close file
    00160       call mficlo(fid,cret)
    00161       if (cret .ne. 0 ) then
    00162          print *,'ERROR :  close file'
    00163          call efexit(-1)
    00164       endif
    00165 C
    00166 C
    00167 C
    00168       end
    00169 C