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 - 2015  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

Généré le Thu Oct 8 14:26:17 2015 pour MED fichier par  doxygen 1.6.1