1 C************************************************************************* 2 C COPYRIGHT (C) 1999 - 2007 EDF R&D, CEA/DEN 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_LECTURE_ECRITURE, cret) 57 print *,cret 58 if (cret .ne. 0 ) then 59 print *,'Erreur creation du fichier' 60 call efexit(-1) 61 endif 62 63 C ** Creation du maillage ** 64 call efmaac(fid,maa,mdim,MED_NON_STRUCTURE, 65 & 'un maillage pour tes14',cret) 66 print *,cret 67 if (cret .ne. 0 ) then 68 print *,'Erreur creation du maillage' 69 call efexit(-1) 70 endif 71 72 C ** Ecriture des noeuds d'un maillage MED : 73 C - Des coordonnees en mode MED_FULL_INTERLACE : (X1,Y1,X2,Y2,X3,Y3,...) 74 C dans un repere cartesien 75 C - Des noms (optionnel dans un fichier MED) 76 C - Des numeros (optionnel dans un fichier MED) 77 C - Des numeros de familles des noeuds ** 78 call efnoee(fid,maa,mdim,coo,MED_FULL_INTERLACE,MED_CART, 79 & nomcoo,unicoo,nomnoe,MED_VRAI,numnoe,MED_VRAI, 80 & nufano,nnoe,cret) 81 print *,cret 82 if (cret .ne. 0 ) then 83 print *,'Erreur ecriture des noeuds' 84 call efexit(-1) 85 endif 86 87 C ** Fermeture du fichier ** 88 call efferm (fid,cret) 89 print *,cret 90 if (cret .ne. 0 ) then 91 print *,'Erreur fermeture du fichier' 92 call efexit(-1) 93 endif 94 C 95 end 96 97 98