usecases/f/UsesCase_MEDmesh_10.f

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

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