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 test6
00025
00026 implicit none
00027 include 'med.hf'
00028
00029
00030 integer cret, fid
00031
00032 integer mdim,nse2,ntr3,sdim
00033 parameter (nse2=5, ntr3=2, mdim=2, sdim=2)
00034 integer se2 (2*nse2)
00035 character*16 nomse2(nse2)
00036 integer numse2(nse2),nufase2(nse2)
00037
00038 character*16 nomcoo(2)
00039 character*16 unicoo(2)
00040
00041
00042 integer tr3 (3*ntr3)
00043 character*16 nomtr3(ntr3)
00044 integer numtr3(ntr3), nufatr3(ntr3)
00045 character*64 maa
00046 real*8 dt
00047 parameter (dt = 0.0)
00048
00049 data nomcoo /"x","y"/, unicoo /"cm","cm"/
00050 data se2 / 1,2,1,3,2,4,3,4,2,3 /
00051 data nomse2 /"se1","se2","se3","se4","se5" /
00052 data numse2 / 1,2,3,4,5 /, nufase2 /-1,-1,0,-2,-3/
00053 data tr3 /1,2,-5,-5,3,-4 /, nomtr3 /"tr1","tr2"/,
00054 & numtr3 /4,5/
00055 data nufatr3 /0,-1/, maa /"maa1"/
00056
00057
00058 call mfiope(fid,'test6.med',MED_ACC_RDWR, cret)
00059 print *,cret
00060 if (cret .ne. 0 ) then
00061 print *,'Erreur creation du fichier'
00062 call efexit(-1)
00063 endif
00064
00065
00066 call mmhcre(fid,maa,mdim,sdim,
00067 & MED_UNSTRUCTURED_MESH,'un maillage pour test6',
00068 & "",MED_SORT_DTIT,MED_CARTESIAN,nomcoo,unicoo,cret)
00069 print *,cret
00070 if (cret .ne. 0 ) then
00071 print *,'Erreur creation du maillage'
00072 call efexit(-1)
00073 endif
00074
00075
00076 call mmhcyw(fid,maa,MED_NO_DT,MED_NO_IT,dt,
00077 & MED_DESCENDING_EDGE,MED_SEG2,MED_DESCENDING,
00078 & MED_NO_INTERLACE,nse2,se2,cret)
00079 print *,cret
00080 if (cret .ne. 0 ) then
00081 print *,'Erreur ecriture de la connectivite'
00082 call efexit(-1)
00083 endif
00084
00085
00086 call mmheaw(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,
00087 & MED_SEG2,nse2,nomse2,cret)
00088 print *,cret
00089 if (cret .ne. 0 ) then
00090 print *,'Erreur ecriture des noms'
00091 call efexit(-1)
00092 endif
00093
00094
00095 call mmhenw(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,
00096 & MED_SEG2,nse2,numse2,cret)
00097 print *,cret
00098 if (cret .ne. 0 ) then
00099 print *,'Erreur ecriture des numeros'
00100 call efexit(-1)
00101 endif
00102
00103
00104 call mmhfnw(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,
00105 & MED_SEG2,nse2,nufase2,cret)
00106 print *,cret
00107 if (cret .ne. 0 ) then
00108 print *,'Erreur ecriture des numéros de famille'
00109 call efexit(-1)
00110 endif
00111
00112
00113 call mmhcyw(fid,maa,MED_NO_DT,MED_NO_IT,dt,
00114 & MED_CELL,MED_TRIA3,MED_DESCENDING,
00115 & MED_NO_INTERLACE,ntr3,tr3,cret)
00116 print *,cret
00117 if (cret .ne. 0 ) then
00118 print *,'Erreur ecriture de la connectivite'
00119 call efexit(-1)
00120 endif
00121
00122
00123 call mmheaw(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00124 & MED_TRIA3,ntr3,nomtr3,cret)
00125 print *,cret
00126 if (cret .ne. 0 ) then
00127 print *,'Erreur ecriture des noms'
00128 call efexit(-1)
00129 endif
00130
00131
00132 call mmhenw(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00133 & MED_TRIA3,ntr3,numtr3,cret)
00134 print *,cret
00135 if (cret .ne. 0 ) then
00136 print *,'Erreur ecriture des numeros'
00137 call efexit(-1)
00138 endif
00139
00140
00141 call mmhfnw(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00142 & MED_TRIA3,ntr3,nufatr3,cret)
00143 print *,cret
00144 if (cret .ne. 0 ) then
00145 print *,'Erreur ecriture des numeros de famille'
00146 call efexit(-1)
00147 endif
00148
00149
00150 call mficlo(fid,cret)
00151 print *,cret
00152 if (cret .ne. 0 ) then
00153 print *,'Erreur a la fermeture du fichier'
00154 call efexit(-1)
00155 endif
00156
00157 end