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