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