2.3.6/test6.f

Aller à la documentation de ce fichier.
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 : test6.f
00020 C       *
00021 C       * - Description : exemples d'ecriture d'elements dans un maillage MED
00022 C       *
00023 C       ******************************************************************************
00024         program test6
00025 C       
00026         implicit none
00027         include 'med.hf'
00028 C
00029 C       
00030         integer cret, fid
00031         
00032         integer     mdim,nse2,ntr3
00033         parameter  (nse2 = 5, ntr3 = 2, mdim = 2)
00034         integer     se2 (2*nse2)
00035         character*16 nomse2(nse2)
00036         integer     numse2(nse2),nufase2(nse2)
00037 
00038         integer     tr3 (3*ntr3)
00039         character*16 nomtr3(ntr3)
00040         integer     numtr3(ntr3), nufatr3(ntr3) 
00041         character*32 maa 
00042 
00043         data se2     / 1,2,1,3,2,4,3,4,2,3 /    
00044         data nomse2  /"se1","se2","se3","se4","se5" / 
00045         data numse2  / 1,2,3,4,5 /, nufase2 /-1,-1,0,-2,-3/
00046         data tr3     /1,2,-5,-5,3,-4 /, nomtr3 /"tr1","tr2"/,
00047      &                                  numtr3 /4,5/
00048         data nufatr3 /0,-1/,  maa /"maa1"/
00049 
00050 C       ** Ouverture du fichier                            **
00051         call efouvr(fid,'test6.med',MED_LECTURE_ECRITURE, cret)
00052         print *,cret
00053         if (cret .ne. 0 ) then
00054            print *,'Erreur creation du fichier'
00055            call efexit(-1)
00056         endif      
00057 
00058 C       ** Creation du maillage maa de dimension 2         **
00059         call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
00060      &                 'un maillage pour test6',cret)
00061         print *,cret
00062         if (cret .ne. 0 ) then
00063            print *,'Erreur creation du maillage'
00064            call efexit(-1)
00065         endif      
00066 
00067 C       ** Ecriture des connectivites des segments         **
00068         call efcone(fid,maa,mdim,se2,MED_NO_INTERLACE,
00069      &               nse2,MED_ARETE,
00070      &               MED_SEG2,MED_DESC,cret ) 
00071         print *,cret
00072         if (cret .ne. 0 ) then
00073            print *,'Erreur ecriture de la connectivite'
00074            call efexit(-1)
00075         endif      
00076 
00077 C       ** Ecriture (optionnelle) des noms des segments    **
00078         call efnome(fid,maa,nomse2,nse2,MED_ARETE,
00079      &                        MED_SEG2 ,cret)
00080         print *,cret
00081         if (cret .ne. 0 ) then
00082            print *,'Erreur ecriture des noms'
00083            call efexit(-1)
00084         endif      
00085 
00086 C       ** Ecriture (optionnelle) des numeros des segments **
00087         call efnume(fid,maa,numse2,nse2,
00088      &              MED_ARETE ,MED_SEG2,cret)
00089         print *,cret
00090         if (cret .ne. 0 ) then
00091            print *,'Erreur ecriture des numeros'
00092            call efexit(-1)
00093         endif      
00094 
00095 C       ** Ecriture des numeros des familles des segments  **
00096         call effame(fid,maa,nufase2,nse2,
00097      &              MED_ARETE,MED_SEG2,cret)
00098         print *,cret
00099         if (cret .ne. 0 ) then
00100            print *,'Erreur ecriture des numéros de famille'
00101            call efexit(-1)
00102         endif      
00103 
00104 C       ** Ecriture des connectivites des triangles        **
00105         call efcone(fid,maa,mdim,tr3,MED_NO_INTERLACE,
00106      &              ntr3,MED_MAILLE,
00107      &              MED_TRIA3,MED_DESC,cret ) 
00108         print *,cret
00109         if (cret .ne. 0 ) then
00110            print *,'Erreur ecriture de la connectivite'
00111            call efexit(-1)
00112         endif      
00113 
00114 C       ** Ecriture (optionnelle) des noms des triangles   **
00115         call efnome(fid,maa,nomtr3,ntr3,MED_MAILLE,
00116      &                        MED_TRIA3,cret)
00117         print *,cret
00118         if (cret .ne. 0 ) then
00119            print *,'Erreur ecriture des noms'
00120            call efexit(-1)
00121         endif      
00122 
00123 C       ** Ecriture (optionnelle) des numeros des triangles **
00124         call efnume(fid,maa,numtr3,ntr3,MED_MAILLE,
00125      &                       MED_TRIA3,cret)
00126         print *,cret
00127         if (cret .ne. 0 ) then
00128            print *,'Erreur ecriture des numeros'
00129            call efexit(-1)
00130         endif      
00131 
00132 C      ** Ecriture des numeros des familles des triangles  **
00133         call effame(fid,maa,nufatr3,ntr3,MED_MAILLE,
00134      &                      MED_TRIA3,cret)
00135         print *,cret
00136         if (cret .ne. 0 ) then
00137            print *,'Erreur ecriture des numeros de famille'
00138            call efexit(-1)
00139         endif      
00140 
00141 C       ** Fermeture du fichier   **
00142         call efferm (fid,cret)
00143         print *,cret
00144         if (cret .ne. 0 ) then
00145            print *,'Erreur a la fermeture du fichier'
00146            call efexit(-1)
00147         endif      
00148 C
00149         end

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