1  !*************************************************************************
  2  ! COPYRIGHT (C) 1999 - 2003  EDF R&D
  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 : test5.f90
 21  !     *
 22  !     * - Description : lecture des noeuds d'un maillage MED.
 23  !     *
 24  !     ******************************************************************************
 25        program test5
 26  !     
 27        implicit none
 28        include 'med.hf'
 29  !     
 30  !     
 31        integer cret, ret
 32        integer fid
 33
 34  !     ** la dimension du maillage                         **
 35        integer mdim
 36  !     ** nom du maillage de longueur maxi MED_TAILLE_NOM  **
 37        character*32 maa
 38        character*200 desc
 39  !     ** le nombre de noeuds                              **
 40        integer nnoe
 41  !     ** table des coordonnees                            **
 42        real*8, allocatable, dimension (:) ::  coo
 43        real*8, allocatable, dimension (:) ::  coo2
 44  !     ** tables des noms et des unites des coordonnees    **
 45        character*16 nomcoo(2)
 46        character*16 unicoo(2)
 47  !     ** tables des noms, numeros, numeros de familles des noeuds  **
 48  !     autant d'elements que de noeuds - les noms ont pout longueur **
 49  !     MED_TAILLE_PNOM=8                                            
 50        character*16, allocatable, dimension (:) :: nomnoe
 51        integer,     allocatable, dimension (:) :: numnoe
 52        integer,     allocatable, dimension (:) :: nufano
 53        integer,     parameter                  :: profil(2) =  (/ 2, 3 /)
 54
 55        integer i,rep
 56        logical inonoe,inunoe
 57        integer type
 58
 59  !     Ouverture du fichier en lecture seule             **
 60        call efouvr(fid,'test4.med',MED_LECTURE, cret)
 61        print *,cret
 62
 63  !   ** Lecture des infos concernant le premier maillage **
 64        if (cret.eq.0) then
 65           call efmaai(fid,1,maa,mdim,type,desc,cret)
 66        endif
 67        print *,cret
 68
 69
 70  !   ** Combien de noeuds a lire  **
 71        if (cret.eq.0) then
 72           nnoe = 0
 73           call efnema(fid,maa,MED_COOR,MED_NOEUD,0,0,        &
 74       &        nnoe,cret)
 75        endif
 76        print *,cret,' Nombre de noeuds : ',nnoe
 77
 78
 79  !   ** Allocations memoires :  **
 80  !   ** table des coordonnees   **
 81  !     profil : (dimension * nombre de noeuds ) **
 82  !   ** table des des numeros, des numeros de familles des noeuds
 83  !   ** table des noms des noeuds ** 
 84
 85        allocate( coo(nnoe*mdim),coo2(nnoe*mdim), numnoe(nnoe),nufano(nnoe),  &
 86       &     nomnoe(nnoe),STAT=ret )
 87        print *,ret
 88
 89
 90  !   ** Lecture des composantes n°2 des coordonnees des noeuds      **
 91        if (cret.eq.0) then
 92           call efcool(fid,maa,mdim,coo,MED_FULL_INTERLACE,   &
 93       &        2,profil,0,rep,nomcoo,unicoo,cret)
 94        endif
 95        print *,cret
 96        print *,'Lecture des composantes 2 des coordonnees : '
 97        print *,coo
 98
 99  !   ** Lecture des composantes n°1 des coordonnees des noeuds      **
100        if (cret.eq.0) then
101           call efcool(fid,maa,mdim,coo,MED_FULL_INTERLACE,   &
102       &        1,profil,0,rep,nomcoo,unicoo,cret)
103        endif
104        print *,cret
105        print *,'Lecture des composantes 1 des coordonnees : '
106        print *,coo
107
108  !   ** Lecture des composantes n°1 des coordonnees des noeuds du profil  **
109        if (cret.eq.0) then
110           call efcool(fid,maa,mdim,coo2,MED_FULL_INTERLACE,   &
111       &        1,profil,2,rep,nomcoo,unicoo,cret)
112        endif
113        print *,cret
114        print *,'Lecture des composantes 1 des coordonnees avec le profil'
115        print *,coo2
116
117  !   ** Lecture des toutes les composantes des coordonnees des noeuds      **
118        if (cret.eq.0) then
119           call efcool(fid,maa,mdim,coo2,MED_FULL_INTERLACE,   &
120       &        MED_ALL,profil,0,rep,nomcoo,unicoo,cret)
121        endif
122        print *,cret
123        print *,'Lecture des toutes les composantes des coordonnees : '
124        print *,coo2
125
126  !   ** Lecture des noms des noeuds (optionnel dans un fichier MED)  **
127        if (cret.eq.0) then
128           call efnoml(fid,maa,nomnoe,nnoe,MED_NOEUD,         &
129       &               0,ret)
130        endif
131
132        if (ret <0) then
133           inonoe = .FALSE.
134        else
135           inonoe = .TRUE.
136        endif
137
138  !  ** Lecture des numeros des noeuds (optionnel dans un fichier MED) **
139        if (cret.eq.0) then
140           call efnuml(fid,maa,numnoe,nnoe,MED_NOEUD,0,ret)
141        endif
142        if (ret <0) then
143           inunoe = .FALSE.
144        else
145           inunoe = .TRUE.
146        endif
147
148  !   ** Lecture des numeros de familles des noeuds                  **      
149        if (cret.eq.0) then
150           call effaml(fid,maa,nufano,nnoe,MED_NOEUD,0,cret)
151        endif
152        print *,cret
153
154  !   ** Fermeture du fichier
155        call efferm (fid,cret)
156        print *,cret
157
158
159  !  ** Affichage des resulats                                         **
160        if (cret.eq.0) then
161
162
163           print *,"Type de repere         : ", rep
164           print *,"Nom des coordonnees    : "
165           print *, nomcoo
166
167           print *,"Unites des coordonnees : "
168           print *, unicoo
169
170           print *,"Coordonnees des noeuds : "
171           print *, coo
172
173           if (inonoe) then
174              print *,"Noms des noeuds : "
175              print *,nomnoe
176           endif
177
178           if (inunoe) then
179              print *,"Numeros des noeuds : "
180              print *,numnoe
181           endif
182
183           print *,"Numeros des familles des noeuds : "
184           print *,nufano
185
186        endif
187
188  ! ** Liberation memoire                                            **
189        deallocate(coo,nomnoe,numnoe,nufano);
190
191        end program test5
192
193
194
195
196
197