# Unittest_MEDinterp_2.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       character *64 name1
    00033       parameter (name1="Interpolation family name")
    00034       integer gtype1,gtype
    00035       parameter (gtype1=MED_TRIA3)
    00036       integer cnode1,cnode
    00037       parameter (cnode1=MED_FALSE)
    00038       integer nvar1,maxd1,nmaxc1
    00039       integer nvar,maxd,nmaxc
    00040       parameter (nvar1=2,maxd1=1,nmaxc1=3)
    00041       integer ncoef1,ncoef2,ncoef3,ncoef
    00042       parameter (ncoef1=3,ncoef2=1,ncoef3=1)
    00043       integer power1(6),power2(2),power3(2)
    00044       integer power(6)
    00045       data power1 / 0,0, 1,0, 0,1 /
    00046       data power2 / 1,0 /
    00047       data power3 / 0,1 /
    00048       real*8 coef1(3), coef2(1), coef3(1)
    00049       real*8 coef(3)
    00050       data coef1 / 1., -1., -1. /
    00051       data coef2 / 1. /
    00052       data coef3 / 1. /
    00053       integer nbf,nbf1,it,size,size1,size2,size3
    00054       parameter (nbf1=3,size1=3,size2=1,size3=1)
    00055 C
    00056 C
    00057 C     file creation
    00058       call mfiope(fid,fname,MED_ACC_RDONLY,cret)
    00059       print *,'Open file',cret
    00060       if (cret .ne. 0 ) then
    00061          print *,'ERROR : open file'
    00062          call efexit(-1)
    00063       endif
    00064 C
    00065 C
    00066 C     interpolation information
    00067       call mipiin(fid,name1,gtype,cnode,nbf,nvar,
    00068      &            maxd,nmaxc,cret)
    00069       print *,'interpolation information',cret
    00070       if (cret .ne. 0 ) then
    00071          print *,'ERROR : interpolation information'
    00072          call efexit(-1)
    00073       endif
    00074 c
    00075       if ( (gtype .ne. gtype1) .or.
    00076      &     (cnode .ne. cnode1) .or.
    00077      &     (nbf .ne. nbf1) .or.
    00078      &     (nvar .ne. nvar1) .or.
    00079      &     (maxd .ne. maxd1) .or.
    00080      &     (nmaxc .ne. nmaxc1) ) then
    00081          print *,'ERROR : interpolation information'
    00082          call efexit(-1)
    00083       endif
    00084 C
    00085 C
    00086 C     read functions
    00087       do it=1,nbf
    00088          call mipcsz(fid,name1,it,size,cret)
    00089          print *,'memory size',cret
    00090          if (cret .ne. 0 ) then
    00091             print *,'ERROR : memory size'
    00092             call efexit(-1)
    00093          endif
    00094 c
    00095          if (it .eq. 1) then
    00096             if (size .ne. size1) then
    00097                print *,'ERROR : memory size size'
    00098                call efexit(-1)
    00099             endif
    00100          endif
    00101 c
    00102          if (it .eq. 2) then
    00103             if (size .ne. size2) then
    00104                print *,'ERROR : allocation size'
    00105                call efexit(-1)
    00106             endif
    00107          endif
    00108 c
    00109          if (it .eq. 3) then
    00110             if (size .ne. size3) then
    00111                print *,'ERROR : allocation size'
    00112                call efexit(-1)
    00113             endif
    00114          endif
    00115 C
    00116          call mipbfr(fid,name1,it,ncoef,power,coef,cret)
    00117          print *,'read function',cret
    00118          if (cret .ne. 0 ) then
    00119             print *,'ERROR : read function'
    00120             call efexit(-1)
    00121          endif
    00122 c
    00123          if (it .eq. 1) then
    00124             if ( (ncoef .ne. ncoef1) .or.
    00125      &           (power(1) .ne. power1(1)) .or.
    00126      &           (power(2) .ne. power1(2)) .or.
    00127      &           (power(3) .ne. power1(3)) .or.
    00128      &           (power(4) .ne. power1(4)) .or.
    00129      &           (power(5) .ne. power1(5)) .or.
    00130      &           (power(6) .ne. power1(6)) .or.
    00131      &           (coef(1) .ne. coef1(1)) .or.
    00132      &           (coef(2) .ne. coef1(2)) .or.
    00133      &           (coef(3) .ne. coef1(3)) ) then
    00134                print *,'ERROR : read function'
    00135                call efexit(-1)
    00136             endif
    00137          endif
    00138 c
    00139          if (it .eq. 2) then
    00140             if ( (ncoef .ne. ncoef2) .or.
    00141      &           (power(1) .ne. power2(1)) .or.
    00142      &           (power(2) .ne. power2(2)) .or.
    00143      &           (coef(1) .ne. coef2(1)) ) then
    00144                print *,'ERROR : read function'
    00145                call efexit(-1)
    00146             endif
    00147          endif
    00148 c
    00149          if (it .eq. 3) then
    00150             if ( (ncoef .ne. ncoef3) .or.
    00151      &           (power(1) .ne. power3(1)) .or.
    00152      &           (power(2) .ne. power3(2)) .or.
    00153      &           (coef(1) .ne. coef3(1)) ) then
    00154                print *,'ERROR : read function'
    00155                call efexit(-1)
    00156             endif
    00157          endif
    00158       enddo
    00159 C
    00160 C
    00161 C     close file
    00162       call mficlo(fid,cret)
    00163       print *,'Close file',cret
    00164       if (cret .ne. 0 ) then
    00165          print *,'ERROR :  close file'
    00166          call efexit(-1)
    00167       endif
    00168 C
    00169 C
    00170 C
    00171       end
    00172