370 integer,
intent(in) :: qunit
372 double precision :: x_TEC(ndim), w_TEC(nw+nwauxio)
373 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC_TMP
374 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC_TMP
375 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC
376 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC
377 double precision,
dimension(ixMlo^D-1:ixMhi^D,nw+nwauxio) :: wC_TMP
378 double precision,
dimension(ixMlo^D:ixMhi^D,nw+nwauxio) :: wCC_TMP
379 double precision,
dimension(0:nw+nwauxio) :: normconv
380 integer:: igrid,iigrid,level,igonlevel,iw,idim,ix^D
381 integer:: NumGridsOnLevel(1:nlevelshi)
382 integer :: nx^D,nxC^D,nodesonlevel,elemsonlevel,ixC^L,ixCC^L
383 integer :: nodes, elems
385 logical :: fileopen,first
386 character(len=80) :: filename
388 character(len=1024) :: tecplothead
389 character(len=name_len) :: wnamei(1:nw+nwauxio),xandwnamei(1:ndim+nw+nwauxio)
390 character(len=1024) :: outfilehead
393 if(
mype==0) print *,
'tecplot not parallel, use tecplotmpi'
394 call mpistop(
'npe>1, tecplot')
397 if(nw/=count(
w_write(1:nw)))
then
398 if(
mype==0) print *,
'tecplot does not use w_write=F'
399 call mpistop(
'w_write, tecplot')
403 if(
mype==0) print *,
'tecplot with nocartesian'
406 inquire(qunit,opened=fileopen)
407 if(.not.fileopen)
then
411 write(filename,
'(a,i4.4,a)') trim(
base_filename),filenr,
".plt"
412 open(qunit,file=filename,status=
'unknown')
417 write(tecplothead,
'(a)')
"VARIABLES = "//trim(outfilehead)
418 write(qunit,
'(a)') tecplothead(1:len_trim(tecplothead))
420 numgridsonlevel(1:nlevelshi)=0
422 numgridsonlevel(level)=0
423 do iigrid=1,igridstail; igrid=igrids(iigrid);
425 numgridsonlevel(level)=numgridsonlevel(level)+1
429 nx^d=ixmhi^d-ixmlo^d+1;
437 nodes=nodes + numgridsonlevel(level)*{nxc^d*}
438 elems=elems + numgridsonlevel(level)*{nx^d*}
441 write(qunit,
"(a,i7,a,1pe12.5,a)") &
442 'ZONE T="all levels", I=',elems, &
446 do iigrid=1,igridstail; igrid=igrids(iigrid);
449 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,ixc^l,ixcc^l,.true.)
450 {
do ix^db=ixccmin^db,ixccmax^db\}
451 x_tec(1:ndim)=xcc_tmp(ix^d,1:ndim)*normconv(0)
452 w_tec(1:nw+nwauxio)=wcc_tmp(ix^d,1:nw+nwauxio)*normconv(1:nw+nwauxio)
453 write(qunit,fmt=
"(100(e24.16))") x_tec, w_tec
459 do level=levmin,levmax
460 nodesonlevel=numgridsonlevel(level)*{nxc^d*}
461 elemsonlevel=numgridsonlevel(level)*{nx^d*}
468 select case(convert_type)
473 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,a)") &
474 'ZONE T="',level,
'"',
', N=',nodesonlevel,
', E=',elemsonlevel, &
475 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=POINT, ZONETYPE=', &
476 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
477 do iigrid=1,igridstail; igrid=igrids(iigrid);
478 if (node(plevel_,igrid)/=level) cycle
480 call calc_x(igrid,xc,xcc)
481 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
483 {
do ix^db=ixcmin^db,ixcmax^db\}
484 x_tec(1:ndim)=xc_tmp(ix^d,1:ndim)*normconv(0)
485 w_tec(1:nw+nwauxio)=wc_tmp(ix^d,1:nw+nwauxio)*normconv(1:nw+nwauxio)
486 write(qunit,fmt=
"(100(e14.6))") x_tec, w_tec
495 if(ndim+nw+nwauxio>99)
call mpistop(
"adjust format specification in writeout")
496 if(nw+nwauxio==1)
then
499 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,i1,a,a)") &
500 'ZONE T="',level,
'"',
', N=',nodesonlevel,
', E=',elemsonlevel, &
501 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=BLOCK, VARLOCATION=([', &
502 ndim+1,
']=CELLCENTERED), ZONETYPE=', &
503 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
505 if(ndim+nw+nwauxio<10)
then
507 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,i1,a,i1,a,a)") &
508 'ZONE T="',level,
'"',
', N=',nodesonlevel,
', E=',elemsonlevel, &
509 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=BLOCK, VARLOCATION=([', &
510 ndim+1,
'-',ndim+nw+nwauxio,
']=CELLCENTERED), ZONETYPE=', &
511 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
513 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,i1,a,i2,a,a)") &
514 'ZONE T="',level,
'"',
', N=',nodesonlevel,
', E=',elemsonlevel, &
515 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=BLOCK, VARLOCATION=([', &
516 ndim+1,
'-',ndim+nw+nwauxio,
']=CELLCENTERED), ZONETYPE=', &
517 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
522 do iigrid=1,igridstail; igrid=igrids(iigrid);
523 if (node(plevel_,igrid)/=level) cycle
525 call calc_x(igrid,xc,xcc)
526 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
528 write(qunit,fmt=
"(100(e14.6))") xc_tmp(ixc^s,idim)*normconv(0)
532 do iigrid=1,igridstail; igrid=igrids(iigrid);
533 if (node(plevel_,igrid)/=level) cycle
535 call calc_x(igrid,xc,xcc)
536 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
538 write(qunit,fmt=
"(100(e14.6))") wcc_tmp(ixcc^s,iw)*normconv(iw)
542 call mpistop(
'no such tecplot type')
545 do iigrid=1,igridstail; igrid=igrids(iigrid);
546 if (node(plevel_,igrid)/=level) cycle
548 igonlevel=igonlevel+1
806 integer,
intent(in) :: qunit
808 double precision :: x_VTK(1:3)
809 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC_TMP
810 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC_TMP
811 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC
812 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC
813 double precision,
dimension(ixMlo^D-1:ixMhi^D,nw+nwauxio):: wC_TMP
814 double precision,
dimension(ixMlo^D:ixMhi^D,nw+nwauxio) :: wCC_TMP
815 double precision :: normconv(0:nw+nwauxio)
816 integer,
allocatable :: intstatus(:,:)
818 integer :: itag,ipe,igrid,level,icel,ixC^L,ixCC^L,Morton_no,Morton_length
819 integer :: nx^D,nxC^D,nc,np,VTK_type,ix^D,filenr
821 integer:: length,lengthcc,length_coords,length_conn,length_offsets
823 character(len=80):: filename
824 character(len=19):: offset_char
825 character(len=name_len) :: wnamei(1:nw+nwauxio),xandwnamei(1:ndim+nw+nwauxio)
826 character(len=1024) :: outfilehead
827 logical :: fileopen,cell_corner=.false.
828 logical,
allocatable :: Morton_aim(:),Morton_aim_p(:)
843 if(({
rnode(
rpxmin^
d_,igrid)>=xprobmin^d+(xprobmax^d-xprobmin^d)&
845 <=xprobmax^d-(xprobmax^d-xprobmin^d)*
writespshift(^d,2)|.and.}))
then
846 morton_aim_p(morton_no)=.true.
850 call mpi_allreduce(morton_aim_p,morton_aim,morton_length,mpi_logical,mpi_lor,&
853 case(
'vtuB',
'vtuBmpi')
855 case(
'vtuBCC',
'vtuBCCmpi')
860 if(.not. morton_aim(morton_no)) cycle
863 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
877 inquire(qunit,opened=fileopen)
878 if(.not.fileopen)
then
882 write(filename,
'(a,i4.4,a)') trim(
base_filename),filenr,
".vtu"
884 open(qunit,file=filename,status=
'replace')
888 write(qunit,
'(a)')
'<?xml version="1.0"?>'
889 write(qunit,
'(a)',advance=
'no')
'<VTKFile type="UnstructuredGrid"'
890 write(qunit,
'(a)')
' version="0.1" byte_order="LittleEndian">'
891 write(qunit,
'(a)')
'<UnstructuredGrid>'
892 write(qunit,
'(a)')
'<FieldData>'
893 write(qunit,
'(2a)')
'<DataArray type="Float32" Name="TIME" ',&
894 'NumberOfTuples="1" format="ascii">'
896 write(qunit,
'(a)')
'</DataArray>'
897 write(qunit,
'(a)')
'</FieldData>'
900 nx^d=ixmhi^d-ixmlo^d+1;
905 lengthcc=nc*size_real
906 length_coords=3*length
907 length_conn=2**^nd*size_int*nc
908 length_offsets=nc*size_int
912 if(.not. morton_aim(morton_no)) cycle
915 write(qunit,
'(a,i7,a,i7,a)') &
916 '<Piece NumberOfPoints="',np,
'" NumberOfCells="',nc,
'">'
917 write(qunit,
'(a)')
'<PointData>'
922 write(offset_char,
'(i19)') offset
923 write(qunit,
'(a,a,a,a,a)')&
924 '<DataArray type="Float32" Name="',trim(wnamei(iw)), &
925 '" format="appended" offset="',trim(adjustl(offset_char)),
'">'
926 write(qunit,
'(a)')
'</DataArray>'
927 offset=offset+length+size_int
929 write(qunit,
'(a)')
'</PointData>'
930 write(qunit,
'(a)')
'<Points>'
931 write(offset_char,
'(i19)') offset
932 write(qunit,
'(a,a,a)') &
933 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
935 offset=offset+length_coords+size_int
936 write(qunit,
'(a)')
'</Points>'
939 write(qunit,
'(a,i7,a,i7,a)') &
940 '<Piece NumberOfPoints="',np,
'" NumberOfCells="',nc,
'">'
941 write(qunit,
'(a)')
'<CellData>'
946 write(offset_char,
'(i19)') offset
947 write(qunit,
'(a,a,a,a,a)')&
948 '<DataArray type="Float32" Name="',trim(wnamei(iw)), &
949 '" format="appended" offset="',trim(adjustl(offset_char)),
'">'
950 write(qunit,
'(a)')
'</DataArray>'
951 offset=offset+lengthcc+size_int
953 write(qunit,
'(a)')
'</CellData>'
954 write(qunit,
'(a)')
'<Points>'
955 write(offset_char,
'(i19)') offset
956 write(qunit,
'(a,a,a)') &
957 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
959 offset=offset+length_coords+size_int
960 write(qunit,
'(a)')
'</Points>'
962 write(qunit,
'(a)')
'<Cells>'
964 write(offset_char,
'(i19)') offset
965 write(qunit,
'(a,a,a)')&
966 '<DataArray type="Int32" Name="connectivity" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
967 offset=offset+length_conn+size_int
969 write(offset_char,
'(i19)') offset
970 write(qunit,
'(a,a,a)') &
971 '<DataArray type="Int32" Name="offsets" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
972 offset=offset+length_offsets+size_int
974 write(offset_char,
'(i19)') offset
975 write(qunit,
'(a,a,a)') &
976 '<DataArray type="Int32" Name="types" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
977 offset=offset+size_int+nc*size_int
978 write(qunit,
'(a)')
'</Cells>'
979 write(qunit,
'(a)')
'</Piece>'
985 if(.not. morton_aim(morton_no)) cycle
988 write(qunit,
'(a,i7,a,i7,a)') &
989 '<Piece NumberOfPoints="',np,
'" NumberOfCells="',nc,
'">'
990 write(qunit,
'(a)')
'<PointData>'
995 write(offset_char,
'(i19)') offset
996 write(qunit,
'(a,a,a,a,a)')&
997 '<DataArray type="Float32" Name="',trim(wnamei(iw)), &
998 '" format="appended" offset="',trim(adjustl(offset_char)),
'">'
999 write(qunit,
'(a)')
'</DataArray>'
1000 offset=offset+length+size_int
1002 write(qunit,
'(a)')
'</PointData>'
1003 write(qunit,
'(a)')
'<Points>'
1004 write(offset_char,
'(i19)') offset
1005 write(qunit,
'(a,a,a)') &
1006 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
1008 offset=offset+length_coords+size_int
1009 write(qunit,
'(a)')
'</Points>'
1012 write(qunit,
'(a,i7,a,i7,a)') &
1013 '<Piece NumberOfPoints="',np,
'" NumberOfCells="',nc,
'">'
1014 write(qunit,
'(a)')
'<CellData>'
1019 write(offset_char,
'(i19)') offset
1020 write(qunit,
'(a,a,a,a,a)')&
1021 '<DataArray type="Float32" Name="',trim(wnamei(iw)), &
1022 '" format="appended" offset="',trim(adjustl(offset_char)),
'">'
1023 write(qunit,
'(a)')
'</DataArray>'
1024 offset=offset+lengthcc+size_int
1026 write(qunit,
'(a)')
'</CellData>'
1027 write(qunit,
'(a)')
'<Points>'
1028 write(offset_char,
'(i19)') offset
1029 write(qunit,
'(a,a,a)') &
1030 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
1032 offset=offset+length_coords+size_int
1033 write(qunit,
'(a)')
'</Points>'
1035 write(qunit,
'(a)')
'<Cells>'
1037 write(offset_char,
'(i19)') offset
1038 write(qunit,
'(a,a,a)')&
1039 '<DataArray type="Int32" Name="connectivity" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
1040 offset=offset+length_conn+size_int
1042 write(offset_char,
'(i19)') offset
1043 write(qunit,
'(a,a,a)') &
1044 '<DataArray type="Int32" Name="offsets" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
1045 offset=offset+length_offsets+size_int
1047 write(offset_char,
'(i19)') offset
1048 write(qunit,
'(a,a,a)') &
1049 '<DataArray type="Int32" Name="types" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
1050 offset=offset+size_int+nc*size_int
1051 write(qunit,
'(a)')
'</Cells>'
1052 write(qunit,
'(a)')
'</Piece>'
1057 write(qunit,
'(a)')
'</UnstructuredGrid>'
1058 write(qunit,
'(a)')
'<AppendedData encoding="raw">'
1060 open(qunit,file=filename,access=
'stream',form=
'unformatted',position=
'append')
1062 write(qunit) trim(buf)
1065 if(.not. morton_aim(morton_no)) cycle
1067 call calc_x(igrid,xc,xcc)
1068 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
1069 ixc^l,ixcc^l,.true.)
1074 if(cell_corner)
then
1076 write(qunit) {(|}real(wc_tmp(ix^d,iw)*normconv(iw)),{ix^d=ixcmin^d,ixcmax^d)}
1078 write(qunit) lengthcc
1079 write(qunit) {(|}real(wcc_tmp(ix^d,iw)*normconv(iw)),{ix^d=ixccmin^d,ixccmax^d)}
1083 write(qunit) length_coords
1084 {
do ix^db=ixcmin^db,ixcmax^db \}
1086 x_vtk(1:ndim)=xc_tmp(ix^d,1:ndim)*normconv(0);
1088 write(qunit) real(x_vtk(k))
1092 write(qunit) length_conn
1094 {^ifoned
write(qunit)ix1-1,ix1 \}
1096 write(qunit)(ix2-1)*nxc1+ix1-1, &
1097 (ix2-1)*nxc1+ix1,ix2*nxc1+ix1-1,ix2*nxc1+ix1
1101 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1-1, &
1102 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
1103 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1-1,&
1104 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1,&
1105 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1-1,&
1106 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
1107 ix3*nxc2*nxc1+ ix2*nxc1+ix1-1,&
1108 ix3*nxc2*nxc1+ ix2*nxc1+ix1
1112 write(qunit) length_offsets
1114 write(qunit) icel*(2**^nd)
1117 {^ifoned vtk_type=3 \}
1118 {^iftwod vtk_type=8 \}
1119 {^ifthreed vtk_type=11 \}
1120 write(qunit) size_int*nc
1122 write(qunit) vtk_type
1125 allocate(intstatus(mpi_status_size,1))
1127 ixccmin^d=ixmlo^d; ixccmax^d=ixmhi^d;
1128 ixcmin^d=ixmlo^d-1; ixcmax^d=ixmhi^d;
1130 do morton_no=morton_start(ipe),morton_stop(ipe)
1131 if(.not. morton_aim(morton_no)) cycle
1133 call mpi_recv(xc_tmp,1,type_block_xc_io, ipe,itag,icomm,intstatus(:,1),ierrmpi)
1134 if(cell_corner)
then
1135 call mpi_recv(wc_tmp,1,type_block_wc_io, ipe,itag,icomm,intstatus(:,1),ierrmpi)
1137 call mpi_recv(wcc_tmp,1,type_block_wcc_io, ipe,itag,icomm,intstatus(:,1),ierrmpi)
1141 if(.not.w_write(iw)) cycle
1143 if(cell_corner)
then
1145 write(qunit) {(|}real(wc_tmp(ix^d,iw)*normconv(iw)),{ix^d=ixcmin^d,ixcmax^d)}
1147 write(qunit) lengthcc
1148 write(qunit) {(|}real(wcc_tmp(ix^d,iw)*normconv(iw)),{ix^d=ixccmin^d,ixccmax^d)}
1151 write(qunit) length_coords
1152 {
do ix^db=ixcmin^db,ixcmax^db \}
1154 x_vtk(1:ndim)=xc_tmp(ix^d,1:ndim)*normconv(0);
1156 write(qunit) real(x_vtk(k))
1159 write(qunit) length_conn
1161 {^ifoned
write(qunit)ix1-1,ix1 \}
1163 write(qunit)(ix2-1)*nxc1+ix1-1, &
1164 (ix2-1)*nxc1+ix1,ix2*nxc1+ix1-1,ix2*nxc1+ix1
1168 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1-1, &
1169 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
1170 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1-1,&
1171 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1,&
1172 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1-1,&
1173 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
1174 ix3*nxc2*nxc1+ ix2*nxc1+ix1-1,&
1175 ix3*nxc2*nxc1+ ix2*nxc1+ix1
1178 write(qunit) length_offsets
1180 write(qunit) icel*(2**^nd)
1182 {^ifoned vtk_type=3 \}
1183 {^iftwod vtk_type=8 \}
1184 {^ifthreed vtk_type=11 \}
1185 write(qunit) size_int*nc
1187 write(qunit) vtk_type
1193 open(qunit,file=filename,status=
'unknown',form=
'formatted',position=
'append')
1194 write(qunit,
'(a)')
'</AppendedData>'
1195 write(qunit,
'(a)')
'</VTKFile>'
1197 deallocate(intstatus)
1200 deallocate(morton_aim,morton_aim_p)
1202 call mpi_barrier(icomm,ierrmpi)
1215 integer,
intent(in) :: qunit
1217 double precision :: x_VTK(1:3)
1218 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC_TMP
1219 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC_TMP
1220 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC
1221 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC
1222 double precision,
dimension(ixMlo^D-1:ixMhi^D,nw+nwauxio):: wC_TMP
1223 double precision,
dimension(ixMlo^D:ixMhi^D,nw+nwauxio) :: wCC_TMP
1224 double precision :: normconv(0:nw+nwauxio)
1225 integer,
allocatable :: intstatus(:,:)
1227 integer :: itag,ipe,igrid,level,icel,ixC^L,ixCC^L,Morton_no,Morton_length
1228 integer :: nx^D,nxC^D,nc,np,VTK_type,ix^D,filenr
1230 integer:: length,lengthcc,length_coords,length_conn,length_offsets
1232 character(len=80):: filename
1233 character(len=name_len) :: wnamei(1:nw+nwauxio),xandwnamei(1:ndim+nw+nwauxio)
1234 character(len=1024) :: outfilehead
1235 logical :: fileopen,cell_corner=.false.
1236 logical,
allocatable :: Morton_aim(:),Morton_aim_p(:)
1243 morton_aim_p=.false.
1251 if(({
rnode(
rpxmin^
d_,igrid)>=xprobmin^d+(xprobmax^d-xprobmin^d)&
1253 <=xprobmax^d-(xprobmax^d-xprobmin^d)*
writespshift(^d,2)|.and.}))
then
1254 morton_aim_p(morton_no)=.true.
1258 call mpi_allreduce(morton_aim_p,morton_aim,morton_length,mpi_logical,mpi_lor,&
1261 case(
'vtuB64',
'vtuBmpi64')
1263 case(
'vtuBCC64',
'vtuBCCmpi64')
1268 if(.not. morton_aim(morton_no)) cycle
1270 call calc_x(igrid,xc,xcc)
1271 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
1272 ixc^l,ixcc^l,.true.)
1275 if(cell_corner)
then
1284 inquire(qunit,opened=fileopen)
1285 if(.not.fileopen)
then
1289 write(filename,
'(a,i4.4,a)') trim(
base_filename),filenr,
".vtu"
1291 open(qunit,file=filename,status=
'replace')
1295 write(qunit,
'(a)')
'<?xml version="1.0"?>'
1296 write(qunit,
'(a)',advance=
'no')
'<VTKFile type="UnstructuredGrid"'
1297 write(qunit,
'(a)')
' version="0.1" byte_order="LittleEndian">'
1298 write(qunit,
'(a)')
'<UnstructuredGrid>'
1299 write(qunit,
'(a)')
'<FieldData>'
1300 write(qunit,
'(2a)')
'<DataArray type="Float32" Name="TIME" ',&
1301 'NumberOfTuples="1" format="ascii">'
1303 write(qunit,
'(a)')
'</DataArray>'
1304 write(qunit,
'(a)')
'</FieldData>'
1306 nx^d=ixmhi^d-ixmlo^d+1;
1310 length=np*size_double
1311 lengthcc=nc*size_double
1312 length_coords=3*length
1313 length_conn=2**^nd*size_int*nc
1314 length_offsets=nc*size_int
1317 if(.not. morton_aim(morton_no)) cycle
1318 if(cell_corner)
then
1320 write(qunit,
'(a,i7,a,i7,a)') &
1321 '<Piece NumberOfPoints="',np,
'" NumberOfCells="',nc,
'">'
1322 write(qunit,
'(a)')
'<PointData>'
1327 write(qunit,
'(a,a,a,i16,a)')&
1328 '<DataArray type="Float64" Name="',trim(wnamei(iw)), &
1329 '" format="appended" offset="',offset,
'">'
1330 write(qunit,
'(a)')
'</DataArray>'
1331 offset=offset+length+size_int
1333 write(qunit,
'(a)')
'</PointData>'
1334 write(qunit,
'(a)')
'<Points>'
1335 write(qunit,
'(a,i16,a)') &
1336 '<DataArray type="Float64" NumberOfComponents="3" format="appended" offset="',offset,
'"/>'
1338 offset=offset+length_coords+size_int
1339 write(qunit,
'(a)')
'</Points>'
1342 write(qunit,
'(a,i7,a,i7,a)') &
1343 '<Piece NumberOfPoints="',np,
'" NumberOfCells="',nc,
'">'
1344 write(qunit,
'(a)')
'<CellData>'
1349 write(qunit,
'(a,a,a,i16,a)')&
1350 '<DataArray type="Float64" Name="',trim(wnamei(iw)), &
1351 '" format="appended" offset="',offset,
'">'
1352 write(qunit,
'(a)')
'</DataArray>'
1353 offset=offset+lengthcc+size_int
1355 write(qunit,
'(a)')
'</CellData>'
1356 write(qunit,
'(a)')
'<Points>'
1357 write(qunit,
'(a,i16,a)') &
1358 '<DataArray type="Float64" NumberOfComponents="3" format="appended" offset="',offset,
'"/>'
1360 offset=offset+length_coords+size_int
1361 write(qunit,
'(a)')
'</Points>'
1363 write(qunit,
'(a)')
'<Cells>'
1365 write(qunit,
'(a,i16,a)')&
1366 '<DataArray type="Int32" Name="connectivity" format="appended" offset="',offset,
'"/>'
1367 offset=offset+length_conn+size_int
1369 write(qunit,
'(a,i16,a)') &
1370 '<DataArray type="Int32" Name="offsets" format="appended" offset="',offset,
'"/>'
1371 offset=offset+length_offsets+size_int
1373 write(qunit,
'(a,i16,a)') &
1374 '<DataArray type="Int32" Name="types" format="appended" offset="',offset,
'"/>'
1375 offset=offset+size_int+nc*size_int
1376 write(qunit,
'(a)')
'</Cells>'
1377 write(qunit,
'(a)')
'</Piece>'
1383 if(.not. morton_aim(morton_no)) cycle
1384 if(cell_corner)
then
1386 write(qunit,
'(a,i7,a,i7,a)') &
1387 '<Piece NumberOfPoints="',np,
'" NumberOfCells="',nc,
'">'
1388 write(qunit,
'(a)')
'<PointData>'
1393 write(qunit,
'(a,a,a,i16,a)')&
1394 '<DataArray type="Float64" Name="',trim(wnamei(iw)), &
1395 '" format="appended" offset="',offset,
'">'
1396 write(qunit,
'(a)')
'</DataArray>'
1397 offset=offset+length+size_int
1399 write(qunit,
'(a)')
'</PointData>'
1400 write(qunit,
'(a)')
'<Points>'
1401 write(qunit,
'(a,i16,a)') &
1402 '<DataArray type="Float64" NumberOfComponents="3" format="appended" offset="',offset,
'"/>'
1404 offset=offset+length_coords+size_int
1405 write(qunit,
'(a)')
'</Points>'
1408 write(qunit,
'(a,i7,a,i7,a)') &
1409 '<Piece NumberOfPoints="',np,
'" NumberOfCells="',nc,
'">'
1410 write(qunit,
'(a)')
'<CellData>'
1415 write(qunit,
'(a,a,a,i16,a)')&
1416 '<DataArray type="Float64" Name="',trim(wnamei(iw)), &
1417 '" format="appended" offset="',offset,
'">'
1418 write(qunit,
'(a)')
'</DataArray>'
1419 offset=offset+lengthcc+size_int
1421 write(qunit,
'(a)')
'</CellData>'
1422 write(qunit,
'(a)')
'<Points>'
1423 write(qunit,
'(a,i16,a)') &
1424 '<DataArray type="Float64" NumberOfComponents="3" format="appended" offset="',offset,
'"/>'
1426 offset=offset+length_coords+size_int
1427 write(qunit,
'(a)')
'</Points>'
1429 write(qunit,
'(a)')
'<Cells>'
1431 write(qunit,
'(a,i16,a)')&
1432 '<DataArray type="Int32" Name="connectivity" format="appended" offset="',offset,
'"/>'
1433 offset=offset+length_conn+size_int
1435 write(qunit,
'(a,i16,a)') &
1436 '<DataArray type="Int32" Name="offsets" format="appended" offset="',offset,
'"/>'
1437 offset=offset+length_offsets+size_int
1439 write(qunit,
'(a,i16,a)') &
1440 '<DataArray type="Int32" Name="types" format="appended" offset="',offset,
'"/>'
1441 offset=offset+size_int+nc*size_int
1442 write(qunit,
'(a)')
'</Cells>'
1443 write(qunit,
'(a)')
'</Piece>'
1447 write(qunit,
'(a)')
'</UnstructuredGrid>'
1448 write(qunit,
'(a)')
'<AppendedData encoding="raw">'
1450 open(qunit,file=filename,access=
'stream',form=
'unformatted',position=
'append')
1452 write(qunit) trim(buf)
1454 if(.not. morton_aim(morton_no)) cycle
1456 call calc_x(igrid,xc,xcc)
1457 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
1458 ixc^l,ixcc^l,.true.)
1463 if(cell_corner)
then
1465 write(qunit) {(|}wc_tmp(ix^d,iw)*normconv(iw),{ix^d=ixcmin^d,ixcmax^d)}
1467 write(qunit) lengthcc
1468 write(qunit) {(|}wcc_tmp(ix^d,iw)*normconv(iw),{ix^d=ixccmin^d,ixccmax^d)}
1471 write(qunit) length_coords
1472 {
do ix^db=ixcmin^db,ixcmax^db \}
1474 x_vtk(1:ndim)=xc_tmp(ix^d,1:ndim)*normconv(0);
1476 write(qunit) x_vtk(k)
1479 write(qunit) length_conn
1481 {^ifoned
write(qunit)ix1-1,ix1 \}
1483 write(qunit)(ix2-1)*nxc1+ix1-1, &
1484 (ix2-1)*nxc1+ix1,ix2*nxc1+ix1-1,ix2*nxc1+ix1
1488 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1-1, &
1489 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
1490 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1-1,&
1491 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1,&
1492 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1-1,&
1493 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
1494 ix3*nxc2*nxc1+ ix2*nxc1+ix1-1,&
1495 ix3*nxc2*nxc1+ ix2*nxc1+ix1
1498 write(qunit) length_offsets
1500 write(qunit) icel*(2**^nd)
1502 {^ifoned vtk_type=3 \}
1503 {^iftwod vtk_type=8 \}
1504 {^ifthreed vtk_type=11 \}
1505 write(qunit) size_int*nc
1507 write(qunit) vtk_type
1510 allocate(intstatus(mpi_status_size,1))
1512 ixccmin^d=ixmlo^d; ixccmax^d=ixmhi^d;
1513 ixcmin^d=ixmlo^d-1; ixcmax^d=ixmhi^d;
1515 do morton_no=morton_start(ipe),morton_stop(ipe)
1516 if(.not. morton_aim(morton_no)) cycle
1518 call mpi_recv(xc_tmp,1,type_block_xc_io, ipe,itag,icomm,intstatus(:,1),ierrmpi)
1519 if(cell_corner)
then
1520 call mpi_recv(wc_tmp,1,type_block_wc_io, ipe,itag,icomm,intstatus(:,1),ierrmpi)
1522 call mpi_recv(wcc_tmp,1,type_block_wcc_io, ipe,itag,icomm,intstatus(:,1),ierrmpi)
1526 if(.not.w_write(iw)) cycle
1528 if(cell_corner)
then
1530 write(qunit) {(|}wc_tmp(ix^d,iw)*normconv(iw),{ix^d=ixcmin^d,ixcmax^d)}
1532 write(qunit) lengthcc
1533 write(qunit) {(|}wcc_tmp(ix^d,iw)*normconv(iw),{ix^d=ixccmin^d,ixccmax^d)}
1536 write(qunit) length_coords
1537 {
do ix^db=ixcmin^db,ixcmax^db \}
1539 x_vtk(1:ndim)=xc_tmp(ix^d,1:ndim)*normconv(0);
1541 write(qunit) x_vtk(k)
1544 write(qunit) length_conn
1546 {^ifoned
write(qunit)ix1-1,ix1 \}
1548 write(qunit)(ix2-1)*nxc1+ix1-1, &
1549 (ix2-1)*nxc1+ix1,ix2*nxc1+ix1-1,ix2*nxc1+ix1
1553 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1-1, &
1554 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
1555 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1-1,&
1556 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1,&
1557 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1-1,&
1558 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
1559 ix3*nxc2*nxc1+ ix2*nxc1+ix1-1,&
1560 ix3*nxc2*nxc1+ ix2*nxc1+ix1
1563 write(qunit) length_offsets
1565 write(qunit) icel*(2**^nd)
1567 {^ifoned vtk_type=3 \}
1568 {^iftwod vtk_type=8 \}
1569 {^ifthreed vtk_type=11 \}
1570 write(qunit) size_int*nc
1572 write(qunit) vtk_type
1578 open(qunit,file=filename,status=
'unknown',form=
'formatted',position=
'append')
1579 write(qunit,
'(a)')
'</AppendedData>'
1580 write(qunit,
'(a)')
'</VTKFile>'
1582 deallocate(intstatus)
1584 deallocate(morton_aim,morton_aim_p)
1586 call mpi_barrier(icomm,ierrmpi)
1878 integer,
intent(in) :: qunit
1880 double precision :: x_VTK(1:3)
1881 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC_TMP,xC_TMP_recv
1882 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC_TMP,xCC_TMP_recv
1883 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC
1884 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC
1885 double precision,
dimension(ixMlo^D-1:ixMhi^D,nw+nwauxio) :: wC_TMP,wC_TMP_recv
1886 double precision,
dimension(ixMlo^D:ixMhi^D,nw+nwauxio) :: wCC_TMP,wCC_TMP_recv
1887 double precision,
dimension(0:nw+nwauxio) :: normconv
1888 integer:: igrid,iigrid,level,ixC^L,ixCC^L
1889 integer:: NumGridsOnLevel(1:nlevelshi)
1890 integer :: nx^D,nxC^D,nodesonlevel,elemsonlevel,nc,np,ix^D
1892 integer :: itag,ipe,Morton_no,siz_ind
1893 integer :: ind_send(4*^ND),ind_recv(4*^ND)
1894 integer :: levmin_recv,levmax_recv,level_recv,igrid_recv,ixrvC^L,ixrvCC^L
1895 integer,
allocatable :: intstatus(:,:)
1896 logical :: fileopen,conv_grid,cond_grid_recv
1897 character(len=80):: filename
1898 character(len=name_len) :: wnamei(1:nw+nwauxio),xandwnamei(1:ndim+nw+nwauxio)
1899 character(len=1024) :: outfilehead
1902 inquire(qunit,opened=fileopen)
1903 if(.not.fileopen)
then
1907 write(filename,
'(a,i4.4,a)') trim(
base_filename),filenr,
".vtu"
1909 open(qunit,file=filename,status=
'unknown',form=
'formatted')
1912 write(qunit,
'(a)')
'<?xml version="1.0"?>'
1913 write(qunit,
'(a)',advance=
'no')
'<VTKFile type="UnstructuredGrid"'
1914 write(qunit,
'(a)')
' version="0.1" byte_order="LittleEndian">'
1915 write(qunit,
'(a)')
'<UnstructuredGrid>'
1916 write(qunit,
'(a)')
'<FieldData>'
1917 write(qunit,
'(2a)')
'<DataArray type="Float32" Name="TIME" ',&
1918 'NumberOfTuples="1" format="ascii">'
1920 write(qunit,
'(a)')
'</DataArray>'
1921 write(qunit,
'(a)')
'</FieldData>'
1926 nx^d=ixmhi^d-ixmlo^d+1;
1948 call mpi_send(igrid,1,mpi_integer, 0,itag,
icomm,
ierrmpi)
1955 conv_grid=({
rnode(
rpxmin^
d_,igrid)>=xprobmin^d+(xprobmax^d-xprobmin^d)&
1957 <=xprobmax^d-(xprobmax^d-xprobmin^d)*
writespshift(^d,2)|.and.})
1959 call mpi_send(conv_grid,1,mpi_logical,0,itag,
icomm,
ierrmpi)
1961 if (.not.conv_grid) cycle
1962 call calc_x(igrid,xc,xcc)
1963 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
1964 ixc^l,ixcc^l,.true.)
1967 ind_send=(/ ixc^l,ixcc^l /)
1969 call mpi_send(ind_send,siz_ind,mpi_integer, 0,itag,
icomm,
ierrmpi)
1970 call mpi_send(normconv,nw+nwauxio+1,mpi_double_precision, 0,itag,
icomm,
ierrmpi)
1977 call write_vtk(qunit,ixg^
ll,ixc^l,ixcc^l,igrid,nc,np,nx^d,nxc^d,&
1978 normconv,wnamei,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp)
1984 allocate(intstatus(mpi_status_size,1))
1988 call mpi_recv(levmin_recv,1,mpi_integer, ipe,itag,
icomm,intstatus(:,1),
ierrmpi)
1991 call mpi_recv(levmax_recv,1,mpi_integer, ipe,itag,
icomm,intstatus(:,1),
ierrmpi)
1993 do level=levmin_recv,levmax_recv
1997 call mpi_recv(igrid_recv,1,mpi_integer, ipe,itag,
icomm,intstatus(:,1),
ierrmpi)
1999 call mpi_recv(level_recv,1,mpi_integer, ipe,itag,
icomm,intstatus(:,1),
ierrmpi)
2000 if (level_recv/=level) cycle
2001 call mpi_recv(cond_grid_recv,1,mpi_logical, ipe,itag,
icomm,intstatus(:,1),
ierrmpi)
2002 if(.not.cond_grid_recv)cycle
2005 call mpi_recv(ind_recv,siz_ind, mpi_integer, ipe,itag,
icomm,intstatus(:,1),
ierrmpi)
2006 ixrvcmin^d=ind_recv(^d);ixrvcmax^d=ind_recv(^nd+^d);
2007 ixrvccmin^d=ind_recv(2*^nd+^d);ixrvccmax^d=ind_recv(3*^nd+^d);
2008 call mpi_recv(normconv,nw+nwauxio+1, mpi_double_precision,ipe,itag&
2015 call write_vtk(qunit,ixg^
ll,ixrvc^l,ixrvcc^l,igrid_recv,&
2016 nc,np,nx^d,nxc^d,normconv,wnamei,&
2017 xc_tmp_recv,xcc_tmp_recv,wc_tmp_recv,wcc_tmp_recv)
2022 write(qunit,
'(a)')
'</UnstructuredGrid>'
2023 write(qunit,
'(a)')
'</VTKFile>'
2028 if(
mype==0)
deallocate(intstatus)
2268 integer,
intent(in) :: qunit
2270 double precision :: x_TEC(ndim), w_TEC(nw+nwauxio)
2271 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC_TMP,xC_TMP_recv
2272 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC_TMP,xCC_TMP_recv
2273 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC
2274 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC
2275 double precision,
dimension(ixMlo^D-1:ixMhi^D,nw+nwauxio) :: wC_TMP,wC_TMP_recv
2276 double precision,
dimension(ixMlo^D:ixMhi^D,nw+nwauxio) :: wCC_TMP,wCC_TMP_recv
2277 double precision,
dimension(0:nw+nwauxio) :: normconv
2278 integer:: igrid,iigrid,level,igonlevel,iw,idim,ix^D
2279 integer:: NumGridsOnLevel(1:nlevelshi)
2280 integer :: nx^D,nxC^D,nodesonlevel,elemsonlevel,ixC^L,ixCC^L
2281 integer :: nodesonlevelmype,elemsonlevelmype
2282 integer :: nodes, elems
2283 integer,
allocatable :: intstatus(:,:)
2284 integer :: itag,Morton_no,ipe,levmin_recv,levmax_recv,igrid_recv,level_recv
2285 integer :: ixrvC^L,ixrvCC^L
2286 integer :: ind_send(2*^ND),ind_recv(2*^ND),siz_ind,igonlevel_recv
2287 integer :: NumGridsOnLevel_mype(1:nlevelshi,0:npe-1)
2289 logical :: fileopen,first
2290 character(len=80) :: filename
2291 character(len=1024) :: tecplothead
2292 character(len=name_len) :: wnamei(1:nw+nwauxio),xandwnamei(1:ndim+nw+nwauxio)
2293 character(len=1024) :: outfilehead
2295 if(nw/=count(
w_write(1:nw)))
then
2296 if(
mype==0) print *,
'tecplot_mpi does not use w_write=F'
2297 call mpistop(
'w_write, tecplot')
2301 if(
mype==0) print *,
'tecplot_mpi with nocartesian'
2304 master_cpu_open :
if (
mype == 0)
then
2305 inquire(qunit,opened=fileopen)
2306 if (.not.fileopen)
then
2310 write(filename,
'(a,i4.4,a)') trim(
base_filename),filenr,
".plt"
2311 open(qunit,file=filename,status=
'unknown')
2314 write(tecplothead,
'(a)')
"VARIABLES = "//trim(outfilehead)
2315 write(qunit,
'(a)') tecplothead(1:len_trim(tecplothead))
2316 end if master_cpu_open
2319 numgridsonlevel(1:nlevelshi)=0
2321 numgridsonlevel(level)=0
2325 numgridsonlevel(level)=numgridsonlevel(level)+1
2327 numgridsonlevel_mype(level,0:npe-1)=0
2328 numgridsonlevel_mype(level,
mype) = numgridsonlevel(level)
2329 call mpi_allreduce(mpi_in_place,numgridsonlevel_mype(level,0:npe-1),npe,mpi_integer,&
2331 call mpi_allreduce(mpi_in_place,numgridsonlevel(level),1,mpi_integer,mpi_sum, &
2335 nx^d=ixmhi^d-ixmlo^d+1;
2338 if(
mype==0.and.npe>1)
allocate(intstatus(mpi_status_size,1))
2345 nodes=nodes + numgridsonlevel(level)*{nxc^d*}
2346 elems=elems + numgridsonlevel(level)*{nx^d*}
2349 if (
mype==0)
write(qunit,
"(a,i7,a,1pe12.5,a)") &
2350 'ZONE T="all levels", I=',elems, &
2356 call calc_x(igrid,xc,xcc)
2357 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,ixc^l,ixcc^l,.true.)
2359 {
do ix^db=ixccmin^db,ixccmax^db\}
2360 x_tec(1:ndim)=xcc_tmp(ix^d,1:ndim)*normconv(0)
2361 w_tec(1:nw+nwauxio)=wcc_tmp(ix^d,1:nw+nwauxio)*normconv(1:nw+nwauxio)
2362 write(qunit,fmt=
"(100(e14.6))") x_tec, w_tec
2364 else if (mype/=0)
then
2366 call mpi_send(igrid,1,mpi_integer, 0,itag,icomm,ierrmpi)
2367 call mpi_send(normconv,nw+nwauxio+1,mpi_double_precision,0,itag,icomm,ierrmpi)
2368 call mpi_send(wcc_tmp,1,type_block_wcc_io, 0,itag,icomm,ierrmpi)
2369 call mpi_send(xcc_tmp,1,type_block_xcc_io, 0,itag,icomm,ierrmpi)
2374 do morton_no=morton_start(ipe),morton_stop(ipe)
2376 call mpi_recv(igrid_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2377 call mpi_recv(normconv,nw+nwauxio+1, mpi_double_precision,ipe,&
2378 itag,icomm,intstatus(:,1),ierrmpi)
2379 call mpi_recv(wcc_tmp_recv,1,type_block_wcc_io, ipe,itag,&
2380 icomm,intstatus(:,1),ierrmpi)
2381 call mpi_recv(xcc_tmp_recv,1,type_block_xcc_io, ipe,itag,&
2382 icomm,intstatus(:,1),ierrmpi)
2383 {
do ix^db=ixccmin^db,ixccmax^db\}
2384 x_tec(1:ndim)=xcc_tmp_recv(ix^d,1:ndim)*normconv(0)
2385 w_tec(1:nw+nwauxio)=wcc_tmp_recv(ix^d,1:nw+nwauxio)*normconv(1:nw+nwauxio)
2386 write(qunit,fmt=
"(100(e14.6))") x_tec, w_tec
2395 itag=1000*morton_stop(mype)
2396 call mpi_send(levmin,1,mpi_integer, 0,itag,icomm,ierrmpi)
2397 itag=2000*morton_stop(mype)
2398 call mpi_send(levmax,1,mpi_integer, 0,itag,icomm,ierrmpi)
2401 do level=levmin,levmax
2402 nodesonlevelmype=numgridsonlevel_mype(level,mype)*{nxc^d*}
2403 elemsonlevelmype=numgridsonlevel_mype(level,mype)*{nx^d*}
2404 nodesonlevel=numgridsonlevel(level)*{nxc^d*}
2405 elemsonlevel=numgridsonlevel(level)*{nx^d*}
2412 select case(convert_type)
2417 if (mype==0.and.(nodesonlevelmype>0.and.elemsonlevelmype>0))&
2418 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,a)") &
2419 'ZONE T="',level,
'"',
', N=',nodesonlevelmype,
', E=',elemsonlevelmype, &
2420 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=POINT, ZONETYPE=', &
2421 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
2422 do morton_no=morton_start(mype),morton_stop(mype)
2423 igrid = sfc_to_igrid(morton_no)
2426 call mpi_send(igrid,1,mpi_integer, 0,itag,icomm,ierrmpi)
2428 call mpi_send(node(plevel_,igrid),1,mpi_integer, 0,itag,icomm,ierrmpi)
2430 if (node(plevel_,igrid)/=level) cycle
2431 call calc_x(igrid,xc,xcc)
2432 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
2433 ixc^l,ixcc^l,.true.)
2436 ind_send=(/ ixc^l /)
2438 call mpi_send(ind_send,siz_ind, mpi_integer, 0,itag,icomm,ierrmpi)
2439 call mpi_send(normconv,nw+nwauxio+1,mpi_double_precision, 0,itag,icomm,ierrmpi)
2441 call mpi_send(wc_tmp,1,type_block_wc_io, 0,itag,icomm,ierrmpi)
2442 call mpi_send(xc_tmp,1,type_block_xc_io, 0,itag,icomm,ierrmpi)
2444 {
do ix^db=ixcmin^db,ixcmax^db\}
2445 x_tec(1:ndim)=xc_tmp(ix^d,1:ndim)*normconv(0)
2446 w_tec(1:nw+nwauxio)=wc_tmp(ix^d,1:nw+nwauxio)*normconv(1:nw+nwauxio)
2447 write(qunit,fmt=
"(100(e14.6))") x_tec, w_tec
2451 case(
'tecplotCCmpi')
2457 if(ndim+nw+nwauxio>99)
call mpistop(
"adjust format specification in writeout")
2458 if(nw+nwauxio==1)
then
2461 if (mype==0.and.(nodesonlevelmype>0.and.elemsonlevelmype>0))&
2462 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,i1,a,a)") &
2463 'ZONE T="',level,
'"',
', N=',nodesonlevelmype,
', E=',elemsonlevelmype, &
2464 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=BLOCK, VARLOCATION=([', &
2465 ndim+1,
']=CELLCENTERED), ZONETYPE=', &
2466 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
2468 if(ndim+nw+nwauxio<10)
then
2470 if (mype==0.and.(nodesonlevelmype>0.and.elemsonlevelmype>0))&
2471 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,i1,a,i1,a,a)") &
2472 'ZONE T="',level,
'"',
', N=',nodesonlevelmype,
', E=',elemsonlevelmype, &
2473 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=BLOCK, VARLOCATION=([', &
2474 ndim+1,
'-',ndim+nw+nwauxio,
']=CELLCENTERED), ZONETYPE=', &
2475 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
2477 if (mype==0.and.(nodesonlevelmype>0.and.elemsonlevelmype>0))&
2478 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,i1,a,i2,a,a)") &
2479 'ZONE T="',level,
'"',
', N=',nodesonlevelmype,
', E=',elemsonlevelmype, &
2480 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=BLOCK, VARLOCATION=([', &
2481 ndim+1,
'-',ndim+nw+nwauxio,
']=CELLCENTERED), ZONETYPE=', &
2482 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
2488 do morton_no=morton_start(mype),morton_stop(mype)
2489 igrid = sfc_to_igrid(morton_no)
2492 call mpi_send(igrid,1,mpi_integer, 0,itag,icomm,ierrmpi)
2494 call mpi_send(node(plevel_,igrid),1,mpi_integer, 0,itag,icomm,ierrmpi)
2496 if (node(plevel_,igrid)/=level) cycle
2497 call calc_x(igrid,xc,xcc)
2498 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
2501 ind_send=(/ ixc^l /)
2504 call mpi_send(ind_send,siz_ind, mpi_integer, 0,itag,icomm,ierrmpi)
2505 call mpi_send(normconv,nw+nwauxio+1,mpi_double_precision, 0,itag,icomm,ierrmpi)
2506 call mpi_send(xc_tmp,1,type_block_xc_io, 0,itag,icomm,ierrmpi)
2508 write(qunit,fmt=
"(100(e14.6))") xc_tmp(ixc^s,idim)*normconv(0)
2513 do morton_no=morton_start(mype),morton_stop(mype)
2514 igrid = sfc_to_igrid(morton_no)
2516 itag=morton_no*(ndim+iw)
2517 call mpi_send(igrid,1,mpi_integer, 0,itag,icomm,ierrmpi)
2518 itag=igrid*(ndim+iw)
2519 call mpi_send(node(plevel_,igrid),1,mpi_integer, 0,itag,icomm,ierrmpi)
2521 if (node(plevel_,igrid)/=level) cycle
2522 call calc_x(igrid,xc,xcc)
2523 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
2524 ixc^l,ixcc^l,.true.)
2526 ind_send=(/ ixcc^l /)
2528 itag=igrid*(ndim+iw)
2529 call mpi_send(ind_send,siz_ind, mpi_integer, 0,itag,icomm,ierrmpi)
2530 call mpi_send(normconv,nw+nwauxio+1,mpi_double_precision, 0,itag,icomm,ierrmpi)
2531 call mpi_send(wcc_tmp,1,type_block_wcc_io, 0,itag,icomm,ierrmpi)
2533 write(qunit,fmt=
"(100(e14.6))") wcc_tmp(ixcc^s,iw)*normconv(iw)
2538 call mpistop(
'no such tecplot type')
2542 do morton_no=morton_start(mype),morton_stop(mype)
2543 igrid = sfc_to_igrid(morton_no)
2546 call mpi_send(igrid,1,mpi_integer, 0,itag,icomm,ierrmpi)
2548 call mpi_send(node(plevel_,igrid),1,mpi_integer, 0,itag,icomm,ierrmpi)
2550 if(node(plevel_,igrid)/=level) cycle
2551 igonlevel=igonlevel+1
2554 call mpi_send(igonlevel,1,mpi_integer, 0,itag,icomm,ierrmpi)
2562 if(mype==0 .and.npe>1)
then
2564 itag=1000*morton_stop(ipe)
2565 call mpi_recv(levmin_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2566 itag=2000*morton_stop(ipe)
2567 call mpi_recv(levmax_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2568 do level=levmin_recv,levmax_recv
2569 nodesonlevelmype=numgridsonlevel_mype(level,ipe)*{nxc^d*}
2570 elemsonlevelmype=numgridsonlevel_mype(level,ipe)*{nx^d*}
2571 nodesonlevel=numgridsonlevel(level)*{nxc^d*}
2572 elemsonlevel=numgridsonlevel(level)*{nx^d*}
2573 select case(convert_type)
2578 if(nodesonlevelmype>0.and.elemsonlevelmype>0) &
2579 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,a)") &
2580 'ZONE T="',level,
'"',
', N=',nodesonlevelmype,
', E=',elemsonlevelmype, &
2581 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=POINT, ZONETYPE=', &
2582 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
2583 do morton_no=morton_start(ipe),morton_stop(ipe)
2585 call mpi_recv(igrid_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2587 call mpi_recv(level_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2588 if (level_recv/=level) cycle
2591 call mpi_recv(ind_recv,siz_ind, mpi_integer, ipe,itag,&
2592 icomm,intstatus(:,1),ierrmpi)
2593 ixrvcmin^d=ind_recv(^d);ixrvcmax^d=ind_recv(^nd+^d);
2594 call mpi_recv(normconv,nw+nwauxio+1, mpi_double_precision,ipe,itag&
2595 ,icomm,intstatus(:,1),ierrmpi)
2596 call mpi_recv(wc_tmp_recv,1,type_block_wc_io, ipe,itag,&
2597 icomm,intstatus(:,1),ierrmpi)
2598 call mpi_recv(xc_tmp_recv,1,type_block_xc_io, ipe,itag,&
2599 icomm,intstatus(:,1),ierrmpi)
2600 {
do ix^db=ixrvcmin^db,ixrvcmax^db\}
2601 x_tec(1:ndim)=xc_tmp_recv(ix^d,1:ndim)*normconv(0)
2602 w_tec(1:nw+nwauxio)=wc_tmp_recv(ix^d,1:nw+nwauxio)*normconv(1:nw+nwauxio)
2603 write(qunit,fmt=
"(100(e14.6))") x_tec, w_tec
2606 case(
'tecplotCCmpi')
2612 if(ndim+nw+nwauxio>99)
call mpistop(
"adjust format specification in writeout")
2613 if(nw+nwauxio==1)
then
2616 if(nodesonlevelmype>0.and.elemsonlevelmype>0) &
2617 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,i1,a,a)") &
2618 'ZONE T="',level,
'"',
', N=',nodesonlevelmype,
', E=',elemsonlevelmype, &
2619 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=BLOCK, VARLOCATION=([', &
2620 ndim+1,
']=CELLCENTERED), ZONETYPE=', &
2621 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
2623 if(ndim+nw+nwauxio<10)
then
2625 if(nodesonlevelmype>0.and.elemsonlevelmype>0) &
2626 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,i1,a,i1,a,a)") &
2627 'ZONE T="',level,
'"',
', N=',nodesonlevelmype,
', E=',elemsonlevelmype, &
2628 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=BLOCK, VARLOCATION=([', &
2629 ndim+1,
'-',ndim+nw+nwauxio,
']=CELLCENTERED), ZONETYPE=', &
2630 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
2632 if(nodesonlevelmype>0.and.elemsonlevelmype>0) &
2633 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,i1,a,i2,a,a)") &
2634 'ZONE T="',level,
'"',
', N=',nodesonlevelmype,
', E=',elemsonlevelmype, &
2635 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=BLOCK, VARLOCATION=([', &
2636 ndim+1,
'-',ndim+nw+nwauxio,
']=CELLCENTERED), ZONETYPE=', &
2637 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
2642 do morton_no=morton_start(ipe),morton_stop(ipe)
2644 call mpi_recv(igrid_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2645 itag=igrid_recv*idim
2646 call mpi_recv(level_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2647 if (level_recv/=level) cycle
2649 itag=igrid_recv*idim
2650 call mpi_recv(ind_recv,siz_ind, mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2651 ixrvcmin^d=ind_recv(^d);ixrvcmax^d=ind_recv(^nd+^d);
2652 call mpi_recv(normconv,nw+nwauxio+1, mpi_double_precision,ipe,itag&
2653 ,icomm,intstatus(:,1),ierrmpi)
2654 call mpi_recv(xc_tmp_recv,1,type_block_xc_io, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2655 write(qunit,fmt=
"(100(e14.6))") xc_tmp_recv(ixrvc^s,idim)*normconv(0)
2659 do morton_no=morton_start(ipe),morton_stop(ipe)
2660 itag=morton_no*(ndim+iw)
2661 call mpi_recv(igrid_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2662 itag=igrid_recv*(ndim+iw)
2663 call mpi_recv(level_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2664 if (level_recv/=level) cycle
2666 itag=igrid_recv*(ndim+iw)
2667 call mpi_recv(ind_recv,siz_ind, mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2668 ixrvccmin^d=ind_recv(^d);ixrvccmax^d=ind_recv(^nd+^d);
2669 call mpi_recv(normconv,nw+nwauxio+1, mpi_double_precision,ipe,itag&
2670 ,icomm,intstatus(:,1),ierrmpi)
2671 call mpi_recv(wcc_tmp_recv,1,type_block_wcc_io, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2672 write(qunit,fmt=
"(100(e14.6))") wcc_tmp_recv(ixrvcc^s,iw)*normconv(iw)
2676 call mpistop(
'no such tecplot type')
2679 do morton_no=morton_start(ipe),morton_stop(ipe)
2681 call mpi_recv(igrid_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2683 call mpi_recv(level_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2684 if (level_recv/=level) cycle
2686 call mpi_recv(igonlevel_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2695 call mpi_barrier(icomm,ierrmpi)
2696 if(mype==0)
deallocate(intstatus)
2976 integer,
intent(in) :: qunit
2978 double precision :: x_VTK(1:3)
2979 double precision,
dimension(ixMlo1-1:ixMhi1,ixMlo2-1:ixMhi2,ixMlo1&
-1:ixMhi1,3) :: xC_TMP
2980 double precision,
dimension(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo1:ixMhi1,&
3) :: xCC_TMP
2981 double precision,
dimension(ixMlo1-1:ixMhi1,ixMlo2-1:ixMhi2,ixMlo1&
-1:ixMhi1,nw+nwauxio) :: wC_TMP
2982 double precision,
dimension(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo1:ixMhi1,nw&
+nwauxio) :: wCC_TMP
2983 double precision,
dimension(ixGlo1:ixGhi1,ixGlo2:ixGhi2,ixGlo1:ixGhi1,1:nw&
+nwauxio) :: w
2984 double precision :: normconv(0:nw+nwauxio)
2985 double precision :: zlength
2986 double precision ::d3grid,zlengsc,zgridsc
2988 integer:: igrid,iigrid,level,igonlevel,icel,ixCmin1,ixCmin2,&
2989 ixCmin3,ixCmax1,ixCmax2,ixCmax3,ixCCmin1,ixCCmin2,ixCCmin3,ixCCmax1,&
2991 integer:: NumGridsOnLevel(1:nlevelshi)
2992 integer :: nx1,nx2,nx3,nxC1,nxC2,nxC3,nodesonlevel,elemsonlevel,nc,np,&
2993 VTK_type,ix1,ix2,ix3
2994 integer :: size_length,recsep,k,iw
2995 integer :: length,lengthcc,offset_points,offset_cells, length_coords,&
2996 length_conn,length_offsets
2997 integer :: i3grid,n3grid
3000 character(len=6):: bufform
3001 character(len=80):: filename
3002 character(len=name_len) :: wnamei(1:nw+nwauxio),xandwnamei(1:3+nw+nwauxio)
3003 character(len=1024) :: outfilehead
3006 if(
mype==0) print *,
'unstructuredvtkB23 not parallel, use vtumpi'
3007 call mpistop(
'npe>1, unstructuredvtkB23')
3013 inquire(qunit,opened=fileopen)
3014 if(.not.fileopen)
then
3018 open(qunit,file=filename,status=
'replace')
3022 write(qunit,
'(a)')
'<?xml version="1.0"?>'
3023 write(qunit,
'(a)',advance=
'no')
'<VTKFile type="UnstructuredGrid"'
3024 write(qunit,
'(a)')
' version="0.1" byte_order="LittleEndian">'
3025 write(qunit,
'(a)')
'<UnstructuredGrid>'
3026 write(qunit,
'(a)')
'<FieldData>'
3027 write(qunit,
'(2a)')
'<DataArray type="Float32" Name="TIME" ',&
3028 'NumberOfTuples="1" format="ascii">'
3030 write(qunit,
'(a)')
'</DataArray>'
3031 write(qunit,
'(a)')
'</FieldData>'
3034 nx1=ixmhi1-ixmlo1+1;nx2=ixmhi2-ixmlo2+1;nx3=ixmhi1-ixmlo1+1;
3035 nxc1=nx1+1;nxc2=nx2+1;nxc3=nx3+1;
3040 lengthcc=nc*size_real
3042 length_coords=3*length
3043 length_conn=2**3*size_int*nc
3044 length_offsets=nc*size_int
3049 zlengsc=2.d0*zgridsc
3050 zlength=zlengsc*(xprobmax1-xprobmin1)
3053 do iigrid=1,igridstail; igrid=igrids(iigrid);
3058 if ((
rnode(rpxmin1_,igrid)>=xprobmin1+(xprobmax1-xprobmin1)&
3061 .and.(
rnode(rpxmax1_,igrid)<=xprobmax1-(xprobmax1-xprobmin1)&
3064 d3grid=zgridsc*(
rnode(rpxmax1_,igrid)-
rnode(rpxmin1_,igrid))
3065 n3grid=nint(zlength/d3grid)
3070 write(qunit,
'(a,i7,a,i7,a)')
'<Piece NumberOfPoints="',np,&
3071 '" NumberOfCells="',nc,
'">'
3072 write(qunit,
'(a)')
'<PointData>'
3075 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3076 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3077 write(qunit,
'(a)')
'</DataArray>'
3078 offset=offset+length+size_int
3081 do iw=nw+1,nw+nwauxio
3082 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3083 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3084 write(qunit,
'(a)')
'</DataArray>'
3085 offset=offset+length+size_int
3088 write(qunit,
'(a)')
'</PointData>'
3090 write(qunit,
'(a)')
'<Points>'
3091 write(qunit,
'(a,i16,a)') &
3092 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',&
3095 offset=offset+length_coords+size_int
3096 write(qunit,
'(a)')
'</Points>'
3099 write(qunit,
'(a,i7,a,i7,a)')
'<Piece NumberOfPoints="',np,&
3100 '" NumberOfCells="',nc,
'">'
3101 write(qunit,
'(a)')
'<CellData>'
3104 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3105 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3106 write(qunit,
'(a)')
'</DataArray>'
3107 offset=offset+lengthcc+size_int
3110 do iw=nw+1,nw+nwauxio
3111 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3112 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3113 write(qunit,
'(a)')
'</DataArray>'
3114 offset=offset+lengthcc+size_int
3117 write(qunit,
'(a)')
'</CellData>'
3118 write(qunit,
'(a)')
'<Points>'
3119 write(qunit,
'(a,i16,a)') &
3120 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',&
3123 offset=offset+length_coords+size_int
3124 write(qunit,
'(a)')
'</Points>'
3126 write(qunit,
'(a)')
'<Cells>'
3128 write(qunit,
'(a,i16,a)')&
3129 '<DataArray type="Int32" Name="connectivity" format="appended" offset="',&
3131 offset=offset+length_conn+size_int
3133 write(qunit,
'(a,i16,a)') &
3134 '<DataArray type="Int32" Name="offsets" format="appended" offset="',&
3136 offset=offset+length_offsets+size_int
3138 write(qunit,
'(a,i16,a)') &
3139 '<DataArray type="Int32" Name="types" format="appended" offset="',&
3141 offset=offset+size_length+nc*size_int
3142 write(qunit,
'(a)')
'</Cells>'
3143 write(qunit,
'(a)')
'</Piece>'
3150 write(qunit,
'(a)')
'</UnstructuredGrid>'
3151 write(qunit,
'(a)')
'<AppendedData encoding="raw">'
3153 open(qunit,file=filename,form=
'unformatted',access=
'stream',status=
'old',position=
'append')
3155 write(qunit) trim(buffer)
3159 do iigrid=1,igridstail; igrid=igrids(iigrid);
3164 if ((
rnode(rpxmin1_,igrid)>=xprobmin1+(xprobmax1-xprobmin1)&
3167 .and.(
rnode(rpxmax1_,igrid)<=xprobmax1-(xprobmax1-xprobmin1)&
3170 d3grid=zgridsc*(
rnode(rpxmax1_,igrid)-
rnode(rpxmin1_,igrid))
3171 n3grid=nint(zlength/d3grid)
3176 ixglo1,ixglo2,ixghi1,ixghi2,ps(igrid)%w,ps(igrid)%x)
3180 do ix3=ixglo1,ixghi1
3181 w(ixglo1:ixghi1,ixglo2:ixghi2,ix3,1:nw)=ps(igrid)%w(ixglo1:ixghi1,&
3185 call calc_grid23(qunit,igrid,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
3186 ixcmin1,ixcmin2,ixcmin3,ixcmax1,ixcmax2,ixcmax3,ixccmin1,ixccmin2,&
3187 ixccmin3,ixccmax1,ixccmax2,ixccmax3,.true.,i3grid,d3grid,w,zlength,zgridsc)
3193 write(qunit) (((real(wc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3194 =ixcmin1,ixcmax1),ix2=ixcmin2,ixcmax2),ix3=ixcmin3,ixcmax3)
3196 write(qunit) lengthcc
3197 write(qunit) (((real(wcc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3198 =ixccmin1,ixccmax1),ix2=ixccmin2,ixccmax2),ix3&
3203 do iw=nw+1,nw+nwauxio
3207 write(qunit) (((real(wc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3208 =ixcmin1,ixcmax1),ix2=ixcmin2,ixcmax2),ix3=ixcmin3,ixcmax3)
3210 write(qunit) lengthcc
3211 write(qunit) (((real(wcc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3212 =ixccmin1,ixccmax1),ix2=ixccmin2,ixccmax2),ix3&
3217 write(qunit) length_coords
3218 do ix3=ixcmin3,ixcmax3
3219 do ix2=ixcmin2,ixcmax2
3220 do ix1=ixcmin1,ixcmax1
3222 x_vtk(1:3)=xc_tmp(ix1,ix2,ix3,1:3)*normconv(0);
3224 write(qunit) real(x_vtk(k))
3229 write(qunit) length_conn
3234 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1-1, &
3235 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
3236 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1-1,&
3237 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1,&
3238 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1-1,&
3239 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
3240 ix3*nxc2*nxc1+ ix2*nxc1+ix1-1,&
3241 ix3*nxc2*nxc1+ ix2*nxc1+ix1
3245 write(qunit) length_offsets
3247 write(qunit) icel*(2**3)
3250 write(qunit) size_int*nc
3252 write(qunit) vtk_type
3261 open(qunit,file=filename,status=
'unknown',form=
'formatted',position=
'append')
3263 write(qunit,
'(a)')
'</AppendedData>'
3264 write(qunit,
'(a)')
'</VTKFile>'
3278 integer,
intent(in) :: qunit
3280 double precision :: x_VTK(1:3)
3281 double precision,
dimension(ixMlo1-1:ixMhi1,ixMlo2-1:ixMhi2,ixMlo1&
-1:ixMhi1,3) :: xC_TMP
3282 double precision,
dimension(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo1:ixMhi1,&
3) :: xCC_TMP
3283 double precision,
dimension(ixMlo1-1:ixMhi1,ixMlo2-1:ixMhi2,ixMlo1&
-1:ixMhi1,nw+nwauxio) :: wC_TMP
3284 double precision,
dimension(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo1:ixMhi1,nw&
+nwauxio) :: wCC_TMP
3285 double precision,
dimension(ixGlo1:ixGhi1,ixGlo2:ixGhi2,ixGlo1:ixGhi1,1:nw&
+nwauxio) :: w
3286 double precision :: normconv(0:nw+nwauxio)
3287 double precision ::d3grid,zlengsc,zgridsc
3288 double precision :: zlength
3290 integer:: igrid,iigrid,level,igonlevel,icel,ixCmin1,ixCmin2,&
3291 ixCmin3,ixCmax1,ixCmax2,ixCmax3,ixCCmin1,ixCCmin2,ixCCmin3,ixCCmax1,&
3293 integer:: NumGridsOnLevel(1:nlevelshi)
3294 integer :: nx1,nx2,nx3,nxC1,nxC2,nxC3,nodesonlevel,elemsonlevel,nc,np,&
3295 VTK_type,ix1,ix2,ix3
3296 integer :: size_length,recsep,k,iw
3297 integer :: length,lengthcc,offset_points,offset_cells, length_coords,&
3298 length_conn,length_offsets
3299 integer :: i3grid,n3grid
3301 character(len=80):: filename
3302 character(len=name_len) :: wnamei(1:nw+nwauxio),xandwnamei(1:3+nw+nwauxio)
3303 character(len=1024) :: outfilehead
3305 character(len=6):: bufform
3308 if(
mype==0) print *,
'unstructuredvtkBsym23 not parallel, use vtumpi'
3309 call mpistop(
'npe>1, unstructuredvtkBsym23')
3316 inquire(qunit,opened=fileopen)
3317 if(.not.fileopen)
then
3321 open(qunit,file=filename,status=
'unknown')
3326 write(qunit,
'(a)')
'<?xml version="1.0"?>'
3327 write(qunit,
'(a)',advance=
'no')
'<VTKFile type="UnstructuredGrid"'
3328 write(qunit,
'(a)')
' version="0.1" byte_order="LittleEndian">'
3329 write(qunit,
'(a)')
'<UnstructuredGrid>'
3330 write(qunit,
'(a)')
'<FieldData>'
3331 write(qunit,
'(2a)')
'<DataArray type="Float32" Name="TIME" ',&
3332 'NumberOfTuples="1" format="ascii">'
3334 write(qunit,
'(a)')
'</DataArray>'
3335 write(qunit,
'(a)')
'</FieldData>'
3338 nx1=ixmhi1-ixmlo1+1;nx2=ixmhi2-ixmlo2+1;nx3=ixmhi1-ixmlo1+1;
3339 nxc1=nx1+1;nxc2=nx2+1;nxc3=nx3+1;
3344 lengthcc=nc*size_real
3346 length_coords=3*length
3347 length_conn=2**3*size_int*nc
3348 length_offsets=nc*size_int
3354 zlength=zlengsc*(xprobmax1-xprobmin1)
3357 do iigrid=1,igridstail; igrid=igrids(iigrid);
3362 if ((
rnode(rpxmin1_,igrid)>=xprobmin1+(xprobmax1-xprobmin1)&
3365 .and.(
rnode(rpxmax1_,igrid)<=xprobmax1-(xprobmax1-xprobmin1)&
3368 d3grid=zgridsc*(
rnode(rpxmax1_,igrid)-
rnode(rpxmin1_,igrid))
3369 n3grid=nint(zlength/d3grid)
3375 write(qunit,
'(a,i7,a,i7,a)')
'<Piece NumberOfPoints="',np,&
3376 '" NumberOfCells="',nc,
'">'
3377 write(qunit,
'(a)')
'<PointData>'
3380 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3381 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3382 write(qunit,
'(a)')
'</DataArray>'
3383 offset=offset+length+size_length
3386 do iw=nw+1,nw+nwauxio
3387 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3388 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3389 write(qunit,
'(a)')
'</DataArray>'
3390 offset=offset+length+size_length
3393 write(qunit,
'(a)')
'</PointData>'
3394 write(qunit,
'(a)')
'<Points>'
3395 write(qunit,
'(a,i16,a)') &
3396 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',&
3399 offset=offset+length_coords+size_length
3400 write(qunit,
'(a)')
'</Points>'
3403 write(qunit,
'(a,i7,a,i7,a)')
'<Piece NumberOfPoints="',np,&
3404 '" NumberOfCells="',nc,
'">'
3405 write(qunit,
'(a)')
'<CellData>'
3408 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3409 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3410 write(qunit,
'(a)')
'</DataArray>'
3411 offset=offset+lengthcc+size_length
3414 do iw=nw+1,nw+nwauxio
3415 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3416 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3417 write(qunit,
'(a)')
'</DataArray>'
3418 offset=offset+lengthcc+size_length
3421 write(qunit,
'(a)')
'</CellData>'
3423 write(qunit,
'(a)')
'<Points>'
3424 write(qunit,
'(a,i16,a)') &
3425 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',&
3428 offset=offset+length_coords+size_length
3429 write(qunit,
'(a)')
'</Points>'
3431 write(qunit,
'(a)')
'<Cells>'
3433 write(qunit,
'(a,i16,a)')&
3434 '<DataArray type="Int32" Name="connectivity" format="appended" offset="',&
3436 offset=offset+length_conn+size_length
3438 write(qunit,
'(a,i16,a)') &
3439 '<DataArray type="Int32" Name="offsets" format="appended" offset="',&
3441 offset=offset+length_offsets+size_length
3443 write(qunit,
'(a,i16,a)') &
3444 '<DataArray type="Int32" Name="types" format="appended" offset="',&
3446 offset=offset+size_length+nc*size_int
3447 write(qunit,
'(a)')
'</Cells>'
3448 write(qunit,
'(a)')
'</Piece>'
3454 write(qunit,
'(a,i7,a,i7,a)')
'<Piece NumberOfPoints="',np,&
3455 '" NumberOfCells="',nc,
'">'
3456 write(qunit,
'(a)')
'<PointData>'
3459 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3460 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3461 write(qunit,
'(a)')
'</DataArray>'
3462 offset=offset+length+size_length
3465 do iw=nw+1,nw+nwauxio
3466 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3467 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3468 write(qunit,
'(a)')
'</DataArray>'
3469 offset=offset+length+size_length
3472 write(qunit,
'(a)')
'</PointData>'
3473 write(qunit,
'(a)')
'<Points>'
3474 write(qunit,
'(a,i16,a)') &
3475 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',&
3478 offset=offset+length_coords+size_length
3479 write(qunit,
'(a)')
'</Points>'
3482 write(qunit,
'(a,i7,a,i7,a)')
'<Piece NumberOfPoints="',np,&
3483 '" NumberOfCells="',nc,
'">'
3484 write(qunit,
'(a)')
'<CellData>'
3487 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3488 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3489 write(qunit,
'(a)')
'</DataArray>'
3490 offset=offset+lengthcc+size_length
3493 do iw=nw+1,nw+nwauxio
3494 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3495 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3496 write(qunit,
'(a)')
'</DataArray>'
3497 offset=offset+lengthcc+size_length
3500 write(qunit,
'(a)')
'</CellData>'
3501 write(qunit,
'(a)')
'<Points>'
3502 write(qunit,
'(a,i16,a)') &
3503 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',&
3506 offset=offset+length_coords+size_length
3507 write(qunit,
'(a)')
'</Points>'
3509 write(qunit,
'(a)')
'<Cells>'
3511 write(qunit,
'(a,i16,a)')&
3512 '<DataArray type="Int32" Name="connectivity" format="appended" offset="',&
3514 offset=offset+length_conn+size_length
3516 write(qunit,
'(a,i16,a)') &
3517 '<DataArray type="Int32" Name="offsets" format="appended" offset="',&
3519 offset=offset+length_offsets+size_length
3521 write(qunit,
'(a,i16,a)') &
3522 '<DataArray type="Int32" Name="types" format="appended" offset="',&
3524 offset=offset+size_length+nc*size_int
3525 write(qunit,
'(a)')
'</Cells>'
3526 write(qunit,
'(a)')
'</Piece>'
3534 write(qunit,
'(a)')
'</UnstructuredGrid>'
3535 write(qunit,
'(a)')
'<AppendedData encoding="raw">'
3537 open(qunit,file=filename,form=
'unformatted',access=
'stream',status=
'old',position=
'append')
3539 write(qunit) trim(buffer)
3542 do iigrid=1,igridstail; igrid=igrids(iigrid);
3547 if ((
rnode(rpxmin1_,igrid)>=xprobmin1+(xprobmax1-xprobmin1)&
3550 .and.(
rnode(rpxmax1_,igrid)<=xprobmax1-(xprobmax1-xprobmin1)&
3553 d3grid=zgridsc*(
rnode(rpxmax1_,igrid)-
rnode(rpxmin1_,igrid))
3554 n3grid=nint(zlength/d3grid)
3559 ixglo1,ixglo2,ixghi1,ixghi2,ps(igrid)%w,ps(igrid)%x)
3563 do ix3=ixglo1,ixghi1
3564 w(ixglo1:ixghi1,ixglo2:ixghi2,ix3,1:nw)=ps(igrid)%w(ixglo1:ixghi1,&
3568 call calc_grid23(qunit,igrid,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
3569 ixcmin1,ixcmin2,ixcmin3,ixcmax1,ixcmax2,ixcmax3,ixccmin1,ixccmin2,&
3570 ixccmin3,ixccmax1,ixccmax2,ixccmax3,.true.,i3grid,d3grid,w,zlength,zgridsc)
3577 write(qunit) (((real(wc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3578 =ixcmin1,ixcmax1),ix2=ixcmin2,ixcmax2),ix3=ixcmin3,ixcmax3)
3580 write(qunit) lengthcc
3581 write(qunit) (((real(wcc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3582 =ixccmin1,ixccmax1),ix2=ixccmin2,ixccmax2),ix3&
3587 do iw=nw+1,nw+nwauxio
3591 write(qunit) (((real(wc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3592 =ixcmin1,ixcmax1),ix2=ixcmin2,ixcmax2),ix3=ixcmin3,ixcmax3)
3594 write(qunit) lengthcc
3595 write(qunit) (((real(wcc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3596 =ixccmin1,ixccmax1),ix2=ixccmin2,ixccmax2),ix3&
3601 write(qunit) length_coords
3602 do ix3=ixcmin3,ixcmax3
3603 do ix2=ixcmin2,ixcmax2
3604 do ix1=ixcmin1,ixcmax1
3606 x_vtk(1:3)=xc_tmp(ix1,ix2,ix3,1:3)*normconv(0);
3608 write(qunit) real(x_vtk(k))
3613 write(qunit) length_conn
3618 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1-1, &
3619 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
3620 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1-1,&
3621 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1,&
3622 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1-1,&
3623 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
3624 ix3*nxc2*nxc1+ ix2*nxc1+ix1-1,&
3625 ix3*nxc2*nxc1+ ix2*nxc1+ix1
3629 write(qunit) length_offsets
3631 write(qunit) icel*(2**3)
3634 write(qunit) size_int*nc
3636 write(qunit) vtk_type
3642 if(iw==2 .or. iw==4 .or. iw==7)
then
3643 wc_tmp(ixcmin1:ixcmax1,ixcmin2:ixcmax2,ixcmin3:ixcmax3,iw)=&
3644 -wc_tmp(ixcmin1:ixcmax1,ixcmin2:ixcmax2,ixcmin3:ixcmax3,iw)
3645 wcc_tmp(ixccmin1:ixccmax1,ixccmin2:ixccmax2,ixccmin3:ixccmax3,iw)=&
3646 -wcc_tmp(ixccmin1:ixccmax1,ixccmin2:ixccmax2,ixccmin3:ixccmax3,iw)
3651 write(qunit) (((real(wc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3652 =ixcmax1,ixcmin1,-1),ix2=ixcmin2,ixcmax2),ix3=ixcmin3,ixcmax3)
3654 write(qunit) lengthcc
3655 write(qunit) (((real(wcc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3656 =ixccmin1,ixccmax1),ix2=ixccmin2,ixccmax2),ix3&
3661 do iw=nw+1,nw+nwauxio
3665 write(qunit) (((real(wc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3666 =ixcmax1,ixcmin1,-1),ix2=ixcmin2,ixcmax2),ix3=ixcmin3,ixcmax3)
3668 write(qunit) lengthcc
3669 write(qunit) (((real(wcc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3670 =ixccmin1,ixccmax1),ix2=ixccmin2,ixccmax2),ix3&
3675 write(qunit) length_coords
3676 do ix3=ixcmin3,ixcmax3
3677 do ix2=ixcmin2,ixcmax2
3678 do ix1=ixcmax1,ixcmin1,-1
3680 x_vtk(1:3)=xc_tmp(ix1,ix2,ix3,1:3)*normconv(0);
3683 write(qunit) real(x_vtk(k))
3688 write(qunit) length_conn
3693 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1-1, &
3694 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
3695 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1-1,&
3696 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1,&
3697 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1-1,&
3698 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
3699 ix3*nxc2*nxc1+ ix2*nxc1+ix1-1,&
3700 ix3*nxc2*nxc1+ ix2*nxc1+ix1
3704 write(qunit) length_offsets
3706 write(qunit) icel*(2**3)
3709 write(qunit) size_int*nc
3711 write(qunit) vtk_type
3720 open(qunit,file=filename,status=
'unknown',form=
'formatted',position=
'append')
3721 write(qunit,
'(a)')
'</AppendedData>'
3722 write(qunit,
'(a)')
'</VTKFile>'
3727 subroutine calc_grid23(qunit,igrid,xC_TMP,xCC_TMP,wC_TMP,wCC_TMP,normconv,&
3728 ixCmin1,ixCmin2,ixCmin3,ixCmax1,ixCmax2,ixCmax3,ixCCmin1,ixCCmin2,ixCCmin3,&
3729 ixCCmax1,ixCCmax2,ixCCmax3,first,i3grid,d3grid,w,zlength,zgridsc)
3737 integer,
intent(in) :: qunit, igrid,i3grid
3738 logical,
intent(in) :: first
3740 double precision :: dx1,dx2,dx3,d3grid,zlength,zgridsc
3741 double precision :: ldw(ixGlo1:ixGhi1,ixGlo2:ixGhi2,ixGlo1:ixGhi1),&
3742 dwC(ixGlo1:ixGhi1,ixGlo2:ixGhi2,ixGlo1:ixGhi1)
3743 double precision,
dimension(ixMlo1-1:ixMhi1,ixMlo2-1:ixMhi2,ixMlo1&
-1:ixMhi1,3) :: xC
3744 double precision,
dimension(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo1:ixMhi1,&
3) :: xCC
3745 double precision,
dimension(ixMlo1-1:ixMhi1,ixMlo2-1:ixMhi2,ixMlo1&
-1:ixMhi1,nw+nwauxio) :: wC
3746 double precision,
dimension(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo1:ixMhi1,nw&
+nwauxio) :: wCC
3747 double precision,
dimension(ixMlo1-1:ixMhi1,ixMlo2-1:ixMhi2,ixMlo1&
-1:ixMhi1,3) :: xC_TMP
3748 double precision,
dimension(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo1:ixMhi1,&
3) :: xCC_TMP
3749 double precision,
dimension(ixMlo1-1:ixMhi1,ixMlo2-1:ixMhi2,ixMlo1&
-1:ixMhi1,nw+nwauxio) :: wC_TMP
3750 double precision,
dimension(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo1:ixMhi1,nw&
+nwauxio) :: wCC_TMP
3751 double precision,
dimension(ixGlo1:ixGhi1,ixGlo2:ixGhi2,ixGlo1:ixGhi1,1:nw&
+nwauxio) :: w
3752 double precision,
dimension(0:nw+nwauxio) :: normconv
3753 integer :: nx1,nx2,nx3, nxC1,nxC2,nxC3, ix1,ix2,ix3, ix, iw, level, idir
3754 integer :: ixCmin1,ixCmin2,ixCmin3,ixCmax1,ixCmax2,ixCmax3,ixCCmin1,&
3755 ixCCmin2,ixCCmin3,ixCCmax1,ixCCmax2,ixCCmax3,nxCC1,nxCC2,nxCC3
3756 integer :: idims,jxCmin1,jxCmin2,jxCmin3,jxCmax1,jxCmax2,jxCmax3
3757 logical,
save :: subfirst=.true.
3760 nx1=ixmhi1-ixmlo1+1;nx2=ixmhi2-ixmlo2+1;nx3=ixmhi1-ixmlo1+1;
3762 dx1=
dx(1,level);dx2=
dx(2,level);dx3=zgridsc*
dx(1,level);
3777 nxcc1=nx1;nxcc2=nx2;nxcc3=nx3;
3778 ixccmin1=ixmlo1;ixccmin2=ixmlo2;ixccmin3=ixmlo1; ixccmax1=ixmhi1
3779 ixccmax2=ixmhi2;ixccmax3=ixmhi1;
3780 do ix=ixccmin1,ixccmax1
3781 xcc(ix,ixccmin2:ixccmax2,ixccmin3:ixccmax3,1)=
rnode(rpxmin1_,igrid)&
3782 +(dble(ix-ixccmin1)+half)*dx1
3784 do ix=ixccmin2,ixccmax2
3785 xcc(ixccmin1:ixccmax1,ix,ixccmin3:ixccmax3,2)=
rnode(rpxmin2_,igrid)&
3786 +(dble(ix-ixccmin2)+half)*dx2
3788 do ix=ixccmin3,ixccmax3
3789 xcc(ixccmin1:ixccmax1,ixccmin2:ixccmax2,ix,3)=-zlength/two+&
3790 dble(i3grid-1)*d3grid+(dble(ix-ixccmin3)+half)*dx3
3794 nxc1=nx1+1;nxc2=nx2+1;nxc3=nx3+1;
3795 ixcmin1=ixmlo1-1;ixcmin2=ixmlo2-1;ixcmin3=ixmlo1-1; ixcmax1=ixmhi1
3796 ixcmax2=ixmhi2;ixcmax3=ixmhi1;
3797 do ix=ixcmin1,ixcmax1
3798 xc(ix,ixcmin2:ixcmax2,ixcmin3:ixcmax3,1)=
rnode(rpxmin1_,igrid)&
3799 +dble(ix-ixcmin1)*dx1
3801 do ix=ixcmin2,ixcmax2
3802 xc(ixcmin1:ixcmax1,ix,ixcmin3:ixcmax3,2)=
rnode(rpxmin2_,igrid)&
3803 +dble(ix-ixcmin2)*dx2
3805 do ix=ixcmin3,ixcmax3
3806 xc(ixcmin1:ixcmax1,ixcmin2:ixcmax2,ix,3)=-zlength/two+&
3807 dble(i3grid-1)*d3grid+dble(ix-ixcmin3)*dx3
3817 jxcmin1=ixghi1+1-
nghostcells;jxcmin2=ixglo2;jxcmin3=ixglo1;
3818 jxcmax1=ixghi1;jxcmax2=ixghi2;jxcmax3=ixghi1;
3819 do ix1=jxcmin1,jxcmax1
3820 w(ix1,jxcmin2:jxcmax2,jxcmin3:jxcmax3,nw-nwextra+1:nw) = w(jxcmin1&
3821 -1,jxcmin2:jxcmax2,jxcmin3:jxcmax3,nw-nwextra+1:nw)
3823 jxcmin1=ixglo1;jxcmin2=ixglo2;jxcmin3=ixglo1;
3824 jxcmax1=ixglo1-1+
nghostcells;jxcmax2=ixghi2;jxcmax3=ixghi1;
3825 do ix1=jxcmin1,jxcmax1
3826 w(ix1,jxcmin2:jxcmax2,jxcmin3:jxcmax3,nw-nwextra+1:nw) = w(jxcmax1&
3827 +1,jxcmin2:jxcmax2,jxcmin3:jxcmax3,nw-nwextra+1:nw)
3830 jxcmin1=ixglo1;jxcmin2=ixghi2+1-
nghostcells;jxcmin3=ixglo1;
3831 jxcmax1=ixghi1;jxcmax2=ixghi2;jxcmax3=ixghi1;
3832 do ix2=jxcmin2,jxcmax2
3833 w(jxcmin1:jxcmax1,ix2,jxcmin3:jxcmax3,nw-nwextra+1:nw) &
3834 = w(jxcmin1:jxcmax1,jxcmin2-1,jxcmin3:jxcmax3,nw-nwextra+1:nw)
3836 jxcmin1=ixglo1;jxcmin2=ixglo2;jxcmin3=ixglo1;
3837 jxcmax1=ixghi1;jxcmax2=ixglo2-1+
nghostcells;jxcmax3=ixghi1;
3838 do ix2=jxcmin2,jxcmax2
3839 w(jxcmin1:jxcmax1,ix2,jxcmin3:jxcmax3,nw-nwextra+1:nw) &
3840 = w(jxcmin1:jxcmax1,jxcmax2+1,jxcmin3:jxcmax3,nw-nwextra+1:nw)
3843 jxcmin1=ixglo1;jxcmin2=ixglo2;jxcmin3=ixghi1+1-
nghostcells;
3844 jxcmax1=ixghi1;jxcmax2=ixghi2;jxcmax3=ixghi1;
3845 do ix3=jxcmin3,jxcmax3
3846 w(jxcmin1:jxcmax1,jxcmin2:jxcmax2,ix3,nw-nwextra+1:nw) &
3847 = w(jxcmin1:jxcmax1,jxcmin2:jxcmax2,jxcmin3-1,nw-nwextra+1:nw)
3849 jxcmin1=ixglo1;jxcmin2=ixglo2;jxcmin3=ixglo1;
3850 jxcmax1=ixghi1;jxcmax2=ixghi2;jxcmax3=ixglo1-1+
nghostcells;
3851 do ix3=jxcmin3,jxcmax3
3852 w(jxcmin1:jxcmax1,jxcmin2:jxcmax2,ix3,nw-nwextra+1:nw) &
3853 = w(jxcmin1:jxcmax1,jxcmin2:jxcmax2,jxcmax3+1,nw-nwextra+1:nw)
3868 +1,ixglo2+1,ixglo1+1,ixghi1-1,ixghi2-1,ixghi1-1,w,xcc,normconv)
3873 wcc(ixccmin1:ixccmax1,ixccmin2:ixccmax2,ixccmin3:ixccmax3,:)=w(ixccmin1:ixccmax1,ixccmin2:ixccmax2,ixccmin3:ixccmax3,:)
3875 do ix3=ixccmin3,ixccmax3
3876 do ix2=ixccmin2,ixccmax2
3877 do ix1=ixccmin1,ixccmax1
3878 wcc(ix1,ix2,ix3,iw_mag(:))=wcc(ix1,ix2,ix3,iw_mag(:))+ps(igrid)%B0(ix1,ix2,&
3885 do ix3=ixccmin3,ixccmax3
3886 do ix2=ixccmin2,ixccmax2
3887 do ix1=ixccmin1,ixccmax1
3888 wcc(ix1,ix2,ix3,iw_e)=w(ix1,ix2,ix3,iw_e) +half*sum(ps(igrid)%B0(ix1,&
3889 ix2,:,0)**2 ) + sum(w(ix1,ix2,ix3,&
3890 iw_mag(:))*ps(igrid)%B0(ix1,ix2,:,0))
3900 if (
b0field.and.iw>iw_mag(1)-1.and.iw<=iw_mag(
ndir))
then
3902 do ix3=ixcmin3,ixcmax3
3903 do ix2=ixcmin2,ixcmax2
3904 do ix1=ixcmin1,ixcmax1
3905 wc(ix1,ix2,ix3,iw)=sum(w(ix1:ix1+1,ix2:ix2+1,ix3,iw) &
3906 +ps(igrid)%B0(ix1:ix1+1,ix2:ix2+1&
3907 ,idir,0))/dble(2**3)+&
3908 sum(w(ix1:ix1+1,ix2:ix2+1,ix3+1,iw) &
3909 +ps(igrid)%B0(ix1:ix1+1,ix2:ix2+1&
3910 ,idir,0))/dble(2**3)
3915 do ix3=ixcmin3,ixcmax3
3916 do ix2=ixcmin2,ixcmax2
3917 do ix1=ixcmin1,ixcmax1
3918 wc(ix1,ix2,ix3,iw)=sum(w(ix1:ix1+1,ix2:ix2+1,ix3:ix3&
3926 do ix3=ixcmin3,ixcmax3
3927 do ix2=ixcmin2,ixcmax2
3928 do ix1=ixcmin1,ixcmax1
3929 wc(ix1,ix2,ix3,iw_e)=sum( w(ix1:ix1+1,ix2:ix2+1,ix3,iw_e) &
3930 +half*sum(ps(igrid)%B0(ix1:ix1+1,ix2:ix2+1&
3931 ,:,0)**2,dim=
ndim+1) + sum( w(ix1:ix1+1,ix2:ix2+1,ix3&
3932 ,iw_mag(:))*ps(igrid)%B0(ix1:ix1+1,ix2:ix2+1&
3933 ,:,0),dim=
ndim+1) ) /dble(2**3)+&
3934 sum( w(ix1:ix1+1,ix2:ix2+1,ix3+1,iw_e) &
3935 +half*sum(ps(igrid)%B0(ix1:ix1+1,ix2:ix2+1&
3936 ,:,0)**2,dim=
ndim+1) + sum( w(ix1:ix1+1,ix2:ix2+1,ix3&
3937 +1,iw_mag(:))*ps(igrid)%B0(ix1:ix1+1,ix2:ix2+1&
3938 ,:,0),dim=
ndim+1) ) /dble(2**3)
3945 xc_tmp(ixcmin1:ixcmax1,ixcmin2:ixcmax2,ixcmin3:ixcmax3,1:3) &
3946 = xc(ixcmin1:ixcmax1,ixcmin2:ixcmax2,ixcmin3:ixcmax3,1:3)
3947 wc_tmp(ixcmin1:ixcmax1,ixcmin2:ixcmax2,ixcmin3:ixcmax3,1:nw&
3948 +
nwauxio) = wc(ixcmin1:ixcmax1,ixcmin2:ixcmax2,ixcmin3:ixcmax3,1:nw&
3950 xcc_tmp(ixccmin1:ixccmax1,ixccmin2:ixccmax2,ixccmin3:ixccmax3,&
3951 1:3) = xcc(ixccmin1:ixccmax1,ixccmin2:ixccmax2,&
3952 ixccmin3:ixccmax3,1:3)
3953 wcc_tmp(ixccmin1:ixccmax1,ixccmin2:ixccmax2,ixccmin3:ixccmax3,1:nw&
3954 +
nwauxio) = wcc(ixccmin1:ixccmax1,ixccmin2:ixccmax2,ixccmin3:ixccmax3,&
3963 integer,
intent(in) :: qunit, igrid
3965 integer :: nx1,nx2,nx3, nxC1,nxC2,nxC3, ix1,ix2,ix3
3967 nx1=ixmhi1-ixmlo1+1;nx2=ixmhi2-ixmlo2+1;nx3=ixmhi1-ixmlo1+1;
3968 nxc1=nx1+1;nxc2=nx2+1;nxc3=nx3+1;
3972 write(qunit,
'(8(i7,1x))')&
3973 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1-1, &
3974 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1,&