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 test5
00025
00026 implicit none
00027 include 'med.hf90'
00028
00029
00030 integer cret, ret
00031 integer fid
00032
00033
00034 integer mdim, sdim
00035
00036 character*64 maa
00037 character*200 desc
00038
00039 integer nnoe
00040
00041 real*8, allocatable, dimension (:) :: coo,coo1
00042
00043 character*16 nomcoo(2)
00044 character*16 unicoo(2)
00045
00046
00047
00048 character*16, allocatable, dimension (:) :: nomnoe
00049 integer, allocatable, dimension (:) :: numnoe
00050 integer, allocatable, dimension (:) :: nufano
00051 integer i
00052 logical inonoe,inunoe
00053 integer type,chgt,tsf
00054 integer flta(1)
00055 integer*8 flt(1)
00056 character(16) :: dtunit
00057 integer nstep, stype, atype
00058 integer swm
00059
00060
00061 call mfiope(fid,'test4.med',MED_ACC_RDONLY, cret)
00062 print *,cret
00063
00064
00065 if (cret.eq.0) then
00066 call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
00067 endif
00068 if (cret.ne.0) then
00069 call efexit(-1)
00070 endif
00071
00072
00073
00074 if (cret.eq.0) then
00075 nnoe = 0
00076 call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,MED_COORDINATE,MED_NO_CMODE,chgt,tsf,nnoe,cret)
00077 endif
00078 print *,cret,' Nombre de noeuds : ',nnoe
00079 if (cret.ne.0) then
00080 call efexit(-1)
00081 endif
00082
00083
00084
00085
00086
00087
00088
00089
00090 allocate( coo(nnoe*sdim),coo1(nnoe*sdim),numnoe(nnoe),nufano(nnoe),nomnoe(nnoe),STAT=ret )
00091 print *,ret
00092 coo1(:)=0.0
00093
00094
00095 if (cret.eq.0) then
00096 call mmhcor(fid,maa,MED_NO_DT,MED_NO_IT,MED_FULL_INTERLACE,coo,cret)
00097 endif
00098 print *,'Lecture des toutes les composantes des coordonnees : '
00099 print *,coo
00100 if (cret.ne.0) then
00101 call efexit(-1)
00102 endif
00103
00104
00105 if (cret .eq. 0) then
00106 call mfrall(1,flt,cret)
00107 endif
00108 if (cret.ne.0) then
00109 call efexit(-1)
00110 endif
00111
00112 if (cret .eq. 0) then
00113 call mfrcre(fid,nnoe,1,sdim,2,MED_FULL_INTERLACE,MED_GLOBAL_PFLMODE, &
00114 MED_NO_PROFILE,MED_UNDEF_SIZE,flta,flt(1),cret)
00115 endif
00116 if (cret.ne.0) then
00117 call efexit(-1)
00118 endif
00119
00120
00121 if (cret.eq.0) then
00122 call mmhcar(fid,maa,MED_NO_DT,MED_NO_IT,flt(1),coo1,cret)
00123 endif
00124 print *,'Lecture de la composante numero 2 des coordonnees : '
00125 print *,coo1
00126
00127
00128 if (cret .eq. 0) then
00129 call mfrdea(1,flt,cret)
00130 endif
00131 if (cret.ne.0) then
00132 call efexit(-1)
00133 endif
00134
00135
00136
00137 if (cret.eq.0) then
00138 call mmhear(fid,maa,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,nomnoe,cret)
00139 endif
00140
00141 if (ret <0) then
00142 inonoe = .FALSE.
00143 else
00144 inonoe = .TRUE.
00145 endif
00146
00147
00148 if (cret.eq.0) then
00149 call mmhenr(fid,maa,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,numnoe,cret)
00150 endif
00151 if (ret <0) then
00152 inunoe = .FALSE.
00153 else
00154 inunoe = .TRUE.
00155 endif
00156
00157
00158 if (cret.eq.0) then
00159 call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,nufano,cret)
00160 endif
00161 print *,cret
00162
00163
00164
00165 call mficlo(fid,cret)
00166 if (cret.ne.0) then
00167 call efexit(-1)
00168 endif
00169
00170
00171
00172 if (cret.eq.0) then
00173
00174
00175 print *,"Type de repere : ", atype
00176 print *,"Nom des coordonnees : "
00177 print *, nomcoo
00178
00179 print *,"Unites des coordonnees : "
00180 print *, unicoo
00181
00182 print *,"Coordonnees des noeuds : "
00183 print *, coo
00184
00185 if (inonoe) then
00186 print *,"Noms des noeuds : "
00187 print *,nomnoe
00188 endif
00189
00190 if (inunoe) then
00191 print *,"Numeros des noeuds : "
00192 print *,numnoe
00193 endif
00194
00195 print *,"Numeros des familles des noeuds : "
00196 print *,nufano
00197
00198 endif
00199
00200
00201 deallocate(coo,coo1,nomnoe,numnoe,nufano);
00202
00203
00204
00205 call efexit(cret)
00206
00207 end program test5
00208
00209
00210
00211
00212
00213