358 integer,
intent(in) :: qunit
360 double precision :: x_TEC(ndim), w_TEC(nw+nwauxio)
361 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC_TMP
362 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC_TMP
363 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC
364 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC
365 double precision,
dimension(ixMlo^D-1:ixMhi^D,nw+nwauxio) :: wC_TMP
366 double precision,
dimension(ixMlo^D:ixMhi^D,nw+nwauxio) :: wCC_TMP
367 double precision,
dimension(0:nw+nwauxio) :: normconv
368 integer:: igrid,iigrid,level,igonlevel,iw,idim,ix^D
369 integer:: NumGridsOnLevel(1:nlevelshi)
370 integer :: nx^D,nxC^D,nodesonlevel,elemsonlevel,ixC^L,ixCC^L
371 integer :: nodes, elems
373 logical :: fileopen,first
374 character(len=80) :: filename
376 character(len=1024) :: tecplothead
377 character(len=name_len) :: wnamei(1:nw+nwauxio),xandwnamei(1:ndim+nw+nwauxio)
378 character(len=1024) :: outfilehead
381 if(
mype==0) print *,
'tecplot not parallel, use tecplotmpi'
382 call mpistop(
'npe>1, tecplot')
385 if(nw/=count(
w_write(1:nw)))
then
386 if(
mype==0) print *,
'tecplot does not use w_write=F'
387 call mpistop(
'w_write, tecplot')
391 if(
mype==0) print *,
'tecplot with nocartesian'
394 inquire(qunit,opened=fileopen)
395 if(.not.fileopen)
then
399 write(filename,
'(a,i4.4,a)') trim(
base_filename),filenr,
".plt"
400 open(qunit,file=filename,status=
'unknown')
405 write(tecplothead,
'(a)')
"VARIABLES = "//trim(outfilehead)
406 write(qunit,
'(a)') tecplothead(1:len_trim(tecplothead))
408 numgridsonlevel(1:nlevelshi)=0
410 numgridsonlevel(level)=0
411 do iigrid=1,igridstail; igrid=igrids(iigrid);
413 numgridsonlevel(level)=numgridsonlevel(level)+1
417 nx^d=ixmhi^d-ixmlo^d+1;
425 nodes=nodes + numgridsonlevel(level)*{nxc^d*}
426 elems=elems + numgridsonlevel(level)*{nx^d*}
429 write(qunit,
"(a,i7,a,1pe12.5,a)") &
430 'ZONE T="all levels", I=',elems, &
434 do iigrid=1,igridstail; igrid=igrids(iigrid);
437 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,ixc^l,ixcc^l,.true.)
438 {
do ix^db=ixccmin^db,ixccmax^db\}
439 x_tec(1:ndim)=xcc_tmp(ix^d,1:ndim)*normconv(0)
440 w_tec(1:nw+nwauxio)=wcc_tmp(ix^d,1:nw+nwauxio)*normconv(1:nw+nwauxio)
441 write(qunit,fmt=
"(100(e24.16))") x_tec, w_tec
447 do level=levmin,levmax
448 nodesonlevel=numgridsonlevel(level)*{nxc^d*}
449 elemsonlevel=numgridsonlevel(level)*{nx^d*}
456 select case(convert_type)
461 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,a)") &
462 'ZONE T="',level,
'"',
', N=',nodesonlevel,
', E=',elemsonlevel, &
463 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=POINT, ZONETYPE=', &
464 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
465 do iigrid=1,igridstail; igrid=igrids(iigrid);
466 if (node(plevel_,igrid)/=level) cycle
468 call calc_x(igrid,xc,xcc)
469 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
471 {
do ix^db=ixcmin^db,ixcmax^db\}
472 x_tec(1:ndim)=xc_tmp(ix^d,1:ndim)*normconv(0)
473 w_tec(1:nw+nwauxio)=wc_tmp(ix^d,1:nw+nwauxio)*normconv(1:nw+nwauxio)
474 write(qunit,fmt=
"(100(e14.6))") x_tec, w_tec
483 if(ndim+nw+nwauxio>99)
call mpistop(
"adjust format specification in writeout")
484 if(nw+nwauxio==1)
then
487 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,i1,a,a)") &
488 'ZONE T="',level,
'"',
', N=',nodesonlevel,
', E=',elemsonlevel, &
489 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=BLOCK, VARLOCATION=([', &
490 ndim+1,
']=CELLCENTERED), ZONETYPE=', &
491 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
493 if(ndim+nw+nwauxio<10)
then
495 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,i1,a,i1,a,a)") &
496 'ZONE T="',level,
'"',
', N=',nodesonlevel,
', E=',elemsonlevel, &
497 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=BLOCK, VARLOCATION=([', &
498 ndim+1,
'-',ndim+nw+nwauxio,
']=CELLCENTERED), ZONETYPE=', &
499 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
501 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,i1,a,i2,a,a)") &
502 'ZONE T="',level,
'"',
', N=',nodesonlevel,
', E=',elemsonlevel, &
503 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=BLOCK, VARLOCATION=([', &
504 ndim+1,
'-',ndim+nw+nwauxio,
']=CELLCENTERED), ZONETYPE=', &
505 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
510 do iigrid=1,igridstail; igrid=igrids(iigrid);
511 if (node(plevel_,igrid)/=level) cycle
513 call calc_x(igrid,xc,xcc)
514 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
516 write(qunit,fmt=
"(100(e14.6))") xc_tmp(ixc^s,idim)*normconv(0)
520 do iigrid=1,igridstail; igrid=igrids(iigrid);
521 if (node(plevel_,igrid)/=level) cycle
523 call calc_x(igrid,xc,xcc)
524 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
526 write(qunit,fmt=
"(100(e14.6))") wcc_tmp(ixcc^s,iw)*normconv(iw)
530 call mpistop(
'no such tecplot type')
533 do iigrid=1,igridstail; igrid=igrids(iigrid);
534 if (node(plevel_,igrid)/=level) cycle
536 igonlevel=igonlevel+1
794 integer,
intent(in) :: qunit
796 double precision :: x_VTK(1:3)
797 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC_TMP
798 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC_TMP
799 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC
800 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC
801 double precision,
dimension(ixMlo^D-1:ixMhi^D,nw+nwauxio):: wC_TMP
802 double precision,
dimension(ixMlo^D:ixMhi^D,nw+nwauxio) :: wCC_TMP
803 double precision :: normconv(0:nw+nwauxio)
804 integer,
allocatable :: intstatus(:,:)
806 integer :: itag,ipe,igrid,level,icel,ixC^L,ixCC^L,Morton_no,Morton_length
807 integer :: nx^D,nxC^D,nc,np,VTK_type,ix^D,filenr
809 integer:: length,lengthcc,length_coords,length_conn,length_offsets
811 character(len=80):: filename
812 character(len=19):: offset_char
813 character(len=name_len) :: wnamei(1:nw+nwauxio),xandwnamei(1:ndim+nw+nwauxio)
814 character(len=1024) :: outfilehead
815 logical :: fileopen,cell_corner=.false.
816 logical,
allocatable :: Morton_aim(:),Morton_aim_p(:)
831 if(({
rnode(
rpxmin^
d_,igrid)>=xprobmin^d+(xprobmax^d-xprobmin^d)&
833 <=xprobmax^d-(xprobmax^d-xprobmin^d)*
writespshift(^d,2)|.and.}))
then
834 morton_aim_p(morton_no)=.true.
838 call mpi_allreduce(morton_aim_p,morton_aim,morton_length,mpi_logical,mpi_lor,&
841 case(
'vtuB',
'vtuBmpi')
843 case(
'vtuBCC',
'vtuBCCmpi')
848 if(.not. morton_aim(morton_no)) cycle
851 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
865 inquire(qunit,opened=fileopen)
866 if(.not.fileopen)
then
870 write(filename,
'(a,i4.4,a)') trim(
base_filename),filenr,
".vtu"
872 open(qunit,file=filename,status=
'replace')
876 write(qunit,
'(a)')
'<?xml version="1.0"?>'
877 write(qunit,
'(a)',advance=
'no')
'<VTKFile type="UnstructuredGrid"'
878 write(qunit,
'(a)')
' version="0.1" byte_order="LittleEndian">'
879 write(qunit,
'(a)')
'<UnstructuredGrid>'
880 write(qunit,
'(a)')
'<FieldData>'
881 write(qunit,
'(2a)')
'<DataArray type="Float32" Name="TIME" ',&
882 'NumberOfTuples="1" format="ascii">'
884 write(qunit,
'(a)')
'</DataArray>'
885 write(qunit,
'(a)')
'</FieldData>'
888 nx^d=ixmhi^d-ixmlo^d+1;
893 lengthcc=nc*size_real
894 length_coords=3*length
895 length_conn=2**^nd*size_int*nc
896 length_offsets=nc*size_int
900 if(.not. morton_aim(morton_no)) cycle
903 write(qunit,
'(a,i7,a,i7,a)') &
904 '<Piece NumberOfPoints="',np,
'" NumberOfCells="',nc,
'">'
905 write(qunit,
'(a)')
'<PointData>'
910 write(offset_char,
'(i19)') offset
911 write(qunit,
'(a,a,a,a,a)')&
912 '<DataArray type="Float32" Name="',trim(wnamei(iw)), &
913 '" format="appended" offset="',trim(adjustl(offset_char)),
'">'
914 write(qunit,
'(a)')
'</DataArray>'
915 offset=offset+length+size_int
917 write(qunit,
'(a)')
'</PointData>'
918 write(qunit,
'(a)')
'<Points>'
919 write(offset_char,
'(i19)') offset
920 write(qunit,
'(a,a,a)') &
921 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
923 offset=offset+length_coords+size_int
924 write(qunit,
'(a)')
'</Points>'
927 write(qunit,
'(a,i7,a,i7,a)') &
928 '<Piece NumberOfPoints="',np,
'" NumberOfCells="',nc,
'">'
929 write(qunit,
'(a)')
'<CellData>'
934 write(offset_char,
'(i19)') offset
935 write(qunit,
'(a,a,a,a,a)')&
936 '<DataArray type="Float32" Name="',trim(wnamei(iw)), &
937 '" format="appended" offset="',trim(adjustl(offset_char)),
'">'
938 write(qunit,
'(a)')
'</DataArray>'
939 offset=offset+lengthcc+size_int
941 write(qunit,
'(a)')
'</CellData>'
942 write(qunit,
'(a)')
'<Points>'
943 write(offset_char,
'(i19)') offset
944 write(qunit,
'(a,a,a)') &
945 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
947 offset=offset+length_coords+size_int
948 write(qunit,
'(a)')
'</Points>'
950 write(qunit,
'(a)')
'<Cells>'
952 write(offset_char,
'(i19)') offset
953 write(qunit,
'(a,a,a)')&
954 '<DataArray type="Int32" Name="connectivity" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
955 offset=offset+length_conn+size_int
957 write(offset_char,
'(i19)') offset
958 write(qunit,
'(a,a,a)') &
959 '<DataArray type="Int32" Name="offsets" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
960 offset=offset+length_offsets+size_int
962 write(offset_char,
'(i19)') offset
963 write(qunit,
'(a,a,a)') &
964 '<DataArray type="Int32" Name="types" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
965 offset=offset+size_int+nc*size_int
966 write(qunit,
'(a)')
'</Cells>'
967 write(qunit,
'(a)')
'</Piece>'
973 if(.not. morton_aim(morton_no)) cycle
976 write(qunit,
'(a,i7,a,i7,a)') &
977 '<Piece NumberOfPoints="',np,
'" NumberOfCells="',nc,
'">'
978 write(qunit,
'(a)')
'<PointData>'
983 write(offset_char,
'(i19)') offset
984 write(qunit,
'(a,a,a,a,a)')&
985 '<DataArray type="Float32" Name="',trim(wnamei(iw)), &
986 '" format="appended" offset="',trim(adjustl(offset_char)),
'">'
987 write(qunit,
'(a)')
'</DataArray>'
988 offset=offset+length+size_int
990 write(qunit,
'(a)')
'</PointData>'
991 write(qunit,
'(a)')
'<Points>'
992 write(offset_char,
'(i19)') offset
993 write(qunit,
'(a,a,a)') &
994 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
996 offset=offset+length_coords+size_int
997 write(qunit,
'(a)')
'</Points>'
1000 write(qunit,
'(a,i7,a,i7,a)') &
1001 '<Piece NumberOfPoints="',np,
'" NumberOfCells="',nc,
'">'
1002 write(qunit,
'(a)')
'<CellData>'
1007 write(offset_char,
'(i19)') offset
1008 write(qunit,
'(a,a,a,a,a)')&
1009 '<DataArray type="Float32" Name="',trim(wnamei(iw)), &
1010 '" format="appended" offset="',trim(adjustl(offset_char)),
'">'
1011 write(qunit,
'(a)')
'</DataArray>'
1012 offset=offset+lengthcc+size_int
1014 write(qunit,
'(a)')
'</CellData>'
1015 write(qunit,
'(a)')
'<Points>'
1016 write(offset_char,
'(i19)') offset
1017 write(qunit,
'(a,a,a)') &
1018 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
1020 offset=offset+length_coords+size_int
1021 write(qunit,
'(a)')
'</Points>'
1023 write(qunit,
'(a)')
'<Cells>'
1025 write(offset_char,
'(i19)') offset
1026 write(qunit,
'(a,a,a)')&
1027 '<DataArray type="Int32" Name="connectivity" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
1028 offset=offset+length_conn+size_int
1030 write(offset_char,
'(i19)') offset
1031 write(qunit,
'(a,a,a)') &
1032 '<DataArray type="Int32" Name="offsets" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
1033 offset=offset+length_offsets+size_int
1035 write(offset_char,
'(i19)') offset
1036 write(qunit,
'(a,a,a)') &
1037 '<DataArray type="Int32" Name="types" format="appended" offset="',trim(adjustl(offset_char)),
'"/>'
1038 offset=offset+size_int+nc*size_int
1039 write(qunit,
'(a)')
'</Cells>'
1040 write(qunit,
'(a)')
'</Piece>'
1045 write(qunit,
'(a)')
'</UnstructuredGrid>'
1046 write(qunit,
'(a)')
'<AppendedData encoding="raw">'
1048 open(qunit,file=filename,access=
'stream',form=
'unformatted',position=
'append')
1050 write(qunit) trim(buf)
1053 if(.not. morton_aim(morton_no)) cycle
1055 call calc_x(igrid,xc,xcc)
1056 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
1057 ixc^l,ixcc^l,.true.)
1062 if(cell_corner)
then
1064 write(qunit) {(|}real(wc_tmp(ix^d,iw)*normconv(iw)),{ix^d=ixcmin^d,ixcmax^d)}
1066 write(qunit) lengthcc
1067 write(qunit) {(|}real(wcc_tmp(ix^d,iw)*normconv(iw)),{ix^d=ixccmin^d,ixccmax^d)}
1071 write(qunit) length_coords
1072 {
do ix^db=ixcmin^db,ixcmax^db \}
1074 x_vtk(1:ndim)=xc_tmp(ix^d,1:ndim)*normconv(0);
1076 write(qunit) real(x_vtk(k))
1080 write(qunit) length_conn
1082 {^ifoned
write(qunit)ix1-1,ix1 \}
1084 write(qunit)(ix2-1)*nxc1+ix1-1, &
1085 (ix2-1)*nxc1+ix1,ix2*nxc1+ix1-1,ix2*nxc1+ix1
1089 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1-1, &
1090 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
1091 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1-1,&
1092 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1,&
1093 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1-1,&
1094 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
1095 ix3*nxc2*nxc1+ ix2*nxc1+ix1-1,&
1096 ix3*nxc2*nxc1+ ix2*nxc1+ix1
1100 write(qunit) length_offsets
1102 write(qunit) icel*(2**^nd)
1105 {^ifoned vtk_type=3 \}
1106 {^iftwod vtk_type=8 \}
1107 {^ifthreed vtk_type=11 \}
1108 write(qunit) size_int*nc
1110 write(qunit) vtk_type
1113 allocate(intstatus(mpi_status_size,1))
1115 ixccmin^d=ixmlo^d; ixccmax^d=ixmhi^d;
1116 ixcmin^d=ixmlo^d-1; ixcmax^d=ixmhi^d;
1118 do morton_no=morton_start(ipe),morton_stop(ipe)
1119 if(.not. morton_aim(morton_no)) cycle
1121 call mpi_recv(xc_tmp,1,type_block_xc_io, ipe,itag,icomm,intstatus(:,1),ierrmpi)
1122 if(cell_corner)
then
1123 call mpi_recv(wc_tmp,1,type_block_wc_io, ipe,itag,icomm,intstatus(:,1),ierrmpi)
1125 call mpi_recv(wcc_tmp,1,type_block_wcc_io, ipe,itag,icomm,intstatus(:,1),ierrmpi)
1129 if(.not.w_write(iw)) cycle
1131 if(cell_corner)
then
1133 write(qunit) {(|}real(wc_tmp(ix^d,iw)*normconv(iw)),{ix^d=ixcmin^d,ixcmax^d)}
1135 write(qunit) lengthcc
1136 write(qunit) {(|}real(wcc_tmp(ix^d,iw)*normconv(iw)),{ix^d=ixccmin^d,ixccmax^d)}
1139 write(qunit) length_coords
1140 {
do ix^db=ixcmin^db,ixcmax^db \}
1142 x_vtk(1:ndim)=xc_tmp(ix^d,1:ndim)*normconv(0);
1144 write(qunit) real(x_vtk(k))
1147 write(qunit) length_conn
1149 {^ifoned
write(qunit)ix1-1,ix1 \}
1151 write(qunit)(ix2-1)*nxc1+ix1-1, &
1152 (ix2-1)*nxc1+ix1,ix2*nxc1+ix1-1,ix2*nxc1+ix1
1156 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1-1, &
1157 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
1158 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1-1,&
1159 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1,&
1160 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1-1,&
1161 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
1162 ix3*nxc2*nxc1+ ix2*nxc1+ix1-1,&
1163 ix3*nxc2*nxc1+ ix2*nxc1+ix1
1166 write(qunit) length_offsets
1168 write(qunit) icel*(2**^nd)
1170 {^ifoned vtk_type=3 \}
1171 {^iftwod vtk_type=8 \}
1172 {^ifthreed vtk_type=11 \}
1173 write(qunit) size_int*nc
1175 write(qunit) vtk_type
1181 open(qunit,file=filename,status=
'unknown',form=
'formatted',position=
'append')
1182 write(qunit,
'(a)')
'</AppendedData>'
1183 write(qunit,
'(a)')
'</VTKFile>'
1185 deallocate(intstatus)
1188 deallocate(morton_aim,morton_aim_p)
1190 call mpi_barrier(icomm,ierrmpi)
1203 integer,
intent(in) :: qunit
1205 double precision :: x_VTK(1:3)
1206 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC_TMP
1207 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC_TMP
1208 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC
1209 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC
1210 double precision,
dimension(ixMlo^D-1:ixMhi^D,nw+nwauxio):: wC_TMP
1211 double precision,
dimension(ixMlo^D:ixMhi^D,nw+nwauxio) :: wCC_TMP
1212 double precision :: normconv(0:nw+nwauxio)
1213 integer,
allocatable :: intstatus(:,:)
1215 integer :: itag,ipe,igrid,level,icel,ixC^L,ixCC^L,Morton_no,Morton_length
1216 integer :: nx^D,nxC^D,nc,np,VTK_type,ix^D,filenr
1218 integer:: length,lengthcc,length_coords,length_conn,length_offsets
1220 character(len=80):: filename
1221 character(len=name_len) :: wnamei(1:nw+nwauxio),xandwnamei(1:ndim+nw+nwauxio)
1222 character(len=1024) :: outfilehead
1223 logical :: fileopen,cell_corner=.false.
1224 logical,
allocatable :: Morton_aim(:),Morton_aim_p(:)
1231 morton_aim_p=.false.
1239 if(({
rnode(
rpxmin^
d_,igrid)>=xprobmin^d+(xprobmax^d-xprobmin^d)&
1241 <=xprobmax^d-(xprobmax^d-xprobmin^d)*
writespshift(^d,2)|.and.}))
then
1242 morton_aim_p(morton_no)=.true.
1246 call mpi_allreduce(morton_aim_p,morton_aim,morton_length,mpi_logical,mpi_lor,&
1249 case(
'vtuB64',
'vtuBmpi64')
1251 case(
'vtuBCC64',
'vtuBCCmpi64')
1256 if(.not. morton_aim(morton_no)) cycle
1258 call calc_x(igrid,xc,xcc)
1259 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
1260 ixc^l,ixcc^l,.true.)
1263 if(cell_corner)
then
1272 inquire(qunit,opened=fileopen)
1273 if(.not.fileopen)
then
1277 write(filename,
'(a,i4.4,a)') trim(
base_filename),filenr,
".vtu"
1279 open(qunit,file=filename,status=
'replace')
1283 write(qunit,
'(a)')
'<?xml version="1.0"?>'
1284 write(qunit,
'(a)',advance=
'no')
'<VTKFile type="UnstructuredGrid"'
1285 write(qunit,
'(a)')
' version="0.1" byte_order="LittleEndian">'
1286 write(qunit,
'(a)')
'<UnstructuredGrid>'
1287 write(qunit,
'(a)')
'<FieldData>'
1288 write(qunit,
'(2a)')
'<DataArray type="Float32" Name="TIME" ',&
1289 'NumberOfTuples="1" format="ascii">'
1291 write(qunit,
'(a)')
'</DataArray>'
1292 write(qunit,
'(a)')
'</FieldData>'
1294 nx^d=ixmhi^d-ixmlo^d+1;
1298 length=np*size_double
1299 lengthcc=nc*size_double
1300 length_coords=3*length
1301 length_conn=2**^nd*size_int*nc
1302 length_offsets=nc*size_int
1305 if(.not. morton_aim(morton_no)) cycle
1306 if(cell_corner)
then
1308 write(qunit,
'(a,i7,a,i7,a)') &
1309 '<Piece NumberOfPoints="',np,
'" NumberOfCells="',nc,
'">'
1310 write(qunit,
'(a)')
'<PointData>'
1315 write(qunit,
'(a,a,a,i16,a)')&
1316 '<DataArray type="Float64" Name="',trim(wnamei(iw)), &
1317 '" format="appended" offset="',offset,
'">'
1318 write(qunit,
'(a)')
'</DataArray>'
1319 offset=offset+length+size_int
1321 write(qunit,
'(a)')
'</PointData>'
1322 write(qunit,
'(a)')
'<Points>'
1323 write(qunit,
'(a,i16,a)') &
1324 '<DataArray type="Float64" NumberOfComponents="3" format="appended" offset="',offset,
'"/>'
1326 offset=offset+length_coords+size_int
1327 write(qunit,
'(a)')
'</Points>'
1330 write(qunit,
'(a,i7,a,i7,a)') &
1331 '<Piece NumberOfPoints="',np,
'" NumberOfCells="',nc,
'">'
1332 write(qunit,
'(a)')
'<CellData>'
1337 write(qunit,
'(a,a,a,i16,a)')&
1338 '<DataArray type="Float64" Name="',trim(wnamei(iw)), &
1339 '" format="appended" offset="',offset,
'">'
1340 write(qunit,
'(a)')
'</DataArray>'
1341 offset=offset+lengthcc+size_int
1343 write(qunit,
'(a)')
'</CellData>'
1344 write(qunit,
'(a)')
'<Points>'
1345 write(qunit,
'(a,i16,a)') &
1346 '<DataArray type="Float64" NumberOfComponents="3" format="appended" offset="',offset,
'"/>'
1348 offset=offset+length_coords+size_int
1349 write(qunit,
'(a)')
'</Points>'
1351 write(qunit,
'(a)')
'<Cells>'
1353 write(qunit,
'(a,i16,a)')&
1354 '<DataArray type="Int32" Name="connectivity" format="appended" offset="',offset,
'"/>'
1355 offset=offset+length_conn+size_int
1357 write(qunit,
'(a,i16,a)') &
1358 '<DataArray type="Int32" Name="offsets" format="appended" offset="',offset,
'"/>'
1359 offset=offset+length_offsets+size_int
1361 write(qunit,
'(a,i16,a)') &
1362 '<DataArray type="Int32" Name="types" format="appended" offset="',offset,
'"/>'
1363 offset=offset+size_int+nc*size_int
1364 write(qunit,
'(a)')
'</Cells>'
1365 write(qunit,
'(a)')
'</Piece>'
1371 if(.not. morton_aim(morton_no)) cycle
1372 if(cell_corner)
then
1374 write(qunit,
'(a,i7,a,i7,a)') &
1375 '<Piece NumberOfPoints="',np,
'" NumberOfCells="',nc,
'">'
1376 write(qunit,
'(a)')
'<PointData>'
1381 write(qunit,
'(a,a,a,i16,a)')&
1382 '<DataArray type="Float64" Name="',trim(wnamei(iw)), &
1383 '" format="appended" offset="',offset,
'">'
1384 write(qunit,
'(a)')
'</DataArray>'
1385 offset=offset+length+size_int
1387 write(qunit,
'(a)')
'</PointData>'
1388 write(qunit,
'(a)')
'<Points>'
1389 write(qunit,
'(a,i16,a)') &
1390 '<DataArray type="Float64" NumberOfComponents="3" format="appended" offset="',offset,
'"/>'
1392 offset=offset+length_coords+size_int
1393 write(qunit,
'(a)')
'</Points>'
1396 write(qunit,
'(a,i7,a,i7,a)') &
1397 '<Piece NumberOfPoints="',np,
'" NumberOfCells="',nc,
'">'
1398 write(qunit,
'(a)')
'<CellData>'
1403 write(qunit,
'(a,a,a,i16,a)')&
1404 '<DataArray type="Float64" Name="',trim(wnamei(iw)), &
1405 '" format="appended" offset="',offset,
'">'
1406 write(qunit,
'(a)')
'</DataArray>'
1407 offset=offset+lengthcc+size_int
1409 write(qunit,
'(a)')
'</CellData>'
1410 write(qunit,
'(a)')
'<Points>'
1411 write(qunit,
'(a,i16,a)') &
1412 '<DataArray type="Float64" NumberOfComponents="3" format="appended" offset="',offset,
'"/>'
1414 offset=offset+length_coords+size_int
1415 write(qunit,
'(a)')
'</Points>'
1417 write(qunit,
'(a)')
'<Cells>'
1419 write(qunit,
'(a,i16,a)')&
1420 '<DataArray type="Int32" Name="connectivity" format="appended" offset="',offset,
'"/>'
1421 offset=offset+length_conn+size_int
1423 write(qunit,
'(a,i16,a)') &
1424 '<DataArray type="Int32" Name="offsets" format="appended" offset="',offset,
'"/>'
1425 offset=offset+length_offsets+size_int
1427 write(qunit,
'(a,i16,a)') &
1428 '<DataArray type="Int32" Name="types" format="appended" offset="',offset,
'"/>'
1429 offset=offset+size_int+nc*size_int
1430 write(qunit,
'(a)')
'</Cells>'
1431 write(qunit,
'(a)')
'</Piece>'
1435 write(qunit,
'(a)')
'</UnstructuredGrid>'
1436 write(qunit,
'(a)')
'<AppendedData encoding="raw">'
1438 open(qunit,file=filename,access=
'stream',form=
'unformatted',position=
'append')
1440 write(qunit) trim(buf)
1442 if(.not. morton_aim(morton_no)) cycle
1444 call calc_x(igrid,xc,xcc)
1445 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
1446 ixc^l,ixcc^l,.true.)
1451 if(cell_corner)
then
1453 write(qunit) {(|}wc_tmp(ix^d,iw)*normconv(iw),{ix^d=ixcmin^d,ixcmax^d)}
1455 write(qunit) lengthcc
1456 write(qunit) {(|}wcc_tmp(ix^d,iw)*normconv(iw),{ix^d=ixccmin^d,ixccmax^d)}
1459 write(qunit) length_coords
1460 {
do ix^db=ixcmin^db,ixcmax^db \}
1462 x_vtk(1:ndim)=xc_tmp(ix^d,1:ndim)*normconv(0);
1464 write(qunit) x_vtk(k)
1467 write(qunit) length_conn
1469 {^ifoned
write(qunit)ix1-1,ix1 \}
1471 write(qunit)(ix2-1)*nxc1+ix1-1, &
1472 (ix2-1)*nxc1+ix1,ix2*nxc1+ix1-1,ix2*nxc1+ix1
1476 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1-1, &
1477 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
1478 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1-1,&
1479 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1,&
1480 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1-1,&
1481 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
1482 ix3*nxc2*nxc1+ ix2*nxc1+ix1-1,&
1483 ix3*nxc2*nxc1+ ix2*nxc1+ix1
1486 write(qunit) length_offsets
1488 write(qunit) icel*(2**^nd)
1490 {^ifoned vtk_type=3 \}
1491 {^iftwod vtk_type=8 \}
1492 {^ifthreed vtk_type=11 \}
1493 write(qunit) size_int*nc
1495 write(qunit) vtk_type
1498 allocate(intstatus(mpi_status_size,1))
1500 ixccmin^d=ixmlo^d; ixccmax^d=ixmhi^d;
1501 ixcmin^d=ixmlo^d-1; ixcmax^d=ixmhi^d;
1503 do morton_no=morton_start(ipe),morton_stop(ipe)
1504 if(.not. morton_aim(morton_no)) cycle
1506 call mpi_recv(xc_tmp,1,type_block_xc_io, ipe,itag,icomm,intstatus(:,1),ierrmpi)
1507 if(cell_corner)
then
1508 call mpi_recv(wc_tmp,1,type_block_wc_io, ipe,itag,icomm,intstatus(:,1),ierrmpi)
1510 call mpi_recv(wcc_tmp,1,type_block_wcc_io, ipe,itag,icomm,intstatus(:,1),ierrmpi)
1514 if(.not.w_write(iw)) cycle
1516 if(cell_corner)
then
1518 write(qunit) {(|}wc_tmp(ix^d,iw)*normconv(iw),{ix^d=ixcmin^d,ixcmax^d)}
1520 write(qunit) lengthcc
1521 write(qunit) {(|}wcc_tmp(ix^d,iw)*normconv(iw),{ix^d=ixccmin^d,ixccmax^d)}
1524 write(qunit) length_coords
1525 {
do ix^db=ixcmin^db,ixcmax^db \}
1527 x_vtk(1:ndim)=xc_tmp(ix^d,1:ndim)*normconv(0);
1529 write(qunit) x_vtk(k)
1532 write(qunit) length_conn
1534 {^ifoned
write(qunit)ix1-1,ix1 \}
1536 write(qunit)(ix2-1)*nxc1+ix1-1, &
1537 (ix2-1)*nxc1+ix1,ix2*nxc1+ix1-1,ix2*nxc1+ix1
1541 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1-1, &
1542 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
1543 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1-1,&
1544 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1,&
1545 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1-1,&
1546 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
1547 ix3*nxc2*nxc1+ ix2*nxc1+ix1-1,&
1548 ix3*nxc2*nxc1+ ix2*nxc1+ix1
1551 write(qunit) length_offsets
1553 write(qunit) icel*(2**^nd)
1555 {^ifoned vtk_type=3 \}
1556 {^iftwod vtk_type=8 \}
1557 {^ifthreed vtk_type=11 \}
1558 write(qunit) size_int*nc
1560 write(qunit) vtk_type
1566 open(qunit,file=filename,status=
'unknown',form=
'formatted',position=
'append')
1567 write(qunit,
'(a)')
'</AppendedData>'
1568 write(qunit,
'(a)')
'</VTKFile>'
1570 deallocate(intstatus)
1572 deallocate(morton_aim,morton_aim_p)
1574 call mpi_barrier(icomm,ierrmpi)
1866 integer,
intent(in) :: qunit
1868 double precision :: x_VTK(1:3)
1869 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC_TMP,xC_TMP_recv
1870 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC_TMP,xCC_TMP_recv
1871 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC
1872 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC
1873 double precision,
dimension(ixMlo^D-1:ixMhi^D,nw+nwauxio) :: wC_TMP,wC_TMP_recv
1874 double precision,
dimension(ixMlo^D:ixMhi^D,nw+nwauxio) :: wCC_TMP,wCC_TMP_recv
1875 double precision,
dimension(0:nw+nwauxio) :: normconv
1876 integer:: igrid,iigrid,level,ixC^L,ixCC^L
1877 integer:: NumGridsOnLevel(1:nlevelshi)
1878 integer :: nx^D,nxC^D,nodesonlevel,elemsonlevel,nc,np,ix^D
1880 integer :: itag,ipe,Morton_no,siz_ind
1881 integer :: ind_send(4*^ND),ind_recv(4*^ND)
1882 integer :: levmin_recv,levmax_recv,level_recv,igrid_recv,ixrvC^L,ixrvCC^L
1883 integer,
allocatable :: intstatus(:,:)
1884 logical :: fileopen,conv_grid,cond_grid_recv
1885 character(len=80):: filename
1886 character(len=name_len) :: wnamei(1:nw+nwauxio),xandwnamei(1:ndim+nw+nwauxio)
1887 character(len=1024) :: outfilehead
1890 inquire(qunit,opened=fileopen)
1891 if(.not.fileopen)
then
1895 write(filename,
'(a,i4.4,a)') trim(
base_filename),filenr,
".vtu"
1897 open(qunit,file=filename,status=
'unknown',form=
'formatted')
1900 write(qunit,
'(a)')
'<?xml version="1.0"?>'
1901 write(qunit,
'(a)',advance=
'no')
'<VTKFile type="UnstructuredGrid"'
1902 write(qunit,
'(a)')
' version="0.1" byte_order="LittleEndian">'
1903 write(qunit,
'(a)')
'<UnstructuredGrid>'
1904 write(qunit,
'(a)')
'<FieldData>'
1905 write(qunit,
'(2a)')
'<DataArray type="Float32" Name="TIME" ',&
1906 'NumberOfTuples="1" format="ascii">'
1908 write(qunit,
'(a)')
'</DataArray>'
1909 write(qunit,
'(a)')
'</FieldData>'
1914 nx^d=ixmhi^d-ixmlo^d+1;
1936 call mpi_send(igrid,1,mpi_integer, 0,itag,
icomm,
ierrmpi)
1943 conv_grid=({
rnode(
rpxmin^
d_,igrid)>=xprobmin^d+(xprobmax^d-xprobmin^d)&
1945 <=xprobmax^d-(xprobmax^d-xprobmin^d)*
writespshift(^d,2)|.and.})
1947 call mpi_send(conv_grid,1,mpi_logical,0,itag,
icomm,
ierrmpi)
1949 if (.not.conv_grid) cycle
1950 call calc_x(igrid,xc,xcc)
1951 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
1952 ixc^l,ixcc^l,.true.)
1955 ind_send=(/ ixc^l,ixcc^l /)
1957 call mpi_send(ind_send,siz_ind,mpi_integer, 0,itag,
icomm,
ierrmpi)
1958 call mpi_send(normconv,nw+nwauxio+1,mpi_double_precision, 0,itag,
icomm,
ierrmpi)
1965 call write_vtk(qunit,ixg^
ll,ixc^l,ixcc^l,igrid,nc,np,nx^d,nxc^d,&
1966 normconv,wnamei,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp)
1972 allocate(intstatus(mpi_status_size,1))
1976 call mpi_recv(levmin_recv,1,mpi_integer, ipe,itag,
icomm,intstatus(:,1),
ierrmpi)
1979 call mpi_recv(levmax_recv,1,mpi_integer, ipe,itag,
icomm,intstatus(:,1),
ierrmpi)
1981 do level=levmin_recv,levmax_recv
1985 call mpi_recv(igrid_recv,1,mpi_integer, ipe,itag,
icomm,intstatus(:,1),
ierrmpi)
1987 call mpi_recv(level_recv,1,mpi_integer, ipe,itag,
icomm,intstatus(:,1),
ierrmpi)
1988 if (level_recv/=level) cycle
1989 call mpi_recv(cond_grid_recv,1,mpi_logical, ipe,itag,
icomm,intstatus(:,1),
ierrmpi)
1990 if(.not.cond_grid_recv)cycle
1993 call mpi_recv(ind_recv,siz_ind, mpi_integer, ipe,itag,
icomm,intstatus(:,1),
ierrmpi)
1994 ixrvcmin^d=ind_recv(^d);ixrvcmax^d=ind_recv(^nd+^d);
1995 ixrvccmin^d=ind_recv(2*^nd+^d);ixrvccmax^d=ind_recv(3*^nd+^d);
1996 call mpi_recv(normconv,nw+nwauxio+1, mpi_double_precision,ipe,itag&
2003 call write_vtk(qunit,ixg^
ll,ixrvc^l,ixrvcc^l,igrid_recv,&
2004 nc,np,nx^d,nxc^d,normconv,wnamei,&
2005 xc_tmp_recv,xcc_tmp_recv,wc_tmp_recv,wcc_tmp_recv)
2010 write(qunit,
'(a)')
'</UnstructuredGrid>'
2011 write(qunit,
'(a)')
'</VTKFile>'
2016 if(
mype==0)
deallocate(intstatus)
2256 integer,
intent(in) :: qunit
2258 double precision :: x_TEC(ndim), w_TEC(nw+nwauxio)
2259 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC_TMP,xC_TMP_recv
2260 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC_TMP,xCC_TMP_recv
2261 double precision,
dimension(ixMlo^D-1:ixMhi^D,ndim) :: xC
2262 double precision,
dimension(ixMlo^D:ixMhi^D,ndim) :: xCC
2263 double precision,
dimension(ixMlo^D-1:ixMhi^D,nw+nwauxio) :: wC_TMP,wC_TMP_recv
2264 double precision,
dimension(ixMlo^D:ixMhi^D,nw+nwauxio) :: wCC_TMP,wCC_TMP_recv
2265 double precision,
dimension(0:nw+nwauxio) :: normconv
2266 integer:: igrid,iigrid,level,igonlevel,iw,idim,ix^D
2267 integer:: NumGridsOnLevel(1:nlevelshi)
2268 integer :: nx^D,nxC^D,nodesonlevel,elemsonlevel,ixC^L,ixCC^L
2269 integer :: nodesonlevelmype,elemsonlevelmype
2270 integer :: nodes, elems
2271 integer,
allocatable :: intstatus(:,:)
2272 integer :: itag,Morton_no,ipe,levmin_recv,levmax_recv,igrid_recv,level_recv
2273 integer :: ixrvC^L,ixrvCC^L
2274 integer :: ind_send(2*^ND),ind_recv(2*^ND),siz_ind,igonlevel_recv
2275 integer :: NumGridsOnLevel_mype(1:nlevelshi,0:npe-1)
2277 logical :: fileopen,first
2278 character(len=80) :: filename
2279 character(len=1024) :: tecplothead
2280 character(len=name_len) :: wnamei(1:nw+nwauxio),xandwnamei(1:ndim+nw+nwauxio)
2281 character(len=1024) :: outfilehead
2283 if(nw/=count(
w_write(1:nw)))
then
2284 if(
mype==0) print *,
'tecplot_mpi does not use w_write=F'
2285 call mpistop(
'w_write, tecplot')
2289 if(
mype==0) print *,
'tecplot_mpi with nocartesian'
2292 master_cpu_open :
if (
mype == 0)
then
2293 inquire(qunit,opened=fileopen)
2294 if (.not.fileopen)
then
2298 write(filename,
'(a,i4.4,a)') trim(
base_filename),filenr,
".plt"
2299 open(qunit,file=filename,status=
'unknown')
2302 write(tecplothead,
'(a)')
"VARIABLES = "//trim(outfilehead)
2303 write(qunit,
'(a)') tecplothead(1:len_trim(tecplothead))
2304 end if master_cpu_open
2307 numgridsonlevel(1:nlevelshi)=0
2309 numgridsonlevel(level)=0
2313 numgridsonlevel(level)=numgridsonlevel(level)+1
2315 numgridsonlevel_mype(level,0:npe-1)=0
2316 numgridsonlevel_mype(level,
mype) = numgridsonlevel(level)
2317 call mpi_allreduce(mpi_in_place,numgridsonlevel_mype(level,0:npe-1),npe,mpi_integer,&
2319 call mpi_allreduce(mpi_in_place,numgridsonlevel(level),1,mpi_integer,mpi_sum, &
2323 nx^d=ixmhi^d-ixmlo^d+1;
2326 if(
mype==0.and.npe>1)
allocate(intstatus(mpi_status_size,1))
2333 nodes=nodes + numgridsonlevel(level)*{nxc^d*}
2334 elems=elems + numgridsonlevel(level)*{nx^d*}
2337 if (
mype==0)
write(qunit,
"(a,i7,a,1pe12.5,a)") &
2338 'ZONE T="all levels", I=',elems, &
2344 call calc_x(igrid,xc,xcc)
2345 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,ixc^l,ixcc^l,.true.)
2347 {
do ix^db=ixccmin^db,ixccmax^db\}
2348 x_tec(1:ndim)=xcc_tmp(ix^d,1:ndim)*normconv(0)
2349 w_tec(1:nw+nwauxio)=wcc_tmp(ix^d,1:nw+nwauxio)*normconv(1:nw+nwauxio)
2350 write(qunit,fmt=
"(100(e14.6))") x_tec, w_tec
2352 else if (mype/=0)
then
2354 call mpi_send(igrid,1,mpi_integer, 0,itag,icomm,ierrmpi)
2355 call mpi_send(normconv,nw+nwauxio+1,mpi_double_precision,0,itag,icomm,ierrmpi)
2356 call mpi_send(wcc_tmp,1,type_block_wcc_io, 0,itag,icomm,ierrmpi)
2357 call mpi_send(xcc_tmp,1,type_block_xcc_io, 0,itag,icomm,ierrmpi)
2362 do morton_no=morton_start(ipe),morton_stop(ipe)
2364 call mpi_recv(igrid_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2365 call mpi_recv(normconv,nw+nwauxio+1, mpi_double_precision,ipe,&
2366 itag,icomm,intstatus(:,1),ierrmpi)
2367 call mpi_recv(wcc_tmp_recv,1,type_block_wcc_io, ipe,itag,&
2368 icomm,intstatus(:,1),ierrmpi)
2369 call mpi_recv(xcc_tmp_recv,1,type_block_xcc_io, ipe,itag,&
2370 icomm,intstatus(:,1),ierrmpi)
2371 {
do ix^db=ixccmin^db,ixccmax^db\}
2372 x_tec(1:ndim)=xcc_tmp_recv(ix^d,1:ndim)*normconv(0)
2373 w_tec(1:nw+nwauxio)=wcc_tmp_recv(ix^d,1:nw+nwauxio)*normconv(1:nw+nwauxio)
2374 write(qunit,fmt=
"(100(e14.6))") x_tec, w_tec
2383 itag=1000*morton_stop(mype)
2384 call mpi_send(levmin,1,mpi_integer, 0,itag,icomm,ierrmpi)
2385 itag=2000*morton_stop(mype)
2386 call mpi_send(levmax,1,mpi_integer, 0,itag,icomm,ierrmpi)
2389 do level=levmin,levmax
2390 nodesonlevelmype=numgridsonlevel_mype(level,mype)*{nxc^d*}
2391 elemsonlevelmype=numgridsonlevel_mype(level,mype)*{nx^d*}
2392 nodesonlevel=numgridsonlevel(level)*{nxc^d*}
2393 elemsonlevel=numgridsonlevel(level)*{nx^d*}
2400 select case(convert_type)
2405 if (mype==0.and.(nodesonlevelmype>0.and.elemsonlevelmype>0))&
2406 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,a)") &
2407 'ZONE T="',level,
'"',
', N=',nodesonlevelmype,
', E=',elemsonlevelmype, &
2408 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=POINT, ZONETYPE=', &
2409 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
2410 do morton_no=morton_start(mype),morton_stop(mype)
2411 igrid = sfc_to_igrid(morton_no)
2414 call mpi_send(igrid,1,mpi_integer, 0,itag,icomm,ierrmpi)
2416 call mpi_send(node(plevel_,igrid),1,mpi_integer, 0,itag,icomm,ierrmpi)
2418 if (node(plevel_,igrid)/=level) cycle
2419 call calc_x(igrid,xc,xcc)
2420 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
2421 ixc^l,ixcc^l,.true.)
2424 ind_send=(/ ixc^l /)
2426 call mpi_send(ind_send,siz_ind, mpi_integer, 0,itag,icomm,ierrmpi)
2427 call mpi_send(normconv,nw+nwauxio+1,mpi_double_precision, 0,itag,icomm,ierrmpi)
2429 call mpi_send(wc_tmp,1,type_block_wc_io, 0,itag,icomm,ierrmpi)
2430 call mpi_send(xc_tmp,1,type_block_xc_io, 0,itag,icomm,ierrmpi)
2432 {
do ix^db=ixcmin^db,ixcmax^db\}
2433 x_tec(1:ndim)=xc_tmp(ix^d,1:ndim)*normconv(0)
2434 w_tec(1:nw+nwauxio)=wc_tmp(ix^d,1:nw+nwauxio)*normconv(1:nw+nwauxio)
2435 write(qunit,fmt=
"(100(e14.6))") x_tec, w_tec
2439 case(
'tecplotCCmpi')
2445 if(ndim+nw+nwauxio>99)
call mpistop(
"adjust format specification in writeout")
2446 if(nw+nwauxio==1)
then
2449 if (mype==0.and.(nodesonlevelmype>0.and.elemsonlevelmype>0))&
2450 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,i1,a,a)") &
2451 'ZONE T="',level,
'"',
', N=',nodesonlevelmype,
', E=',elemsonlevelmype, &
2452 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=BLOCK, VARLOCATION=([', &
2453 ndim+1,
']=CELLCENTERED), ZONETYPE=', &
2454 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
2456 if(ndim+nw+nwauxio<10)
then
2458 if (mype==0.and.(nodesonlevelmype>0.and.elemsonlevelmype>0))&
2459 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,i1,a,i1,a,a)") &
2460 'ZONE T="',level,
'"',
', N=',nodesonlevelmype,
', E=',elemsonlevelmype, &
2461 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=BLOCK, VARLOCATION=([', &
2462 ndim+1,
'-',ndim+nw+nwauxio,
']=CELLCENTERED), ZONETYPE=', &
2463 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
2465 if (mype==0.and.(nodesonlevelmype>0.and.elemsonlevelmype>0))&
2466 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,i1,a,i2,a,a)") &
2467 'ZONE T="',level,
'"',
', N=',nodesonlevelmype,
', E=',elemsonlevelmype, &
2468 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=BLOCK, VARLOCATION=([', &
2469 ndim+1,
'-',ndim+nw+nwauxio,
']=CELLCENTERED), ZONETYPE=', &
2470 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
2476 do morton_no=morton_start(mype),morton_stop(mype)
2477 igrid = sfc_to_igrid(morton_no)
2480 call mpi_send(igrid,1,mpi_integer, 0,itag,icomm,ierrmpi)
2482 call mpi_send(node(plevel_,igrid),1,mpi_integer, 0,itag,icomm,ierrmpi)
2484 if (node(plevel_,igrid)/=level) cycle
2485 call calc_x(igrid,xc,xcc)
2486 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
2489 ind_send=(/ ixc^l /)
2492 call mpi_send(ind_send,siz_ind, mpi_integer, 0,itag,icomm,ierrmpi)
2493 call mpi_send(normconv,nw+nwauxio+1,mpi_double_precision, 0,itag,icomm,ierrmpi)
2494 call mpi_send(xc_tmp,1,type_block_xc_io, 0,itag,icomm,ierrmpi)
2496 write(qunit,fmt=
"(100(e14.6))") xc_tmp(ixc^s,idim)*normconv(0)
2501 do morton_no=morton_start(mype),morton_stop(mype)
2502 igrid = sfc_to_igrid(morton_no)
2504 itag=morton_no*(ndim+iw)
2505 call mpi_send(igrid,1,mpi_integer, 0,itag,icomm,ierrmpi)
2506 itag=igrid*(ndim+iw)
2507 call mpi_send(node(plevel_,igrid),1,mpi_integer, 0,itag,icomm,ierrmpi)
2509 if (node(plevel_,igrid)/=level) cycle
2510 call calc_x(igrid,xc,xcc)
2511 call calc_grid(qunit,igrid,xc,xcc,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
2512 ixc^l,ixcc^l,.true.)
2514 ind_send=(/ ixcc^l /)
2516 itag=igrid*(ndim+iw)
2517 call mpi_send(ind_send,siz_ind, mpi_integer, 0,itag,icomm,ierrmpi)
2518 call mpi_send(normconv,nw+nwauxio+1,mpi_double_precision, 0,itag,icomm,ierrmpi)
2519 call mpi_send(wcc_tmp,1,type_block_wcc_io, 0,itag,icomm,ierrmpi)
2521 write(qunit,fmt=
"(100(e14.6))") wcc_tmp(ixcc^s,iw)*normconv(iw)
2526 call mpistop(
'no such tecplot type')
2530 do morton_no=morton_start(mype),morton_stop(mype)
2531 igrid = sfc_to_igrid(morton_no)
2534 call mpi_send(igrid,1,mpi_integer, 0,itag,icomm,ierrmpi)
2536 call mpi_send(node(plevel_,igrid),1,mpi_integer, 0,itag,icomm,ierrmpi)
2538 if(node(plevel_,igrid)/=level) cycle
2539 igonlevel=igonlevel+1
2542 call mpi_send(igonlevel,1,mpi_integer, 0,itag,icomm,ierrmpi)
2550 if(mype==0 .and.npe>1)
then
2552 itag=1000*morton_stop(ipe)
2553 call mpi_recv(levmin_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2554 itag=2000*morton_stop(ipe)
2555 call mpi_recv(levmax_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2556 do level=levmin_recv,levmax_recv
2557 nodesonlevelmype=numgridsonlevel_mype(level,ipe)*{nxc^d*}
2558 elemsonlevelmype=numgridsonlevel_mype(level,ipe)*{nx^d*}
2559 nodesonlevel=numgridsonlevel(level)*{nxc^d*}
2560 elemsonlevel=numgridsonlevel(level)*{nx^d*}
2561 select case(convert_type)
2566 if(nodesonlevelmype>0.and.elemsonlevelmype>0) &
2567 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,a)") &
2568 'ZONE T="',level,
'"',
', N=',nodesonlevelmype,
', E=',elemsonlevelmype, &
2569 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=POINT, ZONETYPE=', &
2570 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
2571 do morton_no=morton_start(ipe),morton_stop(ipe)
2573 call mpi_recv(igrid_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2575 call mpi_recv(level_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2576 if (level_recv/=level) cycle
2579 call mpi_recv(ind_recv,siz_ind, mpi_integer, ipe,itag,&
2580 icomm,intstatus(:,1),ierrmpi)
2581 ixrvcmin^d=ind_recv(^d);ixrvcmax^d=ind_recv(^nd+^d);
2582 call mpi_recv(normconv,nw+nwauxio+1, mpi_double_precision,ipe,itag&
2583 ,icomm,intstatus(:,1),ierrmpi)
2584 call mpi_recv(wc_tmp_recv,1,type_block_wc_io, ipe,itag,&
2585 icomm,intstatus(:,1),ierrmpi)
2586 call mpi_recv(xc_tmp_recv,1,type_block_xc_io, ipe,itag,&
2587 icomm,intstatus(:,1),ierrmpi)
2588 {
do ix^db=ixrvcmin^db,ixrvcmax^db\}
2589 x_tec(1:ndim)=xc_tmp_recv(ix^d,1:ndim)*normconv(0)
2590 w_tec(1:nw+nwauxio)=wc_tmp_recv(ix^d,1:nw+nwauxio)*normconv(1:nw+nwauxio)
2591 write(qunit,fmt=
"(100(e14.6))") x_tec, w_tec
2594 case(
'tecplotCCmpi')
2600 if(ndim+nw+nwauxio>99)
call mpistop(
"adjust format specification in writeout")
2601 if(nw+nwauxio==1)
then
2604 if(nodesonlevelmype>0.and.elemsonlevelmype>0) &
2605 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,i1,a,a)") &
2606 'ZONE T="',level,
'"',
', N=',nodesonlevelmype,
', E=',elemsonlevelmype, &
2607 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=BLOCK, VARLOCATION=([', &
2608 ndim+1,
']=CELLCENTERED), ZONETYPE=', &
2609 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
2611 if(ndim+nw+nwauxio<10)
then
2613 if(nodesonlevelmype>0.and.elemsonlevelmype>0) &
2614 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,i1,a,i1,a,a)") &
2615 'ZONE T="',level,
'"',
', N=',nodesonlevelmype,
', E=',elemsonlevelmype, &
2616 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=BLOCK, VARLOCATION=([', &
2617 ndim+1,
'-',ndim+nw+nwauxio,
']=CELLCENTERED), ZONETYPE=', &
2618 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
2620 if(nodesonlevelmype>0.and.elemsonlevelmype>0) &
2621 write(qunit,
"(a,i7,a,a,i7,a,i7,a,f25.16,a,i1,a,i2,a,a)") &
2622 'ZONE T="',level,
'"',
', N=',nodesonlevelmype,
', E=',elemsonlevelmype, &
2623 ', SOLUTIONTIME=',global_time*time_convert_factor,
', DATAPACKING=BLOCK, VARLOCATION=([', &
2624 ndim+1,
'-',ndim+nw+nwauxio,
']=CELLCENTERED), ZONETYPE=', &
2625 {^ifoned
'FELINESEG'}{^iftwod
'FEQUADRILATERAL'}{^ifthreed
'FEBRICK'}
2630 do morton_no=morton_start(ipe),morton_stop(ipe)
2632 call mpi_recv(igrid_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2633 itag=igrid_recv*idim
2634 call mpi_recv(level_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2635 if (level_recv/=level) cycle
2637 itag=igrid_recv*idim
2638 call mpi_recv(ind_recv,siz_ind, mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2639 ixrvcmin^d=ind_recv(^d);ixrvcmax^d=ind_recv(^nd+^d);
2640 call mpi_recv(normconv,nw+nwauxio+1, mpi_double_precision,ipe,itag&
2641 ,icomm,intstatus(:,1),ierrmpi)
2642 call mpi_recv(xc_tmp_recv,1,type_block_xc_io, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2643 write(qunit,fmt=
"(100(e14.6))") xc_tmp_recv(ixrvc^s,idim)*normconv(0)
2647 do morton_no=morton_start(ipe),morton_stop(ipe)
2648 itag=morton_no*(ndim+iw)
2649 call mpi_recv(igrid_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2650 itag=igrid_recv*(ndim+iw)
2651 call mpi_recv(level_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2652 if (level_recv/=level) cycle
2654 itag=igrid_recv*(ndim+iw)
2655 call mpi_recv(ind_recv,siz_ind, mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2656 ixrvccmin^d=ind_recv(^d);ixrvccmax^d=ind_recv(^nd+^d);
2657 call mpi_recv(normconv,nw+nwauxio+1, mpi_double_precision,ipe,itag&
2658 ,icomm,intstatus(:,1),ierrmpi)
2659 call mpi_recv(wcc_tmp_recv,1,type_block_wcc_io, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2660 write(qunit,fmt=
"(100(e14.6))") wcc_tmp_recv(ixrvcc^s,iw)*normconv(iw)
2664 call mpistop(
'no such tecplot type')
2667 do morton_no=morton_start(ipe),morton_stop(ipe)
2669 call mpi_recv(igrid_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2671 call mpi_recv(level_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2672 if (level_recv/=level) cycle
2674 call mpi_recv(igonlevel_recv,1,mpi_integer, ipe,itag,icomm,intstatus(:,1),ierrmpi)
2683 call mpi_barrier(icomm,ierrmpi)
2684 if(mype==0)
deallocate(intstatus)
2964 integer,
intent(in) :: qunit
2966 double precision :: x_VTK(1:3)
2967 double precision,
dimension(ixMlo1-1:ixMhi1,ixMlo2-1:ixMhi2,ixMlo1&
-1:ixMhi1,3) :: xC_TMP
2968 double precision,
dimension(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo1:ixMhi1,&
3) :: xCC_TMP
2969 double precision,
dimension(ixMlo1-1:ixMhi1,ixMlo2-1:ixMhi2,ixMlo1&
-1:ixMhi1,nw+nwauxio) :: wC_TMP
2970 double precision,
dimension(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo1:ixMhi1,nw&
+nwauxio) :: wCC_TMP
2971 double precision,
dimension(ixGlo1:ixGhi1,ixGlo2:ixGhi2,ixGlo1:ixGhi1,1:nw&
+nwauxio) :: w
2972 double precision :: normconv(0:nw+nwauxio)
2973 double precision :: zlength
2974 double precision ::d3grid,zlengsc,zgridsc
2976 integer:: igrid,iigrid,level,igonlevel,icel,ixCmin1,ixCmin2,&
2977 ixCmin3,ixCmax1,ixCmax2,ixCmax3,ixCCmin1,ixCCmin2,ixCCmin3,ixCCmax1,&
2979 integer:: NumGridsOnLevel(1:nlevelshi)
2980 integer :: nx1,nx2,nx3,nxC1,nxC2,nxC3,nodesonlevel,elemsonlevel,nc,np,&
2981 VTK_type,ix1,ix2,ix3
2982 integer :: size_length,recsep,k,iw
2983 integer :: length,lengthcc,offset_points,offset_cells, length_coords,&
2984 length_conn,length_offsets
2985 integer :: i3grid,n3grid
2988 character(len=6):: bufform
2989 character(len=80):: filename
2990 character(len=name_len) :: wnamei(1:nw+nwauxio),xandwnamei(1:3+nw+nwauxio)
2991 character(len=1024) :: outfilehead
2994 if(
mype==0) print *,
'unstructuredvtkB23 not parallel, use vtumpi'
2995 call mpistop(
'npe>1, unstructuredvtkB23')
3001 inquire(qunit,opened=fileopen)
3002 if(.not.fileopen)
then
3006 open(qunit,file=filename,status=
'replace')
3010 write(qunit,
'(a)')
'<?xml version="1.0"?>'
3011 write(qunit,
'(a)',advance=
'no')
'<VTKFile type="UnstructuredGrid"'
3012 write(qunit,
'(a)')
' version="0.1" byte_order="LittleEndian">'
3013 write(qunit,
'(a)')
'<UnstructuredGrid>'
3014 write(qunit,
'(a)')
'<FieldData>'
3015 write(qunit,
'(2a)')
'<DataArray type="Float32" Name="TIME" ',&
3016 'NumberOfTuples="1" format="ascii">'
3018 write(qunit,
'(a)')
'</DataArray>'
3019 write(qunit,
'(a)')
'</FieldData>'
3022 nx1=ixmhi1-ixmlo1+1;nx2=ixmhi2-ixmlo2+1;nx3=ixmhi1-ixmlo1+1;
3023 nxc1=nx1+1;nxc2=nx2+1;nxc3=nx3+1;
3028 lengthcc=nc*size_real
3030 length_coords=3*length
3031 length_conn=2**3*size_int*nc
3032 length_offsets=nc*size_int
3037 zlengsc=2.d0*zgridsc
3038 zlength=zlengsc*(xprobmax1-xprobmin1)
3041 do iigrid=1,igridstail; igrid=igrids(iigrid);
3046 if ((
rnode(rpxmin1_,igrid)>=xprobmin1+(xprobmax1-xprobmin1)&
3049 .and.(
rnode(rpxmax1_,igrid)<=xprobmax1-(xprobmax1-xprobmin1)&
3052 d3grid=zgridsc*(
rnode(rpxmax1_,igrid)-
rnode(rpxmin1_,igrid))
3053 n3grid=nint(zlength/d3grid)
3058 write(qunit,
'(a,i7,a,i7,a)')
'<Piece NumberOfPoints="',np,&
3059 '" NumberOfCells="',nc,
'">'
3060 write(qunit,
'(a)')
'<PointData>'
3063 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3064 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3065 write(qunit,
'(a)')
'</DataArray>'
3066 offset=offset+length+size_int
3069 do iw=nw+1,nw+nwauxio
3070 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3071 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3072 write(qunit,
'(a)')
'</DataArray>'
3073 offset=offset+length+size_int
3076 write(qunit,
'(a)')
'</PointData>'
3078 write(qunit,
'(a)')
'<Points>'
3079 write(qunit,
'(a,i16,a)') &
3080 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',&
3083 offset=offset+length_coords+size_int
3084 write(qunit,
'(a)')
'</Points>'
3087 write(qunit,
'(a,i7,a,i7,a)')
'<Piece NumberOfPoints="',np,&
3088 '" NumberOfCells="',nc,
'">'
3089 write(qunit,
'(a)')
'<CellData>'
3092 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3093 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3094 write(qunit,
'(a)')
'</DataArray>'
3095 offset=offset+lengthcc+size_int
3098 do iw=nw+1,nw+nwauxio
3099 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3100 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3101 write(qunit,
'(a)')
'</DataArray>'
3102 offset=offset+lengthcc+size_int
3105 write(qunit,
'(a)')
'</CellData>'
3106 write(qunit,
'(a)')
'<Points>'
3107 write(qunit,
'(a,i16,a)') &
3108 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',&
3111 offset=offset+length_coords+size_int
3112 write(qunit,
'(a)')
'</Points>'
3114 write(qunit,
'(a)')
'<Cells>'
3116 write(qunit,
'(a,i16,a)')&
3117 '<DataArray type="Int32" Name="connectivity" format="appended" offset="',&
3119 offset=offset+length_conn+size_int
3121 write(qunit,
'(a,i16,a)') &
3122 '<DataArray type="Int32" Name="offsets" format="appended" offset="',&
3124 offset=offset+length_offsets+size_int
3126 write(qunit,
'(a,i16,a)') &
3127 '<DataArray type="Int32" Name="types" format="appended" offset="',&
3129 offset=offset+size_length+nc*size_int
3130 write(qunit,
'(a)')
'</Cells>'
3131 write(qunit,
'(a)')
'</Piece>'
3138 write(qunit,
'(a)')
'</UnstructuredGrid>'
3139 write(qunit,
'(a)')
'<AppendedData encoding="raw">'
3141 open(qunit,file=filename,form=
'unformatted',access=
'stream',status=
'old',position=
'append')
3143 write(qunit) trim(buffer)
3147 do iigrid=1,igridstail; igrid=igrids(iigrid);
3152 if ((
rnode(rpxmin1_,igrid)>=xprobmin1+(xprobmax1-xprobmin1)&
3155 .and.(
rnode(rpxmax1_,igrid)<=xprobmax1-(xprobmax1-xprobmin1)&
3158 d3grid=zgridsc*(
rnode(rpxmax1_,igrid)-
rnode(rpxmin1_,igrid))
3159 n3grid=nint(zlength/d3grid)
3164 ixglo1,ixglo2,ixghi1,ixghi2,ps(igrid)%w,ps(igrid)%x)
3168 do ix3=ixglo1,ixghi1
3169 w(ixglo1:ixghi1,ixglo2:ixghi2,ix3,1:nw)=ps(igrid)%w(ixglo1:ixghi1,&
3173 call calc_grid23(qunit,igrid,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
3174 ixcmin1,ixcmin2,ixcmin3,ixcmax1,ixcmax2,ixcmax3,ixccmin1,ixccmin2,&
3175 ixccmin3,ixccmax1,ixccmax2,ixccmax3,.true.,i3grid,d3grid,w,zlength,zgridsc)
3181 write(qunit) (((real(wc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3182 =ixcmin1,ixcmax1),ix2=ixcmin2,ixcmax2),ix3=ixcmin3,ixcmax3)
3184 write(qunit) lengthcc
3185 write(qunit) (((real(wcc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3186 =ixccmin1,ixccmax1),ix2=ixccmin2,ixccmax2),ix3&
3191 do iw=nw+1,nw+nwauxio
3195 write(qunit) (((real(wc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3196 =ixcmin1,ixcmax1),ix2=ixcmin2,ixcmax2),ix3=ixcmin3,ixcmax3)
3198 write(qunit) lengthcc
3199 write(qunit) (((real(wcc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3200 =ixccmin1,ixccmax1),ix2=ixccmin2,ixccmax2),ix3&
3205 write(qunit) length_coords
3206 do ix3=ixcmin3,ixcmax3
3207 do ix2=ixcmin2,ixcmax2
3208 do ix1=ixcmin1,ixcmax1
3210 x_vtk(1:3)=xc_tmp(ix1,ix2,ix3,1:3)*normconv(0);
3212 write(qunit) real(x_vtk(k))
3217 write(qunit) length_conn
3222 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1-1, &
3223 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
3224 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1-1,&
3225 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1,&
3226 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1-1,&
3227 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
3228 ix3*nxc2*nxc1+ ix2*nxc1+ix1-1,&
3229 ix3*nxc2*nxc1+ ix2*nxc1+ix1
3233 write(qunit) length_offsets
3235 write(qunit) icel*(2**3)
3238 write(qunit) size_int*nc
3240 write(qunit) vtk_type
3249 open(qunit,file=filename,status=
'unknown',form=
'formatted',position=
'append')
3251 write(qunit,
'(a)')
'</AppendedData>'
3252 write(qunit,
'(a)')
'</VTKFile>'
3266 integer,
intent(in) :: qunit
3268 double precision :: x_VTK(1:3)
3269 double precision,
dimension(ixMlo1-1:ixMhi1,ixMlo2-1:ixMhi2,ixMlo1&
-1:ixMhi1,3) :: xC_TMP
3270 double precision,
dimension(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo1:ixMhi1,&
3) :: xCC_TMP
3271 double precision,
dimension(ixMlo1-1:ixMhi1,ixMlo2-1:ixMhi2,ixMlo1&
-1:ixMhi1,nw+nwauxio) :: wC_TMP
3272 double precision,
dimension(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo1:ixMhi1,nw&
+nwauxio) :: wCC_TMP
3273 double precision,
dimension(ixGlo1:ixGhi1,ixGlo2:ixGhi2,ixGlo1:ixGhi1,1:nw&
+nwauxio) :: w
3274 double precision :: normconv(0:nw+nwauxio)
3275 double precision ::d3grid,zlengsc,zgridsc
3276 double precision :: zlength
3278 integer:: igrid,iigrid,level,igonlevel,icel,ixCmin1,ixCmin2,&
3279 ixCmin3,ixCmax1,ixCmax2,ixCmax3,ixCCmin1,ixCCmin2,ixCCmin3,ixCCmax1,&
3281 integer:: NumGridsOnLevel(1:nlevelshi)
3282 integer :: nx1,nx2,nx3,nxC1,nxC2,nxC3,nodesonlevel,elemsonlevel,nc,np,&
3283 VTK_type,ix1,ix2,ix3
3284 integer :: size_length,recsep,k,iw
3285 integer :: length,lengthcc,offset_points,offset_cells, length_coords,&
3286 length_conn,length_offsets
3287 integer :: i3grid,n3grid
3289 character(len=80):: filename
3290 character(len=name_len) :: wnamei(1:nw+nwauxio),xandwnamei(1:3+nw+nwauxio)
3291 character(len=1024) :: outfilehead
3293 character(len=6):: bufform
3296 if(
mype==0) print *,
'unstructuredvtkBsym23 not parallel, use vtumpi'
3297 call mpistop(
'npe>1, unstructuredvtkBsym23')
3304 inquire(qunit,opened=fileopen)
3305 if(.not.fileopen)
then
3309 open(qunit,file=filename,status=
'unknown')
3314 write(qunit,
'(a)')
'<?xml version="1.0"?>'
3315 write(qunit,
'(a)',advance=
'no')
'<VTKFile type="UnstructuredGrid"'
3316 write(qunit,
'(a)')
' version="0.1" byte_order="LittleEndian">'
3317 write(qunit,
'(a)')
'<UnstructuredGrid>'
3318 write(qunit,
'(a)')
'<FieldData>'
3319 write(qunit,
'(2a)')
'<DataArray type="Float32" Name="TIME" ',&
3320 'NumberOfTuples="1" format="ascii">'
3322 write(qunit,
'(a)')
'</DataArray>'
3323 write(qunit,
'(a)')
'</FieldData>'
3326 nx1=ixmhi1-ixmlo1+1;nx2=ixmhi2-ixmlo2+1;nx3=ixmhi1-ixmlo1+1;
3327 nxc1=nx1+1;nxc2=nx2+1;nxc3=nx3+1;
3332 lengthcc=nc*size_real
3334 length_coords=3*length
3335 length_conn=2**3*size_int*nc
3336 length_offsets=nc*size_int
3342 zlength=zlengsc*(xprobmax1-xprobmin1)
3345 do iigrid=1,igridstail; igrid=igrids(iigrid);
3350 if ((
rnode(rpxmin1_,igrid)>=xprobmin1+(xprobmax1-xprobmin1)&
3353 .and.(
rnode(rpxmax1_,igrid)<=xprobmax1-(xprobmax1-xprobmin1)&
3356 d3grid=zgridsc*(
rnode(rpxmax1_,igrid)-
rnode(rpxmin1_,igrid))
3357 n3grid=nint(zlength/d3grid)
3363 write(qunit,
'(a,i7,a,i7,a)')
'<Piece NumberOfPoints="',np,&
3364 '" NumberOfCells="',nc,
'">'
3365 write(qunit,
'(a)')
'<PointData>'
3368 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3369 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3370 write(qunit,
'(a)')
'</DataArray>'
3371 offset=offset+length+size_length
3374 do iw=nw+1,nw+nwauxio
3375 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3376 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3377 write(qunit,
'(a)')
'</DataArray>'
3378 offset=offset+length+size_length
3381 write(qunit,
'(a)')
'</PointData>'
3382 write(qunit,
'(a)')
'<Points>'
3383 write(qunit,
'(a,i16,a)') &
3384 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',&
3387 offset=offset+length_coords+size_length
3388 write(qunit,
'(a)')
'</Points>'
3391 write(qunit,
'(a,i7,a,i7,a)')
'<Piece NumberOfPoints="',np,&
3392 '" NumberOfCells="',nc,
'">'
3393 write(qunit,
'(a)')
'<CellData>'
3396 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3397 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3398 write(qunit,
'(a)')
'</DataArray>'
3399 offset=offset+lengthcc+size_length
3402 do iw=nw+1,nw+nwauxio
3403 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3404 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3405 write(qunit,
'(a)')
'</DataArray>'
3406 offset=offset+lengthcc+size_length
3409 write(qunit,
'(a)')
'</CellData>'
3411 write(qunit,
'(a)')
'<Points>'
3412 write(qunit,
'(a,i16,a)') &
3413 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',&
3416 offset=offset+length_coords+size_length
3417 write(qunit,
'(a)')
'</Points>'
3419 write(qunit,
'(a)')
'<Cells>'
3421 write(qunit,
'(a,i16,a)')&
3422 '<DataArray type="Int32" Name="connectivity" format="appended" offset="',&
3424 offset=offset+length_conn+size_length
3426 write(qunit,
'(a,i16,a)') &
3427 '<DataArray type="Int32" Name="offsets" format="appended" offset="',&
3429 offset=offset+length_offsets+size_length
3431 write(qunit,
'(a,i16,a)') &
3432 '<DataArray type="Int32" Name="types" format="appended" offset="',&
3434 offset=offset+size_length+nc*size_int
3435 write(qunit,
'(a)')
'</Cells>'
3436 write(qunit,
'(a)')
'</Piece>'
3442 write(qunit,
'(a,i7,a,i7,a)')
'<Piece NumberOfPoints="',np,&
3443 '" NumberOfCells="',nc,
'">'
3444 write(qunit,
'(a)')
'<PointData>'
3447 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3448 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3449 write(qunit,
'(a)')
'</DataArray>'
3450 offset=offset+length+size_length
3453 do iw=nw+1,nw+nwauxio
3454 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3455 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3456 write(qunit,
'(a)')
'</DataArray>'
3457 offset=offset+length+size_length
3460 write(qunit,
'(a)')
'</PointData>'
3461 write(qunit,
'(a)')
'<Points>'
3462 write(qunit,
'(a,i16,a)') &
3463 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',&
3466 offset=offset+length_coords+size_length
3467 write(qunit,
'(a)')
'</Points>'
3470 write(qunit,
'(a,i7,a,i7,a)')
'<Piece NumberOfPoints="',np,&
3471 '" NumberOfCells="',nc,
'">'
3472 write(qunit,
'(a)')
'<CellData>'
3475 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3476 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3477 write(qunit,
'(a)')
'</DataArray>'
3478 offset=offset+lengthcc+size_length
3481 do iw=nw+1,nw+nwauxio
3482 write(qunit,
'(a,a,a,i16,a)')
'<DataArray type="Float32" Name="',&
3483 trim(wnamei(iw)),
'" format="appended" offset="',offset,
'">'
3484 write(qunit,
'(a)')
'</DataArray>'
3485 offset=offset+lengthcc+size_length
3488 write(qunit,
'(a)')
'</CellData>'
3489 write(qunit,
'(a)')
'<Points>'
3490 write(qunit,
'(a,i16,a)') &
3491 '<DataArray type="Float32" NumberOfComponents="3" format="appended" offset="',&
3494 offset=offset+length_coords+size_length
3495 write(qunit,
'(a)')
'</Points>'
3497 write(qunit,
'(a)')
'<Cells>'
3499 write(qunit,
'(a,i16,a)')&
3500 '<DataArray type="Int32" Name="connectivity" format="appended" offset="',&
3502 offset=offset+length_conn+size_length
3504 write(qunit,
'(a,i16,a)') &
3505 '<DataArray type="Int32" Name="offsets" format="appended" offset="',&
3507 offset=offset+length_offsets+size_length
3509 write(qunit,
'(a,i16,a)') &
3510 '<DataArray type="Int32" Name="types" format="appended" offset="',&
3512 offset=offset+size_length+nc*size_int
3513 write(qunit,
'(a)')
'</Cells>'
3514 write(qunit,
'(a)')
'</Piece>'
3522 write(qunit,
'(a)')
'</UnstructuredGrid>'
3523 write(qunit,
'(a)')
'<AppendedData encoding="raw">'
3525 open(qunit,file=filename,form=
'unformatted',access=
'stream',status=
'old',position=
'append')
3527 write(qunit) trim(buffer)
3530 do iigrid=1,igridstail; igrid=igrids(iigrid);
3535 if ((
rnode(rpxmin1_,igrid)>=xprobmin1+(xprobmax1-xprobmin1)&
3538 .and.(
rnode(rpxmax1_,igrid)<=xprobmax1-(xprobmax1-xprobmin1)&
3541 d3grid=zgridsc*(
rnode(rpxmax1_,igrid)-
rnode(rpxmin1_,igrid))
3542 n3grid=nint(zlength/d3grid)
3547 ixglo1,ixglo2,ixghi1,ixghi2,ps(igrid)%w,ps(igrid)%x)
3551 do ix3=ixglo1,ixghi1
3552 w(ixglo1:ixghi1,ixglo2:ixghi2,ix3,1:nw)=ps(igrid)%w(ixglo1:ixghi1,&
3556 call calc_grid23(qunit,igrid,xc_tmp,xcc_tmp,wc_tmp,wcc_tmp,normconv,&
3557 ixcmin1,ixcmin2,ixcmin3,ixcmax1,ixcmax2,ixcmax3,ixccmin1,ixccmin2,&
3558 ixccmin3,ixccmax1,ixccmax2,ixccmax3,.true.,i3grid,d3grid,w,zlength,zgridsc)
3565 write(qunit) (((real(wc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3566 =ixcmin1,ixcmax1),ix2=ixcmin2,ixcmax2),ix3=ixcmin3,ixcmax3)
3568 write(qunit) lengthcc
3569 write(qunit) (((real(wcc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3570 =ixccmin1,ixccmax1),ix2=ixccmin2,ixccmax2),ix3&
3575 do iw=nw+1,nw+nwauxio
3579 write(qunit) (((real(wc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3580 =ixcmin1,ixcmax1),ix2=ixcmin2,ixcmax2),ix3=ixcmin3,ixcmax3)
3582 write(qunit) lengthcc
3583 write(qunit) (((real(wcc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3584 =ixccmin1,ixccmax1),ix2=ixccmin2,ixccmax2),ix3&
3589 write(qunit) length_coords
3590 do ix3=ixcmin3,ixcmax3
3591 do ix2=ixcmin2,ixcmax2
3592 do ix1=ixcmin1,ixcmax1
3594 x_vtk(1:3)=xc_tmp(ix1,ix2,ix3,1:3)*normconv(0);
3596 write(qunit) real(x_vtk(k))
3601 write(qunit) length_conn
3606 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1-1, &
3607 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
3608 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1-1,&
3609 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1,&
3610 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1-1,&
3611 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
3612 ix3*nxc2*nxc1+ ix2*nxc1+ix1-1,&
3613 ix3*nxc2*nxc1+ ix2*nxc1+ix1
3617 write(qunit) length_offsets
3619 write(qunit) icel*(2**3)
3622 write(qunit) size_int*nc
3624 write(qunit) vtk_type
3630 if(iw==2 .or. iw==4 .or. iw==7)
then
3631 wc_tmp(ixcmin1:ixcmax1,ixcmin2:ixcmax2,ixcmin3:ixcmax3,iw)=&
3632 -wc_tmp(ixcmin1:ixcmax1,ixcmin2:ixcmax2,ixcmin3:ixcmax3,iw)
3633 wcc_tmp(ixccmin1:ixccmax1,ixccmin2:ixccmax2,ixccmin3:ixccmax3,iw)=&
3634 -wcc_tmp(ixccmin1:ixccmax1,ixccmin2:ixccmax2,ixccmin3:ixccmax3,iw)
3639 write(qunit) (((real(wc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3640 =ixcmax1,ixcmin1,-1),ix2=ixcmin2,ixcmax2),ix3=ixcmin3,ixcmax3)
3642 write(qunit) lengthcc
3643 write(qunit) (((real(wcc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3644 =ixccmin1,ixccmax1),ix2=ixccmin2,ixccmax2),ix3&
3649 do iw=nw+1,nw+nwauxio
3653 write(qunit) (((real(wc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3654 =ixcmax1,ixcmin1,-1),ix2=ixcmin2,ixcmax2),ix3=ixcmin3,ixcmax3)
3656 write(qunit) lengthcc
3657 write(qunit) (((real(wcc_tmp(ix1,ix2,ix3,iw)*normconv(iw)),ix1&
3658 =ixccmin1,ixccmax1),ix2=ixccmin2,ixccmax2),ix3&
3663 write(qunit) length_coords
3664 do ix3=ixcmin3,ixcmax3
3665 do ix2=ixcmin2,ixcmax2
3666 do ix1=ixcmax1,ixcmin1,-1
3668 x_vtk(1:3)=xc_tmp(ix1,ix2,ix3,1:3)*normconv(0);
3671 write(qunit) real(x_vtk(k))
3676 write(qunit) length_conn
3681 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1-1, &
3682 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
3683 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1-1,&
3684 (ix3-1)*nxc2*nxc1+ ix2*nxc1+ix1,&
3685 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1-1,&
3686 ix3*nxc2*nxc1+(ix2-1)*nxc1+ix1,&
3687 ix3*nxc2*nxc1+ ix2*nxc1+ix1-1,&
3688 ix3*nxc2*nxc1+ ix2*nxc1+ix1
3692 write(qunit) length_offsets
3694 write(qunit) icel*(2**3)
3697 write(qunit) size_int*nc
3699 write(qunit) vtk_type
3708 open(qunit,file=filename,status=
'unknown',form=
'formatted',position=
'append')
3709 write(qunit,
'(a)')
'</AppendedData>'
3710 write(qunit,
'(a)')
'</VTKFile>'
3715 subroutine calc_grid23(qunit,igrid,xC_TMP,xCC_TMP,wC_TMP,wCC_TMP,normconv,&
3716 ixCmin1,ixCmin2,ixCmin3,ixCmax1,ixCmax2,ixCmax3,ixCCmin1,ixCCmin2,ixCCmin3,&
3717 ixCCmax1,ixCCmax2,ixCCmax3,first,i3grid,d3grid,w,zlength,zgridsc)
3725 integer,
intent(in) :: qunit, igrid,i3grid
3726 logical,
intent(in) :: first
3728 double precision :: dx1,dx2,dx3,d3grid,zlength,zgridsc
3729 double precision :: ldw(ixGlo1:ixGhi1,ixGlo2:ixGhi2,ixGlo1:ixGhi1),&
3730 dwC(ixGlo1:ixGhi1,ixGlo2:ixGhi2,ixGlo1:ixGhi1)
3731 double precision,
dimension(ixMlo1-1:ixMhi1,ixMlo2-1:ixMhi2,ixMlo1&
-1:ixMhi1,3) :: xC
3732 double precision,
dimension(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo1:ixMhi1,&
3) :: xCC
3733 double precision,
dimension(ixMlo1-1:ixMhi1,ixMlo2-1:ixMhi2,ixMlo1&
-1:ixMhi1,nw+nwauxio) :: wC
3734 double precision,
dimension(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo1:ixMhi1,nw&
+nwauxio) :: wCC
3735 double precision,
dimension(ixMlo1-1:ixMhi1,ixMlo2-1:ixMhi2,ixMlo1&
-1:ixMhi1,3) :: xC_TMP
3736 double precision,
dimension(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo1:ixMhi1,&
3) :: xCC_TMP
3737 double precision,
dimension(ixMlo1-1:ixMhi1,ixMlo2-1:ixMhi2,ixMlo1&
-1:ixMhi1,nw+nwauxio) :: wC_TMP
3738 double precision,
dimension(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo1:ixMhi1,nw&
+nwauxio) :: wCC_TMP
3739 double precision,
dimension(ixGlo1:ixGhi1,ixGlo2:ixGhi2,ixGlo1:ixGhi1,1:nw&
+nwauxio) :: w
3740 double precision,
dimension(0:nw+nwauxio) :: normconv
3741 integer :: nx1,nx2,nx3, nxC1,nxC2,nxC3, ix1,ix2,ix3, ix, iw, level, idir
3742 integer :: ixCmin1,ixCmin2,ixCmin3,ixCmax1,ixCmax2,ixCmax3,ixCCmin1,&
3743 ixCCmin2,ixCCmin3,ixCCmax1,ixCCmax2,ixCCmax3,nxCC1,nxCC2,nxCC3
3744 integer :: idims,jxCmin1,jxCmin2,jxCmin3,jxCmax1,jxCmax2,jxCmax3
3745 logical,
save :: subfirst=.true.
3748 nx1=ixmhi1-ixmlo1+1;nx2=ixmhi2-ixmlo2+1;nx3=ixmhi1-ixmlo1+1;
3750 dx1=
dx(1,level);dx2=
dx(2,level);dx3=zgridsc*
dx(1,level);
3765 nxcc1=nx1;nxcc2=nx2;nxcc3=nx3;
3766 ixccmin1=ixmlo1;ixccmin2=ixmlo2;ixccmin3=ixmlo1; ixccmax1=ixmhi1
3767 ixccmax2=ixmhi2;ixccmax3=ixmhi1;
3768 do ix=ixccmin1,ixccmax1
3769 xcc(ix,ixccmin2:ixccmax2,ixccmin3:ixccmax3,1)=
rnode(rpxmin1_,igrid)&
3770 +(dble(ix-ixccmin1)+half)*dx1
3772 do ix=ixccmin2,ixccmax2
3773 xcc(ixccmin1:ixccmax1,ix,ixccmin3:ixccmax3,2)=
rnode(rpxmin2_,igrid)&
3774 +(dble(ix-ixccmin2)+half)*dx2
3776 do ix=ixccmin3,ixccmax3
3777 xcc(ixccmin1:ixccmax1,ixccmin2:ixccmax2,ix,3)=-zlength/two+&
3778 dble(i3grid-1)*d3grid+(dble(ix-ixccmin3)+half)*dx3
3782 nxc1=nx1+1;nxc2=nx2+1;nxc3=nx3+1;
3783 ixcmin1=ixmlo1-1;ixcmin2=ixmlo2-1;ixcmin3=ixmlo1-1; ixcmax1=ixmhi1
3784 ixcmax2=ixmhi2;ixcmax3=ixmhi1;
3785 do ix=ixcmin1,ixcmax1
3786 xc(ix,ixcmin2:ixcmax2,ixcmin3:ixcmax3,1)=
rnode(rpxmin1_,igrid)&
3787 +dble(ix-ixcmin1)*dx1
3789 do ix=ixcmin2,ixcmax2
3790 xc(ixcmin1:ixcmax1,ix,ixcmin3:ixcmax3,2)=
rnode(rpxmin2_,igrid)&
3791 +dble(ix-ixcmin2)*dx2
3793 do ix=ixcmin3,ixcmax3
3794 xc(ixcmin1:ixcmax1,ixcmin2:ixcmax2,ix,3)=-zlength/two+&
3795 dble(i3grid-1)*d3grid+dble(ix-ixcmin3)*dx3
3805 jxcmin1=ixghi1+1-
nghostcells;jxcmin2=ixglo2;jxcmin3=ixglo1;
3806 jxcmax1=ixghi1;jxcmax2=ixghi2;jxcmax3=ixghi1;
3807 do ix1=jxcmin1,jxcmax1
3808 w(ix1,jxcmin2:jxcmax2,jxcmin3:jxcmax3,nw-nwextra+1:nw) = w(jxcmin1&
3809 -1,jxcmin2:jxcmax2,jxcmin3:jxcmax3,nw-nwextra+1:nw)
3811 jxcmin1=ixglo1;jxcmin2=ixglo2;jxcmin3=ixglo1;
3812 jxcmax1=ixglo1-1+
nghostcells;jxcmax2=ixghi2;jxcmax3=ixghi1;
3813 do ix1=jxcmin1,jxcmax1
3814 w(ix1,jxcmin2:jxcmax2,jxcmin3:jxcmax3,nw-nwextra+1:nw) = w(jxcmax1&
3815 +1,jxcmin2:jxcmax2,jxcmin3:jxcmax3,nw-nwextra+1:nw)
3818 jxcmin1=ixglo1;jxcmin2=ixghi2+1-
nghostcells;jxcmin3=ixglo1;
3819 jxcmax1=ixghi1;jxcmax2=ixghi2;jxcmax3=ixghi1;
3820 do ix2=jxcmin2,jxcmax2
3821 w(jxcmin1:jxcmax1,ix2,jxcmin3:jxcmax3,nw-nwextra+1:nw) &
3822 = w(jxcmin1:jxcmax1,jxcmin2-1,jxcmin3:jxcmax3,nw-nwextra+1:nw)
3824 jxcmin1=ixglo1;jxcmin2=ixglo2;jxcmin3=ixglo1;
3825 jxcmax1=ixghi1;jxcmax2=ixglo2-1+
nghostcells;jxcmax3=ixghi1;
3826 do ix2=jxcmin2,jxcmax2
3827 w(jxcmin1:jxcmax1,ix2,jxcmin3:jxcmax3,nw-nwextra+1:nw) &
3828 = w(jxcmin1:jxcmax1,jxcmax2+1,jxcmin3:jxcmax3,nw-nwextra+1:nw)
3831 jxcmin1=ixglo1;jxcmin2=ixglo2;jxcmin3=ixghi1+1-
nghostcells;
3832 jxcmax1=ixghi1;jxcmax2=ixghi2;jxcmax3=ixghi1;
3833 do ix3=jxcmin3,jxcmax3
3834 w(jxcmin1:jxcmax1,jxcmin2:jxcmax2,ix3,nw-nwextra+1:nw) &
3835 = w(jxcmin1:jxcmax1,jxcmin2:jxcmax2,jxcmin3-1,nw-nwextra+1:nw)
3837 jxcmin1=ixglo1;jxcmin2=ixglo2;jxcmin3=ixglo1;
3838 jxcmax1=ixghi1;jxcmax2=ixghi2;jxcmax3=ixglo1-1+
nghostcells;
3839 do ix3=jxcmin3,jxcmax3
3840 w(jxcmin1:jxcmax1,jxcmin2:jxcmax2,ix3,nw-nwextra+1:nw) &
3841 = w(jxcmin1:jxcmax1,jxcmin2:jxcmax2,jxcmax3+1,nw-nwextra+1:nw)
3856 +1,ixglo2+1,ixglo1+1,ixghi1-1,ixghi2-1,ixghi1-1,w,xcc,normconv)
3861 wcc(ixccmin1:ixccmax1,ixccmin2:ixccmax2,ixccmin3:ixccmax3,:)=w(ixccmin1:ixccmax1,ixccmin2:ixccmax2,ixccmin3:ixccmax3,:)
3863 do ix3=ixccmin3,ixccmax3
3864 do ix2=ixccmin2,ixccmax2
3865 do ix1=ixccmin1,ixccmax1
3866 wcc(ix1,ix2,ix3,iw_mag(:))=wcc(ix1,ix2,ix3,iw_mag(:))+ps(igrid)%B0(ix1,ix2,&
3873 do ix3=ixccmin3,ixccmax3
3874 do ix2=ixccmin2,ixccmax2
3875 do ix1=ixccmin1,ixccmax1
3876 wcc(ix1,ix2,ix3,iw_e)=w(ix1,ix2,ix3,iw_e) +half*sum(ps(igrid)%B0(ix1,&
3877 ix2,:,0)**2 ) + sum(w(ix1,ix2,ix3,&
3878 iw_mag(:))*ps(igrid)%B0(ix1,ix2,:,0))
3888 if (
b0field.and.iw>iw_mag(1)-1.and.iw<=iw_mag(
ndir))
then
3890 do ix3=ixcmin3,ixcmax3
3891 do ix2=ixcmin2,ixcmax2
3892 do ix1=ixcmin1,ixcmax1
3893 wc(ix1,ix2,ix3,iw)=sum(w(ix1:ix1+1,ix2:ix2+1,ix3,iw) &
3894 +ps(igrid)%B0(ix1:ix1+1,ix2:ix2+1&
3895 ,idir,0))/dble(2**3)+&
3896 sum(w(ix1:ix1+1,ix2:ix2+1,ix3+1,iw) &
3897 +ps(igrid)%B0(ix1:ix1+1,ix2:ix2+1&
3898 ,idir,0))/dble(2**3)
3903 do ix3=ixcmin3,ixcmax3
3904 do ix2=ixcmin2,ixcmax2
3905 do ix1=ixcmin1,ixcmax1
3906 wc(ix1,ix2,ix3,iw)=sum(w(ix1:ix1+1,ix2:ix2+1,ix3:ix3&
3914 do ix3=ixcmin3,ixcmax3
3915 do ix2=ixcmin2,ixcmax2
3916 do ix1=ixcmin1,ixcmax1
3917 wc(ix1,ix2,ix3,iw_e)=sum( w(ix1:ix1+1,ix2:ix2+1,ix3,iw_e) &
3918 +half*sum(ps(igrid)%B0(ix1:ix1+1,ix2:ix2+1&
3919 ,:,0)**2,dim=
ndim+1) + sum( w(ix1:ix1+1,ix2:ix2+1,ix3&
3920 ,iw_mag(:))*ps(igrid)%B0(ix1:ix1+1,ix2:ix2+1&
3921 ,:,0),dim=
ndim+1) ) /dble(2**3)+&
3922 sum( w(ix1:ix1+1,ix2:ix2+1,ix3+1,iw_e) &
3923 +half*sum(ps(igrid)%B0(ix1:ix1+1,ix2:ix2+1&
3924 ,:,0)**2,dim=
ndim+1) + sum( w(ix1:ix1+1,ix2:ix2+1,ix3&
3925 +1,iw_mag(:))*ps(igrid)%B0(ix1:ix1+1,ix2:ix2+1&
3926 ,:,0),dim=
ndim+1) ) /dble(2**3)
3933 xc_tmp(ixcmin1:ixcmax1,ixcmin2:ixcmax2,ixcmin3:ixcmax3,1:3) &
3934 = xc(ixcmin1:ixcmax1,ixcmin2:ixcmax2,ixcmin3:ixcmax3,1:3)
3935 wc_tmp(ixcmin1:ixcmax1,ixcmin2:ixcmax2,ixcmin3:ixcmax3,1:nw&
3936 +
nwauxio) = wc(ixcmin1:ixcmax1,ixcmin2:ixcmax2,ixcmin3:ixcmax3,1:nw&
3938 xcc_tmp(ixccmin1:ixccmax1,ixccmin2:ixccmax2,ixccmin3:ixccmax3,&
3939 1:3) = xcc(ixccmin1:ixccmax1,ixccmin2:ixccmax2,&
3940 ixccmin3:ixccmax3,1:3)
3941 wcc_tmp(ixccmin1:ixccmax1,ixccmin2:ixccmax2,ixccmin3:ixccmax3,1:nw&
3942 +
nwauxio) = wcc(ixccmin1:ixccmax1,ixccmin2:ixccmax2,ixccmin3:ixccmax3,&
3951 integer,
intent(in) :: qunit, igrid
3953 integer :: nx1,nx2,nx3, nxC1,nxC2,nxC3, ix1,ix2,ix3
3955 nx1=ixmhi1-ixmlo1+1;nx2=ixmhi2-ixmlo2+1;nx3=ixmhi1-ixmlo1+1;
3956 nxc1=nx1+1;nxc2=nx2+1;nxc3=nx3+1;
3960 write(qunit,
'(8(i7,1x))')&
3961 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1-1, &
3962 (ix3-1)*nxc2*nxc1+(ix2-1)*nxc1+ix1,&