# Unittest_MEDinterp_3.f

Aller à la documentation de ce fichier.

    00001 C*  This file is part of MED.
    00002 C*
    00003 C*  COPYRIGHT (C) 1999 - 2012  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 * Tests for interp module
    00020 C *
    00021 C *****************************************************************************
    00022       program MEDinterp2
    00023 C
    00024       implicit none
    00025       include 'med.hf'
    00026 C
    00027 C
    00028       integer cret
    00029       integer fid
    00030       character*64 fname
    00031       parameter (fname = "Unittest_MEDinterp_1.med")
    00032       integer n,ni
    00033       parameter (ni=1)
    00034       integer it
    00035       character *64 name1,name
    00036       parameter (name1="Interpolation family name")
    00037       integer gtype1,gtype
    00038       parameter (gtype1=MED_TRIA3)
    00039       integer cnode1,cnode
    00040       parameter (cnode1=MED_FALSE)
    00041       integer nvar1,maxd1,nmaxc1
    00042       integer nvar,maxd,nmaxc
    00043       parameter (nvar1=2,maxd1=1,nmaxc1=3)
    00044       integer nbf,nbf1
    00045       parameter (nbf1=3)
    00046 C
    00047 C
    00048 C     file creation
    00049       call mfiope(fid,fname,MED_ACC_RDONLY,cret)
    00050       print *,'Open file',cret
    00051       if (cret .ne. 0 ) then
    00052          print *,'ERROR : file creation'
    00053          call efexit(-1)
    00054       endif
    00055 C
    00056 C
    00057 C     number of interpolation
    00058       call mipnip(fid,n,cret)
    00059       print *,'Number of interpolation',cret
    00060       if (cret .ne. 0 ) then
    00061          print *,'ERROR : number of interpolation'
    00062          call efexit(-1)
    00063       endif
    00064       if (n .ne. ni) then
    00065          print *,'ERROR : number of interpolation'
    00066          call efexit(-1)
    00067       endif
    00068 C
    00069 C
    00070 C     read information
    00071       do it=1,n
    00072          call mipipi(fid,it,name,gtype,cnode,
    00073      &               nbf,nvar,maxd,nmaxc,cret)
    00074          print *,'interpolation information',cret
    00075          if (cret .ne. 0 ) then
    00076             print *,'ERROR : interpolation information'
    00077             call efexit(-1)
    00078          endif
    00079 c
    00080          if (it .eq. 1) then
    00081             if ( (gtype .ne. gtype1) .or.
    00082      &           (cnode .ne. cnode1) .or.
    00083      &           (nbf .ne. nbf1) .or.
    00084      &           (nvar .ne. nvar1) .or.
    00085      &           (maxd .ne. maxd1) .or.
    00086      &           (nmaxc .ne. nmaxc1) ) then
    00087                print *,'ERROR : interpolation information'
    00088                call efexit(-1)
    00089             endif
    00090          endif
    00091 c
    00092       enddo
    00093
    00094 C
    00095 C
    00096 C     close file
    00097       call mficlo(fid,cret)
    00098       print *,'Close file',cret
    00099       if (cret .ne. 0 ) then
    00100          print *,'ERROR :  close file'
    00101          call efexit(-1)
    00102       endif
    00103 C
    00104 C
    00105 C
    00106       end
    00107