00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022 program MEDloc2
00023
00024 implicit none
00025 include 'med.hf'
00026
00027
00028 integer cret
00029 integer fid
00030 character*64 fname,lname1,giname1,isname1
00031 character*64 giname,isname
00032 parameter (fname="Unittest_MEDlocalization_1.med")
00033 parameter (lname1 = "Localization name")
00034 parameter (giname1=MED_NO_INTERPOLATION)
00035 parameter (isname1=MED_NO_MESH_SUPPORT)
00036 integer gtype1,sdim1,nip1
00037 integer gtype,sdim,nip
00038 parameter(gtype1=MED_TRIA3)
00039 parameter(sdim1=2)
00040 parameter(nip1=3)
00041 real*8 ecoo1(6), ipcoo1(6), wght1(3)
00042 real*8 ecoo(6), ipcoo(6), wght(3)
00043 data ecoo1 / 0.0, 0.0, 1.0, 0.0, 0.0,1.0 /
00044 data ipcoo1 / 0.166666, 0.166666, 0.66666, 0.166666,
00045 & 0.166666, 0.666666 /
00046 data wght1 / 0.166666, 0.166666, 0.166666 /
00047 integer nsmc, nsmc1
00048 parameter (nsmc1=0)
00049 integer sgtype,sgtype1
00050 parameter (sgtype1=MED_UNDEF_GEOTYPE)
00051
00052
00053
00054 call mfiope(fid,fname,MED_ACC_RDONLY,cret)
00055 print *,cret
00056 if (cret .ne. 0 ) then
00057 print *,'ERROR : open file'
00058 call efexit(-1)
00059 endif
00060
00061
00062
00063 call mlclni(fid, lname1, gtype, sdim, nip,
00064 & giname, isname, nsmc, sgtype, cret)
00065 print *,cret
00066 if (cret .ne. 0 ) then
00067 print *,'ERROR : read information'
00068 call efexit(-1)
00069 endif
00070 if ((gtype .ne. gtype1) .or.
00071 & (sdim .ne. sdim1) .or.
00072 & (nip .ne. nip1) .or.
00073 & (giname .ne. giname1) .or.
00074 & (isname .ne. isname1) .or.
00075 & (nsmc .ne. nsmc1) .or.
00076 & (sgtype .ne. sgtype1) ) then
00077 print *,cret
00078 print *,gtype1,sdim1,nip1,"|",giname1,"|","|",
00079 & isname1,"|",nsmc1,sgtype1
00080 print *,gtype,sdim,nip,"|",giname,"|","|",isname,"|",
00081 & nsmc,sgtype
00082 print *,'ERROR : read information'
00083 call efexit(-1)
00084 endif
00085
00086
00087
00088 call mlclor(fid,lname1,MED_FULL_INTERLACE,
00089 & ecoo,ipcoo,wght,cret)
00090 print *,cret
00091 if (cret .ne. 0 ) then
00092 print *,'ERROR : read localization'
00093 call efexit(-1)
00094 endif
00095
00096 if ((ecoo(1) .ne. ecoo1(1)) .or.
00097 & (ecoo(2) .ne. ecoo1(2)) .or.
00098 & (ecoo(3) .ne. ecoo1(3)) .or.
00099 & (ecoo(4) .ne. ecoo1(4)) .or.
00100 & (ecoo(5) .ne. ecoo1(5)) .or.
00101 & (ecoo(6) .ne. ecoo1(6))) then
00102 print *,'ERROR : read localization'
00103 call efexit(-1)
00104 endif
00105
00106 if ((ipcoo(1) .ne. ipcoo1(1)) .or.
00107 & (ipcoo(2) .ne. ipcoo1(2)) .or.
00108 & (ipcoo(3) .ne. ipcoo1(3)) .or.
00109 & (ipcoo(4) .ne. ipcoo1(4)) .or.
00110 & (ipcoo(5) .ne. ipcoo1(5)) .or.
00111 & (ipcoo(6) .ne. ipcoo1(6))) then
00112 print *,'ERROR : read localization'
00113 call efexit(-1)
00114 endif
00115
00116 if ((wght(1) .ne. wght1(1)) .or.
00117 & (wght(2) .ne. wght1(2)) .or.
00118 & (wght(3) .ne. wght1(3))) then
00119 print *,'ERROR : read localization'
00120 call efexit(-1)
00121 endif
00122
00123
00124
00125 call mficlo(fid,cret)
00126 print *,cret
00127 if (cret .ne. 0 ) then
00128 print *,'ERROR : close file'
00129 call efexit(-1)
00130 endif
00131
00132
00133
00134 end
00135