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
00035 character*32 maa
00036
00037 integer nnoe
00038
00039 real*8 coo(8)
00040 character*16 comp, comp2(2)
00041 character*16 unit, unit2(2)
00042 character*200 desc
00043 integer strgri(2)
00044
00045 integer axe
00046 real*8 indice(4)
00047 integer tmp
00048
00049
00050
00051 call efouvr(fid,'test27.med',MED_LECTURE, cret)
00052 if (cret .ne. 0 ) then
00053 print *,'Erreur ouverture du fichier'
00054 call efexit(-1)
00055 endif
00056 print *,cret
00057
00058 print *,'Ouverture du fichier test27.med'
00059
00060
00061 call efnmaa(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
00068
00069
00070 do 10 i=1,nmaa
00071
00072
00073
00074 call efmaai(fid,i,maa,mdim,typmaa,desc,cret)
00075 print *,cret
00076 if (cret .ne. 0 ) then
00077 print *,'Erreur lecture maillage info'
00078 call efexit(-1)
00079 endif
00080 print *,'Maillge de nom : ',maa
00081 print *,'- Dimension : ',mdim
00082 if (typmaa.eq.MED_STRUCTURE) then
00083 print *,'- Type : MED_STRUCTURE'
00084 else
00085 print *,'- Type : MED_NON_STRUCTURE'
00086 endif
00087
00088
00089 if (typmaa.eq.MED_STRUCTURE) then
00090 call efnagl(fid,maa,type,cret)
00091 print *,cret
00092 if (cret .ne. 0 ) then
00093 print *,'Erreur lecture nature de la grille'
00094 call efexit(-1)
00095 endif
00096 if (type.eq.MED_GRILLE_CARTESIENNE) then
00097 print *,'- Nature de la grille :',
00098 & 'MED_GRILLE_CARTESIENNE'
00099 endif
00100 if (type.eq.MED_GRILLE_STANDARD) then
00101 print *,'- Nature de la grille : MED_GRILLE_STANDARD'
00102 endif
00103 endif
00104
00105
00106 if ((type.eq.MED_GRILLE_STANDARD)
00107 & .and. (typmaa.eq.MED_STRUCTURE)) then
00108
00109 call efnema(fid,maa,MED_COOR,MED_NOEUD,0,0,nnoe,cret)
00110 print *,cret
00111 if (cret .ne. 0 ) then
00112 print *,'Erreur lecture nombre de noeud'
00113 call efexit(-1)
00114 endif
00115 print *,'- Nombre de noeuds : ',nnoe
00116
00117 call efscol(fid,maa,mdim,strgri,cret)
00118 print *,cret
00119 if (cret .ne. 0 ) then
00120 print *,'Erreur lecture structure de la grille'
00121 call efexit(-1)
00122 endif
00123 print *,'- Structure de la grille : ',strgri
00124
00125 call efcool(fid,maa,mdim,coo,
00126 & MED_FULL_INTERLACE,MED_ALL,tmp,
00127 & 0,rep,comp2,unit2,cret)
00128 print *,cret
00129 if (cret .ne. 0 ) then
00130 print *,'Erreur lecture des coordonnees des noeuds'
00131 call efexit(-1)
00132 endif
00133 print *,'- Coordonnees :'
00134 do 20 j=1,nnoe*mdim
00135 print *,coo(j)
00136 20 continue
00137 endif
00138
00139 if ((type.eq.MED_GRILLE_CARTESIENNE)
00140 & .and. (typmaa.eq.MED_STRUCTURE)) then
00141
00142 do 30 axe=1,mdim
00143 if (axe.eq.1) then
00144 quoi = MED_COOR_IND1
00145 endif
00146 if (axe.eq.2) then
00147 quoi = MED_COOR_IND2
00148 endif
00149 if (axe.eq.3) then
00150 quoi = MED_COOR_IND3
00151 endif
00152
00153
00154 call efnema(fid,maa,quoi,MED_NOEUD,0,0,nind,cret)
00155 print *,cret
00156 if (cret .ne. 0 ) then
00157 print *,'Erreur lecture taille indice'
00158 call efexit(-1)
00159 endif
00160 print *,'- Axe ',axe
00161 print *,'- Nombre d indices : ',nind
00162
00163 call eficol(fid,maa,mdim,indice,nind,axe,comp,unit,
00164 & cret)
00165 print *,cret
00166 if (cret .ne. 0 ) then
00167 print *,'Erreur lecture indices de coordonnées'
00168 call efexit(-1)
00169 endif
00170 print *,'- Axe ',comp
00171 print *,' unite : ',unit
00172 do 40 j=1,nind
00173 print *,indice(j)
00174 40 continue
00175 30 continue
00176
00177 endif
00178
00179 10 continue
00180
00181
00182 call efferm (fid,cret)
00183 print *,cret
00184 if (cret .ne. 0 ) then
00185 print *,'Erreur fermeture du fichier'
00186 call efexit(-1)
00187 endif
00188 print *,'Fermeture du fichier'
00189
00190 end
00191