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 test28
00026
00027 implicit none
00028 include 'med.hf'
00029
00030
00031 integer cret, fid,i,j
00032
00033 integer mdim,nind,nmaa,type,quoi,rep,typmaa
00034 integer edim,nstep,stype,atype, chgt, tsf
00035
00036 character*64 maa
00037
00038 integer nnoe
00039
00040 real*8 coo(8)
00041 character*16 nomcoo(2), unicoo(2)
00042 character*200 desc
00043 integer strgri(2)
00044
00045 integer axe
00046 real*8 indice(4)
00047 character(16) :: dtunit
00048
00049
00050
00051 call mfiope(fid,'test27.med',MED_ACC_RDONLY, cret)
00052 if (cret .ne. 0 ) then
00053 print *,'Erreur ouverture du fichier'
00054 call efexit(-1)
00055 endif
00056 print *,cret
00057 print *,'Ouverture du fichier test27.med'
00058
00059
00060 call mmhnmh(fid,nmaa,cret)
00061 print *,cret
00062 if (cret .ne. 0 ) then
00063 print *,'Erreur lecture du nombre de maillage'
00064 call efexit(-1)
00065 endif
00066
00067
00068
00069 do 10 i=1,nmaa
00070
00071
00072
00073 call mmhmii(fid,i,maa,edim,mdim,type,desc,
00074 & dtunit,stype,nstep,atype,
00075 & nomcoo,unicoo,cret)
00076 print *,cret
00077 if (cret .ne. 0 ) then
00078 print *,'Erreur lecture maillage info'
00079 call efexit(-1)
00080 endif
00081 print *,'Maillage de nom : ',maa
00082 print *,'- Dimension : ',mdim
00083 if (type.eq.MED_STRUCTURED_MESH) then
00084 print *,'- Type : structure'
00085 else
00086 print *,'- Type : non structure'
00087 endif
00088
00089
00090 if (type.eq.MED_STRUCTURED_MESH) then
00091 call mmhgtr(fid,maa,typmaa,cret)
00092 print *,cret
00093 if (cret .ne. 0 ) then
00094 print *,'Erreur lecture nature de la grille'
00095 call efexit(-1)
00096 endif
00097 if (typmaa.eq.MED_CARTESIAN_GRID) then
00098 print *,'- Nature de la grille : cartesienne'
00099 endif
00100 if (typmaa.eq.MED_CURVILINEAR_GRID) then
00101 print *,'- Nature de la grille : curviligne'
00102 endif
00103 endif
00104
00105
00106
00107 if ((typmaa.eq.MED_CURVILINEAR_GRID)
00108 & .and. (type.eq.MED_STRUCTURED_MESH)) then
00109
00110 call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_NODE,
00111 & MED_NONE,MED_COORDINATE,MED_NO_CMODE,
00112 & chgt,tsf,nnoe,cret)
00113 print *,cret
00114 if (cret .ne. 0 ) then
00115 print *,'Erreur lecture nombre de noeud'
00116 call efexit(-1)
00117 endif
00118 print *,'- Nombre de noeuds : ',nnoe
00119
00120 call mmhgsr(fid,maa,MED_NO_DT,MED_NO_IT,strgri,cret)
00121
00122 print *,cret
00123 if (cret .ne. 0 ) then
00124 print *,'Erreur lecture structure de la grille'
00125 call efexit(-1)
00126 endif
00127 print *,'- Structure de la grille : ',strgri
00128
00129 call mmhcor(fid,maa,MED_NO_DT,MED_NO_IT,
00130 & MED_FULL_INTERLACE,coo,cret)
00131 print *,cret
00132 if (cret .ne. 0 ) then
00133 print *,'Erreur lecture des coordonnees des noeuds'
00134 call efexit(-1)
00135 endif
00136 print *,'- Coordonnees :'
00137 do 20 j=1,nnoe*mdim
00138 print *,coo(j)
00139 20 continue
00140 endif
00141
00142 if ((typmaa.eq.MED_CARTESIAN_GRID)
00143 & .and. (type.eq. MED_STRUCTURED_MESH)) then
00144
00145 do 30 axe=1,mdim
00146 if (axe.eq.1) then
00147 quoi = MED_COORDINATE_AXIS1
00148 endif
00149 if (axe.eq.2) then
00150 quoi = MED_COORDINATE_AXIS2
00151 endif
00152 if (axe.eq.3) then
00153 quoi = MED_COORDINATE_AXIS3
00154 endif
00155
00156
00157 call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_NODE,
00158 & MED_NONE,quoi,MED_NO_CMODE,
00159 & chgt,tsf,nind,cret)
00160 print *,cret
00161 if (cret .ne. 0 ) then
00162 print *,'Erreur lecture taille indice'
00163 call efexit(-1)
00164 endif
00165 print *,'- Axe ',axe
00166 print *,'- Nombre d indices : ',nind
00167
00168 call mmhgcr(fid,maa,MED_NO_DT,MED_NO_IT,
00169 & axe,indice,cret)
00170 print *,cret
00171 if (cret .ne. 0 ) then
00172 print *,'Erreur lecture indices de coordonnées'
00173 call efexit(-1)
00174 endif
00175 print *,'- Axe ', nomcoo
00176 print *,' unite : ',unicoo
00177 do 40 j=1,nind
00178 print *,indice(j)
00179 40 continue
00180 30 continue
00181
00182 endif
00183
00184 10 continue
00185
00186
00187 call mficlo(fid,cret)
00188 print *,cret
00189 if (cret .ne. 0 ) then
00190 print *,'Erreur fermeture du fichier'
00191 call efexit(-1)
00192 endif
00193 print *,'Fermeture du fichier'
00194
00195 end
00196