1C* This file is part of MED. 2C* 3C* COPYRIGHT (C) 1999 - 2019 EDF R&D, CEA/DEN 4C* MED is free software: you can redistribute it and/or modify 5C* it under the terms of the GNU Lesser General Public License as published by 6C* the Free Software Foundation, either version 3 of the License, or 7C* (at your option) any later version. 8C* 9C* MED is distributed in the hope that it will be useful, 10C* but WITHOUT ANY WARRANTY; without even the implied warranty of 11C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12C* GNU Lesser General Public License for more details. 13C* 14C* You should have received a copy of the GNU Lesser General Public License 15C* along with MED. If not, see <http://www.gnu.org/licenses/>. 16C* 17 18C****************************************************************************** 19C * Tests for filter module 20C * 21C ***************************************************************************** 22 program MEDfilter1 23C 24 implicit none 25 include 'med.hf' 26C 27C 28 integer cret 29 integer*8 fid 30 31 character*64 fname 32 parameter (fname = "Unittest_MEDfilter_1.med") 33 integer nflt 34 parameter (nflt=1) 35 integer flta(1) 36 integer*8 flt(1) 37 integer nent,nvale,scent 38 parameter (nent=10,nvale=1,scent=2) 39C 40C 41C open file 42 call mfiope(fid,fname,MED_ACC_CREAT,cret) 43 print *,'Open file',cret 44 if (cret .ne. 0 ) then 45 print *,'ERROR : open file' 46 call efexit(-1) 47 endif 48C 49C 50C filter creation 51 call mfrall(nflt,flt,cret) 52 print *,'Filter array allocation',cret 53 if (cret .ne. 0 ) then 54 print *,'ERROR : filter array allocation' 55 call efexit(-1) 56 endif 57c 58 call mfrcre(fid,nent,nvale,scent,MED_ALL_CONSTITUENT, 59 & MED_FULL_INTERLACE,MED_GLOBAL_STMODE, 60 & MED_NO_PROFILE,MED_UNDEF_SIZE,flta,flt(1), 61 & cret) 62 print *,'Filter creation',cret 63 if (cret .ne. 0 ) then 64 print *,'ERROR : filter creation' 65 call efexit(-1) 66 endif 67C 68C 69C filter deallocation 70 call mfrdea(nflt,flt,cret) 71 print *,'Filter array deallocation',cret 72 if (cret .ne. 0 ) then 73 print *,'ERROR : filter dearray allocation' 74 call efexit(-1) 75 endif 76C 77C 78C close file 79 call mficlo(fid,cret) 80 print *,'Close file',cret 81 if (cret .ne. 0 ) then 82 print *,'ERROR : close file' 83 call efexit(-1) 84 endif 85C 86C 87C 88 end 89 90