Unittest_MEDstructElement_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 struct element module
00020 C *
00021 C *****************************************************************************
00022       program MEDstructElement2
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_MEDstructElement_1.med")
00032       character*64  mname1, mname2, mname3
00033       parameter (mname1 = "model name 1")
00034       parameter (mname2 = "model name 2")
00035       parameter (mname3 = "model name 3")
00036       integer dim1, dim2, dim3
00037       parameter (dim1=2)
00038       parameter (dim2=2)
00039       parameter (dim3=2)
00040       character*64  smname1
00041       parameter (smname1=MED_NO_NAME)
00042       character*64  smname2
00043       parameter (smname2="support mesh name")
00044       integer setype1
00045       parameter (setype1=MED_NONE)
00046       integer setype2
00047       parameter (setype2=MED_NODE)
00048       integer setype3
00049       parameter (setype3=MED_CELL)
00050       integer sgtype1
00051       parameter (sgtype1=MED_NO_GEOTYPE)
00052       integer sgtype2
00053       parameter (sgtype2=MED_NO_GEOTYPE)
00054       integer sgtype3
00055       parameter (sgtype3=MED_SEG2)
00056       integer mtype1,mtype2,mtype3
00057       parameter (mtype1=601)
00058       parameter (mtype2=602)
00059       parameter (mtype3=603)
00060       integer nnode1,nnode2
00061       parameter (nnode1=1)
00062       parameter (nnode2=3)
00063       integer ncell2
00064       parameter (ncell2=2)
00065       integer ncell1
00066       parameter (ncell1=0)
00067       integer ncatt1,profile1,nvatt1
00068       parameter (ncatt1=0)
00069       parameter (nvatt1=0)
00070       parameter (profile1=0)
00071 c
00072       integer mgtype,mdim,setype,snnode,sncell
00073       integer sgtype,ncatt,nvatt,profile
00074       character*64 smname
00075 C 
00076 C
00077 C     open file
00078       call mfiope(fid,fname,MED_ACC_RDONLY,cret)
00079       print *,'Open file',cret
00080       if (cret .ne. 0 ) then
00081          print *,'ERROR : file creation'
00082          call efexit(-1)
00083       endif 
00084 C
00085 C
00086 C     Read information about a struct element model
00087 C     Access by name
00088       call msesin(fid,mname1,mgtype,mdim,smname,
00089      &            setype,snnode,sncell,sgtype,
00090      &            ncatt,profile,nvatt,cret)
00091       print *,'Read information about struct element (by name)',cret
00092       if (cret .ne. 0 ) then
00093          print *,'ERROR : information about struct element (by name) '
00094          call efexit(-1)
00095       endif 
00096       if ( (mgtype .ne. mtype1) .or.
00097      &     (mdim .ne. dim1) .or.
00098      &     (smname .ne. smname1) .or.
00099      &     (setype .ne. setype1) .or.
00100      &     (snnode .ne. nnode1) .or.
00101      &     (sncell .ne. ncell1) .or.
00102      &     (sgtype .ne. sgtype1) .or.
00103      &     (ncatt .ne. ncatt1) .or.
00104      &     (profile .ne. profile1) .or.
00105      &     (nvatt .ne. nvatt1) 
00106      &    )  then
00107          print *,'ERROR : information about struct element (by name) '
00108          call efexit(-1)
00109       endif 
00110 C
00111 C
00112 C
00113       call msesin(fid,mname2,mgtype,mdim,smname,
00114      &            setype,snnode,sncell,sgtype,
00115      &            ncatt,profile,nvatt,cret)
00116       print *,'Read information about struct element (by name)',cret
00117       if (cret .ne. 0 ) then
00118          print *,'ERROR : information about struct element (by name) '
00119          call efexit(-1)
00120       endif 
00121       if ( (mgtype .ne. mtype2) .or.
00122      &     (mdim .ne. dim2) .or.
00123      &     (smname .ne. smname2) .or.
00124      &     (setype .ne. setype2) .or.
00125      &     (snnode .ne. nnode2) .or.
00126      &     (sncell .ne. ncell1) .or.
00127      &     (sgtype .ne. sgtype2) .or.
00128      &     (ncatt .ne. ncatt1) .or.
00129      &     (profile .ne. profile1) .or.
00130      &     (nvatt .ne. nvatt1) 
00131      &    )  then
00132          print *,'ERROR : information about struct element (by name) '
00133          call efexit(-1)
00134       endif 
00135 C
00136 C
00137 C
00138       call msesin(fid,mname3,mgtype,mdim,smname,
00139      &            setype,snnode,sncell,sgtype,
00140      &            ncatt,profile,nvatt,cret)
00141       print *,'Read information about struct element (by name)',cret
00142       if (cret .ne. 0 ) then
00143          print *,'ERROR : information about struct element (by name) '
00144          call efexit(-1)
00145       endif 
00146       if ( (mgtype .ne. mtype3) .or.
00147      &     (mdim .ne. dim3) .or.
00148      &     (smname .ne. smname2) .or.
00149      &     (setype .ne. setype3) .or.
00150      &     (snnode .ne. nnode2) .or.
00151      &     (sncell .ne. ncell2) .or.
00152      &     (sgtype .ne. sgtype3) .or.
00153      &     (ncatt .ne. ncatt1) .or.
00154      &     (profile .ne. profile1) .or.
00155      &     (nvatt .ne. nvatt1) 
00156      &    )  then
00157          print *,'ERROR : information about struct element (by name) '
00158          call efexit(-1)
00159       endif 
00160 C
00161 C
00162 C     Read model type from the name
00163       call msesgt(fid,mname1,mgtype,cret)
00164       print *,'Read struct element type (by name)',cret
00165       if (cret .ne. 0 ) then
00166          print *,'ERROR : struct element type (by name)'
00167          call efexit(-1)
00168       endif 
00169       if (mgtype .ne. mtype1) then
00170          print *,'ERROR : struct element type (by name)'
00171          call efexit(-1)
00172       endif
00173 c
00174 c
00175 c     Read model type from the name
00176       call msesgt(fid,mname2,mgtype,cret)
00177       print *,'Read struct element type (by name)',cret
00178       if (cret .ne. 0 ) then
00179          print *,'ERROR : struct element type (by name)'
00180          call efexit(-1)
00181       endif 
00182       if (mgtype .ne. mtype2) then
00183          print *,'ERROR : struct element type (by name)'
00184          call efexit(-1)
00185       endif
00186 c
00187 c
00188 c     Read model type from the name
00189       call msesgt(fid,mname3,mgtype,cret)
00190       print *,'Read struct element type (by name)',cret
00191       if (cret .ne. 0 ) then
00192          print *,'ERROR : struct element type (by name)'
00193          call efexit(-1)
00194       endif 
00195       if (mgtype .ne. mtype3) then
00196          print *,'ERROR : struct element type (by name)'
00197          call efexit(-1)
00198       endif
00199 C
00200 C
00201 C     close file
00202       call mficlo(fid,cret)
00203       print *,'Close file',cret
00204       if (cret .ne. 0 ) then
00205          print *,'ERROR :  close file'
00206          call efexit(-1)
00207       endif  
00208 C
00209 C
00210 C
00211       end
00212 

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