33 integer cret,ret,lret,retmem
34 integer user_interlace,user_mode
35 character*64 :: maa,nomcha,pflname,nomlien,locname
38 character*16,
allocatable,
dimension(:) :: comp,unit
40 integer mdim,ncomp,ncha,npro,nln,pflsize,nval
41 integer,
allocatable,
dimension(:) :: pflval
43 integer t1,t2,t3,typcha,
type,type_geo
44 real*8,
allocatable,
dimension(:) :: refcoo, gscoo, wg
48 integer nstep, stype, atype,sdim
49 character*16 nomcoo(3)
50 character*16 unicoo(3)
52 character*64 :: giname, isname
55 parameter(user_interlace = med_full_interlace)
56 parameter(user_mode = med_compact_stmode)
58 cret=0;ret=0;lret=0;retmem=0
59 print *,
"Indiquez le fichier med a decrire : "
64 call mfiope(fid,argc,med_acc_rdonly, ret)
65 if (ret .ne. 0)
call efexit(-1)
69 call mmhmii(fid,1,maa,sdim,mdim,
type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,ret)
72 print *,
"Erreur a la lecture des informations sur le maillage : ", &
77 write (*,
'(/A,A,A,I1)')
"Maillage de nom |",trim(maa),
"| et de dimension ",mdim
82 print *,
"Impossible de lire le nombre de champs : ",ncha
86 write (*,
'(A,I1/)')
"Nombre de champs : ",ncha
92 write(*,
'(A,I5)')
"- Champ numero : ",i
95 call mfdnfc(fid,i,ncomp,ret)
98 print *,
"Erreur a la lecture du nombre de composantes : ",ncomp
103 allocate(comp(ncomp),unit(ncomp),stat=retmem)
104 if (retmem .ne. 0)
then
105 print *,
"Erreur a l'allocation mémoire de comp et unit : "
110 call mfdfdi(fid,i,nomcha,maa,lmesh,typcha,comp,unit,dtunit,ncst,ret)
112 print *,
"Erreur a la demande d'information sur les champs : ",nomcha,typcha,comp,unit,ncomp,ncst
117 write(*,
'(/5X,A,A)')
'Nom du champ : ', trim(nomcha)
118 write(*,
'(/5X,A,A)')
'Nom du maillage : ',trim(maa)
119 write(*,
'(5X,A,I5)')
'Type du champ : ', typcha
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 &,
"| à",ngauss,
" points d'intégration 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)
273integer function getfieldson(fid, nomcha, typcha, ncomp, entite, stockage, ncst)
278 integer ::typcha,ncomp,entite,stockage, ncst
279 character(LEN=*) nomcha
281 integer :: itm,j,k,l,m,n,nb_geo,cret,ret,retmem,nvl,nref
282 integer :: nbpdtnor,pflsize,ngauss,ngroup,nent,nprofile
283 integer,
allocatable,
dimension(:) :: pflval
284 integer,
allocatable,
dimension(:) :: vale
285 integer :: numdt,numo,lnsize,nbrefmaa
286 real*8,
allocatable,
dimension(:) :: valr
289 character*64 :: pflname,locname,maa_ass,mname
290 character*16 :: dt_unit
293 integer :: nmesh,lmesh, mnumdt, mnumit
295 integer,
pointer,
dimension(:) :: type_geo
296 integer,
target :: typ_noeud(1) = (/ med_none /)
298 integer :: my_nof_cell_type = 17
299 integer :: my_nof_descending_face_type = 5
300 integer :: my_nof_descending_edge_type = 2
302 integer,
target :: typmai(17) = (/ med_point1,med_seg2, &
303 & med_seg3,med_tria3, &
304 & med_quad4,med_tria6, &
305 & med_quad8,med_tetra4, &
306 & med_pyra5,med_penta6, &
307 & med_hexa8,med_tetra10, &
308 & med_pyra13,med_penta15, &
309 & med_hexa20,med_polygon,&
312 integer,
target :: typfac(5) = (/med_tria3,med_tria6, &
313 & med_quad4,med_quad8,med_polygon/)
314 integer,
target ::typare(2) = (/med_seg2,med_seg3/)
316 character(LEN=15),
pointer,
dimension(:) :: aff
317 character(LEN=15),
target,
dimension(17) :: fmed_geometrie_maille_aff = (/&
334 &
"MED_POLYHEDRON " /)
336 character(LEN=15),
target,
dimension(5) :: fmed_geometrie_face_aff = (/&
343 character(LEN=15),
target,
dimension(2) :: fmed_geometrie_arete_aff = (/&
347 character(LEN=15),
target,
dimension(1) :: fmed_geometrie_noeud_aff = (/ &
351 character(LEN=20),
target,
dimension(0:4) :: fmed_entite_maillage_aff =(/ &
353 &
"MED_DESCENDING_FACE ", &
354 &
"MED_DESCENDING_EDGE ", &
356 &
"MED_NODE_ELEMENT "/)
358 parameter(user_mode = med_compact_stmode )
366 nbpdtnor=0;pflsize=0;ngauss=0;nent=0
367 numdt = 0;numo=0;retmem=0
376 type_geo => typ_noeud
378 aff => fmed_geometrie_noeud_aff
382 aff => fmed_geometrie_maille_aff
383 case (med_node_element)
386 aff => fmed_geometrie_maille_aff
387 case (med_descending_face)
390 aff => fmed_geometrie_face_aff
391 case (med_descending_edge)
393 nb_geo = my_nof_descending_edge_type
394 aff => fmed_geometrie_arete_aff
401 if(nbpdtnor < 1 )
continue
405 call mfdoci(fid,nomcha,j,numdt,numo,dt, nmesh, mname, lmesh, mnumdt, mnumit, ret)
408 print *,
"Erreur a la demande d'information sur (pdt,nor) : " &
409 & ,nomcha,entite, numdt, numo, dt
415 call mfdonp(fid,nomcha,numdt,numo,entite,type_geo(k),itm,mname,pflname,locname,nprofile,ret)
418 print *,
"Erreur a la lecture du nombre de profil : " &
419 & ,nomcha,entite, type_geo(k),numdt, numo
427 call mfdonv(fid,nomcha,numdt,numo,entite,type_geo(k),mname,l, &
428 & user_mode,pflname,pflsize,locname,ngauss,nent,ret)
432 print *,
"Erreur a la lecture du nombre de valeurs du champ : " &
433 & ,nomcha,entite,type_geo(k), &
439 write(*,
'(5X,A,I2,A,I2,A,I2,A,E10.5,A)')
'Étape de calcul n° ',l,
' (',numdt,
',',numo,
'), dt=(',dt,
')'
440 write(*,
'(5X,A,I5,A,I2,A,A,A,A,A,A,I2,A,A)') &
441 &
'Il y a ',nent,
' valeurs en mode ',user_mode, &
442 &
'. Chaque entite ',trim(fmed_entite_maillage_aff(entite)), &
443 &
' de type geometrique ',trim(aff(k)),
' associes au profil |',&
444 & trim(pflname)//
'| a ',ngauss,
' valeur(s) par entité une localization de nom |',trim(locname)//
'|'
445 print *,
'Le maillage associe est ', mname
449 allocate(valr(ncomp*nent*ngauss),stat=retmem)
451 call mfdorr(fid,nomcha,numdt,numo,entite,type_geo(k),mname,user_mode, &
452 & pflname,stockage,med_all_constituent,valr,ret)
455 print *,
"Erreur a la lecture des valeurs du champ : ", &
456 & nomcha,valr,stockage,med_all_constituent, &
457 & pflname,user_mode,entite,type_geo(k),numdt,numo
462 allocate(vale(ncomp*nent*ngauss),stat=retmem)
464 call mfdoir(fid,nomcha,numdt,numo,entite,type_geo(k),mname,user_mode, &
465 & pflname,stockage,med_all_constituent,vale,ret)
468 print *,
"Erreur a la lecture des valeurs du champ : ",&
469 & nomcha,vale,stockage,med_all_constituent, &
470 & pflname,user_mode,entite,type_geo(k),numdt,numo
476 if (ngauss .gt. 1 )
then
477 write (*,
'(5X,A,A,A)')
"- Modèle de localisation des ", &
478 &
"points de Gauss de nom ", trim(locname)
481 if ( entite .eq. med_node_element )
then
482 ngroup = mod(type_geo(k),100)
487 select case (stockage)
488 case (med_full_interlace)
489 write(*,
'(5X,A)')
"- Valeurs :";
write(*,
'(5X,A)')
""
492 do n=0,(ngroup*ncomp-1)
494 write (*,
'(1X,E20.5,1X)') valr( m*ngroup*ncomp+n +1 )
496 write (*,
'(1X,I8,1X)') vale( m*ngroup*ncomp+n +1 )
500 case (med_no_interlace)
501 write(*,
'(5X,A)')
"- Valeurs :";
write(*,
'(5X,A)')
""
506 write (*,
'(1X,E20.5,1X)') valr(m*nent+n +1)
508 write (*,
'(1X,I8,1X)') vale(m*nent+n +1)
522 if (pflname .eq. med_no_profile)
then
525 write(*,
'(5X,A,A)')
'Profil :',pflname
526 call mpfpsn(fid,pflname,pflsize,ret)
528 print *,
"Erreur a la lecture du nombre de valeurs du profil : ", &
532 write(*,
'(5X,A,I5)')
'Taille du profil : ',pflsize
535 allocate(pflval(pflsize),stat=retmem)
536 if (retmem .ne. 0)
then
537 print *,
"Erreur a l'allocation mémoire de pflsize : "
541 call mpfprr(fid,pflname,pflval,ret)
542 if (cret .ne. 0)
write(*,
'(I1)') cret
544 print *,
"Erreur a la lecture du profil : ", &
548 write(*,
'(5X,A)')
'Valeurs du profil : '
550 write (*,
'(5X,I6)') pflval(m)
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 mfdoci(fid, fname, it, numdt, numit, dt, nmesh, mname, lmesh, mnumdt, mnumit, cret)
Cette fonction permet de lire les informations caractérisant une étape de calcul : numéro de pas de t...
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 étape de calcul,...
subroutine mfdnfd(fid, n, cret)
Cette fonction permet de lire le nombre de champs dans un fichier.
subroutine mfdnfc(fid, ind, n, cret)
Cette fonction lit le nombre de composantes d'un champ.
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 étape de calcul,...
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
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 mlnlni(fid, it, mname, lsize, cret)
Cette routine permet de lire les informations sur un 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 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 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 mpfnpf(fid, n, cret)
Cette routine permet de lire le nombre de profils 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 mpfpfi(fid, it, pname, psize, cret)
Cette routine permet de lire les informations sur un profil dans un fichier MED.
subroutine mfdorr(fid, fname, numdt, numit, etype, gtype, mname, stm, pname, swm, cs, val, cret)
subroutine mfdoir(fid, fname, numdt, numit, etype, gtype, mname, stm, pname, swm, cs, val, cret)
subroutine mlclor(fid, lname, swm, ecoo, ipcoo, wght, cret)
subroutine mpfprr(fid, pname, profil, cret)
integer function getfieldson(fid, nomcha, typcha, ncomp, entite, stockage, ncst)