1 !************************************************************************* 2 ! COPYRIGHT (C) 1999 - 2007 EDF R&D, CEA/DEN 3 ! THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY 4 ! IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE 5 ! AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION; 6 ! EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION. 7 ! 8 ! THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT 9 ! WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF 10 ! MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU 11 ! LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS. 12 ! 13 ! YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE 14 ! ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION, 15 ! INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA 16 ! 17 !************************************************************************** 18 19 ! ******************************************************************************* 20 ! * - Nom du fichier : test15.f90 21 ! * 22 ! * - Description : lecture des noeuds d'un maillage MED. 23 ! * a l'aide des routines de niveau 2 24 ! * - equivalent a test5.f90 25 ! * 26 ! ****************************************************************************** 27 28 program test15 29 30 implicit none 31 include 'med.hf' 32 ! 33 ! 34 integer ret,cret, fid; 35 ! ** la dimension du maillage ** 36 integer mdim 37 ! ** nom du maillage de longueur maxi MED_TAILLE_NOM ** 38 character*32 maa 39 character*200 desc 40 ! ** le nombre de noeuds ** 41 integer :: nnoe = 0 42 ! ** table des coordonnees ** 43 real*8, allocatable, dimension(:) :: coo 44 ! ** tables des noms et des unites des coordonnees 45 ! profil : (dimension) ** 46 character*16 nomcoo(2) 47 character*16 unicoo(2) 48 ! ** tables des noms, numeros, numeros de familles des noeuds 49 ! autant d'elements que de noeuds - les noms ont pout longueur 50 ! MED_TAILLE_PNOM ** 51 character*16, allocatable, dimension(:) :: nomnoe 52 integer, allocatable, dimension(:) :: numnoe,nufano 53 integer rep 54 logical inonoe,inunoe 55 character*16 str 56 integer i 57 character*255 argc 58 integer type 59 60 print *,"Indiquez le fichier med a decrire : " 61 !! read(*,*) argc 62 argc = "test14.med" 63 64 ! ** Ouverture du fichier ** 65 call efouvr(fid,argc,MED_LECTURE, cret) 66 print *,cret 67 68 69 ! ** Lecture des infos concernant le premier maillage ** 70 if (cret.eq.0) then 71 call efmaai(fid,1,maa,mdim,type,desc,cret) 72 print *,"Maillage de nom : ",maa," et de dimension : ",mdim 73 endif 74 print *,cret 75 76 ! ** Lecture du nombre de noeud ** 77 if (cret.eq.0) then 78 call efnema(fid,maa,MED_COOR,MED_NOEUD,0,0,nnoe,cret) 79 print *,"Nombre de noeuds : ",nnoe 80 endif 81 print *,cret 82 83 ! ** Allocations memoires ** 84 ! ** table des coordonnees 85 ! ** profil : (dimension * nombre de noeuds ) ** 86 allocate (coo(nnoe*mdim),STAT=ret) 87 ! ** table des des numeros, des numeros de familles des noeuds 88 ! profil : (nombre de noeuds) ** 89 allocate (numnoe(nnoe),nufano(nnoe),STAT=ret) 90 ! ** table des noms des noeuds 91 ! profil : (nnoe*MED_TAILLE_PNOM+1) ** 92 allocate (nomnoe(nnoe),STAT=ret) 93 94 ! ** Lecture des noeuds : 95 ! - Coordonnees 96 ! - Noms (optionnel dans un fichier MED) 97 ! - Numeros (optionnel dans un fichier MED) 98 ! - Numeros de familles ** 99 if (cret.eq.0) then 100 call efnoel(fid,maa,mdim,coo,MED_FULL_INTERLACE,rep,nomcoo,unicoo, & 101 & nomnoe,inonoe,numnoe,inunoe,nufano,nnoe,cret) 102 endif 103 104 ! ** Affichage des resulats ** 105 if (cret.eq.0) then 106 print *,"Type de repere : ",rep 107 print *,"Nom des coordonnees : ",nomcoo 108 109 print *,"Unites des coordonnees : ",unicoo 110 111 print *,"Coordonnees des noeuds : ",coo 112 113 if (inonoe) then 114 print *,"Noms des noeuds : |",nomnoe,"|" 115 endif 116 117 if (inunoe) then 118 print *,"Numeros des noeuds : ",numnoe 119 endif 120 121 print *,"Numeros des familles des noeuds : ",nufano 122 endif 123 124 ! ** Liberation memoire ** 125 deallocate(coo,nomnoe,numnoe,nufano) 126 127 ! ** Fermeture du fichier ** 128 call efferm (fid,cret) 129 print *,cret 130 131 ! **Code retour 132 call efexit(cret) 133 134 end program test15 135