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 - 2015  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 

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