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 test25
00025
00026 implicit none
00027 include 'med.hf'
00028
00029 integer cret, fid,mdim, sdim
00030 parameter (mdim = 3, sdim = 3)
00031 character*64 maa
00032 integer n
00033 parameter (n=2)
00034
00035 integer np,nf
00036 parameter (nf=9,np=3)
00037 integer indexp(np),indexf(nf)
00038 integer conn(24)
00039
00040 integer np2,nf2
00041 parameter (nf2=8,np2=3)
00042 integer indexp2(np2),indexf2(nf2)
00043 integer conn2(nf2)
00044 character*16 nom(n)
00045 integer num(n),fam(n)
00046
00047
00048 character*16 nomcoo(3)
00049 character*16 unicoo(3)
00050
00051 data indexp / 1,5,9 /
00052 data indexf / 1,4,7,10,13,16,19,22,25 /
00053 data conn / 1,2,3,4,5,6,7,8,9,10,11,12,13,14,
00054 & 15,16,17,18,19,20,21,22,23,24 /
00055 data indexp2 / 1,5,9 /
00056 data indexf2 / MED_TRIA3,MED_TRIA3,MED_TRIA3,MED_TRIA3,
00057 & MED_TRIA3,MED_TRIA3,MED_TRIA3,MED_TRIA3 /
00058 data conn2 / 1,2,3,4,5,6,7,8 /
00059 data nom / "poly1", "poly2"/
00060 data num / 1,2 /, fam / 0,-1 /
00061 data maa /"maa1"/
00062 data nomcoo /"x","y","z"/, unicoo /"cm","cm","cm"/
00063
00064
00065 call mfiope(fid,'test25.med',MED_ACC_RDWR, cret)
00066 print *,cret
00067 if (cret .ne. 0 ) then
00068 print *,'Erreur creation du fichier'
00069 call efexit(-1)
00070 endif
00071 print *,'Creation du fichier test25.med'
00072
00073
00074 call mmhcre(fid,maa,mdim,sdim,
00075 & MED_UNSTRUCTURED_MESH,'un maillage pour test 25',
00076 & "",MED_SORT_DTIT,MED_CARTESIAN,nomcoo,unicoo,cret)
00077 if (cret .ne. 0 ) then
00078 print *,'Erreur creation du maillage'
00079 call efexit(-1)
00080 endif
00081 print *,cret
00082 print *,'Creation du maillage'
00083
00084
00085 call mmhphw(fid,maa,MED_NO_DT,MED_NO_IT,MED_UNDEF_DT,MED_CELL,
00086 & MED_NODAL,np,indexp,nf,indexf,conn,cret)
00087 print *,cret
00088 if (cret .ne. 0 ) then
00089 print *,'Erreur ecriture connectivite des polyedres'
00090 call efexit(-1)
00091 endif
00092 print *,
00093 'Ecriture des connectivites des mailles & de type MED_POLYEDRE'
00094 print *,'Description nodale'
00095
00096
00097 call mmhphw(fid,maa,MED_NO_DT,MED_NO_IT,MED_UNDEF_DT,MED_CELL,
00098 & MED_DESCENDING,np2,indexp2,nf2,indexf2,conn2,cret)
00099 print *,cret
00100 if (cret .ne. 0 ) then
00101 print *,'Erreur ecriture connectivite des polyedres'
00102 call efexit(-1)
00103 endif
00104 print *,
00105 'Ecriture des connectivites des mailles & de type MED_POLYEDRE'
00106 print *,'Description descendante'
00107
00108
00109 call mmheaw(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00110 & MED_POLYHEDRON,n,nom,cret)
00111 print *,cret
00112 if (cret .ne. 0 ) then
00113 print *,'Erreur ecriture noms des polyedres'
00114 call efexit(-1)
00115 endif
00116 print *,'Ecriture des noms des polyedress'
00117
00118
00119 call mmhenw(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00120 & MED_POLYHEDRON,n,num,cret)
00121 print *,cret
00122 if (cret .ne. 0 ) then
00123 print *,'Erreur ecriture numeros des polyedres'
00124 call efexit(-1)
00125 endif
00126 print *,'Ecriture des numeros des polyedres'
00127
00128
00129 call mmhfnw(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00130 & MED_POLYHEDRON,n,fam,cret)
00131 print *,cret
00132 if (cret .ne. 0 ) then
00133 print *,'Erreur ecriture numeros de familles polyedres'
00134 call efexit(-1)
00135 endif
00136 print *,'Ecriture des numeros de familles des polyedres'
00137
00138
00139 call mficlo(fid,cret)
00140 print *,cret
00141 if (cret .ne. 0 ) then
00142 print *,'Erreur fermeture du fichier'
00143 call efexit(-1)
00144 endif
00145 print *,'Fermeture du fichier'
00146
00147 end