32 integer cret,ret,lret,retmem, fid
33 integer USER_INTERLACE,USER_MODE
34 character*64 :: maa,nomcha,pflname,nomlien,locname
37 character*16,
allocatable,
dimension(:) :: comp,unit
39 integer mdim,ncomp,ncha,npro,nln,pflsize,nval
40 integer,
allocatable,
dimension(:) :: pflval
42 integer t1,t2,t3,typcha,
type,type_geo
43 real*8,
allocatable,
dimension(:) :: refcoo, gscoo, wg
47 integer nstep, stype, atype,sdim
48 character*16 nomcoo(3)
49 character*16 unicoo(3)
51 character*64 :: giname, isname
54 parameter(user_interlace = med_full_interlace)
55 parameter(user_mode = med_compact_stmode)
57 cret=0;ret=0;lret=0;retmem=0
58 print *,
"Indiquez le fichier med a decrire : "
63 call mfiope(fid,argc,med_acc_rdonly, ret)
64 if (ret .ne. 0)
call efexit(-1)
68 call mmhmii(fid,1,maa,sdim,mdim,
type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,ret)
71 print *,
"Erreur a la lecture des informations sur le maillage : ", &
76 write (*,
'(/A,A,A,I1)')
"Maillage de nom |",trim(maa),
"| et de dimension ",mdim
81 print *,
"Impossible de lire le nombre de champs : ",ncha
85 write (*,
'(A,I1/)')
"Nombre de champs : ",ncha
91 write(*,
'(A,I5)')
"- Champ numero : ",i
94 call mfdnfc(fid,i,ncomp,ret)
97 print *,
"Erreur a la lecture du nombre de composantes : ",ncomp
102 allocate(comp(ncomp),unit(ncomp),stat=retmem)
103 if (retmem .ne. 0)
then
104 print *,
"Erreur a l'allocation mémoire de comp et unit : "
109 call mfdfdi(fid,i,nomcha,maa,lmesh,typcha,comp,unit,dtunit,ncst,ret)
111 print *,
"Erreur a la demande d'information sur les champs : ",nomcha,typcha,comp,unit,ncomp,ncst
116 write(*,
'(/5X,A,A)')
'Nom du champ : ', trim(nomcha)
117 write(*,
'(/5X,A,A)')
'Nom du maillage : ',trim(maa)
118 write(*,
'(5X,A,I5)')
'Type du champ : ', typcha
120 write(*,
'(5X,A,I1,A,A,A,A)')
'Composante ',j,
' : ',trim(comp(j)),
' ',trim(unit(j))
122 write(*,
'(5X,A,I1)')
'Nombre de pas de temps = ',ncst
125 deallocate(comp,unit)
127 lret = getfieldson(fid, nomcha, typcha, ncomp, med_node, user_interlace, ncst)
130 if (lret .eq. 0)
then
131 lret = getfieldson(fid, nomcha, typcha, ncomp, med_cell, user_interlace, ncst)
133 print *,
"Erreur a la lecture des champs aux noeuds "; cret = -1;
continue
136 if (lret .eq. 0)
then
137 lret = getfieldson(fid, nomcha, typcha, ncomp, med_descending_face,user_interlace, ncst)
139 print *,
"Erreur a la lecture des champs aux mailles "; cret = -1;
continue
142 if (lret .eq. 0)
then
143 lret = getfieldson(fid, nomcha, typcha, ncomp, med_descending_edge,user_interlace, ncst)
145 print *,
"Erreur a la lecture des champs aux faces "; cret = -1;
continue
148 if (lret .eq. 0)
then
149 lret = getfieldson(fid, nomcha, typcha, ncomp, med_node_element,user_interlace, ncst)
151 print *,
"Erreur a la lecture des champs aux aretes "; cret = -1;
continue
154 if (lret .ne. 0)
then
155 print *,
"Erreur a la lecture des champs aux noeuds des mailles "; cret = -1
162 write (*,
'(5X,A,I2)')
'Nombre de profils stockés : ', nval
164 if (nval .gt. 0 )
then
166 call mpfpfi(fid,i,pflname,nval,ret)
167 write (*,
'(5X,A,I2,A,A,A,I2)')
'Profil n ',i,
' : ',pflname,
' et de taille',nval
175 print *,
"Erreur a la lecture du nombre de liens : " &
180 write (*,
'(5X,A,I5)')
"Nombre de liens stockes : ",nln;print *,
"";print *,
""
182 call mlnlni(fid, i, nomlien, nval, ret)
184 print *,
"Erreur a la demande d'information sur le lien n° : ",i
187 write (*,
'(5X,A,I4,A,A,A,I4)')
"- Lien n°",i,
" de nom |",trim(nomlien),
"| et de taille ",nval
190 call mlnlir(fid,nomlien,lien,ret)
192 print *,
"Erreur a la lecture du lien : ", lien,nval,nomlien
195 write (*,
'(5X,A,A,A)')
"|",trim(lien),
"|";print *,
"";print *,
""
205 print *,
"Erreur a la lecture du nombre de points de Gauss : " &
209 print *,
"Nombre de localisations stockees : ",nloc;print *,
"";print *,
""
211 call mlclci(fid, i, locname, type_geo, sdim, ngauss, giname, isname, nsmc, sgtype, ret)
213 print *,
"Erreur a la demande d'information sur la localisation n° : ",i
216 write (*,
'(5X,A,I4,A,A,A,I4,A,I4)')
"- Loc n°",i,
" de nom |",trim(locname) &
217 &,
"| à",ngauss,
" points d'intégration dans un espace de dimension ",sdim
218 t1 = mod(type_geo,100)*sdim
221 allocate(refcoo(t1),stat=retmem)
222 if (retmem .ne. 0)
then
223 print *,
"Erreur a l'allocation mémoire de refcoo : "
226 allocate(gscoo(t2),stat=retmem)
227 if (retmem .ne. 0)
then
228 print *,
"Erreur a l'allocation mémoire de gscoo : "
231 allocate(wg(t3),stat=retmem)
232 if (retmem .ne. 0)
then
233 print *,
"Erreur a l'allocation mémoire de wg : "
236 call mlclor(fid, locname,user_interlace,refcoo,gscoo,wg, ret )
238 print *,
"Erreur a la lecture des valeurs de la localisation : " &
242 write (*,
'(5X,A,I4)')
"Coordonnees de l'element de reference de type ",type_geo
244 write (*,
'(5X,E20.8)') refcoo(j)
247 write (*,
'(5X,A)')
"Localisation des points de GAUSS : "
249 write (*,
'(5X,E20.8)') gscoo(j)
252 write (*,
'(5X,A)')
"Poids associes aux points de GAUSS "
254 write (*,
'(5X,E20.8)') wg(j)
272 integer function getfieldson(fid, nomcha, typcha, ncomp, entite, stockage, ncst)
276 integer ::fid,typcha,ncomp,entite,stockage, ncst
277 character(LEN=*) nomcha
279 integer :: itm,j,k,l,m,n,nb_geo,cret,ret,retmem,nvl,nref
280 integer :: nbpdtnor,pflsize,ngauss,ngroup,nent,nprofile
281 integer,
allocatable,
dimension(:) :: pflval
282 integer,
allocatable,
dimension(:) :: vale
283 integer :: numdt,numo,lnsize,nbrefmaa
284 real*8,
allocatable,
dimension(:) :: valr
287 character*64 :: pflname,locname,maa_ass,mname
288 character*16 :: dt_unit
291 integer :: nmesh,lmesh, mnumdt, mnumit
293 integer,
pointer,
dimension(:) :: type_geo
294 integer,
target :: typ_noeud(1) = (/ med_none /)
296 integer :: MY_NOF_CELL_TYPE = 17
297 integer :: MY_NOF_DESCENDING_FACE_TYPE = 5
298 integer :: MY_NOF_DESCENDING_EDGE_TYPE = 2
300 integer,
target :: typmai(17) = (/ med_point1,med_seg2, &
301 & med_seg3,med_tria3, &
302 & med_quad4,med_tria6, &
303 & med_quad8,med_tetra4, &
304 & med_pyra5,med_penta6, &
305 & med_hexa8,med_tetra10, &
306 & med_pyra13,med_penta15, &
307 & med_hexa20,med_polygon,&
310 integer,
target :: typfac(5) = (/med_tria3,med_tria6, &
311 & med_quad4,med_quad8,med_polygon/)
312 integer,
target ::typare(2) = (/med_seg2,med_seg3/)
314 character(LEN=15),
pointer,
dimension(:) :: AFF
315 character(LEN=15),
target,
dimension(17) :: FMED_GEOMETRIE_MAILLE_AFF = (/&
332 &
"MED_POLYHEDRON " /)
334 character(LEN=15),
target,
dimension(5) :: FMED_GEOMETRIE_FACE_AFF = (/&
341 character(LEN=15),
target,
dimension(2) :: FMED_GEOMETRIE_ARETE_AFF = (/&
345 character(LEN=15),
target,
dimension(1) :: FMED_GEOMETRIE_NOEUD_AFF = (/ &
349 character(LEN=20),
target,
dimension(0:4) :: FMED_ENTITE_MAILLAGE_AFF =(/ &
351 &
"MED_DESCENDING_FACE ", &
352 &
"MED_DESCENDING_EDGE ", &
354 &
"MED_NODE_ELEMENT "/)
356 parameter(user_mode = med_compact_stmode )
364 nbpdtnor=0;pflsize=0;ngauss=0;nent=0
365 numdt = 0;numo=0;retmem=0
374 type_geo => typ_noeud
376 aff => fmed_geometrie_noeud_aff
380 aff => fmed_geometrie_maille_aff
381 case (med_node_element)
384 aff => fmed_geometrie_maille_aff
385 case (med_descending_face)
388 aff => fmed_geometrie_face_aff
389 case (med_descending_edge)
391 nb_geo = my_nof_descending_edge_type
392 aff => fmed_geometrie_arete_aff
399 if(nbpdtnor < 1 )
continue
403 call mfdoci(fid,nomcha,j,numdt,numo,dt, nmesh, mname, lmesh, mnumdt, mnumit, ret)
406 print *,
"Erreur a la demande d'information sur (pdt,nor) : " &
407 & ,nomcha,entite, numdt, numo, dt
413 call mfdonp(fid,nomcha,numdt,numo,entite,type_geo(k),itm,mname,pflname,locname,nprofile,ret)
416 print *,
"Erreur a la lecture du nombre de profil : " &
417 & ,nomcha,entite, type_geo(k),numdt, numo
425 call mfdonv(fid,nomcha,numdt,numo,entite,type_geo(k),mname,l, &
426 & user_mode,pflname,pflsize,locname,ngauss,nent,ret)
430 print *,
"Erreur a la lecture du nombre de valeurs du champ : " &
431 & ,nomcha,entite,type_geo(k), &
437 write(*,
'(5X,A,I2,A,I2,A,I2,A,E10.5,A)')
'Séquence de calcul n° ',l,
' (',numdt,
',',numo,
'), dt=(',dt,
')'
438 write(*,
'(5X,A,I5,A,I2,A,A,A,A,A,A,I2,A,A)') &
439 &
'Il y a ',nent,
' valeurs en mode ',user_mode, &
440 &
'. Chaque entite ',trim(fmed_entite_maillage_aff(entite)), &
441 &
' de type geometrique ',trim(aff(k)),
' associes au profil |',&
442 & trim(pflname)//
'| a ',ngauss,
' valeur(s) par entité une localization de nom |',trim(locname)//
'|'
443 print *,
'Le maillage associe est ', mname
446 if (typcha .eq. med_float64)
then
447 allocate(valr(ncomp*nent*ngauss),stat=retmem)
449 call mfdorr(fid,nomcha,numdt,numo,entite,type_geo(k),mname,user_mode, &
450 & pflname,stockage,med_all_constituent,valr,ret)
453 print *,
"Erreur a la lecture des valeurs du champ : ", &
454 & nomcha,valr,stockage,med_all_constituent, &
455 & pflname,user_mode,entite,type_geo(k),numdt,numo
460 allocate(vale(ncomp*nent*ngauss),stat=retmem)
462 call mfdoir(fid,nomcha,numdt,numo,entite,type_geo(k),mname,user_mode, &
463 & pflname,stockage,med_all_constituent,vale,ret)
466 print *,
"Erreur a la lecture des valeurs du champ : ",&
467 & nomcha,vale,stockage,med_all_constituent, &
468 & pflname,user_mode,entite,type_geo(k),numdt,numo
474 if (ngauss .gt. 1 )
then
475 write (*,
'(5X,A,A,A)')
"- Modèle de localisation des ", &
476 &
"points de Gauss de nom ", trim(locname)
479 if ( entite .eq. med_node_element )
then
480 ngroup = mod(type_geo(k),100)
485 select case (stockage)
486 case (med_full_interlace)
487 write(*,
'(5X,A)')
"- Valeurs :";
write(*,
'(5X,A)')
""
490 do n=0,(ngroup*ncomp-1)
491 if (typcha .eq. med_float64)
then
492 write (*,
'(1X,E20.5,1X)') valr( m*ngroup*ncomp+n +1 )
494 write (*,
'(1X,I8,1X)') vale( m*ngroup*ncomp+n +1 )
498 case (med_no_interlace)
499 write(*,
'(5X,A)')
"- Valeurs :";
write(*,
'(5X,A)')
""
503 if (typcha .eq. med_float64)
then
504 write (*,
'(1X,E20.5,1X)') valr(m*nent+n +1)
506 write (*,
'(1X,I8,1X)') vale(m*nent+n +1)
513 if (typcha .eq. med_float64)
then
520 if (pflname .eq. med_no_profile)
then
523 write(*,
'(5X,A,A)')
'Profil :',pflname
524 call mpfpsn(fid,pflname,pflsize,ret)
526 print *,
"Erreur a la lecture du nombre de valeurs du profil : ", &
530 write(*,
'(5X,A,I5)')
'Taille du profil : ',pflsize
533 allocate(pflval(pflsize),stat=retmem)
534 if (retmem .ne. 0)
then
535 print *,
"Erreur a l'allocation mémoire de pflsize : "
539 call mpfprr(fid,pflname,pflval,ret)
540 if (cret .ne. 0)
write(*,
'(I1)') cret
542 print *,
"Erreur a la lecture du profil : ", &
546 write(*,
'(5X,A)')
'Valeurs du profil : '
548 write (*,
'(5X,I6)') pflval(m)
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
subroutine mfdonv(fid, fname, numdt, numit, etype, gtype, mname, pit, stm, pname, psize, lname, nip, n, cret)
Cette fonction permet de lire le nombre de valeurs à lire dans un champ pour une séquence de calcul...
subroutine mfdoci(fid, fname, it, numdt, numit, dt, nmesh, mname, lmesh, mnumdt, mnumit, cret)
Cette fonction permet de lire les informations caractérisant une séquence de calcul : numéro de pas d...
subroutine mfdonp(fid, fname, numdt, numit, etype, gtype, it, mname, dpname, dlname, n, cret)
Cette fonction permet de lire le nombre de profils référencés dans un champ pour une séquence de calc...
integer function getfieldson(fid, nomcha, typcha, ncomp, entite, stockage, ncst)
subroutine mpfprr(fid, pname, profil, cret)
Cette routine permet de lire un profil dans un fichier MED.
subroutine mlclor(fid, lname, swm, ecoo, ipcoo, wght, cret)
Cette routine permet la lecture d'une localisation localizationname de points d'intégration dans/auto...
subroutine mfdnfc(fid, ind, n, cret)
Cette fonction lit le nombre de composantes d'un champ.
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Cette routine permet de lire les informations relatives à un maillage dans un fichier.
subroutine mfdorr(fid, fname, numdt, numit, etype, gtype, mname, stm, pname, swm, cs, val, cret)
Cette fonction permet de lire les valeurs d'un champ définies sur des entités d'un maillage pour une ...
subroutine mlnnln(fid, n, cret)
Cette routine permet la lecture du nombre de lien dans un fichier MED.
subroutine mlcnlc(fid, n, cret)
Cette routine permet de lire le nombre de localisations de points d'intégration contenues dans un fic...
subroutine mlnlir(fid, mname, lname, cret)
Cette routine permet de lire un lien dans un fichier MED.
subroutine mfdnfd(fid, n, cret)
Cette fonction permet de lire le nombre de champs dans un fichier.
subroutine mfdoir(fid, fname, numdt, numit, etype, gtype, mname, stm, pname, swm, cs, val, cret)
Cette fonction permet de lire les valeurs d'un champ définies sur des entités d'un maillage pour une ...
subroutine mlclci(fid, it, lname, gtype, sdim, nip, giname, isname, nsmc, sgtype, cret)
Cette routine permet d'obtenir la description de la localisation de points d'intégration n° localizat...
subroutine mpfpfi(fid, it, pname, psize, cret)
Cette routine permet de lire les informations sur un profil dans un fichier MED.
subroutine mpfpsn(fid, pname, psize, cret)
Cette routine permet de lire la taille d'un profil dont on connait le nom.
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
subroutine mfdfdi(fid, it, fname, mname, lmesh, type, cname, cunit, dtunit, nc, cret)
Cette fonction permet de lire les informations concernant le champ d'indice ind . ...
subroutine mlnlni(fid, it, mname, lsize, cret)
Cette routine permet de lire les informations sur un lien dans un fichier MED.
subroutine mpfnpf(fid, n, cret)
Cette routine permet de lire le nombre de profil dans un fichier MED.