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 program UsesCase_MEDmesh_9
00026
00027 implicit none
00028 include 'med.hf77'
00029
00030
00031 integer cret
00032 integer fid
00033
00034 character (MED_NAME_SIZE) mname
00035 character (MED_NAME_SIZE) fname
00036 character (MED_COMMENT_SIZE) cmt1,mdesc
00037 integer sdim, mdim
00038
00039 character (MED_SNAME_SIZE) axname(2)
00040
00041 character (MED_SNAME_SIZE) unname(2)
00042 real*8 inicoo(30)
00043 integer nnodes, ntria3, nquad4
00044
00045 integer triacy(24)
00046
00047 integer quadcy(16)
00048
00049 real*8 trama1(7)
00050
00051 real*8 trama2(7)
00052
00053 parameter (fname = "UsesCase_MEDmesh_9.med")
00054 parameter (cmt1 = "A 2D unstructured mesh : 15 nodes, 12 cells")
00055 parameter (mdesc = "A 2D unstructured mesh")
00056 parameter (mname="2D unstructured mesh")
00057 parameter (sdim=2, mdim=2)
00058 parameter (nnodes=15,ntria3=8,nquad4=4)
00059
00060 data axname /"x", "y"/
00061 data unname /"cm", "cm"/
00062 data inicoo /2.,1., 7.,1., 12.,1., 17.,1., 22.,1.,
00063 & 2.,6., 7.,6., 12.,6., 17.,6., 22.,6.,
00064 & 2.,11.,7.,11.,12.,11.,17.,11., 22.,11./
00065 data triacy /1,7,6, 2,7,1, 3,7,2, 8,7,3,
00066 & 13,7,8, 12,7,13, 11,7,12, 6,7,11/
00067 data quadcy /3,4,9,8, 4,5,10,9,
00068 & 15,14,9,10, 13,8,9,14/
00069
00070 data trama1 /0.0, 0.0, 0.0, 0.92388, 0.0, 0.38268, 0.0/
00071
00072 data trama2 /0.0, 0.0, 0.0, 0.707, 0.0, 0.707, 0.0/
00073
00074
00075 call mfiope(fid,fname,MED_ACC_CREAT,cret)
00076 if (cret .ne. 0 ) then
00077 print *,"ERROR : file creation"
00078 call efexit(-1)
00079 endif
00080
00081
00082 call mficow(fid,cmt1,cret)
00083 if (cret .ne. 0 ) then
00084 print *,"ERROR : write file description"
00085 call efexit(-1)
00086 endif
00087
00088
00089 call mmhcre(fid, mname, sdim, mdim, MED_UNSTRUCTURED_MESH, mdesc,
00090 & "", MED_SORT_DTIT, MED_CARTESIAN, axname, unname, cret)
00091 if (cret .ne. 0 ) then
00092 print *,"ERROR : mesh creation"
00093 call efexit(-1)
00094 endif
00095
00096
00097
00098
00099 call mmhcpw(fid, mname, MED_NO_DT, MED_NO_IT, 0.0D0,
00100 & MED_COMPACT_PFLMODE, MED_NO_PROFILE,
00101 & MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,
00102 & nnodes, inicoo, cret)
00103 if (cret .ne. 0 ) then
00104 print *,"ERROR : nodes coordinates"
00105 call efexit(-1)
00106 endif
00107
00108
00109
00110 call mmhypw(fid, mname, MED_NO_DT, MED_NO_IT, 0.0D0,
00111 & MED_CELL, MED_TRIA3, MED_NODAL,
00112 & MED_COMPACT_PFLMODE, MED_NO_PROFILE,
00113 & MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,
00114 & ntria3, triacy, cret)
00115 if (cret .ne. 0 ) then
00116 print *,"ERROR : triangular cells connectivity"
00117 call efexit(-1)
00118 endif
00119
00120
00121 call mmhypw(fid, mname, MED_NO_DT, MED_NO_IT, 0.0D0,
00122 & MED_CELL, MED_QUAD4, MED_NODAL,
00123 & MED_COMPACT_PFLMODE, MED_NO_PROFILE,
00124 & MED_FULL_INTERLACE, MED_ALL_CONSTITUENT,
00125 & nquad4, quadcy, cret)
00126 if (cret .ne. 0 ) then
00127 print *,"ERROR : quadrangular cells connectivity"
00128 call efexit(-1)
00129 endif
00130
00131
00132
00133
00134
00135
00136 call mmhtfw(fid, mname, 1, 1, 5.5D0, trama1, cret)
00137
00138
00139
00140 call mmhtfw(fid, mname, 2, 1, 8.9D0, trama2, cret)
00141
00142
00143
00144 call mfacre(fid, mname,MED_NO_NAME, 0, 0, MED_NO_GROUP, cret)
00145 if (cret .ne. 0 ) then
00146 print *,"ERROR : create family 0"
00147 call efexit(-1)
00148 endif
00149
00150
00151
00152 call mficlo(fid,cret)
00153 if (cret .ne. 0 ) then
00154 print *,"ERROR : close file"
00155 call efexit(-1)
00156 endif
00157
00158
00159 end
00160