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 test26
00026
00027 implicit none
00028 include 'med.hf'
00029
00030 integer cret,fid,mdim,nmaa,npoly,i,j,k,l,nfindex
00031 integer edim,nstep,stype,atype, chgt, tsf
00032 integer nfaces, nnoeuds
00033 integer ind1, ind2
00034 character*64 maa
00035 character*200 desc
00036 integer n
00037 parameter (n=2)
00038 integer np,nf,np2,nf2,taille,tmp
00039 parameter (np=3,nf=9,np2=3,nf2=8)
00040 integer indexp(np),indexf(nf)
00041 integer conn(24)
00042 integer indexp2(np2),indexf2(nf2)
00043 integer conn2(nf2)
00044 character*16 nom(n)
00045 integer num(n),fam(n)
00046 integer type
00047 character*16 nomcoo(3)
00048 character*16 unicoo(3)
00049 character(16) :: dtunit
00050
00051
00052 call mfiope(fid,'test25.med',MED_ACC_RDONLY, cret)
00053 print *,cret
00054 if (cret .ne. 0 ) then
00055 print *,'Erreur ouverture du fichier'
00056 call efexit(-1)
00057 endif
00058 print *,'Ouverture du fichier test25.med'
00059
00060
00061 call mmhnmh(fid,nmaa,cret)
00062 print *,cret
00063 if (cret .ne. 0 ) then
00064 print *,'Erreur lecture du nombre de maillage'
00065 call efexit(-1)
00066 endif
00067 print *,'Nombre de maillages : ',nmaa
00068
00069
00070
00071 do 10 i=1,nmaa
00072
00073
00074 call mmhmii(fid,i,maa,edim,mdim,type,desc,
00075 & dtunit,stype,nstep,atype,
00076 & nomcoo,unicoo,cret)
00077 print *,cret
00078 if (cret .ne. 0 ) then
00079 print *,'Erreur infos maillage'
00080 call efexit(-1)
00081 endif
00082 print *,'Maillage : ',maa
00083 print *,'Dimension : ',mdim
00084
00085
00086
00087 call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,
00088 & MED_CELL,MED_POLYHEDRON,MED_INDEX_FACE,MED_NODAL,
00089 & chgt,tsf,nfindex,cret)
00090 npoly = nfindex - 1
00091 print *,cret
00092 if (cret .ne. 0 ) then
00093 print *,'Erreur lecture nombre de polyedre'
00094 call efexit(-1)
00095 endif
00096 print *,'Nombre de mailles MED_POLYEDRE : ',npoly
00097
00098
00099
00100 call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,
00101 & MED_CELL,MED_POLYHEDRON,
00102 & MED_INDEX_NODE,MED_NODAL,
00103 & chgt,tsf,taille,cret)
00104 print *,cret
00105 if (cret .ne. 0 ) then
00106 print *,'Erreur infos sur les polyedres'
00107 call efexit(-1)
00108 endif
00109 print *,'Taille de la connectivite : ',taille
00110 print *,'Taille du tableau indexf : ', nfindex
00111
00112
00113 call mmhphr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00114 & MED_NODAL,indexp,indexf,conn,cret)
00115 print *,cret
00116 if (cret .ne. 0 ) then
00117 print *,'Erreur lecture connectivites polyedres'
00118 call efexit(-1)
00119 endif
00120 print *,'Lecture de la connectivite des polyedres'
00121 print *,'Connectivite nodale'
00122
00123
00124 call mmhphr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00125 & MED_DESCENDING,indexp2,indexf2,conn2,cret)
00126 print *,cret
00127 if (cret .ne. 0 ) then
00128 print *,'Erreur lecture connectivite des polyedres'
00129 call efexit(-1)
00130 endif
00131 print *,'Lecture de la connectivite des polyedres'
00132 print *,'Connectivite descendante'
00133
00134
00135 call mmhear(fid,maa,MED_NO_DT,MED_NO_IT,
00136 & MED_CELL,MED_POLYHEDRON,nom,cret)
00137 print *,cret
00138 if (cret .ne. 0 ) then
00139 print *,'Erreur lecture noms des polyedres'
00140 call efexit(-1)
00141 endif
00142 print *,'Lecture des noms'
00143
00144
00145 call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00146 & MED_POLYHEDRON,num,cret)
00147 print *,cret
00148 if (cret .ne. 0 ) then
00149 print *,'Erreur lecture des numeros des polyedres'
00150 call efexit(-1)
00151 endif
00152 print *,'Lecture des numeros'
00153
00154
00155 call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00156 & MED_POLYHEDRON,fam,cret)
00157 print *,cret
00158 if (cret .ne. 0 ) then
00159 print *,'Erreur lecture numeros de famille polyedres'
00160 call efexit(-1)
00161 endif
00162 print *,'Lecture des numeros de famille'
00163
00164
00165 print *,'Affichage des resultats'
00166 do 20 j=1,npoly
00167
00168 print *,'>> Maille polyhedre ',j
00169 print *,'---- Connectivite nodale ---- : '
00170 nfaces = indexp(j+1) - indexp(j)
00171
00172
00173 ind1 = indexp(j)
00174 do 30 k=1,nfaces
00175
00176 ind2 = indexf(ind1+k-1)
00177 nnoeuds = indexf(ind1+k) - indexf(ind1+k-1)
00178 print *,' - Face ',k
00179 do 40 l=1,nnoeuds
00180 print *,' ',conn(ind2+l-1)
00181 40 continue
00182 30 continue
00183 print *,'---- Connectivite descendante ---- : '
00184 nfaces = indexp2(j+1) - indexp2(j)
00185
00186 ind1 = indexp2(j)
00187 do 50 k=1,nfaces
00188 print *,' - Face ',k
00189 print *,' => Numero : ',conn2(ind1+k-1)
00190 print *,' => Type : ',indexf2(ind1+k-1)
00191 50 continue
00192 print *,'---- Nom ---- : ',nom(j)
00193 print *,'---- Numero ----: ',num(j)
00194 print *,'---- Numero de famille ---- : ',fam(j)
00195
00196 20 continue
00197
00198 10 continue
00199
00200
00201 call mficlo(fid,cret)
00202 print *,cret
00203 if (cret .ne. 0 ) then
00204 print *,'Erreur fermeture du fichier'
00205 call efexit(-1)
00206 endif
00207 print *,'Fermeture du fichier'
00208
00209 end