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_1
00025 
00026       implicit none
00027       include 'med.hf77'
00028 
00029 
00030 
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 
00067 
00068 
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 
00075 
00076 
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 
00083 
00084 
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 
00092 
00093 
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 
00101 
00102 
00103 
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 
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 
00122 
00123 
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 
00131 
00132 
00133       call mficlo(fid,cret)
00134       if (cret .ne. 0 ) then
00135          print *,'ERROR :  close file'
00136          call efexit(-1)
00137       endif
00138 
00139 
00140 
00141       end
00142