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 : test4.f 21 C * 22 C * - Description : ecriture des noeuds d'un maillage MED. 23 C * 24 C ***************************************************************************** 25 program test4 26 C 27 implicit none 28 include 'med.hf' 29 C 30 C 31 integer cret, fid 32 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 C ** table des coordonnees ** 40 C profil : (dimension * nombre de noeuds) ici 8 ** 41 real*8 coo(8) 42 C ** tables des noms et des unites des coordonnees ** 43 C profil : (dimension) ** 44 character*16 nomcoo(2) 45 character*16 unicoo(2) 46 C ** tables des noms, numeros, numeros de familles des noeuds ** 47 C autant d'elements que de noeuds - les noms ont pout longueur ** 48 C MED_TAILLE_PNOM ** 49 character*16 nomnoe(4) 50 integer numnoe(4) 51 integer nufano(4) 52 53 parameter ( mdim = 2, maa = "maa1",nnoe = 4 ) 54 data coo /0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0/ 55 data nomcoo /"x","y"/, unicoo /"cm","cm"/ 56 data nomnoe /"nom1","nom2","nom3","nom4"/ 57 data numnoe /1,2,3,4/, nufano /0,1,2,2/ 58 59 C ** Creation du fichier test4.med ** 60 call efouvr(fid,'test4.med',MED_LECTURE_ECRITURE, cret) 61 print *,cret 62 if (cret .ne. 0 ) then 63 print *,'Erreur creation du fichier' 64 call efexit(-1) 65 endif 66 67 C ** Creation du maillage maa de dimension 2 ** 68 C ** et de type MED_NON_STRUCTURE ** 69 call efmaac(fid,maa,mdim,MED_NON_STRUCTURE, 70 & 'un maillage pour test4',cret) 71 print *,cret 72 if (cret .ne. 0 ) then 73 print *,'Erreur creation du maillage' 74 call efexit(-1) 75 endif 76 77 C ** Ecriture des coordonnees en mode MED_FULL_INTERLACE : ** 78 C ** (X1,Y1, X2,Y2, X3,Y3, ...) dans un repere cartesien ** 79 call efcooe(fid,maa,mdim,coo,MED_FULL_INTERLACE, 80 & nnoe,MED_CART,nomcoo,unicoo,cret) 81 print *,cret 82 if (cret .ne. 0 ) then 83 print *,'Erreur ecriture des coordonnees des noeuds' 84 call efexit(-1) 85 endif 86 87 C ** Ecriture des noms des noeuds (optionnel dans un maillage MED) ** 88 call efnome(fid,maa,nomnoe,nnoe,MED_NOEUD,0,cret) 89 print *,cret 90 if (cret .ne. 0 ) then 91 print *,'Erreur ecriture des noms des noeuds' 92 call efexit(-1) 93 endif 94 95 C ** Ecriture des numeros des noeuds (optionnel dans un maillage MED) ** 96 call efnume(fid,maa,numnoe,nnoe,MED_NOEUD,0,cret) 97 print *,cret 98 if (cret .ne. 0 ) then 99 print *,'Erreur ecriture des numeros des noeuds' 100 call efexit(-1) 101 endif 102 103 104 C ** Ecriture des numeros de familles des noeuds ** 105 call effame(fid,maa,nufano,nnoe,MED_NOEUD,0,cret) 106 print *,cret 107 if (cret .ne. 0 ) then 108 print *,'Erreur ecriture des numeros de famille' 109 call efexit(-1) 110 endif 111 112 C ** Fermeture du fichier ** 113 call efferm (fid,cret) 114 print *,cret 115 if (cret .ne. 0 ) then 116 print *,'Erreur fermeture du fichier' 117 call efexit(-1) 118 endif 119 120 end 121 122 123 124