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