00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034 program UsesCase_MEDmesh_13
00035
00036 implicit none
00037 include 'med.hf77'
00038
00039
00040 integer cret
00041 integer fid
00042
00043 integer sdim, mdim
00044
00045 character*16 axname(2), unname(2)
00046
00047 character*64 mname, finame
00048 character*64 dtunit
00049
00050 real*8 coords(2*10)
00051 integer nnodes
00052 integer isize
00053 integer index(3)
00054 integer conity(12)
00055
00056 character*200 cmt1, mdesc
00057
00058 parameter (sdim = 2, mdim = 2)
00059 parameter (mname = "2D unstructured mesh")
00060 parameter (dtunit = "")
00061 parameter (finame = "UsesCase_MEDmesh_13.med")
00062
00063 parameter (nnodes = 10)
00064 parameter (isize = 3)
00065 parameter (cmt1 ="A 2D unstructured mesh : 10 nodes, 2 polygons")
00066 parameter (mdesc = "A 2D mesh with 2 polygons")
00067
00068 data axname /"x ","y "/
00069 data unname /"cm ","cm "/
00070 data coords / 0.5, 0.,
00071 & 1.5, 0.,
00072 & 0., 0.5,
00073 & 1., 0.5,
00074 & 2., 0.5,
00075 & 0., 1.,
00076 & 1., 1.,
00077 & 2., 1.,
00078 & 0.5, 2.,
00079 & 1.5, 2. /
00080 data index / 1, 7, 13 /
00081 data conity / 1,4,7,9,6,3,
00082 & 2,5,8,10,7,4 /
00083
00084
00085
00086 call mfiope(fid,finame,MED_ACC_CREAT,cret)
00087 if (cret .ne. 0 ) then
00088 print *,'ERROR : file creation'
00089 call efexit(-1)
00090 endif
00091
00092
00093
00094 call mficow(fid,cmt1,cret)
00095 if (cret .ne. 0 ) then
00096 print *,'ERROR : write file description'
00097 call efexit(-1)
00098 endif
00099
00100
00101
00102 call mmhcre(fid, mname, sdim, mdim, MED_UNSTRUCTURED_MESH, mdesc,
00103 & dtunit, MED_SORT_DTIT, MED_CARTESIAN,
00104 & axname, unname, cret)
00105 if (cret .ne. 0 ) then
00106 print *,'ERROR : mesh creation'
00107 call efexit(-1)
00108 endif
00109
00110
00111
00112
00113 call mmhcow(fid,mname,MED_NO_DT,MED_NO_IT, MED_UNDEF_DT,
00114 & MED_FULL_INTERLACE,nnodes,coords,cret)
00115 if (cret .ne. 0 ) then
00116 print *,'ERROR : write nodes coordinates description'
00117 call efexit(-1)
00118 endif
00119
00120
00121
00122
00123 call mmhpgw(fid, mname, MED_NO_DT, MED_NO_IT, MED_UNDEF_DT,
00124 & MED_CELL, MED_NODAL, isize, index, conity, cret)
00125 if (cret .ne. 0 ) then
00126 print *,'ERROR : polygon 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 call mficlo(fid,cret)
00141 if (cret .ne. 0 ) then
00142 print *,'ERROR : close file'
00143 call efexit(-1)
00144 endif
00145
00146
00147
00148 end
00149