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
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)
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)')
"" 504 write (*,
'(1X,E20.5,1X)') valr(m*nent+n +1)
506 write (*,
'(1X,I8,1X)') vale(m*nent+n +1)
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)
subroutine mfdfdi(fid, it, fname, mname, lmesh, type, cname, cunit, dtunit, nc, cret)
subroutine mpfnpf(fid, n, cret)
subroutine mlnnln(fid, n, cret)
subroutine mlclor(fid, lname, swm, ecoo, ipcoo, wght, cret)
subroutine mfdonp(fid, fname, numdt, numit, etype, gtype, it, mname, dpname, dlname, n, cret)
subroutine mpfprr(fid, pname, profil, cret)
subroutine mfdorr(fid, fname, numdt, numit, etype, gtype, mname, stm, pname, swm, cs, val, cret)
subroutine mpfpfi(fid, it, pname, psize, cret)
subroutine mfdoci(fid, fname, it, numdt, numit, dt, nmesh, mname, lmesh, mnumdt, mnumit, cret)
integer function getfieldson(fid, nomcha, typcha, ncomp, entite, stockage, ncst)
subroutine mfdnfc(fid, ind, n, cret)
subroutine mlclci(fid, it, lname, gtype, sdim, nip, giname, isname, nsmc, sgtype, cret)
subroutine mlnlni(fid, it, mname, lsize, cret)
subroutine mlcnlc(fid, n, cret)
subroutine mfdnfd(fid, n, cret)
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mlnlir(fid, mname, lname, cret)
subroutine mpfpsn(fid, pname, psize, cret)
subroutine mfdonv(fid, fname, numdt, numit, etype, gtype, mname, pit, stm, pname, psize, lname, nip, n, cret)
subroutine mfdoir(fid, fname, numdt, numit, etype, gtype, mname, stm, pname, swm, cs, val, cret)