f/test23.f

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 : test23.f
00020 C       *
00021 C       * - Description : ecriture de mailles MED_POLYGONE dans un maillage MED
00022 C       *
00023 C       ******************************************************************************
00024         program test23
00025 C       
00026         implicit none
00027         include 'med.hf'
00028 C       
00029         integer cret, fid,mdim,sdim
00030         parameter  (mdim = 2, sdim = 2)
00031         character*64 maa        
00032         integer ni, n
00033         parameter (ni=4, n=3)
00034         integer index(ni)
00035         character*16 nom(n)
00036         integer num(n),fam(n)
00037         integer con(16)
00038 C       ** tables des noms et des unites des coordonnees    **
00039 C           profil : (dimension)                            **
00040         character*16 nomcoo(2)
00041         character*16 unicoo(2)
00042 C
00043         data con  / 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16 /    
00044         data nom  / "poly1", "poly2", "poly3"/ 
00045         data num  / 1,2,3 /, fam /0,-1,-2/
00046         data index /1,6,12,17/
00047         data maa /"maa1"/
00048         data nomcoo /"x","y"/, unicoo /"cm","cm"/
00049 
00050 C       ** Creation du fichier test23.med                   **
00051         call mfiope(fid,'test23.med',MED_ACC_RDWR, cret)
00052         print *,cret
00053         if (cret .ne. 0 ) then
00054            print *,'Erreur creation du fichier'
00055            call efexit(-1)
00056         endif      
00057         print *,'Creation du fichier test23.med'
00058 
00059 C       ** Creation du maillage          **
00060         call mmhcre(fid,maa,mdim,sdim,
00061      &     MED_UNSTRUCTURED_MESH,'un maillage pour test 23', 
00062      &     "",MED_SORT_DTIT,MED_CARTESIAN,nomcoo,unicoo,cret)
00063         print *,cret
00064         if (cret .ne. 0 ) then
00065            print *,'Erreur creation du maillage'
00066            call efexit(-1)
00067         endif      
00068         print *,'Creation du maillage'
00069 
00070 C       ** Ecriture de la connectivite des mailles polygones **
00071         call mmhpgw(fid,maa,MED_NO_DT,MED_NO_IT,MED_UNDEF_DT,MED_CELL,
00072      &              MED_NODAL,ni,index,con,cret)
00073         if (cret .ne. 0 ) then
00074            print *,'Erreur ecriture des connectivite polygones'
00075            call efexit(-1)
00076         endif      
00077         print *,cret
00078         print *,
00079 'Ecriture des connectivites des mailles de type     & MED_POLYGONE'
00080 
00081 C       ** Ecriture des noms des mailles polygones          **
00082         call mmheaw(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00083      &              MED_POLYGON,n,nom,cret)
00084         print *,cret
00085         if (cret .ne. 0 ) then
00086            print *,'Erreur ecriture des noms polygones'
00087            call efexit(-1)
00088         endif      
00089         print *,'Ecriture des noms des polygones'
00090 
00091 C       ** Ecriture des numeros des mailles polygones **
00092         call mmhenw(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00093      &              MED_POLYGON,n,num,cret)
00094         if (cret .ne. 0 ) then
00095            print *,'Erreur ecriture des numeros polygones'
00096            call efexit(-1)
00097         endif      
00098         print *,cret
00099         print *,'Ecriture des numeros des polygones'
00100 
00101 C       ** Ecriture des numeros des familles des mailles polygones  **
00102         call mmhfnw(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00103      &              MED_POLYGON,n,fam,cret)         
00104         if (cret .ne. 0 ) then
00105            print *,'Erreur ecriture des numeros de famille polygones'
00106            call efexit(-1)
00107         endif      
00108         print *,cret
00109         print *,'Ecriture des numeros de familles des polygones'
00110 
00111 C       ** Fermeture du fichier                            **
00112         call mficlo(fid,cret)
00113         print *,cret
00114         if (cret .ne. 0 ) then
00115            print *,'Erreur fermeture du fichier'
00116            call efexit(-1)
00117         endif      
00118         print *,'Fermeture du fichier'
00119 C     
00120         end

Généré le Thu Oct 8 14:26:16 2015 pour MED fichier par  doxygen 1.6.1