test30.f90

Aller à la documentation de ce fichier.
00001 !*  This file is part of MED.
00002 !*
00003 !*  COPYRIGHT (C) 1999 - 2015  EDF R&D, CEA/DEN
00004 !*  MED is free software: you can redistribute it and/or modify
00005 !*  it under the terms of the GNU Lesser General Public License as published by
00006 !*  the Free Software Foundation, either version 3 of the License, or
00007 !*  (at your option) any later version.
00008 !*
00009 !*  MED is distributed in the hope that it will be useful,
00010 !*  but WITHOUT ANY WARRANTY; without even the implied warranty of
00011 !*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00012 !*  GNU Lesser General Public License for more details.
00013 !*
00014 !*  You should have received a copy of the GNU Lesser General Public License
00015 !*  along with MED.  If not, see <http://www.gnu.org/licenses/>.
00016 !*
00017 
00018 ! ******************************************************************************
00019 ! * - Nom du fichier : test30.f90
00020 ! *
00021 ! * - Description : lecture des joints dans un maillage MED.
00022 ! *
00023 ! ******************************************************************************
00024 
00025 program test30
00026   
00027   implicit none
00028   include 'med.hf90'
00029 !
00030 !
00031   integer      ret,cret,fid,edim
00032   character*64 maa,maadst,corr,jnt
00033   integer      mdim,njnt,ncor,domdst,nc,nent
00034   character*64  equ,ent, nodenn, nodent
00035   character*200 des, dcornn, dcornt
00036   integer       i,j,k
00037   character*255 argc
00038   character*200 desc
00039   integer type
00040   integer nstep,stype,atype
00041   character*16 nomcoo(2)
00042   character*16 unicoo(2)
00043   character*16 dtunit
00044   integer entlcl,geolcl, entdst, geodst
00045   
00046   data nodent /"CorresTria3"/
00047   data nodenn /"CorresNodes"/
00048   
00049   argc = "test29.med"
00050   
00051   !  ** Ouverture du fichier en lecture seule **
00052   call mfiope(fid,argc,MED_ACC_RDONLY, cret)
00053   print '(I1)',cret
00054   
00055      
00056   !  ** Lecture des infos sur le premier maillage **
00057   if (cret.eq.0) then
00058       call mmhmii(fid,1,maa,edim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
00059       print '(A,A,A,I3)',"Maillage de nom : ",maa
00060    endif
00061    print '(I1)',cret
00062    
00063 
00064    !  ** Lecture du nombre de joints **
00065    if (cret.eq.0) then
00066       call  msdnjn(fid,maa,njnt,cret)
00067       if (cret.eq.0) then
00068          print '(A,I3)',"Nombre de joints : ",njnt
00069       endif
00070    endif
00071    
00072    !** Lecture de tous les joints **
00073    if (cret.eq.0) then
00074       do i=1,njnt
00075          print '(A,I3)',"Joint numero : ",i
00076          !** Lecture des infos sur le joint **
00077          if (cret.eq.0) then
00078             call msdjni(fid,maa,i,jnt,des,domdst,maadst,nstep,ncor,cret)
00079          endif
00080          print '(I1)',cret
00081          if (cret.eq.0) then
00082             print '(A,A)',"Nom du joint                              : ",jnt          
00083             print '(A,A)' ,"Description du joint                     : ",des 
00084             print '(A,I3)',"Domaine en regard                        : ",domdst
00085             print '(A,A)' ,"Maillage en regard                       : ",maadst
00086             print '(A,I3)',"Nombre de sequence                       : ",nstep
00087             print '(A,I3)',"Nombre de correspondance (NO_DT,NO_IT)   : ",ncor
00088          endif
00089          
00090          do nc=1,ncor
00091             call msdszi(fid,maa,jnt,MED_NO_DT,MED_NO_IT,nc,entlcl,geolcl,entdst,geodst,ncor,cret)
00092             print '(I3)',cret
00093             if (cret>=0) then
00094                call affCorr(fid,maa,jnt,entlcl,geolcl,entdst,geodst)
00095             endif
00096          enddo
00097 
00098          
00099       end do
00100    end if
00101 
00102 !  ** Fermeture du fichier   **
00103    call mficlo (fid,cret)
00104    print '(I2)',cret
00105    
00106 !   call flush(6)
00107 
00108 
00109 !  ** Code retour
00110    call efexit(cret)
00111    
00112  end program test30
00113         
00114 
00115  subroutine affCorr(fid,maa,jnt,entlcl,geolcl,entdst,geodst)
00116    
00117    implicit none
00118    include 'med.hf90'
00119 
00120    character*(*) maa,jnt
00121    character*200 des;
00122    integer ret,cret,ncor,ntypnent,i,j,fid,nent,ntypent
00123    integer entlcl,geolcl, entdst, geodst
00124    integer, allocatable, dimension(:) :: cortab
00125 
00126    
00127    call msdcsz(fid,maa,jnt,MED_NO_DT,MED_NO_IT,entlcl,geolcl,entdst,geodst,ncor,cret)
00128    print '(I3,i5)',cret,ncor
00129            
00130 
00131    !** Lecture des correspondances sur les differents types d'entites connus a priori **
00132    if (cret.eq.0) then
00133 
00134       print '(A,I4,A,I4,A,I4,A,I4,A)','correspondance entre les types : (',entlcl,'/',geolcl,') et (',entdst,'/',geodst,')'
00135       print '(A,I4)','nombre de type de couples d''entite en regard ',ncor
00136 
00137 !      call flush(6)
00138       
00139       allocate(cortab(ncor*2),STAT=ret)
00140       call msdcrr(fid,maa,jnt,MED_NO_DT,MED_NO_IT,entlcl,geolcl,entdst,geodst,cortab,cret)
00141       do j=0,(ncor-1)
00142          print '(A,I3,A,I4,A,I4)',"Correspondance ",j+1," : ",cortab(2*j+1)," et ",cortab(2*j+2)
00143       end do
00144       deallocate(cortab)
00145    end if
00146 
00147 
00148          
00149    return
00150  end subroutine affCorr
00151 
00152 
00153 

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