00001 
00002 
00003 
00004 
00005 
00006 
00007 
00008 
00009 
00010 
00011 
00012 
00013 
00014 
00015 
00016 
00017 
00018 
00019 
00020 
00021 
00022 
00023 
00024       program UsesCase_MEDmesh_10
00025 
00026       implicit none
00027       include 'med.hf77'
00028 
00029 
00030       integer cret
00031       integer fid
00032 
00033       integer sdim, mdim
00034 
00035       character*16 axname(2), unname(2)
00036 
00037       character*64 mname, fyname, dtunit, finame
00038 
00039       integer mtype, stype, grtype
00040 
00041       integer fnum, ngro
00042 
00043       character*80 gname
00044 
00045       real*8 coords(30), dt
00046       integer nnodes, ntria3, nquad4
00047 
00048       integer tricon(24), quacon(16)
00049 
00050       integer fanbrs(15)
00051 
00052       character*200 cmt1, mdesc
00053 
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 
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 
00078 
00079 
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 
00086 
00087 
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 
00094 
00095 
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 
00103 
00104 
00105 
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 
00113 
00114 
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 
00130 
00131 
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 
00138 
00139 
00140 
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 
00149 
00150 
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 
00158 
00159 
00160       call mficlo(fid,cret)
00161       if (cret .ne. 0 ) then
00162          print *,'ERROR :  close file'
00163          call efexit(-1)
00164       endif        
00165 
00166 
00167 
00168       end
00169