# test30.f90

Aller à la documentation de ce fichier.

    00001 !*  This file is part of MED.
    00002 !*
    00003 !*  COPYRIGHT (C) 1999 - 2012  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