# 2.3.6/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.hf'
    00029 !
    00030 !
    00031   integer      ret,cret,fid
    00032   character*32 maa,maadst,corr, jnt
    00033   integer      mdim,njnt,ncor,domdst,nc,nent
    00034   character*32  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
    00041    integer entlcl,geolcl, entdst, geodst
    00042
    00043    data nodent /"CorresTria3"/
    00044    data nodenn /"CorresNodes"/
    00045
    00046    print '(A)',"Indiquez le fichier med a decrire : "
    00047    !!read(*,*) argc
    00048    argc = "test29.med"
    00049
    00050    !  ** Ouverture du fichier en lecture seule **
    00051    call efouvr(fid,argc,MED_LECTURE, cret)
    00052    print '(I1)',cret
    00053
    00054
    00055    !  ** Lecture des infos sur le premier maillage **
    00056    if (cret.eq.0) then
    00057       call efmaai(fid,1,maa,mdim,type,desc,cret)
    00058       print '(A,A,A,I3)',"Maillage de nom : ",maa," et de dimension : ", mdim
    00059    endif
    00060    print '(I1)',cret
    00061
    00062
    00063    !  ** Lecture du nombre de joints **
    00064    if (cret.eq.0) then
    00065       call efnjnt(fid,maa,njnt,cret)
    00066       if (cret.eq.0) then
    00067          print '(A,I3)',"Nombre de joints : ",njnt
    00068       endif
    00069    endif
    00070
    00071    !** Lecture de tous les joints **
    00072    if (cret.eq.0) then
    00073       do i=1,njnt
    00074          print '(A,I3)',"Joint numero : ",i
    00075          !** Lecture des infos sur le joint **
    00076          if (cret.eq.0) then
    00077             call efjnti(fid,maa,i,jnt,des,domdst,maadst,cret)
    00078          endif
    00079          print '(I1)',cret
    00080          if (cret.eq.0) then
    00081             print '(A,A)',"Nom du joint               : ",jnt
    00082             print '(A,A)' ,"Description du joint       : ",des
    00083             print '(A,I3)',"Domaine en regard          : ",domdst
    00084             print '(A,A)' ,"Maillage en regard         : ",maadst
    00085          endif
    00086
    00087          nc=1
    00088
    00089          do while (cret>=0)
    00090
    00091             call efjtco(fid,maa,jnt,nc,entlcl,geolcl,entdst,geodst,cret)
    00092             print '(I3)',cret
    00093
    00094             nc=nc+1
    00095             if (cret>=0) then
    00096                call affCorr(fid,maa,jnt,entlcl,geolcl,entdst,geodst)
    00097             endif
    00098
    00099          end do
    00100
    00101
    00102
    00103       end do
    00104    end if
    00105
    00106 !  ** Fermeture du fichier   **
    00107    call efferm (fid,cret)
    00108    print '(I2)',cret
    00109
    00110 !   call flush(6)
    00111
    00112
    00113 !  ** Code retour
    00114    call efexit(cret)
    00115
    00116  end program test30
    00117
    00118
    00119  subroutine affCorr(fid,maa,jnt,entlcl,geolcl,entdst,geodst)
    00120
    00121    implicit none
    00122    include 'med.hf'
    00123
    00124    character*(*) maa,jnt
    00125    character*200 des;
    00126    integer ret,cret,ncor,ntypnent,i,j,fid,nent,ntypent
    00127    integer entlcl,geolcl, entdst, geodst
    00128    integer, allocatable, dimension(:) :: cortab
    00129
    00130
    00131    call efjnco(fid,maa,jnt,entlcl,geolcl,entdst,geodst,ncor,cret)
    00132    print '(I3,i5)',cret,ncor
    00133
    00134
    00135    !** Lecture des correspondances sur les differents types d'entites connus a priori **
    00136    if (cret.eq.0) then
    00137
    00138       print '(A,I4,A,I4,A,I4,A,I4,A)','correspondance entre les types : (',entlcl,'/',geolcl,') et (',entdst,'/',geodst,')'
    00139       print '(A,I4)','nombre de type de couples d''entite en regard ',ncor
    00140
    00141 !      call flush(6)
    00142
    00143       allocate(cortab(ncor*2),STAT=ret)
    00144       call efjntl(fid,maa,jnt,cortab,ncor,entlcl,geolcl,entdst,geodst,cret)
    00145       do j=0,(ncor-1)
    00146          print '(A,I3,A,I4,A,I4)',"Correspondance ",j+1," : ",cortab(2*j+1)," et ",cortab(2*j+2)
    00147       end do
    00148       deallocate(cortab)
    00149    end if
    00150
    00151
    00152
    00153    return
    00154  end subroutine affCorr
    00155
    00156
    00157