updated library for vtk output

This commit is contained in:
Martin Diehl 2014-01-15 14:58:59 +00:00
parent 3fffb2ae3e
commit cbc6f2a3af
3 changed files with 27 additions and 19 deletions

View File

@ -388,7 +388,7 @@ contains
!--------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------
bits = size(transfer(c,mold),dim=1,kind=I1P)*8_I4P bits = size(transfer(c,mold),dim=1,kind=I4P)*8_I4P
return return
!--------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------
endfunction bit_size_chr endfunction bit_size_chr
@ -1159,10 +1159,14 @@ contains
! checking the bit ordering architecture ! checking the bit ordering architecture
call check_endian call check_endian
! computing the bits/bytes sizes of real variables ! computing the bits/bytes sizes of real variables
BIR16P = bit_size(r=MaxR16P) ; BYR16P = BIR16P/8_I2P
BIR8P = bit_size(r=MaxR8P) ; BYR8P = BIR8P/8_I1P BIR8P = bit_size(r=MaxR8P) ; BYR8P = BIR8P/8_I1P
BIR4P = bit_size(r=MaxR4P) ; BYR4P = BIR4P/8_I1P BIR4P = bit_size(r=MaxR4P) ; BYR4P = BIR4P/8_I1P
BIR_P = bit_size(r=MaxR_P) ; BYR_P = BIR_P/8_I1P BIR_P = bit_size(r=MaxR_P) ; BYR_P = BIR_P/8_I1P
#ifdef r16p
BIR16P = bit_size(r=MaxR16P) ; BYR16P = BIR16P/8_I2P
#else
BIR16P = int(BIR8P,kind=I2P) ; BYR16P = BIR16P/8_I2P
#endif
ir_initialized = .true. ir_initialized = .true.
return return
!--------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------

View File

@ -749,7 +749,7 @@ contains
!--------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------
c = 1_I8P c = 1_I8P
do e=1_I8P,size(bits,dim=1),3_I8P ! loop over array elements: 3 bytes (24 bits) scanning do e=1_I8P,size(bits,dim=1,kind=I8P),3_I8P ! loop over array elements: 3 bytes (24 bits) scanning
sixb = 0_I1P sixb = 0_I1P
call mvbits(bits(e ),2,6,sixb(1),0) call mvbits(bits(e ),2,6,sixb(1),0)
call mvbits(bits(e ),0,2,sixb(2),4) ; call mvbits(bits(e+1),4,4,sixb(2),0) call mvbits(bits(e ),0,2,sixb(2),4) ; call mvbits(bits(e+1),4,4,sixb(2),0)

View File

@ -481,7 +481,7 @@ contains
integer function Get_Unit(Free_Unit) integer function Get_Unit(Free_Unit)
!--------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------
implicit none implicit none
integer(I4P), intent(OUT), optional:: Free_Unit !< Free logic unit. integer, intent(OUT), optional:: Free_Unit !< Free logic unit.
integer:: n1 !< Counter. integer:: n1 !< Counter.
integer:: ios !< Inquiring flag. integer:: ios !< Inquiring flag.
logical:: lopen !< Inquiring flag. logical:: lopen !< Inquiring flag.
@ -972,7 +972,7 @@ contains
case(binary) case(binary)
s_buffer=repeat(' ',vtk(rf)%indent)//'<DataArray type="Int32" NumberOfTuples="1" Name="'//trim(fname)//'" format="binary">' s_buffer=repeat(' ',vtk(rf)%indent)//'<DataArray type="Int32" NumberOfTuples="1" Name="'//trim(fname)//'" format="binary">'
write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec
Nfldp=size(transfer([int(BYI4P,I4P),fld],fldp)) ; if (allocated(fldp)) deallocate(fldp) ; allocate(fldp(1:Nfldp)) Nfldp=size(transfer([int(BYI4P,I4P),fld],fldp),kind=I8P) ; if (allocated(fldp)) deallocate(fldp) ; allocate(fldp(1:Nfldp))
fldp = transfer([int(BYI4P,I4P),fld],fldp) fldp = transfer([int(BYI4P,I4P),fld],fldp)
call b64_encode(nB=int(BYI1P,I4P),n=fldp,code=fld64) ; deallocate(fldp) call b64_encode(nB=int(BYI1P,I4P),n=fldp,code=fld64) ; deallocate(fldp)
write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//tochar(fld64)//end_rec ; deallocate(fld64) write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//tochar(fld64)//end_rec ; deallocate(fld64)
@ -2326,14 +2326,15 @@ contains
write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//'<Cells>'//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//'<Cells>'//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2
write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//& write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//&
'<DataArray type="Int32" Name="connectivity" format="binary">'//end_rec '<DataArray type="Int32" Name="connectivity" format="binary">'//end_rec
Ncocp=size(transfer([int(offset(NC)*BYI4P,I4P),connect],cocp)) ; if (allocated(cocp)) deallocate(cocp) ; allocate(cocp(1:Ncocp)) Ncocp=size(transfer([int(offset(NC)*BYI4P,I4P),connect],cocp),kind=I8P)
if (allocated(cocp)) deallocate(cocp) ; allocate(cocp(1:Ncocp))
cocp = transfer([int(offset(NC)*BYI4P,I4P),connect],cocp) cocp = transfer([int(offset(NC)*BYI4P,I4P),connect],cocp)
call b64_encode(nB=int(BYI1P,I4P),n=cocp,code=coc64) call b64_encode(nB=int(BYI1P,I4P),n=cocp,code=coc64)
deallocate(cocp) deallocate(cocp)
write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//tochar(coc64)//end_rec write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//tochar(coc64)//end_rec
write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//'</DataArray>'//end_rec write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//'</DataArray>'//end_rec
write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//'<DataArray type="Int32" Name="offsets" format="binary">'//end_rec write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//'<DataArray type="Int32" Name="offsets" format="binary">'//end_rec
Ncocp=size(transfer([int(NC*BYI4P,I4P),offset],cocp)) ; if (allocated(cocp)) deallocate(cocp) ; allocate(cocp(1:Ncocp)) Ncocp=size(transfer([int(NC*BYI4P,I4P),offset],cocp),kind=I8P) ; if (allocated(cocp)) deallocate(cocp) ; allocate(cocp(1:Ncocp))
cocp = transfer([int(NC*BYI4P,I4P),offset],cocp) cocp = transfer([int(NC*BYI4P,I4P),offset],cocp)
call b64_encode(nB=int(BYI1P,I4P),n=cocp,code=coc64) call b64_encode(nB=int(BYI1P,I4P),n=cocp,code=coc64)
deallocate(cocp) deallocate(cocp)
@ -2773,7 +2774,7 @@ contains
s_buffer=repeat(' ',vtk(rf)%indent)//'<DataArray type="Int32" Name="'//trim(varname)// & s_buffer=repeat(' ',vtk(rf)%indent)//'<DataArray type="Int32" Name="'//trim(varname)// &
'" NumberOfComponents="1" format="binary">' '" NumberOfComponents="1" format="binary">'
write(vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec write(vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec
Nvarp=size(transfer([int(NC_NN*BYI4P,I4P),var],varp)) ; if (allocated(varp)) deallocate(varp) ; allocate(varp(1:Nvarp)) Nvarp=size(transfer([int(NC_NN*BYI4P,I4P),var],varp),kind=I8P) ; if (allocated(varp)) deallocate(varp) ; allocate(varp(1:Nvarp))
varp = transfer([int(NC_NN*BYI4P,I4P),var],varp) varp = transfer([int(NC_NN*BYI4P,I4P),var],varp)
call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) ; deallocate(varp) call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) ; deallocate(varp)
write(vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//tochar(var64)//end_rec ; deallocate(var64) write(vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//tochar(var64)//end_rec ; deallocate(var64)
@ -2826,7 +2827,7 @@ contains
s_buffer=repeat(' ',vtk(rf)%indent)//'<DataArray type="Int32" Name="'//trim(varname)// & s_buffer=repeat(' ',vtk(rf)%indent)//'<DataArray type="Int32" Name="'//trim(varname)// &
'" NumberOfComponents="1" format="binary">' '" NumberOfComponents="1" format="binary">'
write(vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec write(vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec
Nvarp=size(transfer([int(NC_NN*BYI4P,I4P),reshape(var,[NC_NN])],varp)) Nvarp=size(transfer([int(NC_NN*BYI4P,I4P),reshape(var,[NC_NN])],varp),kind=I8P)
if (allocated(varp)) deallocate(varp); allocate(varp(1:Nvarp)) if (allocated(varp)) deallocate(varp); allocate(varp(1:Nvarp))
varp = transfer([int(NC_NN*BYI4P,I4P),reshape(var,[NC_NN])],varp) varp = transfer([int(NC_NN*BYI4P,I4P),reshape(var,[NC_NN])],varp)
call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) ; deallocate(varp) call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) ; deallocate(varp)
@ -3451,7 +3452,8 @@ contains
do n1=1,NC_NN do n1=1,NC_NN
var(1+(n1-1)*3:1+(n1-1)*3+2)=[varX(n1),varY(n1),varZ(n1)] var(1+(n1-1)*3:1+(n1-1)*3+2)=[varX(n1),varY(n1),varZ(n1)]
enddo enddo
Nvarp=size(transfer([int(3*NC_NN*BYI4P,I4P),var],varp)) ; if (allocated(varp)) deallocate(varp); allocate(varp(1:Nvarp)) Nvarp=size(transfer([int(3*NC_NN*BYI4P,I4P),var],varp),kind=I8P)
if (allocated(varp)) deallocate(varp); allocate(varp(1:Nvarp))
varp = transfer([int(3*NC_NN*BYI4P,I4P),var],varp) ; deallocate(var) varp = transfer([int(3*NC_NN*BYI4P,I4P),var],varp) ; deallocate(var)
call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) ; deallocate(varp) call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) ; deallocate(varp)
write(vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//tochar(var64)//end_rec ; deallocate(var64) write(vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//tochar(var64)//end_rec ; deallocate(var64)
@ -3515,7 +3517,8 @@ contains
do nz=1,size(varX,dim=3) ; do ny=1,size(varX,dim=2) ; do nx=1,size(varX,dim=1) do nz=1,size(varX,dim=3) ; do ny=1,size(varX,dim=2) ; do nx=1,size(varX,dim=1)
n1 = n1 + 1_I4P ; var(1+(n1-1)*3:1+(n1-1)*3+2)=[varX(nx,ny,nz),varY(nx,ny,nz),varZ(nx,ny,nz)] n1 = n1 + 1_I4P ; var(1+(n1-1)*3:1+(n1-1)*3+2)=[varX(nx,ny,nz),varY(nx,ny,nz),varZ(nx,ny,nz)]
enddo ; enddo ; enddo enddo ; enddo ; enddo
Nvarp=size(transfer([int(3*NC_NN*BYI4P,I4P),var],varp)) ; if (allocated(varp)) deallocate(varp); allocate(varp(1:Nvarp)) Nvarp=size(transfer([int(3*NC_NN*BYI4P,I4P),var],varp),kind=I8P)
if (allocated(varp)) deallocate(varp); allocate(varp(1:Nvarp))
varp = transfer([int(3*NC_NN*BYI4P,I4P),var],varp) ; deallocate(var) varp = transfer([int(3*NC_NN*BYI4P,I4P),var],varp) ; deallocate(var)
call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) ; deallocate(varp) call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) ; deallocate(varp)
write(vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//tochar(var64)//end_rec ; deallocate(var64) write(vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//tochar(var64)//end_rec ; deallocate(var64)
@ -4137,7 +4140,7 @@ contains
s_buffer = repeat(' ',vtk(rf)%indent)//'<DataArray type="Int32" Name="'//trim(varname)//'" NumberOfComponents="'// & s_buffer = repeat(' ',vtk(rf)%indent)//'<DataArray type="Int32" Name="'//trim(varname)//'" NumberOfComponents="'// &
trim(str(.true.,N_COL))//'" format="binary">' trim(str(.true.,N_COL))//'" format="binary">'
write(vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec write(vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec
Nvarp=size(transfer([int(N_COL*NC_NN*BYI4P,I4P),reshape(var,[N_COL*NC_NN])],varp)) Nvarp=size(transfer([int(N_COL*NC_NN*BYI4P,I4P),reshape(var,[N_COL*NC_NN])],varp),kind=I8P)
if (allocated(varp)) deallocate(varp); allocate(varp(1:Nvarp)) if (allocated(varp)) deallocate(varp); allocate(varp(1:Nvarp))
varp = transfer([int(N_COL*NC_NN*BYI4P,I4P),reshape(var,[N_COL*NC_NN])],varp) varp = transfer([int(N_COL*NC_NN*BYI4P,I4P),reshape(var,[N_COL*NC_NN])],varp)
call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) ; deallocate(varp) call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) ; deallocate(varp)
@ -4194,7 +4197,7 @@ contains
s_buffer = repeat(' ',vtk(rf)%indent)//'<DataArray type="Int32" Name="'//trim(varname)//'" NumberOfComponents="'// & s_buffer = repeat(' ',vtk(rf)%indent)//'<DataArray type="Int32" Name="'//trim(varname)//'" NumberOfComponents="'// &
trim(str(.true.,N_COL))//'" format="binary">' trim(str(.true.,N_COL))//'" format="binary">'
write(vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec write(vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec
Nvarp=size(transfer([int(N_COL*NC_NN*BYI4P,I4P),reshape(var,[N_COL*NC_NN])],varp)) Nvarp=size(transfer([int(N_COL*NC_NN*BYI4P,I4P),reshape(var,[N_COL*NC_NN])],varp),kind=I8P)
if (allocated(varp)) deallocate(varp); allocate(varp(1:Nvarp)) if (allocated(varp)) deallocate(varp); allocate(varp(1:Nvarp))
varp = transfer([int(N_COL*NC_NN*BYI4P,I4P),reshape(var,[N_COL*NC_NN])],varp) varp = transfer([int(N_COL*NC_NN*BYI4P,I4P),reshape(var,[N_COL*NC_NN])],varp)
call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) ; deallocate(varp) call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) ; deallocate(varp)
@ -4518,7 +4521,8 @@ contains
if (vtk(rf)%f==raw) then if (vtk(rf)%f==raw) then
write(unit=vtk(rf)%u,iostat=E_IO)int(vtk(rf)%N_Byte,I4P),(v_I4(n1),n1=1,N_v) write(unit=vtk(rf)%u,iostat=E_IO)int(vtk(rf)%N_Byte,I4P),(v_I4(n1),n1=1,N_v)
else else
Nvarp=size(transfer([int(vtk(rf)%N_Byte,I4P),v_I4],varp)) ; if (allocated(varp)) deallocate(varp); allocate(varp(1:Nvarp)) Nvarp=size(transfer([int(vtk(rf)%N_Byte,I4P),v_I4],varp),kind=I8P)
if (allocated(varp)) deallocate(varp); allocate(varp(1:Nvarp))
varp = transfer([int(vtk(rf)%N_Byte,I4P),v_I4],varp) varp = transfer([int(vtk(rf)%N_Byte,I4P),v_I4],varp)
call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) ; deallocate(varp) call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) ; deallocate(varp)
write(unit=vtk(rf)%u,iostat=E_IO)tochar(var64) ; deallocate(var64) write(unit=vtk(rf)%u,iostat=E_IO)tochar(var64) ; deallocate(var64)
@ -5840,7 +5844,7 @@ contains
integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO).
integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done.
integer(I4P):: rf !< Real file index. integer(I4P):: rf !< Real file index.
integer(I8P):: n1 !< Counter. integer(I4P):: n1 !< Counter.
!--------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------
@ -5886,7 +5890,7 @@ contains
integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO).
integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done.
integer(I4P):: rf !< Real file index. integer(I4P):: rf !< Real file index.
integer(I8P):: n1 !< Counter. integer(I4P):: n1 !< Counter.
!--------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------
@ -5931,7 +5935,7 @@ contains
integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO).
integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done.
integer(I4P):: rf !< Real file index. integer(I4P):: rf !< Real file index.
integer(I8P):: n1 !< Counter. integer(I4P):: n1 !< Counter.
!--------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------
@ -5966,7 +5970,7 @@ contains
integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done.
character(len=maxlen):: s_buffer !< Buffer string. character(len=maxlen):: s_buffer !< Buffer string.
integer(I4P):: rf !< Real file index. integer(I4P):: rf !< Real file index.
integer(I8P):: n1,n2 !< Counters. integer(I4P):: n1,n2 !< Counters.
!--------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------
@ -6008,7 +6012,7 @@ contains
integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done.
character(len=maxlen):: s_buffer !< Buffer string. character(len=maxlen):: s_buffer !< Buffer string.
integer(I4P):: rf !< Real file index. integer(I4P):: rf !< Real file index.
integer(I8P):: n1,n2 !< Counters. integer(I4P):: n1,n2 !< Counters.
!--------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------
!--------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------