1 C************************************************************************* 2 C COPYRIGHT (C) 1999 - 2003 EDF R&D 3 C THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY 4 C IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE 5 C AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION; 6 C EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION. 7 C 8 C THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT 9 C WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF 10 C MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU 11 C LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS. 12 C 13 C YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE 14 C ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION, 15 C INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA 16 C 17 C************************************************************************** 18 19 C ****************************************************************************** 20 C * - Nom du fichier : test14.f 21 C * 22 C * - Description : ecriture des noeuds d'un maillage MED 23 C * a l'aide des routines de niveau 2 24 C * MED - equivalent a test4.f 25 C * 26 C ****************************************************************************** 27 program test14 28 C 29 implicit none 30 include 'med.hf' 31 C 32 integer cret, fid 33 C ** la dimension du maillage ** 34 integer mdim 35 C ** nom du maillage de longueur maxi MED_TAILLE_NOM ** 36 character*32 maa 37 C ** le nombre de noeuds ** 38 integer nnoe 39 parameter (mdim=2,maa="maa1",nnoe=4) 40 C ** table des coordonnees 41 real*8 coo(mdim*nnoe) 42 C ** tables des noms et des unites des coordonnees 43 character*16 nomcoo(mdim), unicoo(mdim) 44 C ** tables des noms, numeros, numeros de familles des noeuds 45 C autant d'elements que de noeuds - les noms ont pout longueur 46 C MED_TAILLE_PNOM : 8 ** 47 character*16 nomnoe(nnoe) 48 integer numnoe(nnoe), nufano(nnoe) 49 50 data coo /0.0, 0.0, 1.0, 0.0, 0.0, 1.0, 1.0, 1.0/ 51 data nomcoo /"x","y"/, unicoo /"cm","cm"/ 52 data nomnoe /"nom1","nom2","nom3","nom4"/ 53 data numnoe /1,2,3,4/,nufano /0,1,2,2/ 54 55 C ** Creation du fichier test14.med ** 56 call efouvr(fid,'test14.med',MED_CREATION, cret) 57 print *,cret 58 59 C ** Creation du maillage ** 60 if (cret .eq. 0) then 61 call efmaac(fid,maa,mdim,MED_NON_STRUCTURE, 62 & 'un maillage pour tes14',cret) 63 endif 64 print *,cret 65 66 C ** Ecriture des noeuds d'un maillage MED : 67 C - Des coordonnees en mode MED_FULL_INTERLACE : (X1,Y1,X2,Y2,X3,Y3,...) 68 C dans un repere cartesien 69 C - Des noms (optionnel dans un fichier MED) 70 C - Des numeros (optionnel dans un fichier MED) 71 C - Des numeros de familles des noeuds ** 72 if (cret.eq.0) then 73 call efnoee(fid,maa,mdim,coo,MED_FULL_INTERLACE,MED_CART, 74 & nomcoo,unicoo,nomnoe,MED_VRAI,numnoe,MED_VRAI, 75 & nufano,nnoe,cret) 76 endif 77 print *,cret 78 79 C ** Fermeture du fichier ** 80 call efferm (fid,cret) 81 print *,cret 82 83 end 84 85