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_MEDfield_1
00024
00025 implicit none
00026 include 'med.hf77'
00027
00028
00029
00030 integer cret
00031 integer fid
00032
00033 integer ncompo, nnodes
00034
00035 integer ntria3, nquad4
00036
00037 character*64 fname, finame, lfname
00038
00039 character*16 cpname, cpunit
00040
00041 character*64 mname
00042 character*16 dtunit
00043 real*8 dt
00044
00045 real*8 verval(15)
00046 real*8 tria3v(8)
00047 real*8 quad4v(4)
00048
00049 parameter (fname = "./UsesCase_MEDfield_1.med")
00050 parameter (lfname= "./UsesCase_MEDmesh_1.med")
00051 parameter (mname = "2D unstructured mesh")
00052 parameter (finame = "TEMPERATURE_FIELD")
00053 parameter (cpname = "TEMPERATURE")
00054 parameter (cpunit = "C")
00055 parameter (dtunit = " ")
00056 parameter (nnodes = 15, ncompo = 1 )
00057 parameter (ntria3 = 8, nquad4 = 4)
00058 parameter (dt = 0.0d0)
00059
00060 data verval / 0., 100., 200., 300., 400.,
00061 & 500., 600., 700., 800., 900,
00062 & 1000., 1100, 1200., 1300., 1500. /
00063 data tria3v / 1000., 2000., 3000., 4000.,
00064 & 5000., 6000., 7000., 8000. /
00065 data quad4v / 10000., 20000., 30000., 4000. /
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 mlnliw(fid,mname,lfname,cret)
00078 if (cret .ne. 0 ) then
00079 print *,'ERROR : create mesh link ...'
00080 call efexit(-1)
00081 endif
00082
00083
00084
00085
00086
00087 call mfdcre(fid,finame,MED_FLOAT64,ncompo,cpname,cpunit,dtunit,
00088 & mname,cret)
00089 if (cret .ne. 0 ) then
00090 print *,'ERROR : create field ...'
00091 call efexit(-1)
00092 endif
00093
00094
00095
00096 call mfdrvw(fid,finame,MED_NO_DT,MED_NO_IT,dt,MED_NODE,
00097 & MED_NONE,MED_FULL_INTERLACE,MED_ALL_CONSTITUENT,
00098 & nnodes,verval,cret)
00099 if (cret .ne. 0 ) then
00100 print *,'ERROR : write field values on vertices'
00101 call efexit(-1)
00102 endif
00103
00104
00105
00106
00107 call mfdrvw(fid,finame,MED_NO_DT,MED_NO_IT,dt,MED_CELL,
00108 & MED_TRIA3,MED_FULL_INTERLACE,MED_ALL_CONSTITUENT,
00109 & ntria3,tria3v,cret)
00110 if (cret .ne. 0 ) then
00111 print *,'ERROR : write field values on MED_TRIA3'
00112 call efexit(-1)
00113 endif
00114
00115
00116
00117 call mfdrvw(fid,finame,MED_NO_DT,MED_NO_IT,dt,MED_CELL,
00118 & MED_QUAD4,MED_FULL_INTERLACE,MED_ALL_CONSTITUENT,
00119 & nquad4,quad4v,cret)
00120 if (cret .ne. 0 ) then
00121 print *,'ERROR : write field values on MED_QUAD4'
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 end
00134