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 test23
00026
00027 implicit none
00028 include 'med.hf'
00029
00030 integer cret, fid,mdim,nmaa,npoly,i,j,k,taille
00031 integer edim,nstep,stype,atype, chgt, tsf
00032 character*64 maa
00033 character*200 desc
00034 integer ni, n, isize;
00035 parameter (ni=4, n=3)
00036 integer index(ni),ind1,ind2
00037 character*16 nom(n)
00038 integer num(n),fam(n)
00039 integer con(16)
00040 integer type
00041 character*16 nomcoo(2)
00042 character*16 unicoo(2)
00043 character(16) :: dtunit
00044
00045
00046 call mfiope(fid,'test23.med',MED_ACC_RDONLY, cret)
00047 print *,cret
00048 if (cret .ne. 0 ) then
00049 print *,'Erreur ouverture du fichier'
00050 call efexit(-1)
00051 endif
00052 print *,'Ouverture du fichier test23.med'
00053
00054
00055 call mmhnmh(fid,nmaa,cret)
00056 print *,cret
00057 if (cret .ne. 0 ) then
00058 print *,'Erreur lecture nombre de maillage'
00059 call efexit(-1)
00060 endif
00061 print *,'Nombre de maillages : ',nmaa
00062
00063
00064
00065 do 10 i=1,nmaa
00066
00067
00068 call mmhmii(fid,i,maa,edim,mdim,type,desc,
00069 & dtunit,stype,nstep,atype,
00070 & nomcoo,unicoo,cret)
00071 if (cret .ne. 0 ) then
00072 print *,'Erreur lecture infos maillage'
00073 call efexit(-1)
00074 endif
00075 print *,cret
00076 print *,'Maillage : ',maa
00077 print *,'Dimension : ',mdim
00078
00079
00080 call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON,
00081 & MED_INDEX_NODE,MED_NODAL,chgt,tsf,isize,cret)
00082 npoly = isize - 1;
00083 print *,cret
00084 if (cret .ne. 0 ) then
00085 print *,'Erreur lecture du nombre de polygone'
00086 call efexit(-1)
00087 endif
00088 print *,'Nombre de mailles MED_POLYGONE : ',npoly
00089
00090
00091 call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON,
00092 & MED_CONNECTIVITY,MED_NODAL,chgt,tsf,taille,cret)
00093 print *,cret
00094 if (cret .ne. 0 ) then
00095 print *,'Erreur lecture infos polygones'
00096 call efexit(-1)
00097 endif
00098 print *,'Taille de la connectivite : ',taille
00099
00100
00101 call mmhpgr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00102 & MED_NODAL,index,con,cret)
00103 print *,cret
00104 if (cret .ne. 0 ) then
00105 print *,'Erreur lecture des connectivites polygones'
00106 call efexit(-1)
00107 endif
00108 print *,'Lecture de la connectivite des polygones'
00109
00110
00111 call mmhear(fid,maa,MED_NO_DT,MED_NO_IT,
00112 & MED_CELL,MED_POLYGON,nom,cret)
00113 print *,cret
00114 if (cret .ne. 0 ) then
00115 print *,'Erreur lecture des noms des polygones'
00116 call efexit(-1)
00117 endif
00118 print *,'Lecture des noms'
00119
00120
00121 call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON,
00122 & num,cret)
00123 print *,cret
00124 if (cret .ne. 0 ) then
00125 print *,'Erreur lecture des numeros des polygones'
00126 call efexit(-1)
00127 endif
00128 print *,'Lecture des numeros'
00129
00130
00131 call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON,
00132 & fam,cret)
00133 print *,cret
00134 if (cret .ne. 0 ) then
00135 print *,
00136 'Erreur lecture des numeros de famille des & polygones'
00137 call efexit(-1)
00138 endif
00139 print *,'Lecture des numeros de famille'
00140
00141
00142 print *,'Affichage des resultats'
00143 do 20 j=1,npoly
00144
00145 print *,'>> Maille polygone ',j
00146 print *,'---- Connectivite ---- : '
00147 ind1 = index(j)
00148 ind2 = index(j+1)
00149 do 30 k=ind1,ind2-1
00150 print *,con(k)
00151 30 continue
00152
00153 print *,'---- Numero ----: ',num(j)
00154 print *,'---- Numero de famille ---- : ',fam(j)
00155
00156 20 continue
00157
00158 10 continue
00159
00160
00161 call mficlo(fid,cret)
00162 print *,cret
00163 if (cret .ne. 0 ) then
00164 print *,'Erreur fermeture du fichier'
00165 call efexit(-1)
00166 endif
00167 print *,'Fermeture du fichier'
00168
00169 end