00001 C* This file is part of MED. 00002 C* 00003 C* COPYRIGHT (C) 1999 - 2015 EDF R&D, CEA/DEN 00004 C* MED is free software: you can redistribute it and/or modify 00005 C* it under the terms of the GNU Lesser General Public License as published by 00006 C* the Free Software Foundation, either version 3 of the License, or 00007 C* (at your option) any later version. 00008 C* 00009 C* MED is distributed in the hope that it will be useful, 00010 C* but WITHOUT ANY WARRANTY; without even the implied warranty of 00011 C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00012 C* GNU Lesser General Public License for more details. 00013 C* 00014 C* You should have received a copy of the GNU Lesser General Public License 00015 C* along with MED. If not, see <http://www.gnu.org/licenses/>. 00016 C* 00017 00018 C ****************************************************************************** 00019 C * - Nom du fichier : test14.f 00020 C * 00021 C * - Description : ecriture des noeuds d'un maillage MED 00022 C * a l'aide des routines de niveau 2 00023 C * MED - equivalent a test4.f 00024 C * 00025 C ****************************************************************************** 00026 program test14 00027 C 00028 implicit none 00029 include 'med.hf' 00030 C 00031 integer cret, fid 00032 C ** la dimension du maillage ** 00033 integer mdim 00034 C ** nom du maillage de longueur maxi MED_TAILLE_NOM ** 00035 character*32 maa 00036 C ** le nombre de noeuds ** 00037 integer nnoe 00038 parameter (mdim=2,maa="maa1",nnoe=4) 00039 C ** table des coordonnees 00040 real*8 coo(mdim*nnoe) 00041 C ** tables des noms et des unites des coordonnees 00042 character*16 nomcoo(mdim), unicoo(mdim) 00043 C ** tables des noms, numeros, numeros de familles des noeuds 00044 C autant d'elements que de noeuds - les noms ont pout longueur 00045 C MED_TAILLE_PNOM : 8 ** 00046 character*16 nomnoe(nnoe) 00047 integer numnoe(nnoe), nufano(nnoe) 00048 00049 data coo /0.0, 0.0, 1.0, 0.0, 0.0, 1.0, 1.0, 1.0/ 00050 data nomcoo /"x","y"/, unicoo /"cm","cm"/ 00051 data nomnoe /"nom1","nom2","nom3","nom4"/ 00052 data numnoe /1,2,3,4/,nufano /0,1,2,2/ 00053 00054 C ** Creation du fichier test14.med ** 00055 call efouvr(fid,'test14.med',MED_LECTURE_ECRITURE, cret) 00056 print *,cret 00057 if (cret .ne. 0 ) then 00058 print *,'Erreur creation du fichier' 00059 call efexit(-1) 00060 endif 00061 00062 C ** Creation du maillage ** 00063 call efmaac(fid,maa,mdim,MED_NON_STRUCTURE, 00064 & 'un maillage pour tes14',cret) 00065 print *,cret 00066 if (cret .ne. 0 ) then 00067 print *,'Erreur creation du maillage' 00068 call efexit(-1) 00069 endif 00070 00071 C ** Ecriture des noeuds d'un maillage MED : 00072 C - Des coordonnees en mode MED_FULL_INTERLACE : (X1,Y1,X2,Y2,X3,Y3,...) 00073 C dans un repere cartesien 00074 C - Des noms (optionnel dans un fichier MED) 00075 C - Des numeros (optionnel dans un fichier MED) 00076 C - Des numeros de familles des noeuds ** 00077 call efnoee(fid,maa,mdim,coo,MED_FULL_INTERLACE,MED_CART, 00078 & nomcoo,unicoo,nomnoe,MED_VRAI,numnoe,MED_VRAI, 00079 & nufano,nnoe,cret) 00080 print *,cret 00081 if (cret .ne. 0 ) then 00082 print *,'Erreur ecriture des noeuds' 00083 call efexit(-1) 00084 endif 00085 00086 C ** Fermeture du fichier ** 00087 call efferm (fid,cret) 00088 print *,cret 00089 if (cret .ne. 0 ) then 00090 print *,'Erreur fermeture du fichier' 00091 call efexit(-1) 00092 endif 00093 C 00094 end 00095 00096 00097