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_pflmode)
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
119 write(*,
'(5X,A,I1)')
'Nombre de composantes = ',ncomp
121 write(*,
'(5X,A,I1,A,A,A,A)')
'Composante ',j,
' : ',trim(comp(j)),
' ',trim(unit(j))
123 write(*,
'(5X,A,I1)')
'Nombre de pas de temps = ',ncst
126 deallocate(comp,unit)
128 lret = getfieldson(fid, nomcha, typcha, ncomp, med_node, user_interlace, ncst)
131 if (lret .eq. 0)
then
132 lret = getfieldson(fid, nomcha, typcha, ncomp, med_cell, user_interlace, ncst)
134 print *,
"Erreur a la lecture des champs aux noeuds "; cret = -1;
continue
137 if (lret .eq. 0)
then
138 lret = getfieldson(fid, nomcha, typcha, ncomp, med_descending_face,user_interlace, ncst)
140 print *,
"Erreur a la lecture des champs aux mailles "; cret = -1;
continue
143 if (lret .eq. 0)
then
144 lret = getfieldson(fid, nomcha, typcha, ncomp, med_descending_edge,user_interlace, ncst)
146 print *,
"Erreur a la lecture des champs aux faces "; cret = -1;
continue
149 if (lret .eq. 0)
then
150 lret = getfieldson(fid, nomcha, typcha, ncomp, med_node_element,user_interlace, ncst)
152 print *,
"Erreur a la lecture des champs aux aretes "; cret = -1;
continue
155 if (lret .ne. 0)
then
156 print *,
"Erreur a la lecture des champs aux noeuds des mailles "; cret = -1
163 write (*,
'(5X,A,I2)')
'Nombre de profils stockés : ', nval
165 if (nval .gt. 0 )
then
167 call mpfpfi(fid,i,pflname,nval,ret)
168 write (*,
'(5X,A,I2,A,A,A,I2)')
'Profil n ',i,
' : ',pflname,
' et de taille',nval
176 print *,
"Erreur a la lecture du nombre de liens : " &
181 write (*,
'(5X,A,I5)')
"Nombre de liens stockes : ",nln;print *,
"";print *,
""
183 call mlnlni(fid, i, nomlien, nval, ret)
185 print *,
"Erreur a la demande d'information sur le lien n° : ",i
188 write (*,
'(5X,A,I4,A,A,A,I4)')
"- Lien n°",i,
" de nom |",trim(nomlien),
"| et de taille ",nval
191 call mlnlir(fid,nomlien,lien,ret)
193 print *,
"Erreur a la lecture du lien : ", lien,nval,nomlien
196 write (*,
'(5X,A,A,A)')
"|",trim(lien),
"|";print *,
"";print *,
""
206 print *,
"Erreur a la lecture du nombre de points de Gauss : " &
210 print *,
"Nombre de localisations stockees : ",nloc;print *,
"";print *,
""
212 call mlclci(fid, i, locname, type_geo, sdim, ngauss, giname, isname, nsmc, sgtype, ret)
214 print *,
"Erreur a la demande d'information sur la localisation n° : ",i
217 write (*,
'(5X,A,I4,A,A,A,I4,A,I4)')
"- Loc n°",i,
" de nom |",trim(locname) &
218 &,
"| et nbr. de pts Gauss ",ngauss,
"| et dans un espace de dimension ",sdim
219 t1 = mod(type_geo,100)*sdim
222 allocate(refcoo(t1),stat=retmem)
223 if (retmem .ne. 0)
then
224 print *,
"Erreur a l'allocation mémoire de refcoo : "
227 allocate(gscoo(t2),stat=retmem)
228 if (retmem .ne. 0)
then
229 print *,
"Erreur a l'allocation mémoire de gscoo : "
232 allocate(wg(t3),stat=retmem)
233 if (retmem .ne. 0)
then
234 print *,
"Erreur a l'allocation mémoire de wg : "
237 call mlclor(fid, locname,user_interlace,refcoo,gscoo,wg, ret )
239 print *,
"Erreur a la lecture des valeurs de la localisation : " &
243 write (*,
'(5X,A,I4)')
"Coordonnees de l'element de reference de type ",type_geo
245 write (*,
'(5X,E20.8)') refcoo(j)
248 write (*,
'(5X,A)')
"Localisation des points de GAUSS : "
250 write (*,
'(5X,E20.8)') gscoo(j)
253 write (*,
'(5X,A)')
"Poids associes aux points de GAUSS "
255 write (*,
'(5X,E20.8)') wg(j)
273 integer function getfieldson(fid, nomcha, typcha, ncomp, entite, stockage, ncst)
277 integer ::fid,typcha,ncomp,entite,stockage, ncst
278 character(LEN=*) nomcha
280 integer :: j,k,l,m,n,nb_geo,cret,ret,retmem,nvl,nref
281 integer :: nbpdtnor,pflsize,ngauss,ngroup,nent,nprofile
282 integer,
allocatable,
dimension(:) :: pflval
283 integer,
allocatable,
dimension(:) :: vale
284 integer :: numdt,numo,lnsize,nbrefmaa
285 real*8,
allocatable,
dimension(:) :: valr
288 character*64 :: pflname,locname,maa_ass
289 character*16 :: dt_unit
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 mfdcsi(fid,nomcha,j,numdt,numo,dt,ret)
406 print *,
"Erreur a la demande d'information sur (pdt,nor) : " &
407 & ,nomcha,entite, numdt, numo, dt
411 call mfdnpf(fid,nomcha,numdt,numo,entite,type_geo(k),pflname,locname,nprofile,ret)
414 print *,
"Erreur a la lecture du nombre de profil : " &
415 & ,nomcha,entite, type_geo(k),numdt, numo
423 call mfdnvp(fid,nomcha,numdt,numo,entite,type_geo(k),l,user_mode,pflname,pflsize,locname,ngauss,nent,ret)
426 print *,
"Erreur a la lecture du nombre de valeurs du champ : " &
427 & ,nomcha,entite,type_geo(k), &
433 write(*,
'(5X,A,I2,A,I2,A,I2,A,E10.5,A)')
'Séquence de calcul n° ',l,
' (',numdt,
',',numo,
'), dt=(',dt,
')'
434 write(*,
'(5X,A,I5,A,I2,A,A,A,A,A,A,I2,A,A)') &
435 &
'Il y a ',nent,
' valeurs en mode ',user_mode, &
436 &
'. Chaque entite ',trim(fmed_entite_maillage_aff(entite)), &
437 &
' de type geometrique ',trim(aff(k)),
' associes au profil |',&
438 & trim(pflname)//
'| a ',ngauss,
' valeur(s) par entité, et une localization de nom |',trim(locname)//
'|'
442 allocate(valr(ncomp*nent*ngauss),stat=retmem)
444 call mfdrpr(fid,nomcha,numdt,numo,entite,type_geo(k),user_mode, &
445 & pflname,stockage,med_all_constituent,valr,ret)
448 print *,
"Erreur a la lecture des valeurs du champ : ", &
449 & nomcha,valr,stockage,med_all_constituent, &
450 & pflname,user_mode,entite,type_geo(k),numdt,numo
455 allocate(vale(ncomp*nent*ngauss),stat=retmem)
457 call mfdipr(fid,nomcha,numdt,numo,entite,type_geo(k),user_mode, &
458 & pflname,stockage,med_all_constituent,vale,ret)
461 print *,
"Erreur a la lecture des valeurs du champ : ",&
462 & nomcha,vale,stockage,med_all_constituent, &
463 & pflname,user_mode,entite,type_geo(k),numdt,numo
469 if (ngauss .gt. 1 )
then
470 write (*,
'(5X,A,A,A)')
"- Modèle de localisation des ", &
471 &
"points de Gauss de nom ", trim(locname)
474 if ( entite .eq. med_node_element )
then
475 ngroup = mod(type_geo(k),100)
480 select case (stockage)
481 case (med_full_interlace)
482 write(*,
'(5X,A)')
"- Valeurs :";
write(*,
'(5X,A)')
""
485 do n=0,(ngroup*ncomp-1)
487 write (*,
'(1X,E20.5,1X)') valr( m*ngroup*ncomp+n +1 )
489 write (*,
'(1X,I8,1X)') vale( m*ngroup*ncomp+n +1 )
493 case (med_no_interlace)
494 write(*,
'(5X,A)')
"- Valeurs :";
write(*,
'(5X,A)')
""
499 write (*,
'(1X,E20.5,1X)') valr(m*nent+n +1)
501 write (*,
'(1X,I8,1X)') vale(m*nent+n +1)
515 if (pflname .eq. med_no_profile)
then
518 write(*,
'(5X,A,A)')
'Profil :',pflname
519 call mpfpsn(fid,pflname,pflsize,ret)
521 print *,
"Erreur a la lecture du nombre de valeurs du profil : ", &
525 write(*,
'(5X,A,I5)')
'Taille du profil : ',pflsize
528 allocate(pflval(pflsize),stat=retmem)
529 if (retmem .ne. 0)
then
530 print *,
"Erreur a l'allocation mémoire de pflsize : "
534 call mpfprr(fid,pflname,pflval,ret)
535 if (cret .ne. 0)
write(*,
'(I1)') cret
537 print *,
"Erreur a la lecture du profil : ", &
541 write(*,
'(5X,A)')
'Valeurs du profil : '
543 write (*,
'(5X,I6)') pflval(m)
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 mlcnlc(fid, n, cret)
Cette routine permet de lire le nombre de localisations de points d'intégration contenues dans un fic...
subroutine mfdnvp(fid, fname, numdt, numit, etype, gtype, 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...
integer function getfieldson(fid, nomcha, typcha, ncomp, entite, stockage, ncst)
subroutine mfdnfd(fid, n, cret)
Cette fonction permet de lire le nombre de champs dans un fichier.
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
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 mlnlni(fid, it, mname, lsize, cret)
Cette routine permet de lire les informations sur un lien dans un fichier MED.
subroutine mfdrpr(fid, fname, numdt, numit, etype, gtype, 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 mfdcsi(fid, fname, it, numdt, numit, dt, cret)
Cette fonction permet de lire les informations caractérisant une séquence de calcul : numéro de pas d...
subroutine mlnlir(fid, mname, lname, cret)
Cette routine permet de lire un lien dans un fichier MED.
subroutine mlnnln(fid, n, cret)
Cette routine permet la lecture du nombre de lien dans un fichier MED.
subroutine mpfpfi(fid, it, pname, psize, cret)
Cette routine permet de lire les informations sur un profil dans un fichier MED.
subroutine mfdnfc(fid, ind, n, cret)
Cette fonction lit le nombre de composantes d'un champ.
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 mfdnpf(fid, fname, numdt, numit, etype, gtype, 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...
subroutine mpfpsn(fid, pname, psize, cret)
Cette routine permet de lire la taille d'un profil dont on connait le nom.
subroutine mpfprr(fid, pname, profil, cret)
Cette routine permet de lire un profil dans un fichier MED.
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 mpfnpf(fid, n, cret)
Cette routine permet de lire le nombre de profil dans un fichier MED.
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
subroutine mfdipr(fid, fname, numdt, numit, etype, gtype, 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 ...