00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023 program UsesCase_MEDmesh_4
00024
00025 implicit none
00026 include 'med.hf77'
00027
00028
00029 integer cret
00030 integer fid
00031 integer sdim, mdim, stype, mtype, atype
00032 integer axis, isize, entype, nquad4
00033 character*200 mdesc
00034 character*64 fname
00035 character*64 mname
00036
00037 character*16 axname(2)
00038
00039 character*16 unname(2)
00040 character*16 dtunit
00041 character*16 cnames(8)
00042 real*8 dt
00043 real*8 cooXaxis(5)
00044 real*8 cooYaxis(3)
00045 parameter (fname = "UsesCase_MEDmesh_4.med")
00046 parameter (mdesc = "A 2D structured mesh")
00047 parameter (mname = "2D structured mesh")
00048 parameter (sdim = 2, mdim = 2)
00049 parameter (stype=MED_SORT_DTIT, mtype=MED_STRUCTURED_MESH)
00050 parameter (atype=MED_CARTESIAN_GRID)
00051 parameter (nquad4=8)
00052 parameter (dt=0.0d0)
00053 data dtunit /" "/
00054 data axname /"x" ,"y"/
00055 data unname /"cm","cm"/
00056 data cnames /"CELL_1","CELL_2",
00057 & "CELL_3","CELL_4",
00058 & "CELL_5","CELL_6",
00059 & "CELL_7","CELL_8"/
00060 data cooXaxis /1.,2.,3.,4.,5./
00061 data cooYaxis /1.,2.,3./
00062
00063
00064
00065 call mfiope(fid,fname,MED_ACC_CREAT,cret)
00066 if (cret .ne. 0 ) then
00067 print *,'ERROR : file creation'
00068 call efexit(-1)
00069 endif
00070
00071
00072
00073 call mmhcre(fid, mname, sdim, mdim, mtype,mdesc,
00074 & dtunit, stype, atype, axname, unname, cret)
00075 if (cret .ne. 0 ) then
00076 print *,'ERROR : mesh creation'
00077 call efexit(-1)
00078 endif
00079
00080
00081
00082 call mmhgtw(fid,mname,MED_CARTESIAN_GRID,cret)
00083 if (cret .ne. 0 ) then
00084 print *,'ERROR : write grid type'
00085 call efexit(-1)
00086 endif
00087
00088
00089
00090 axis = 1
00091 isize = 5
00092 call mmhgcw(fid,mname,MED_NO_DT,MED_NO_IT,dt,
00093 & axis,isize,cooXaxis,cret)
00094 if (cret .ne. 0 ) then
00095 print *,'ERROR : write X coordinates'
00096 call efexit(-1)
00097 endif
00098 axis = 2
00099 isize = 3
00100 call mmhgcw(fid,mname,MED_NO_DT,MED_NO_IT,dt,
00101 & axis,isize,cooYaxis,cret)
00102 if (cret .ne. 0 ) then
00103 print *,'ERROR : write Y coordinates'
00104 call efexit(-1)
00105 endif
00106
00107
00108
00109
00110 call mmheaw(fid,mname,MED_NO_DT,MED_NO_IT,MED_CELL,MED_QUAD4,
00111 & nquad4,cnames,cret)
00112 if (cret .ne. 0 ) then
00113 print *,'ERROR : write names for elements'
00114 call efexit(-1)
00115 endif
00116
00117
00118
00119 call mfacre(fid,mname,MED_NO_NAME,0,0,MED_NO_GROUP,cret)
00120 if (cret .ne. 0 ) then
00121 print *,'ERROR : create family 0'
00122 call efexit(-1)
00123 endif
00124
00125
00126
00127 call mficlo(fid,cret)
00128 if (cret .ne. 0 ) then
00129 print *,'ERROR : close file'
00130 call efexit(-1)
00131 endif
00132
00133
00134
00135 end
00136