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_pflmode)
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
120 write(*,
'(5X,A,I1)')
'Nombre de composantes = ',ncomp
122 write(*,
'(5X,A,I1,A,A,A,A)')
'Composante ',j,
' : ',trim(comp(j)),
' ',trim(unit(j))
124 write(*,
'(5X,A,I1)')
'Nombre de pas de temps = ',ncst
127 deallocate(comp,unit)
129 lret =
getfieldson(fid, nomcha, typcha, ncomp, med_node, user_interlace, ncst)
132 if (lret .eq. 0)
then
133 lret =
getfieldson(fid, nomcha, typcha, ncomp, med_cell, user_interlace, ncst)
135 print *,
"Erreur a la lecture des champs aux noeuds "; cret = -1;
continue
138 if (lret .eq. 0)
then
139 lret =
getfieldson(fid, nomcha, typcha, ncomp, med_descending_face,user_interlace, ncst)
141 print *,
"Erreur a la lecture des champs aux mailles "; cret = -1;
continue
144 if (lret .eq. 0)
then
145 lret =
getfieldson(fid, nomcha, typcha, ncomp, med_descending_edge,user_interlace, ncst)
147 print *,
"Erreur a la lecture des champs aux faces "; cret = -1;
continue
150 if (lret .eq. 0)
then
151 lret =
getfieldson(fid, nomcha, typcha, ncomp, med_node_element,user_interlace, ncst)
153 print *,
"Erreur a la lecture des champs aux aretes "; cret = -1;
continue
156 if (lret .ne. 0)
then
157 print *,
"Erreur a la lecture des champs aux noeuds des mailles "; cret = -1
164 write (*,
'(5X,A,I2)')
'Nombre de profils stockés : ', nval
166 if (nval .gt. 0 )
then
168 call mpfpfi(fid,i,pflname,nval,ret)
169 write (*,
'(5X,A,I2,A,A,A,I2)')
'Profil n ',i,
' : ',pflname,
' et de taille',nval
177 print *,
"Erreur a la lecture du nombre de liens : " &
182 write (*,
'(5X,A,I5)')
"Nombre de liens stockes : ",nln;print *,
"";print *,
""
184 call mlnlni(fid, i, nomlien, nval, ret)
186 print *,
"Erreur a la demande d'information sur le lien n° : ",i
189 write (*,
'(5X,A,I4,A,A,A,I4)')
"- Lien n°",i,
" de nom |",trim(nomlien),
"| et de taille ",nval
192 call mlnlir(fid,nomlien,lien,ret)
194 print *,
"Erreur a la lecture du lien : ", lien,nval,nomlien
197 write (*,
'(5X,A,A,A)')
"|",trim(lien),
"|";print *,
"";print *,
""
207 print *,
"Erreur a la lecture du nombre de points de Gauss : " &
211 print *,
"Nombre de localisations stockees : ",nloc;print *,
"";print *,
""
213 call mlclci(fid, i, locname, type_geo, sdim, ngauss, giname, isname, nsmc, sgtype, ret)
215 print *,
"Erreur a la demande d'information sur la localisation n° : ",i
218 write (*,
'(5X,A,I4,A,A,A,I4,A,I4)')
"- Loc n°",i,
" de nom |",trim(locname) &
219 &,
"| et nbr. de pts Gauss ",ngauss,
"| et dans un espace de dimension ",sdim
220 t1 = mod(type_geo,100)*sdim
223 allocate(refcoo(t1),stat=retmem)
224 if (retmem .ne. 0)
then
225 print *,
"Erreur a l'allocation mémoire de refcoo : "
228 allocate(gscoo(t2),stat=retmem)
229 if (retmem .ne. 0)
then
230 print *,
"Erreur a l'allocation mémoire de gscoo : "
233 allocate(wg(t3),stat=retmem)
234 if (retmem .ne. 0)
then
235 print *,
"Erreur a l'allocation mémoire de wg : "
238 call mlclor(fid, locname,user_interlace,refcoo,gscoo,wg, ret )
240 print *,
"Erreur a la lecture des valeurs de la localisation : " &
244 write (*,
'(5X,A,I4)')
"Coordonnees de l'element de reference de type ",type_geo
246 write (*,
'(5X,E20.8)') refcoo(j)
249 write (*,
'(5X,A)')
"Localisation des points de GAUSS : "
251 write (*,
'(5X,E20.8)') gscoo(j)
254 write (*,
'(5X,A)')
"Poids associes aux points de GAUSS "
256 write (*,
'(5X,E20.8)') wg(j)
274 integer function getfieldson(fid, nomcha, typcha, ncomp, entite, stockage, ncst)
279 integer ::typcha,ncomp,entite,stockage, ncst
280 character(LEN=*) nomcha
282 integer :: j,k,l,m,n,nb_geo,cret,ret,retmem,nvl,nref
283 integer :: nbpdtnor,pflsize,ngauss,ngroup,nent,nprofile
284 integer,
allocatable,
dimension(:) :: pflval
285 integer,
allocatable,
dimension(:) :: vale
286 integer :: numdt,numo,lnsize,nbrefmaa
287 real*8,
allocatable,
dimension(:) :: valr
290 character*64 :: pflname,locname,maa_ass
291 character*16 :: dt_unit
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 mfdcsi(fid,nomcha,j,numdt,numo,dt,ret)
408 print *,
"Erreur a la demande d'information sur (pdt,nor) : " &
409 & ,nomcha,entite, numdt, numo, dt
413 call mfdnpf(fid,nomcha,numdt,numo,entite,type_geo(k),pflname,locname,nprofile,ret)
416 print *,
"Erreur a la lecture du nombre de profil : " &
417 & ,nomcha,entite, type_geo(k),numdt, numo
425 call mfdnvp(fid,nomcha,numdt,numo,entite,type_geo(k),l,user_mode,pflname,pflsize,locname,ngauss,nent,ret)
428 print *,
"Erreur a la lecture du nombre de valeurs du champ : " &
429 & ,nomcha,entite,type_geo(k), &
435 write(*,
'(5X,A,I2,A,I2,A,I2,A,E10.5,A)')
'Étape de calcul n° ',l,
' (',numdt,
',',numo,
'), dt=(',dt,
')'
436 write(*,
'(5X,A,I5,A,I2,A,A,A,A,A,A,I2,A,A)') &
437 &
'Il y a ',nent,
' valeurs en mode ',user_mode, &
438 &
'. Chaque entite ',trim(fmed_entite_maillage_aff(entite)), &
439 &
' de type geometrique ',trim(aff(k)),
' associes au profil |',&
440 & trim(pflname)//
'| a ',ngauss,
' valeur(s) par entité, et une localization de nom |',trim(locname)//
'|'
444 allocate(valr(ncomp*nent*ngauss),stat=retmem)
446 call mfdrpr(fid,nomcha,numdt,numo,entite,type_geo(k),user_mode, &
447 & pflname,stockage,med_all_constituent,valr,ret)
450 print *,
"Erreur a la lecture des valeurs du champ : ", &
451 & nomcha,valr,stockage,med_all_constituent, &
452 & pflname,user_mode,entite,type_geo(k),numdt,numo
457 allocate(vale(ncomp*nent*ngauss),stat=retmem)
459 call mfdipr(fid,nomcha,numdt,numo,entite,type_geo(k),user_mode, &
460 & pflname,stockage,med_all_constituent,vale,ret)
463 print *,
"Erreur a la lecture des valeurs du champ : ",&
464 & nomcha,vale,stockage,med_all_constituent, &
465 & pflname,user_mode,entite,type_geo(k),numdt,numo
471 if (ngauss .gt. 1 )
then
472 write (*,
'(5X,A,A,A)')
"- Modèle de localisation des ", &
473 &
"points de Gauss de nom ", trim(locname)
476 if ( entite .eq. med_node_element )
then
477 ngroup = mod(type_geo(k),100)
482 select case (stockage)
483 case (med_full_interlace)
484 write(*,
'(5X,A)')
"- Valeurs :";
write(*,
'(5X,A)')
""
487 do n=0,(ngroup*ncomp-1)
489 write (*,
'(1X,E20.5,1X)') valr( m*ngroup*ncomp+n +1 )
491 write (*,
'(1X,I8,1X)') vale( m*ngroup*ncomp+n +1 )
495 case (med_no_interlace)
496 write(*,
'(5X,A)')
"- Valeurs :";
write(*,
'(5X,A)')
""
501 write (*,
'(1X,E20.5,1X)') valr(m*nent+n +1)
503 write (*,
'(1X,I8,1X)') vale(m*nent+n +1)
517 if (pflname .eq. med_no_profile)
then
520 write(*,
'(5X,A,A)')
'Profil :',pflname
521 call mpfpsn(fid,pflname,pflsize,ret)
523 print *,
"Erreur a la lecture du nombre de valeurs du profil : ", &
527 write(*,
'(5X,A,I5)')
'Taille du profil : ',pflsize
530 allocate(pflval(pflsize),stat=retmem)
531 if (retmem .ne. 0)
then
532 print *,
"Erreur a l'allocation mémoire de pflsize : "
536 call mpfprr(fid,pflname,pflval,ret)
537 if (cret .ne. 0)
write(*,
'(I1)') cret
539 print *,
"Erreur a la lecture du profil : ", &
543 write(*,
'(5X,A)')
'Valeurs du profil : '
545 write (*,
'(5X,I6)') pflval(m)