From e1e4f504ef41e0b8ae6599e46ca82a2eaa3aa5b8 Mon Sep 17 00:00:00 2001 From: Hiroaki Matsui Date: Mon, 8 Apr 2024 10:44:58 -0500 Subject: [PATCH] Fix inconsistency of structure names --- src/C_libraries/BASE/read_image_2_png.c | 144 +++++++-------- src/C_libraries/BASE/read_image_2_png.h | 12 +- .../MHD_src/IO/Makefile.depends | 2 +- .../MHD_src/IO/bcast_dynamo_viz_control.f90 | 8 + .../MHD_src/IO/t_control_data_dynamo_vizs.f90 | 46 +++-- .../MHD_src/IO/t_ctl_data_sph_MHD_w_vizs.f90 | 91 ++++++---- .../MHD_src/sph_MHD/Makefile.depends | 2 +- .../sph_MHD/input_control_sph_MHD_vizs.f90 | 3 +- .../Fortran2003/t_png_file_access.f90 | 16 +- .../VIZ_src/fieldline/Makefile | 4 +- .../VIZ_src/fieldline/Makefile.depends | 8 +- .../fieldline/bcast_ctl_data_field_line.f90 | 6 + .../fieldline/ctl_data_field_line_IO.f90 | 98 +++++----- .../fieldline/ctl_file_fieldlines_IO.f90 | 7 +- .../fieldline/m_control_fline_flags.f90 | 99 +++++++++++ .../fieldline/set_control_each_fline.f90 | 1 + .../fieldline/t_control_data_flines.f90 | 118 ++++++++++--- .../fieldline/t_control_params_4_fline.f90 | 103 ----------- .../fieldline/t_ctl_data_field_line.f90 | 4 + .../VIZ_src/map_rendering/Makefile | 4 +- .../VIZ_src/map_rendering/Makefile.depends | 14 +- .../map_rendering/bcast_maps_control_data.f90 | 49 ++++- .../ctl_data_map_rendering_IO.f90 | 81 ++++----- .../ctl_data_map_section_IO.f90} | 166 ++++++++--------- .../ctl_file_map_renderings_IO.f90 | 7 +- .../map_rendering/t_control_data_4_map.f90 | 25 +-- .../map_rendering/t_control_data_maps.f90 | 123 +++++++++---- .../map_rendering/t_ctl_data_map_section.f90 | 151 ++++++++++++++++ .../map_rendering/t_map_rendering_data.f90 | 6 +- .../VIZ_src/volume_rendering/Makefile | 4 +- .../VIZ_src/volume_rendering/Makefile.depends | 34 ++-- .../bcast_control_data_4_pvr.f90 | 66 +------ .../bcast_control_data_pvrs.f90 | 2 + .../bcast_ctl_data_pvr_surfaces.f90 | 49 ++--- .../bcast_ctl_data_view_trans.f90 | 35 +++- .../volume_rendering/bcast_ctl_data_viz3.f90 | 4 + .../volume_rendering/bcast_pvr_color_ctl.f90 | 27 ++- .../volume_rendering/ctl_data_each_pvr_IO.f90 | 141 ++++++++------- .../ctl_data_four_vizs_IO.f90 | 33 ++-- .../ctl_data_pvr_colorbar_IO.f90 | 83 +++++---- .../ctl_data_pvr_colormap_IO.f90 | 148 +++++----------- .../ctl_data_pvr_movie_IO.f90 | 103 ++++------- .../ctl_data_three_vizs_IO.f90 | 75 ++++++-- .../ctl_data_view_transfer_IO.f90 | 87 ++++----- .../volume_rendering/ctl_file_each_pvr_IO.f90 | 15 +- .../ctl_file_pvr_light_IO.f90 | 6 +- .../ctl_file_pvr_modelview_IO.f90 | 6 +- .../volume_rendering/draw_pvr_colorbar.f90 | 101 +++++------ .../draw_pvr_colorbar_nums.f90 | 79 +++++---- .../volume_rendering/m_pvr_control_labels.f90 | 120 +++++++++++++ .../volume_rendering/pvr_axis_label.f90 | 37 ++-- .../pvr_surface_enhancement.f90 | 43 +---- .../volume_rendering/rendering_vr_image.f90 | 2 +- .../volume_rendering/set_control_each_pvr.f90 | 1 + .../set_control_pvr_color.f90 | 68 +++---- .../set_control_pvr_movie.f90 | 1 + .../volume_rendering/set_pvr_control.f90 | 2 +- .../set_rgba_4_each_pixel.f90 | 32 ---- .../volume_rendering/t_control_data_4_pvr.f90 | 66 +++++++ .../t_control_data_pvr_isosurfs.f90 | 114 +++++++++--- .../t_control_data_pvr_sections.f90 | 111 +++++++++--- .../volume_rendering/t_control_data_pvrs.f90 | 114 +++++++++--- .../volume_rendering/t_control_data_viz3.f90 | 3 + .../t_control_params_4_pvr.f90 | 63 ------- .../t_ctl_data_4_projection.f90 | 115 ++++++++---- .../t_ctl_data_4_screen_pixel.f90 | 77 +++++--- .../t_ctl_data_4_streo_view.f90 | 101 +++++++---- .../t_ctl_data_4_view_transfer.f90 | 64 ++++++- .../volume_rendering/t_ctl_data_pvr_area.f90 | 53 +++--- .../t_ctl_data_pvr_colorbar.f90 | 58 +++++- .../t_ctl_data_pvr_colormap.f90 | 88 ++++++--- .../t_ctl_data_pvr_colormap_bar.f90 | 112 +++++++----- .../t_ctl_data_pvr_isosurface.f90 | 56 +++--- .../volume_rendering/t_ctl_data_pvr_light.f90 | 125 +++++++++---- .../volume_rendering/t_ctl_data_pvr_movie.f90 | 10 +- .../t_ctl_data_pvr_section.f90 | 167 +++++++++++++----- .../t_ctl_data_quilt_image.f90 | 62 ++++--- .../t_ctl_data_view_transfers.f90 | 165 ++++++++++++----- .../volume_rendering/t_volume_rendering.f90 | 9 +- .../volume_rendering/volume_rendering.f90 | 2 +- .../main_control_MHD_viz_check.f90 | 4 +- .../VIZ_only/t_control_data_three_vizs.f90 | 26 ++- 82 files changed, 2844 insertions(+), 1723 deletions(-) create mode 100644 src/Fortran_libraries/VIZ_src/fieldline/m_control_fline_flags.f90 rename src/Fortran_libraries/VIZ_src/{volume_rendering/ctl_data_pvr_section_IO.f90 => map_rendering/ctl_data_map_section_IO.f90} (59%) create mode 100644 src/Fortran_libraries/VIZ_src/map_rendering/t_ctl_data_map_section.f90 create mode 100644 src/Fortran_libraries/VIZ_src/volume_rendering/m_pvr_control_labels.f90 diff --git a/src/C_libraries/BASE/read_image_2_png.c b/src/C_libraries/BASE/read_image_2_png.c index 5d647896..ba6c6660 100644 --- a/src/C_libraries/BASE/read_image_2_png.c +++ b/src/C_libraries/BASE/read_image_2_png.c @@ -144,41 +144,42 @@ void read_png_file_c(const char *fhead, int *num_x, int *num_y, int *iflag_rgba) return; } -void copy_rgb_from_png_c(int *num_x, int *num_y, int *iflag_rgba, unsigned char *cimage) +void copy_rgb_from_png_c(const int num_x, const int num_y, + const int iflag_rgba, unsigned char *cimage) { int k, j, l; - if(*iflag_rgba == RGBA_COLOR){ - for (l = 0; l < *num_x; l++) { - for (j = 0; j < *num_y; j++) { - k = (*num_y-j-1) * (*num_x) + l; + if(iflag_rgba == RGBA_COLOR){ + for (l = 0; l < num_x; l++) { + for (j = 0; j < num_y; j++) { + k = (num_y-j-1) * num_x + l; cimage[3*k ] = bimage[j][4*l ]; cimage[3*k+1] = bimage[j][4*l+1]; cimage[3*k+2] = bimage[j][4*l+2]; } }; - } else if(*iflag_rgba == RGB_COLOR){ - for (l = 0; l < *num_x; l++) { - for (j = 0; j < *num_y; j++) { - k = (*num_y-j-1) * (*num_x) + l; + } else if(iflag_rgba == RGB_COLOR){ + for (l = 0; l < num_x; l++) { + for (j = 0; j < num_y; j++) { + k = (num_y-j-1) * num_x + l; cimage[3*k ] = bimage[j][3*l ]; cimage[3*k+1] = bimage[j][3*l+1]; cimage[3*k+2] = bimage[j][3*l+2]; } }; - } else if(*iflag_rgba == BW_ALPHA){ - for (l = 0; l < *num_x; l++) { - for (j = 0; j < *num_y; j++) { - k = (*num_y-j-1) * (*num_x) + l; + } else if(iflag_rgba == BW_ALPHA){ + for (l = 0; l < num_x; l++) { + for (j = 0; j < num_y; j++) { + k = (num_y-j-1) * num_x + l; cimage[3*k ] = bimage[j][2*l]; cimage[3*k+1] = bimage[j][2*l]; cimage[3*k+2] = bimage[j][2*l]; } }; - } else if(*iflag_rgba == B_AND_W){ - for (l = 0; l < *num_x; l++) { - for (j = 0; j < *num_y; j++) { - k = (*num_y-j-1) * (*num_x) + l; + } else if(iflag_rgba == B_AND_W){ + for (l = 0; l < num_x; l++) { + for (j = 0; j < num_y; j++) { + k = (num_y-j-1) * num_x + l; cimage[3*k ] = bimage[j][l]; cimage[3*k+1] = bimage[j][l]; cimage[3*k+2] = bimage[j][l]; @@ -189,44 +190,45 @@ void copy_rgb_from_png_c(int *num_x, int *num_y, int *iflag_rgba, unsigned char free(bimage); }; -void copy_rgba_from_png_c(int *num_x, int *num_y, int *iflag_rgba, unsigned char *cimage) +void copy_rgba_from_png_c(const int num_x, const int num_y, + const int iflag_rgba, unsigned char *cimage) { int i, k, j, l; - if(*iflag_rgba == RGBA_COLOR){ - for (l = 0; l < *num_x; l++) { - for (j = 0; j < *num_y; j++) { - k = (*num_y-j-1) * (*num_x) + l; + if(iflag_rgba == RGBA_COLOR){ + for (l = 0; l < num_x; l++) { + for (j = 0; j < num_y; j++) { + k = (num_y-j-1) * num_x + l; cimage[4*k ] = bimage[j][4*l ]; cimage[4*k+1] = bimage[j][4*l+1]; cimage[4*k+2] = bimage[j][4*l+2]; cimage[4*k+3] = bimage[j][4*l+3]; } }; - } else if(*iflag_rgba == RGB_COLOR){ - for (l = 0; l < *num_x; l++) { - for (j = 0; j < *num_y; j++) { - k = (*num_y-j-1) * (*num_x) + l; + } else if(iflag_rgba == RGB_COLOR){ + for (l = 0; l < num_x; l++) { + for (j = 0; j < num_y; j++) { + k = (num_y-j-1) * num_x + l; cimage[4*k ] = bimage[j][3*l ]; cimage[4*k+1] = bimage[j][3*l+1]; cimage[4*k+2] = bimage[j][3*l+2]; cimage[4*k+3] = (unsigned char) 255; } }; - } else if(*iflag_rgba == BW_ALPHA){ - for (l = 0; l < *num_x; l++) { - for (j = 0; j < *num_y; j++) { - k = (*num_y-j-1) * (*num_x) + l; + } else if(iflag_rgba == BW_ALPHA){ + for (l = 0; l < num_x; l++) { + for (j = 0; j < num_y; j++) { + k = (num_y-j-1) * num_x + l; cimage[4*k ] = bimage[j][2*l ]; cimage[4*k+1] = bimage[j][2*l ]; cimage[4*k+2] = bimage[j][2*l ]; cimage[4*k+3] = bimage[j][2*l+1]; } }; - } else if(*iflag_rgba == B_AND_W){ - for (l = 0; l < *num_x; l++) { - for (j = 0; j < *num_y; j++) { - k = (*num_y-j-1) * (*num_x) + l; + } else if(iflag_rgba == B_AND_W){ + for (l = 0; l < num_x; l++) { + for (j = 0; j < num_y; j++) { + k = (num_y-j-1) * num_x + l; cimage[4*k ] = bimage[j][l]; cimage[4*k+1] = bimage[j][l]; cimage[4*k+2] = bimage[j][l]; @@ -235,41 +237,42 @@ void copy_rgba_from_png_c(int *num_x, int *num_y, int *iflag_rgba, unsigned char }; }; - for (i = 0; i < *num_y; i++) free(bimage[i]); + for (i = 0; i < num_y; i++) free(bimage[i]); free(bimage); }; -void copy_grayscale_from_png_c(int *num_x, int *num_y, int *iflag_rgba, unsigned char *cimage) +void copy_grayscale_from_png_c(const int num_x, const int num_y, + const int iflag_rgba, unsigned char *cimage) { int k, j, l, mixed; - if(*iflag_rgba == RGBA_COLOR){ - for (l = 0; l < *num_x; l++) { - for (j = 0; j < *num_y; j++) { - k = (*num_y-j-1) * (*num_x) + l; + if(iflag_rgba == RGBA_COLOR){ + for (l = 0; l < num_x; l++) { + for (j = 0; j < num_y; j++) { + k = (num_y-j-1) * num_x + l; mixed = ((int) bimage[j][4*l ] + (int) bimage[j][4*l+1] + (int) bimage[j][4*l+2]) / 3; cimage[k ] = (unsigned char) mixed; } }; - } else if(*iflag_rgba == RGB_COLOR){ - for (l = 0; l < *num_x; l++) { - for (j = 0; j < *num_y; j++) { - k = (*num_y-j-1) * (*num_x) + l; + } else if(iflag_rgba == RGB_COLOR){ + for (l = 0; l < num_x; l++) { + for (j = 0; j < num_y; j++) { + k = (num_y-j-1) * num_x + l; mixed = ((int) bimage[j][3*l ] + (int) bimage[j][3*l+1] + (int) bimage[j][3*l+2]) / 3; cimage[k ] = (unsigned char) mixed; } }; - } else if(*iflag_rgba == BW_ALPHA){ - for (l = 0; l < *num_x; l++) { - for (j = 0; j < *num_y; j++) { - k = (*num_y-j-1) * (*num_x) + l; + } else if(iflag_rgba == BW_ALPHA){ + for (l = 0; l < num_x; l++) { + for (j = 0; j < num_y; j++) { + k = (num_y-j-1) * num_x + l; cimage[k ] = bimage[j][2*l ]; } }; - } else if(*iflag_rgba == B_AND_W){ - for (l = 0; l < *num_x; l++) { - for (j = 0; j < *num_y; j++) { - k = (*num_y-j-1) * (*num_x) + l; + } else if(iflag_rgba == B_AND_W){ + for (l = 0; l < num_x; l++) { + for (j = 0; j < num_y; j++) { + k = (num_y-j-1) * num_x + l; cimage[k ] = bimage[j][l]; } }; @@ -278,46 +281,47 @@ void copy_grayscale_from_png_c(int *num_x, int *num_y, int *iflag_rgba, unsigned free(bimage); }; -void copy_grayalpha_from_png_c(int *num_x, int *num_y, int *iflag_rgba, unsigned char *cimage) +void copy_grayalpha_from_png_c(const int num_x, const int num_y, + const int iflag_rgba, unsigned char *cimage) { int i, k, j, l, mixed; - if(*iflag_rgba == RGBA_COLOR){ - for (l = 0; l < *num_x; l++) { - for (j = 0; j < *num_y; j++) { - k = (*num_y-j-1) * (*num_x) + l; + if(iflag_rgba == RGBA_COLOR){ + for (l = 0; l < num_x; l++) { + for (j = 0; j < num_y; j++) { + k = (num_y-j-1) * num_x + l; mixed = ((int) bimage[j][4*l ] + (int) bimage[j][4*l+1] + (int) bimage[j][4*l+2]) / 3; cimage[2*k ] = (unsigned char) mixed; cimage[2*k+1] = bimage[j][2*l+1]; } }; - } else if(*iflag_rgba == RGB_COLOR){ - for (l = 0; l < *num_x; l++) { - for (j = 0; j < *num_y; j++) { - k = (*num_y-j-1) * (*num_x) + l; + } else if(iflag_rgba == RGB_COLOR){ + for (l = 0; l < num_x; l++) { + for (j = 0; j < num_y; j++) { + k = (num_y-j-1) * num_x + l; mixed = ((int) bimage[j][3*l ] + (int) bimage[j][3*l+1] + (int) bimage[j][3*l+2]) / 3; cimage[2*k ] = (unsigned char) mixed; cimage[2*k+3] = (unsigned char) 255; } }; - } else if(*iflag_rgba == BW_ALPHA){ - for (l = 0; l < *num_x; l++) { - for (j = 0; j < *num_y; j++) { - k = (*num_y-j-1) * (*num_x) + l; + } else if(iflag_rgba == BW_ALPHA){ + for (l = 0; l < num_x; l++) { + for (j = 0; j < num_y; j++) { + k = (num_y-j-1) * num_x + l; cimage[2*k ] = bimage[j][2*l ]; cimage[2*k+1] = bimage[j][2*l+1]; } }; - } else if(*iflag_rgba == B_AND_W){ - for (l = 0; l < *num_x; l++) { - for (j = 0; j < *num_y; j++) { - k = (*num_y-j-1) * (*num_x) + l; + } else if(iflag_rgba == B_AND_W){ + for (l = 0; l < num_x; l++) { + for (j = 0; j < num_y; j++) { + k = (num_y-j-1) * num_x + l; cimage[2*k ] = bimage[j][l]; cimage[2*k+3] = (unsigned char) 255; } }; }; - for (i = 0; i < *num_y; i++) free(bimage[i]); + for (i = 0; i < num_y; i++) free(bimage[i]); free(bimage); }; diff --git a/src/C_libraries/BASE/read_image_2_png.h b/src/C_libraries/BASE/read_image_2_png.h index fb9708d0..496df623 100644 --- a/src/C_libraries/BASE/read_image_2_png.h +++ b/src/C_libraries/BASE/read_image_2_png.h @@ -14,9 +14,13 @@ void read_png_file_c(const char *fhead, int *num_x, int *num_y, int *iflag_rgba); -void copy_rgb_from_png_c(int *num_x, int *num_y, int *iflag_rgba, unsigned char *cimage); -void copy_rgba_from_png_c(int *num_x, int *num_y, int *iflag_rgba, unsigned char *cimage); -void copy_grayscale_from_png_c(int *num_x, int *num_y, int *iflag_rgba, unsigned char *cimage); -void copy_grayalpha_from_png_c(int *num_x, int *num_y, int *iflag_rgba, unsigned char *cimage); +void copy_rgb_from_png_c(const int num_x, const int num_y, + const int iflag_rgba, unsigned char *cimage); +void copy_rgba_from_png_c(const int num_x, const int num_y, + const int iflag_rgba, unsigned char *cimage); +void copy_grayscale_from_png_c(const int num_x, const int num_y, + const int iflag_rgba, unsigned char *cimage); +void copy_grayalpha_from_png_c(const int num_x, const int num_y, + const int iflag_rgba, unsigned char *cimage); #endif diff --git a/src/Fortran_libraries/MHD_src/IO/Makefile.depends b/src/Fortran_libraries/MHD_src/IO/Makefile.depends index 069dd473..df5d5ae9 100644 --- a/src/Fortran_libraries/MHD_src/IO/Makefile.depends +++ b/src/Fortran_libraries/MHD_src/IO/Makefile.depends @@ -14,7 +14,7 @@ bcast_ctl_data_mhd_time_rst.o: $(MHD_IO_DIR)/bcast_ctl_data_mhd_time_rst.f90 m_p $(F90) -c $(F90OPTFLAGS) $< bcast_dynamo_sect_control.o: $(MHD_IO_DIR)/bcast_dynamo_sect_control.f90 m_precision.o calypso_mpi.o m_machine_parameter.o t_control_data_dynamo_sects.o bcast_control_arrays.o bcast_section_control_data.o bcast_control_sph_MHD.o calypso_mpi_int.o calypso_mpi_char.o transfer_to_long_integers.o $(F90) -c $(F90OPTFLAGS) $< -bcast_dynamo_viz_control.o: $(MHD_IO_DIR)/bcast_dynamo_viz_control.f90 m_precision.o calypso_mpi.o m_machine_parameter.o t_control_data_dynamo_vizs.o bcast_section_control_data.o bcast_maps_control_data.o bcast_control_sph_MHD.o +bcast_dynamo_viz_control.o: $(MHD_IO_DIR)/bcast_dynamo_viz_control.f90 m_precision.o calypso_mpi.o m_machine_parameter.o t_control_data_dynamo_vizs.o calypso_mpi_int.o calypso_mpi_char.o transfer_to_long_integers.o bcast_section_control_data.o bcast_maps_control_data.o bcast_control_sph_MHD.o $(F90) -c $(F90OPTFLAGS) $< bcast_monitor_data_ctl.o: $(MHD_IO_DIR)/bcast_monitor_data_ctl.f90 m_precision.o m_machine_parameter.o t_ctl_data_node_monitor.o calypso_mpi.o transfer_to_long_integers.o calypso_mpi_char.o calypso_mpi_int.o bcast_control_arrays.o $(F90) -c $(F90OPTFLAGS) $< diff --git a/src/Fortran_libraries/MHD_src/IO/bcast_dynamo_viz_control.f90 b/src/Fortran_libraries/MHD_src/IO/bcast_dynamo_viz_control.f90 index 1b787c5d..d8e477ce 100644 --- a/src/Fortran_libraries/MHD_src/IO/bcast_dynamo_viz_control.f90 +++ b/src/Fortran_libraries/MHD_src/IO/bcast_dynamo_viz_control.f90 @@ -34,6 +34,10 @@ module bcast_dynamo_viz_control subroutine s_bcast_dynamo_viz_control(zm_ctls) ! use t_control_data_dynamo_vizs +! + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers use bcast_section_control_data use bcast_maps_control_data use bcast_control_sph_MHD @@ -46,6 +50,10 @@ subroutine s_bcast_dynamo_viz_control(zm_ctls) call bcast_files_4_psf_ctl(zm_ctls%zRMS_psf_ctls) call bcast_files_4_map_ctl(zm_ctls%zm_map_ctls) call bcast_files_4_map_ctl(zm_ctls%zRMS_map_ctls) +! + call calypso_mpi_bcast_character & + & (zm_ctls%block_name, cast_long(kchara), 0) + call calypso_mpi_bcast_one_int(zm_ctls%i_viz_ctl, 0) ! end subroutine s_bcast_dynamo_viz_control ! diff --git a/src/Fortran_libraries/MHD_src/IO/t_control_data_dynamo_vizs.f90 b/src/Fortran_libraries/MHD_src/IO/t_control_data_dynamo_vizs.f90 index 668668df..0f0e6fb2 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_control_data_dynamo_vizs.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_control_data_dynamo_vizs.f90 @@ -7,16 +7,15 @@ !> @brief Control data structure for zonal mean visualization controls !! !!@verbatim +!! subroutine init_dynamo_viz_control(hd_block, zm_ctls) !! subroutine read_dynamo_viz_control & !! & (id_control, hd_block, zm_ctls, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(sph_dynamo_viz_controls), intent(inout) :: zm_ctls !! type(buffer_for_control), intent(inout) :: c_buf -!! subroutine write_dynamo_viz_control & -!! & (id_control, hd_block, zm_ctls, level) +!! subroutine write_dynamo_viz_control(id_control, zm_ctls, level) !! integer(kind = kint), intent(in) :: id_control -!! character(len=kchara), intent(in) :: hd_block !! type(sph_dynamo_viz_controls), intent(in) :: zm_ctls !! integer(kind = kint), intent(inout) :: level !! subroutine dealloc_dynamo_viz_control(zm_ctls) @@ -66,6 +65,8 @@ module t_control_data_dynamo_vizs ! !> Structures of zonal mean controls type sph_dynamo_viz_controls +!> Block name + character(len=kchara) :: block_name = 'dynamo_vizs_control' !> Structure of crustal filtering of mangeitc field type(clust_filtering_ctl) :: crust_filter_ctl ! @@ -118,8 +119,8 @@ subroutine read_dynamo_viz_control & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(zm_ctls%i_viz_ctl .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do call load_one_line_from_control(id_control, hd_block, c_buf) if(c_buf%iend .gt. 0) exit @@ -145,8 +146,7 @@ end subroutine read_dynamo_viz_control ! ! -------------------------------------------------------------------- ! - subroutine write_dynamo_viz_control & - & (id_control, hd_block, zm_ctls, level) + subroutine write_dynamo_viz_control(id_control, zm_ctls, level) ! use t_read_control_elements use write_control_elements @@ -154,16 +154,16 @@ subroutine write_dynamo_viz_control & use ctl_file_map_renderings_IO ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(sph_dynamo_viz_controls), intent(in) :: zm_ctls integer(kind = kint), intent(inout) :: level ! ! if(zm_ctls%i_viz_ctl .le. 0) return ! - level = write_begin_flag_for_ctl(id_control, level, hd_block) + level = write_begin_flag_for_ctl(id_control, level, & + & zm_ctls%block_name) call write_crustal_filtering_ctl(id_control, & - & hd_crustal_filtering, zm_ctls%crust_filter_ctl, level) + & zm_ctls%crust_filter_ctl, level) ! call write_single_section_ctl(id_control, hd_zm_section, & & zm_ctls%zm_psf_ctls, level) @@ -174,11 +174,34 @@ subroutine write_dynamo_viz_control & & zm_ctls%zm_map_ctls, level) call write_files_4_map_ctl(id_control, hd_zRMS_rendering, & & zm_ctls%zRMS_map_ctls, level) - level = write_end_flag_for_ctl(id_control, level, hd_block) + level = write_end_flag_for_ctl(id_control, level, & + & zm_ctls%block_name) ! end subroutine write_dynamo_viz_control ! ! -------------------------------------------------------------------- +! + subroutine init_dynamo_viz_control(hd_block, zm_ctls) +! + use ctl_file_map_renderings_IO +! + character(len=kchara), intent(in) :: hd_block + type(sph_dynamo_viz_controls), intent(inout) :: zm_ctls +! +! + zm_ctls%block_name = trim(hd_block) + call init_crustal_filtering_ctl(hd_crustal_filtering, & + & zm_ctls%crust_filter_ctl) + call init_psf_ctls_labels(hd_zm_section, zm_ctls%zm_psf_ctls) + call init_psf_ctls_labels(hd_zRMS_section, & + & zm_ctls%zRMS_psf_ctls) + call init_map_ctls_labels(hd_zm_rendering, zm_ctls%zm_map_ctls) + call init_map_ctls_labels(hd_zRMS_rendering, & + & zm_ctls%zRMS_map_ctls) +! + end subroutine init_dynamo_viz_control +! +! -------------------------------------------------------------------- ! subroutine dealloc_dynamo_viz_control(zm_ctls) ! @@ -218,6 +241,9 @@ subroutine read_single_section_ctl & & .or. check_begin_flag(c_buf, hd_section)) then psf_ctls%num_psf_ctl = 1 call alloc_psf_ctl_stract(psf_ctls) + call init_psf_ctl_stract(hd_section, & + & psf_ctls%psf_ctl_struct(1)) + psf_ctls%fname_psf_ctl(1) = 'NO_FILE' ! call write_multi_ctl_file_message & & (hd_section, psf_ctls%num_psf_ctl, c_buf%level) diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_sph_MHD_w_vizs.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_sph_MHD_w_vizs.f90 index faefad9b..31ac719f 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_sph_MHD_w_vizs.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_sph_MHD_w_vizs.f90 @@ -13,8 +13,6 @@ !!@verbatim !! subroutine read_control_4_sph_MHD_w_vizs(file_name, MHD_ctl, & !! & add_VMHD_ctl, c_buf) -!! subroutine read_sph_mhd_ctl_w_vizs(id_control, hd_block, & -!! & MHD_ctl, add_VMHD_ctl, c_buf) !! character(len=kchara), intent(in) :: file_name !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block @@ -23,11 +21,10 @@ !! type(buffer_for_control), intent(inout) :: c_buf !! subroutine write_control_4_sph_MHD_w_vizs(file_name, MHD_ctl, & !! & add_VMHD_ctl) -!! subroutine write_sph_mhd_ctl_w_vizs(id_control, hd_block, & +!! subroutine write_sph_mhd_ctl_w_vizs(id_control, & !! & MHD_ctl, add_VMHD_ctl, level) !! character(len=kchara), intent(in) :: file_name !! integer(kind = kint), intent(in) :: id_control -!! character(len=kchara), intent(in) :: hd_block !! type(mhd_simulation_control), intent(in) :: MHD_ctl !! type(add_vizs_sph_mhd_ctl), intent(in) :: add_VMHD_ctl !! integer(kind = kint), intent(inout) :: level @@ -65,6 +62,10 @@ module t_ctl_data_sph_MHD_w_vizs type(sph_dynamo_viz_controls) :: zm_ctls end type add_vizs_sph_mhd_ctl ! +! + character(len=kchara), parameter, private & + & :: hd_mhd_ctl = 'MHD_control' +! ! 2nd level for MHD ! character(len=kchara), parameter, private & @@ -89,10 +90,6 @@ module t_ctl_data_sph_MHD_w_vizs character(len=kchara), parameter, private & & :: hd_dynamo_viz_ctl = 'dynamo_vizs_control' ! -! Top level of label - character(len=kchara), parameter, private & - & :: hd_mhd_ctl = 'MHD_control' -! !> Here is the old label character(len=kchara), parameter, private & & :: hd_zm_viz_ctl = 'zonal_mean_control' @@ -115,15 +112,17 @@ subroutine read_control_4_sph_MHD_w_vizs(file_name, MHD_ctl, & ! ! c_buf%level = c_buf%level + 1 + call init_sph_mhd_ctl_w_vizs_label(hd_mhd_ctl, & + & MHD_ctl, add_VMHD_ctl) open(id_control_file, file = file_name, status='old' ) ! do - call load_one_line_from_control(id_control_file, hd_mhd_ctl, & - & c_buf) + call load_one_line_from_control(id_control_file, & + & hd_mhd_ctl, c_buf) if(c_buf%iend .gt. 0) exit ! - call read_sph_mhd_ctl_w_vizs(id_control_file, hd_mhd_ctl, & - & MHD_ctl, add_VMHD_ctl, c_buf) + call read_sph_mhd_ctl_w_vizs(id_control_file, & + & hd_mhd_ctl, MHD_ctl, add_VMHD_ctl, c_buf) if(MHD_ctl%i_mhd_ctl .gt. 0) exit end do close(id_control_file) @@ -160,8 +159,8 @@ subroutine write_control_4_sph_MHD_w_vizs(file_name, MHD_ctl, & write(*,*) 'Write MHD control file: ', trim(file_name) open(id_control_file, file = file_name) level1 = 0 - call write_sph_mhd_ctl_w_vizs(id_control_file, hd_mhd_ctl, & - & MHD_ctl, add_VMHD_ctl, level1) + call write_sph_mhd_ctl_w_vizs(id_control_file, & + & MHD_ctl, add_VMHD_ctl, level1) close(id_control_file) ! end subroutine write_control_4_sph_MHD_w_vizs @@ -186,8 +185,8 @@ subroutine read_sph_mhd_ctl_w_vizs(id_control, hd_block, & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(MHD_ctl%i_mhd_ctl .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do call load_one_line_from_control(id_control, hd_block, c_buf) if(c_buf%iend .gt. 0) exit @@ -200,7 +199,7 @@ subroutine read_sph_mhd_ctl_w_vizs(id_control, hd_block, & & (id_control, hd_org_data, MHD_ctl%org_plt, c_buf) ! call sel_read_ctl_gen_shell_grids(id_control, hd_sph_shell, & - & MHD_ctl%fname_psph_ctl, MHD_ctl%psph_ctl, c_buf) + & MHD_ctl%fname_psph, MHD_ctl%psph_ctl, c_buf) ! call read_sph_mhd_model & & (id_control, hd_model, MHD_ctl%model_ctl, c_buf) @@ -226,7 +225,7 @@ end subroutine read_sph_mhd_ctl_w_vizs ! ! -------------------------------------------------------------------- ! - subroutine write_sph_mhd_ctl_w_vizs(id_control, hd_block, & + subroutine write_sph_mhd_ctl_w_vizs(id_control, & & MHD_ctl, add_VMHD_ctl, level) ! use ctl_data_platforms_IO @@ -238,7 +237,6 @@ subroutine write_sph_mhd_ctl_w_vizs(id_control, hd_block, & use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(mhd_simulation_control), intent(in) :: MHD_ctl type(add_vizs_sph_mhd_ctl), intent(in) :: add_VMHD_ctl ! @@ -247,35 +245,68 @@ subroutine write_sph_mhd_ctl_w_vizs(id_control, hd_block, & ! if(MHD_ctl%i_mhd_ctl .le. 0) return ! - level = write_begin_flag_for_ctl(id_control, level, hd_block) + level = write_begin_flag_for_ctl(id_control, level, & + & MHD_ctl%block_name) call write_control_platforms & & (id_control, hd_platform, MHD_ctl%plt, level) call write_control_platforms & & (id_control, hd_org_data, MHD_ctl%org_plt, level) ! - call sel_write_ctl_gen_shell_grids(id_control, hd_sph_shell, & - & MHD_ctl%fname_psph_ctl, MHD_ctl%psph_ctl, level) + call sel_write_ctl_gen_shell_grids(id_control, & + & MHD_ctl%fname_psph, MHD_ctl%psph_ctl, level) ! - call write_sph_mhd_model & - & (id_control, hd_model, MHD_ctl%model_ctl, level) - call write_sph_mhd_control & - & (id_control, hd_control, MHD_ctl%smctl_ctl, level) + call write_sph_mhd_model(id_control, MHD_ctl%model_ctl, level) + call write_sph_mhd_control(id_control, MHD_ctl%smctl_ctl, level) ! - call write_monitor_data_ctl & - & (id_control, hd_monitor_data, MHD_ctl%nmtr_ctl, level) + call write_monitor_data_ctl(id_control, MHD_ctl%nmtr_ctl, level) call write_sph_monitoring_ctl & - & (id_control, hd_pick_sph, MHD_ctl%smonitor_ctl, level) + & (id_control, MHD_ctl%smonitor_ctl, level) ! call write_viz3_controls & & (id_control, hd_viz_ctl, add_VMHD_ctl%viz3_ctls, level) ! call write_dynamo_viz_control & - & (id_control, hd_dynamo_viz_ctl, add_VMHD_ctl%zm_ctls, level) - level = write_end_flag_for_ctl(id_control, level, hd_block) + & (id_control, add_VMHD_ctl%zm_ctls, level) + level = write_end_flag_for_ctl(id_control, level, & + & MHD_ctl%block_name) ! end subroutine write_sph_mhd_ctl_w_vizs ! ! -------------------------------------------------------------------- +! + subroutine init_sph_mhd_ctl_w_vizs_label(hd_block, & + & MHD_ctl, add_VMHD_ctl) +! + use ctl_data_platforms_IO + use ctl_data_sph_monitor_IO + use ctl_data_MHD_model_IO + use ctl_data_three_vizs_IO + use ctl_file_gen_sph_shell_IO +! + character(len=kchara), intent(in) :: hd_block +! + type(mhd_simulation_control), intent(inout) :: MHD_ctl + type(add_vizs_sph_mhd_ctl), intent(inout) :: add_VMHD_ctl +! +! + MHD_ctl%block_name = trim(hd_block) + call init_platforms_labels(hd_platform, MHD_ctl%plt) + call init_platforms_labels(hd_org_data, MHD_ctl%org_plt) + call init_parallel_shell_ctl_label(hd_sph_shell, & + & MHD_ctl%psph_ctl) + call init_sph_mhd_model_label(hd_model, MHD_ctl%model_ctl) + call init_sph_mhd_control_label(hd_control, MHD_ctl%smctl_ctl) + call init_sph_monitoring_labels(hd_pick_sph, & + & MHD_ctl%smonitor_ctl) + call init_viz3_ctl_label(hd_viz_ctl, add_VMHD_ctl%viz3_ctls) + call init_dynamo_viz_control(hd_dynamo_viz_ctl, & + & add_VMHD_ctl%zm_ctls) + call init_monitor_data_ctl_label(hd_monitor_data, & + & MHD_ctl%nmtr_ctl) +! + end subroutine init_sph_mhd_ctl_w_vizs_label +! +! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine dealloc_sph_mhd_ctl_w_vizs(add_VMHD_ctl) diff --git a/src/Fortran_libraries/MHD_src/sph_MHD/Makefile.depends b/src/Fortran_libraries/MHD_src/sph_MHD/Makefile.depends index de3f768d..7ef87917 100644 --- a/src/Fortran_libraries/MHD_src/sph_MHD/Makefile.depends +++ b/src/Fortran_libraries/MHD_src/sph_MHD/Makefile.depends @@ -174,7 +174,7 @@ initial_magne_dynamobench.o: $(MHD_SPH_DIR)/initial_magne_dynamobench.f90 m_prec $(F90) -c $(F90OPTFLAGS) $< input_control_sph_MHD.o: $(MHD_SPH_DIR)/input_control_sph_MHD.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_const_spherical_grid.o t_MHD_file_parameter.o t_MHD_step_parameter.o t_SPH_MHD_model_data.o t_SPH_mesh_field_data.o t_FEM_mesh_field_data.o t_control_data_dynamo_sects.o t_rms_4_sph_spectr.o t_file_IO_parameter.o t_sph_boundary_input_data.o t_bc_data_list.o t_flex_delta_t_data.o t_work_SPH_MHD.o t_ctl_data_MHD.o t_ctl_data_sph_MHD_w_psf.o t_read_control_elements.o bcast_control_sph_MHD.o bcast_ctl_data_surfacings.o bcast_dynamo_sect_control.o t_time_data.o t_node_monitor_IO.o m_error_IDs.o set_control_sph_mhd.o set_control_SPH_MHD_w_viz.o sph_file_IO_select.o set_control_4_SPH_to_FEM.o parallel_load_data_4_sph.o set_control_SPH_MHD_noviz.o $(F90) -c $(F90OPTFLAGS) $< -input_control_sph_MHD_vizs.o: $(MHD_SPH_DIR)/input_control_sph_MHD_vizs.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_const_spherical_grid.o t_MHD_file_parameter.o t_MHD_step_parameter.o t_SPH_MHD_model_data.o t_SPH_mesh_field_data.o t_FEM_mesh_field_data.o t_control_data_dynamo_vizs.o t_rms_4_sph_spectr.o t_file_IO_parameter.o t_sph_boundary_input_data.o t_bc_data_list.o t_flex_delta_t_data.o t_work_SPH_MHD.o t_ctl_data_MHD.o t_ctl_data_sph_MHD_w_vizs.o t_read_control_elements.o bcast_control_sph_MHD.o bcast_ctl_data_viz3.o bcast_dynamo_viz_control.o t_time_data.o t_node_monitor_IO.o m_error_IDs.o set_control_sph_mhd.o sph_file_IO_select.o set_control_4_SPH_to_FEM.o parallel_load_data_4_sph.o +input_control_sph_MHD_vizs.o: $(MHD_SPH_DIR)/input_control_sph_MHD_vizs.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_const_spherical_grid.o t_MHD_file_parameter.o t_MHD_step_parameter.o t_SPH_MHD_model_data.o t_SPH_mesh_field_data.o t_FEM_mesh_field_data.o t_control_data_dynamo_vizs.o t_rms_4_sph_spectr.o t_file_IO_parameter.o t_sph_boundary_input_data.o t_bc_data_list.o t_flex_delta_t_data.o t_work_SPH_MHD.o t_ctl_data_MHD.o t_ctl_data_sph_MHD_w_vizs.o t_read_control_elements.o bcast_control_sph_MHD.o bcast_ctl_data_viz3.o bcast_dynamo_viz_control.o t_time_data.o t_node_monitor_IO.o m_error_IDs.o set_control_sph_mhd.o set_control_SPH_MHD_w_viz.o sph_file_IO_select.o set_control_4_SPH_to_FEM.o parallel_load_data_4_sph.o $(F90) -c $(F90OPTFLAGS) $< interact_coriolis_rlm.o: $(MHD_SPH_DIR)/interact_coriolis_rlm.f90 m_precision.o m_constants.o m_machine_parameter.o t_gaunt_coriolis_rlm.o cal_gaunt_itgs.o $(F90) -c $(F90OPTFLAGS) $< diff --git a/src/Fortran_libraries/MHD_src/sph_MHD/input_control_sph_MHD_vizs.f90 b/src/Fortran_libraries/MHD_src/sph_MHD/input_control_sph_MHD_vizs.f90 index d3607db7..eb34887c 100644 --- a/src/Fortran_libraries/MHD_src/sph_MHD/input_control_sph_MHD_vizs.f90 +++ b/src/Fortran_libraries/MHD_src/sph_MHD/input_control_sph_MHD_vizs.f90 @@ -101,6 +101,7 @@ subroutine s_input_control_SPH_MHD_vizs & use m_error_IDs ! use set_control_sph_mhd + use set_control_SPH_MHD_w_viz use sph_file_IO_select use set_control_4_SPH_to_FEM use parallel_load_data_4_sph @@ -130,7 +131,7 @@ subroutine s_input_control_SPH_MHD_vizs & & SPH_model%MHD_prop, SPH_model%MHD_BC, SPH_WK%trans_p, & & SPH_WK%trns_WK, SPH_MHD) ! - call set_control_SPH_MHD_w_viz & + call s_set_control_SPH_MHD_w_viz & & (MHD_ctl%model_ctl, MHD_ctl%psph_ctl, MHD_ctl%smonitor_ctl, & & add_VMHD_ctl%zm_ctls%crust_filter_ctl, MHD_ctl%nmtr_ctl, & & SPH_model%MHD_prop, SPH_model%MHD_BC, SPH_MHD%sph, & diff --git a/src/Fortran_libraries/SERIAL_src/Fortran2003/t_png_file_access.f90 b/src/Fortran_libraries/SERIAL_src/Fortran2003/t_png_file_access.f90 index 94f633d8..5297cf3c 100644 --- a/src/Fortran_libraries/SERIAL_src/Fortran2003/t_png_file_access.f90 +++ b/src/Fortran_libraries/SERIAL_src/Fortran2003/t_png_file_access.f90 @@ -95,8 +95,8 @@ subroutine copy_rgb_from_png_c & & BIND(C, name = 'copy_rgb_from_png_c') use ISO_C_BINDING ! - integer(C_int), intent(in) :: num_x, num_y - integer(C_int), intent(in) :: iflag_rgba + integer(C_int), value :: num_x, num_y + integer(C_int), value :: iflag_rgba type(C_ptr), value, intent(in) :: cimage end subroutine copy_rgb_from_png_c ! ----------------- @@ -105,8 +105,8 @@ subroutine copy_rgba_from_png_c & & BIND(C, name = 'copy_rgba_from_png_c') use ISO_C_BINDING ! - integer(C_int), intent(in) :: num_x, num_y - integer(C_int), intent(in) :: iflag_rgba + integer(C_int), value :: num_x, num_y + integer(C_int), value :: iflag_rgba type(C_ptr), value, intent(in) :: cimage end subroutine copy_rgba_from_png_c ! ----------------- @@ -115,8 +115,8 @@ subroutine copy_grayscale_from_png_c & & BIND(C, name = 'copy_grayscale_from_png_c') use ISO_C_BINDING ! - integer(C_int), intent(in) :: num_x, num_y - integer(C_int), intent(in) :: iflag_rgba + integer(C_int), value :: num_x, num_y + integer(C_int), value :: iflag_rgba type(C_ptr), value, intent(in) :: cimage end subroutine copy_grayscale_from_png_c ! ----------------- @@ -125,8 +125,8 @@ subroutine copy_grayalpha_from_png_c & & BIND(C, name = 'copy_grayalpha_from_png_c') use ISO_C_BINDING ! - integer(C_int), intent(in) :: num_x, num_y - integer(C_int), intent(in) :: iflag_rgba + integer(C_int), value :: num_x, num_y + integer(C_int), value :: iflag_rgba type(C_ptr), value, intent(in) :: cimage end subroutine copy_grayalpha_from_png_c ! ----------------- diff --git a/src/Fortran_libraries/VIZ_src/fieldline/Makefile b/src/Fortran_libraries/VIZ_src/fieldline/Makefile index 76300e2d..e5bf475c 100644 --- a/src/Fortran_libraries/VIZ_src/fieldline/Makefile +++ b/src/Fortran_libraries/VIZ_src/fieldline/Makefile @@ -15,12 +15,12 @@ dir_list: lib_name: -lib_tasks: libtarget lib_archve +lib_tasks: lib_archve @echo ' ''$$(RANLIB) $$@' >> $(MAKENAME) libtarget: -lib_archve: +lib_archve: libtarget @echo ' ''$$(AR)' '$$(ARFLUGS)' rcsv '$$@' '$$(MOD_FIELDLINE)' \ >> $(MAKENAME) diff --git a/src/Fortran_libraries/VIZ_src/fieldline/Makefile.depends b/src/Fortran_libraries/VIZ_src/fieldline/Makefile.depends index f0192e66..a23d4874 100644 --- a/src/Fortran_libraries/VIZ_src/fieldline/Makefile.depends +++ b/src/Fortran_libraries/VIZ_src/fieldline/Makefile.depends @@ -18,7 +18,9 @@ ctl_file_fieldlines_IO.o: $(FIELDLINE_DIR)/ctl_file_fieldlines_IO.f90 m_precisio $(F90) -c $(F90OPTFLAGS) $< extend_field_line.o: $(FIELDLINE_DIR)/extend_field_line.f90 m_precision.o m_constants.o m_geometry_constants.o calypso_mpi.o t_geometry_data.o t_surface_data.o t_local_fline.o cal_field_on_surf_viz.o cal_fline_in_cube.o $(F90) -c $(F90OPTFLAGS) $< -set_control_each_fline.o: $(FIELDLINE_DIR)/set_control_each_fline.f90 m_precision.o calypso_mpi.o m_constants.o m_error_IDs.o m_machine_parameter.o t_control_params_4_fline.o t_ctl_data_field_line.o t_geometry_data.o t_group_data.o set_area_4_viz.o set_field_comp_for_viz.o set_fields_for_fieldline.o m_field_file_format.o t_source_of_filed_line.o skip_comment_f.o delete_data_files.o set_components_flags.o +m_control_fline_flags.o: $(FIELDLINE_DIR)/m_control_fline_flags.f90 m_precision.o t_control_array_character.o + $(F90) -c $(F90OPTFLAGS) $< +set_control_each_fline.o: $(FIELDLINE_DIR)/set_control_each_fline.f90 m_precision.o calypso_mpi.o m_constants.o m_error_IDs.o m_machine_parameter.o t_control_params_4_fline.o t_ctl_data_field_line.o t_geometry_data.o t_group_data.o set_area_4_viz.o set_field_comp_for_viz.o set_fields_for_fieldline.o m_field_file_format.o m_control_fline_flags.o t_source_of_filed_line.o skip_comment_f.o delete_data_files.o set_components_flags.o $(F90) -c $(F90OPTFLAGS) $< set_fields_for_fieldline.o: $(FIELDLINE_DIR)/set_fields_for_fieldline.f90 m_precision.o calypso_mpi.o m_constants.o m_machine_parameter.o t_phys_data.o t_geometry_data.o t_surface_data.o t_group_data.o t_control_params_4_fline.o t_source_of_filed_line.o convert_components_4_viz.o t_mesh_data.o start_surface_by_gl_table.o start_surface_by_flux.o start_surface_in_volume.o start_surface_4_fline.o $(F90) -c $(F90OPTFLAGS) $< @@ -36,9 +38,9 @@ start_surface_by_gl_table.o: $(FIELDLINE_DIR)/start_surface_by_gl_table.f90 m_pr $(F90) -c $(F90OPTFLAGS) $< start_surface_in_volume.o: $(FIELDLINE_DIR)/start_surface_in_volume.f90 m_precision.o calypso_mpi.o m_constants.o m_machine_parameter.o t_phys_data.o t_geometry_data.o t_surface_data.o t_group_data.o t_control_params_4_fline.o t_source_of_filed_line.o calypso_mpi_real.o extend_field_line.o cal_field_on_surf_viz.o set_fline_start_surface.o $(F90) -c $(F90OPTFLAGS) $< -t_control_data_flines.o: $(FIELDLINE_DIR)/t_control_data_flines.f90 m_precision.o m_constants.o m_machine_parameter.o t_ctl_data_field_line.o t_control_array_character3.o +t_control_data_flines.o: $(FIELDLINE_DIR)/t_control_data_flines.f90 m_precision.o m_constants.o m_machine_parameter.o t_ctl_data_field_line.o ctl_data_field_line_IO.o t_control_array_character3.o $(F90) -c $(F90OPTFLAGS) $< -t_control_params_4_fline.o: $(FIELDLINE_DIR)/t_control_params_4_fline.f90 m_precision.o t_geometry_data.o t_read_control_elements.o +t_control_params_4_fline.o: $(FIELDLINE_DIR)/t_control_params_4_fline.f90 m_precision.o t_geometry_data.o $(F90) -c $(F90OPTFLAGS) $< t_ctl_data_field_line.o: $(FIELDLINE_DIR)/t_ctl_data_field_line.f90 m_precision.o m_machine_parameter.o t_read_control_elements.o t_control_array_integer.o t_control_array_character.o t_control_array_integer2.o t_control_array_real3.o skip_comment_f.o t_control_array_character3.o add_nodal_fields_ctl.o $(F90) -c $(F90OPTFLAGS) $< diff --git a/src/Fortran_libraries/VIZ_src/fieldline/bcast_ctl_data_field_line.f90 b/src/Fortran_libraries/VIZ_src/fieldline/bcast_ctl_data_field_line.f90 index 54c098ed..53f5cb69 100644 --- a/src/Fortran_libraries/VIZ_src/fieldline/bcast_ctl_data_field_line.f90 +++ b/src/Fortran_libraries/VIZ_src/fieldline/bcast_ctl_data_field_line.f90 @@ -40,6 +40,8 @@ subroutine bcast_files_4_fline_ctl(fline_ctls) integer (kind=kint) :: i_fline ! ! + call calypso_mpi_bcast_character(fline_ctls%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(fline_ctls%num_fline_ctl, 0) if(fline_ctls%num_fline_ctl .le. 0) return ! @@ -58,12 +60,16 @@ end subroutine bcast_files_4_fline_ctl subroutine bcast_field_line_ctl(fln) ! use t_ctl_data_field_line + use transfer_to_long_integers + use calypso_mpi_char use calypso_mpi_int use bcast_control_arrays ! type(fline_ctl), intent(inout) :: fln ! ! + call calypso_mpi_bcast_character(fln%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(fln%i_vr_fline_ctl, 0) ! call bcast_ctl_array_c1(fln%fline_area_grp_ctl) diff --git a/src/Fortran_libraries/VIZ_src/fieldline/ctl_data_field_line_IO.f90 b/src/Fortran_libraries/VIZ_src/fieldline/ctl_data_field_line_IO.f90 index 4484a3e8..ead76734 100644 --- a/src/Fortran_libraries/VIZ_src/fieldline/ctl_data_field_line_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/fieldline/ctl_data_field_line_IO.f90 @@ -6,6 +6,7 @@ !>@brief control data for each field line !! !!@verbatim +!! subroutine init_field_line_ctl_label(hd_block, fln) !! subroutine s_read_field_line_ctl(id_control, hd_block, & !! & fln, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -18,9 +19,6 @@ !! character(len=kchara), intent(in) :: hd_block !! type(fline_ctl), intent(in) :: fln !! integer(kind = kint), intent(inout) :: level -!! -!! integer(kind = kint) function num_label_fline_ctl() -!! subroutine set_label_fline_ctl(names) !! --------------------------------------------------------------------- !! example of control for Kemo's field line !! @@ -116,8 +114,6 @@ module ctl_data_field_line_IO & :: hd_fline_file_head = 'fline_file_head' character(len=kchara), parameter, private & & :: hd_fline_output_type = 'fline_output_type' -! - integer(kind = kint), parameter :: n_label_fline_ctl = 14 ! ! --------------------------------------------------------------------- ! @@ -221,78 +217,92 @@ subroutine write_field_line_ctl(id_control, hd_block, & ! level = write_begin_flag_for_ctl(id_control, level, hd_block) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_fline_file_prefix, fln%fline_file_head_ctl) + & fln%fline_file_head_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_fline_output_format, fln%fline_output_type_ctl) + & fln%fline_output_type_ctl) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_field_line_field, fln%fline_field_ctl) + & fln%fline_field_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_coloring_field, fln%fline_color_field_ctl) + & fln%fline_color_field_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_coloring_comp, fln%fline_color_comp_ctl) + & fln%fline_color_comp_ctl) ! call write_control_array_c1(id_control, level, & - & hd_fline_grp, fln%fline_area_grp_ctl) + & fln%fline_area_grp_ctl) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_line_direction, fln%line_direction_ctl) + & fln%line_direction_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_max_line_stepping, fln%max_line_stepping_ctl) + & fln%max_line_stepping_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_starting_type, fln%starting_type_ctl) + & fln%starting_type_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_start_surf_grp, fln%start_surf_grp_ctl) + & fln%start_surf_grp_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_num_fieldline, fln%num_fieldline_ctl) + & fln%num_fieldline_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_selection_type, fln%selection_type_ctl) + & fln%selection_type_ctl) ! call write_control_array_r3(id_control, level, & - & hd_xx_start_point, fln%seed_point_ctl) + & fln%seed_point_ctl) call write_control_array_i2 (id_control, level, & - & hd_start_global_surf, fln%seed_surface_ctl) + & fln%seed_surface_ctl) ! level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_field_line_ctl ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- ! - integer(kind = kint) function num_label_fline_ctl() - num_label_fline_ctl = n_label_fline_ctl - return - end function num_label_fline_ctl + subroutine init_field_line_ctl_label(hd_block, fln) +! + character(len=kchara), intent(in) :: hd_block + type(fline_ctl), intent(inout) :: fln ! -! ---------------------------------------------------------------------- ! - subroutine set_label_fline_ctl(names) + fln%block_name = hd_block ! - character(len = kchara), intent(inout) & - & :: names(n_label_fline_ctl) + call init_chara_ctl_array_label & + & (hd_fline_grp, fln%fline_area_grp_ctl) ! + call init_r3_ctl_array_label & + & (hd_xx_start_point, fln%seed_point_ctl) + call init_int2_ctl_array_label & + & (hd_start_global_surf, fln%seed_surface_ctl) ! - call set_control_labels(hd_fline_file_prefix, names( 1)) - call set_control_labels(hd_fline_output_format, names( 2)) + call init_chara_ctl_item_label(hd_fline_file_prefix, & + & fln%fline_file_head_ctl) + call init_chara_ctl_item_label(hd_fline_file_head, & + & fln%fline_file_head_ctl) ! - call set_control_labels(hd_fline_grp, names( 3)) - call set_control_labels(hd_field_line_field, names( 4)) - call set_control_labels(hd_coloring_field, names( 5)) - call set_control_labels(hd_coloring_comp, names( 6)) + call init_chara_ctl_item_label(hd_fline_output_format, & + & fln%fline_output_type_ctl) + call init_chara_ctl_item_label(hd_fline_output_type, & + & fln%fline_output_type_ctl) ! - call set_control_labels(hd_num_fieldline, names( 7)) - call set_control_labels(hd_line_direction, names( 8)) - call set_control_labels(hd_max_line_stepping, names( 9)) + call init_chara_ctl_item_label(hd_field_line_field, & + & fln%fline_field_ctl ) + call init_chara_ctl_item_label(hd_coloring_field, & + & fln%fline_color_field_ctl ) + call init_chara_ctl_item_label(hd_coloring_comp, & + & fln%fline_color_comp_ctl ) + call init_chara_ctl_item_label(hd_starting_type, & + & fln%starting_type_ctl ) + call init_chara_ctl_item_label(hd_start_surf_grp, & + & fln%start_surf_grp_ctl ) + call init_chara_ctl_item_label(hd_selection_type, & + & fln%selection_type_ctl ) + call init_chara_ctl_item_label(hd_line_direction, & + & fln%line_direction_ctl ) ! - call set_control_labels(hd_starting_type, names(10)) - call set_control_labels(hd_selection_type, names(11)) - call set_control_labels(hd_start_surf_grp, names(12)) - call set_control_labels(hd_xx_start_point, names(13)) - call set_control_labels(hd_start_global_surf, names(14)) + call init_int_ctl_item_label(hd_num_fieldline, & + & fln%num_fieldline_ctl ) + call init_int_ctl_item_label(hd_max_line_stepping, & + & fln%max_line_stepping_ctl) ! - end subroutine set_label_fline_ctl + end subroutine init_field_line_ctl_label ! -! ---------------------------------------------------------------------- +! --------------------------------------------------------------------- ! end module ctl_data_field_line_IO diff --git a/src/Fortran_libraries/VIZ_src/fieldline/ctl_file_fieldlines_IO.f90 b/src/Fortran_libraries/VIZ_src/fieldline/ctl_file_fieldlines_IO.f90 index 5cf2d1a9..069fdb9d 100644 --- a/src/Fortran_libraries/VIZ_src/fieldline/ctl_file_fieldlines_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/fieldline/ctl_file_fieldlines_IO.f90 @@ -68,10 +68,10 @@ subroutine read_files_4_fline_ctl & type(fieldline_controls), intent(inout) :: fline_ctls type(buffer_for_control), intent(inout) :: c_buf ! + integer(kind = kint) :: n_append ! if(check_array_flag(c_buf, hd_block) .eqv. .FALSE.) return if(allocated(fline_ctls%fline_ctl_struct)) return - fline_ctls%num_fline_ctl = 0 call alloc_fline_ctl_struct(fline_ctls) ! do @@ -81,7 +81,8 @@ subroutine read_files_4_fline_ctl & ! if(check_file_flag(c_buf, hd_block) & & .or. check_begin_flag(c_buf, hd_block)) then - call append_new_fline_control(fline_ctls) + n_append = fline_ctls%num_fline_ctl + call append_fline_control(n_append, hd_block, fline_ctls) ! call write_multi_ctl_file_message & & (hd_block, fline_ctls%num_fline_ctl, c_buf%level) @@ -202,7 +203,7 @@ subroutine sel_write_fline_control(id_control, hd_block, & integer(kind = kint), intent(inout) :: level ! ! - if(cmp_no_case(file_name, 'NO_FILE')) then + if(no_file_flag(file_name)) then write(*,'(a)') ' is included.' call write_field_line_ctl(id_control, hd_block, & & fline_ctl_struct, level) diff --git a/src/Fortran_libraries/VIZ_src/fieldline/m_control_fline_flags.f90 b/src/Fortran_libraries/VIZ_src/fieldline/m_control_fline_flags.f90 new file mode 100644 index 00000000..c97cc089 --- /dev/null +++ b/src/Fortran_libraries/VIZ_src/fieldline/m_control_fline_flags.f90 @@ -0,0 +1,99 @@ +!>@file m_control_fline_flags.f90 +!!@brief module m_control_fline_flags +!! +!!@date Programmed by H.Matsui in Aug. 2011 +! +!>@brief control parameters for each field line +!! +!!@verbatim +!! subroutine fline_start_label_array(array_c) +!! subroutine fline_direction_label_array(array_c) +!! subroutine fline_seeds_label_array(array_c) +!!! type(ctl_array_chara), intent(inout) :: array_c +!!@endverbatim +! + module m_control_fline_flags +! + use m_precision +! + implicit none +! + character(len = kchara), parameter & + & :: cflag_surface_group = 'surface_group' + character(len = kchara), parameter & + & :: cflag_surface_list = 'surface_list' + character(len = kchara), parameter & + & :: cflag_position_list = 'position_list' + character(len = kchara), parameter & + & :: cflag_spray_in_domain = 'spray_in_domain' +! + character(len = kchara), parameter & + & :: cflag_forward_trace = 'forward' + character(len = kchara), parameter & + & :: cflag_backward_trace = 'backward' + character(len = kchara), parameter & + & :: cflag_both_trace = 'both' +! + character(len = kchara), parameter & + & :: cflag_random_by_amp = 'amplitude' + character(len = kchara), parameter & + & :: cflag_random_by_area = 'area_size' + character(len = kchara), parameter & + & :: cflag_no_random = 'no_random' +! +! --------------------------------------------------------------------- +! + contains +! +! --------------------------------------------------------------------- +! + subroutine fline_start_label_array(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + array_c%array_name = ' ' + array_c%num = 0 + call alloc_control_array_chara(array_c) +! + call append_c_to_ctl_array(cflag_surface_group, array_c) + call append_c_to_ctl_array(cflag_surface_list, array_c) + call append_c_to_ctl_array(cflag_position_list, array_c) + call append_c_to_ctl_array(cflag_spray_in_domain, array_c) +! + end subroutine fline_start_label_array +! +! ---------------------------------------------------------------------- +! + subroutine fline_direction_label_array(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + array_c%array_name = ' ' + array_c%num = 0 + call alloc_control_array_chara(array_c) +! + call append_c_to_ctl_array(cflag_forward_trace, array_c) + call append_c_to_ctl_array(cflag_backward_trace, array_c) + call append_c_to_ctl_array(cflag_both_trace, array_c) +! + end subroutine fline_direction_label_array +! +! ---------------------------------------------------------------------- +! + subroutine fline_seeds_label_array(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + array_c%array_name = ' ' + array_c%num = 0 + call alloc_control_array_chara(array_c) +! + call append_c_to_ctl_array(cflag_random_by_amp, array_c) + call append_c_to_ctl_array(cflag_random_by_area, array_c) + call append_c_to_ctl_array(cflag_no_random, array_c) +! + end subroutine fline_seeds_label_array +! +! ---------------------------------------------------------------------- +! + end module m_control_fline_flags diff --git a/src/Fortran_libraries/VIZ_src/fieldline/set_control_each_fline.f90 b/src/Fortran_libraries/VIZ_src/fieldline/set_control_each_fline.f90 index 84ac1e2b..0096e8e6 100644 --- a/src/Fortran_libraries/VIZ_src/fieldline/set_control_each_fline.f90 +++ b/src/Fortran_libraries/VIZ_src/fieldline/set_control_each_fline.f90 @@ -44,6 +44,7 @@ subroutine count_control_4_fline & & (fln, ele, ele_grp, sf_grp, fln_prm, fln_src) ! use m_field_file_format + use m_control_fline_flags ! use t_source_of_filed_line use set_area_4_viz diff --git a/src/Fortran_libraries/VIZ_src/fieldline/t_control_data_flines.f90 b/src/Fortran_libraries/VIZ_src/fieldline/t_control_data_flines.f90 index 8f6effd5..f33d09e9 100644 --- a/src/Fortran_libraries/VIZ_src/fieldline/t_control_data_flines.f90 +++ b/src/Fortran_libraries/VIZ_src/fieldline/t_control_data_flines.f90 @@ -8,12 +8,17 @@ !!@verbatim !! subroutine dealloc_fline_ctl_struct(fline_ctls) !! subroutine alloc_fline_ctl_struct(fline_ctls) -!! subroutine append_new_fline_control(fline_ctls) -!! type(fieldline_controls), intent(inout) :: fline_ctls +!! subroutine init_fline_ctl_struct(hd_block, fline_ctls) !! !! subroutine add_fields_4_flines_to_fld_ctl(fline_ctls, field_ctl) !! type(fieldline_controls), intent(in) :: fline_ctls !! type(ctl_array_c3), intent(inout) :: field_ctl +!! +!! subroutine append_fline_control(idx_in, hd_block, fline_ctls) +!! subroutine delete_fline_control(idx_in, fline_ctls) +!! integer(kind = kint), intent(in) :: idx_in +!! character(len=kchara), intent(in) :: hd_block +!! type(fieldline_controls), intent(inout) :: fline_ctls !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! array fieldline 1 !! file fieldline 'ctl_fline_magne' @@ -32,15 +37,14 @@ module t_control_data_flines implicit none ! type fieldline_controls +!> Control block name + character(len = kchara) :: block_name = 'fieldline' +! integer(kind = kint) :: num_fline_ctl = 0 character(len = kchara), allocatable :: fname_fline_ctl(:) type(fline_ctl), allocatable :: fline_ctl_struct(:) end type fieldline_controls ! -! fieldline flag -! - private :: dup_control_4_flines -! ! -------------------------------------------------------------------- ! contains @@ -76,53 +80,117 @@ subroutine alloc_fline_ctl_struct(fline_ctls) end subroutine alloc_fline_ctl_struct ! ! --------------------------------------------------------------------- +! + subroutine init_fline_ctl_struct(hd_block, fline_ctls) +! + character(len=kchara), intent(in) :: hd_block + type(fieldline_controls), intent(inout) :: fline_ctls +! + fline_ctls%block_name = hd_block + fline_ctls%num_fline_ctl = 0 +! + end subroutine init_fline_ctl_struct +! +! --------------------------------------------------------------------- ! --------------------------------------------------------------------- ! - subroutine append_new_fline_control(fline_ctls) + subroutine append_fline_control(idx_in, hd_block, fline_ctls) ! + use ctl_data_field_line_IO +! + integer(kind = kint), intent(in) :: idx_in + character(len=kchara), intent(in) :: hd_block type(fieldline_controls), intent(inout) :: fline_ctls ! type(fieldline_controls) :: tmp_fline_c + integer(kind = kint) :: i +! ! + if(idx_in.lt.0 .or. idx_in.gt.fline_ctls%num_fline_ctl) return ! tmp_fline_c%num_fline_ctl = fline_ctls%num_fline_ctl call alloc_fline_ctl_struct(tmp_fline_c) - call dup_control_4_flines & - & (tmp_fline_c%num_fline_ctl, fline_ctls, tmp_fline_c) ! - call dealloc_fline_ctl_struct(fline_ctls) + do i = 1, tmp_fline_c%num_fline_ctl + tmp_fline_c%fname_fline_ctl(i) & + & = fline_ctls%fname_fline_ctl(i) + call dup_control_4_fline(fline_ctls%fline_ctl_struct(i), & + tmp_fline_c%fline_ctl_struct(i)) + end do ! + call dealloc_fline_ctl_struct(fline_ctls) fline_ctls%num_fline_ctl = tmp_fline_c%num_fline_ctl + 1 call alloc_fline_ctl_struct(fline_ctls) ! - call dup_control_4_flines & - & (tmp_fline_c%num_fline_ctl, tmp_fline_c, fline_ctls) + do i = 1, idx_in + fline_ctls%fname_fline_ctl(i) & + & = tmp_fline_c%fname_fline_ctl(i) + call dup_control_4_fline(tmp_fline_c%fline_ctl_struct(i), & + fline_ctls%fline_ctl_struct(i)) + end do +! + fline_ctls%fname_fline_ctl(idx_in+1) = 'NO_FILE' + call init_field_line_ctl_label(hd_block, & + & fline_ctls%fline_ctl_struct(idx_in+1)) +! + do i = idx_in+1, tmp_fline_c%num_fline_ctl + fline_ctls%fname_fline_ctl(i+1) & + & = tmp_fline_c%fname_fline_ctl(i) + call dup_control_4_fline(tmp_fline_c%fline_ctl_struct(i), & + fline_ctls%fline_ctl_struct(i+1)) + end do ! call dealloc_fline_ctl_struct(tmp_fline_c) ! - end subroutine append_new_fline_control + end subroutine append_fline_control ! ! ----------------------------------------------------------------------- ! - subroutine dup_control_4_flines & - & (num_fline, org_fline_ctls, new_fline_ctls) + subroutine delete_fline_control(idx_in, fline_ctls) +! + use ctl_data_field_line_IO ! - integer(kind = kint), intent(in) :: num_fline - type(fieldline_controls), intent(in) :: org_fline_ctls - type(fieldline_controls), intent(inout) :: new_fline_ctls + integer(kind = kint), intent(in) :: idx_in + type(fieldline_controls), intent(inout) :: fline_ctls ! + type(fieldline_controls) :: tmp_fline_c integer(kind = kint) :: i ! - do i = 1, num_fline - call dup_control_4_fline(org_fline_ctls%fline_ctl_struct(i), & - new_fline_ctls%fline_ctl_struct(i)) +! + if(idx_in.le.0 .or. idx_in.gt.fline_ctls%num_fline_ctl) return +! + tmp_fline_c%num_fline_ctl = fline_ctls%num_fline_ctl + call alloc_fline_ctl_struct(tmp_fline_c) +! + do i = 1, tmp_fline_c%num_fline_ctl + tmp_fline_c%fname_fline_ctl(i) & + & = fline_ctls%fname_fline_ctl(i) + call dup_control_4_fline(fline_ctls%fline_ctl_struct(i), & + tmp_fline_c%fline_ctl_struct(i)) end do - new_fline_ctls%fname_fline_ctl(1:num_fline) & - & = org_fline_ctls%fname_fline_ctl(1:num_fline) ! - end subroutine dup_control_4_flines + call dealloc_fline_ctl_struct(fline_ctls) + fline_ctls%num_fline_ctl = tmp_fline_c%num_fline_ctl + 1 + call alloc_fline_ctl_struct(fline_ctls) ! -! --------------------------------------------------------------------- + do i = 1, idx_in-1 + fline_ctls%fname_fline_ctl(i) & + & = tmp_fline_c%fname_fline_ctl(i) + call dup_control_4_fline(tmp_fline_c%fline_ctl_struct(i), & + fline_ctls%fline_ctl_struct(i)) + end do + do i = idx_in, fline_ctls%num_fline_ctl + fline_ctls%fname_fline_ctl(i) & + & = tmp_fline_c%fname_fline_ctl(i+1) + call dup_control_4_fline(tmp_fline_c%fline_ctl_struct(i+1), & + fline_ctls%fline_ctl_struct(i)) + end do +! + call dealloc_fline_ctl_struct(tmp_fline_c) +! + end subroutine delete_fline_control +! +! ----------------------------------------------------------------------- ! subroutine add_fields_4_flines_to_fld_ctl(fline_ctls, field_ctl) ! diff --git a/src/Fortran_libraries/VIZ_src/fieldline/t_control_params_4_fline.f90 b/src/Fortran_libraries/VIZ_src/fieldline/t_control_params_4_fline.f90 index ccd0ef26..b5f4064d 100644 --- a/src/Fortran_libraries/VIZ_src/fieldline/t_control_params_4_fline.f90 +++ b/src/Fortran_libraries/VIZ_src/fieldline/t_control_params_4_fline.f90 @@ -17,13 +17,6 @@ !! !! subroutine check_control_params_fline(fln_prm) !! type(fieldline_paramter), intent(in) :: fln_prm -!! -!! integer(kind = kint) function num_fline_start_flags() -!! integer(kind = kint) function num_fline_direction_flags() -!! integer(kind = kint) function num_fline_seeds_flags() -!! subroutine set_fline_start_flags(names) -!! subroutine set_fline_direction_flags(names) -!! subroutine set_fline_seeds_flags(names) !!@endverbatim ! module t_control_params_4_fline @@ -88,40 +81,16 @@ module t_control_params_4_fline end type fieldline_paramter ! ! - integer(kind = kint), parameter :: n_fline_start_flags = 4 -! - character(len = kchara), parameter & - & :: cflag_surface_group = 'surface_group' - character(len = kchara), parameter & - & :: cflag_surface_list = 'surface_list' - character(len = kchara), parameter & - & :: cflag_position_list = 'position_list' - character(len = kchara), parameter & - & :: cflag_spray_in_domain = 'spray_in_domain' integer(kind = kint), parameter :: iflag_surface_group = 0 integer(kind = kint), parameter :: iflag_surface_list = 1 integer(kind = kint), parameter :: iflag_position_list = 2 integer(kind = kint), parameter :: iflag_spray_in_domain = 3 ! ! - integer(kind = kint), parameter :: n_fline_direction_flags = 3 - character(len = kchara), parameter & - & :: cflag_forward_trace = 'forward' - character(len = kchara), parameter & - & :: cflag_backward_trace = 'backward' - character(len = kchara), parameter & - & :: cflag_both_trace = 'both' integer(kind = kint), parameter :: iflag_backward_trace = -1 integer(kind = kint), parameter :: iflag_both_trace = 0 integer(kind = kint), parameter :: iflag_forward_trace = 1 ! - integer(kind = kint), parameter :: n_fline_seeds_flags = 3 - character(len = kchara), parameter & - & :: cflag_random_by_amp = 'amplitude' - character(len = kchara), parameter & - & :: cflag_random_by_area = 'area_size' - character(len = kchara), parameter & - & :: cflag_no_random = 'no_random' integer(kind = kint), parameter :: iflag_random_by_amp = 0 integer(kind = kint), parameter :: iflag_random_by_area = 1 integer(kind = kint), parameter :: iflag_no_random = 2 @@ -253,77 +222,5 @@ subroutine check_control_params_fline(fln_prm) end subroutine check_control_params_fline ! ! --------------------------------------------------------------------- -! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_fline_start_flags() - num_fline_start_flags = n_fline_start_flags - return - end function num_fline_start_flags -! -! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_fline_direction_flags() - num_fline_direction_flags = n_fline_direction_flags - return - end function num_fline_direction_flags -! -! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_fline_seeds_flags() - num_fline_seeds_flags = n_fline_seeds_flags - return - end function num_fline_seeds_flags -! -! ---------------------------------------------------------------------- -! ---------------------------------------------------------------------- -! - subroutine set_fline_start_flags(names) -! - use t_read_control_elements -! - character(len = kchara), intent(inout) & - & :: names(n_fline_start_flags) -! -! - call set_control_labels(cflag_surface_group, names( 1)) - call set_control_labels(cflag_surface_list, names( 2)) - call set_control_labels(cflag_position_list, names( 3)) - call set_control_labels(cflag_spray_in_domain, names( 4)) -! - end subroutine set_fline_start_flags -! -! --------------------------------------------------------------------- -! - subroutine set_fline_direction_flags(names) -! - use t_read_control_elements -! - character(len = kchara), intent(inout) & - & :: names(n_fline_direction_flags) -! -! - call set_control_labels(cflag_forward_trace, names( 1)) - call set_control_labels(cflag_backward_trace, names( 2)) - call set_control_labels(cflag_both_trace, names( 3)) -! - end subroutine set_fline_direction_flags -! -! --------------------------------------------------------------------- -! - subroutine set_fline_seeds_flags(names) -! - use t_read_control_elements -! - character(len = kchara), intent(inout) & - & :: names(n_fline_seeds_flags) -! -! - call set_control_labels(cflag_random_by_amp, names( 1)) - call set_control_labels(cflag_random_by_area, names( 2)) - call set_control_labels(cflag_no_random, names( 3)) -! - end subroutine set_fline_seeds_flags -! -! --------------------------------------------------------------------- ! end module t_control_params_4_fline diff --git a/src/Fortran_libraries/VIZ_src/fieldline/t_ctl_data_field_line.f90 b/src/Fortran_libraries/VIZ_src/fieldline/t_ctl_data_field_line.f90 index 27fcc86b..ca1d5dc1 100644 --- a/src/Fortran_libraries/VIZ_src/fieldline/t_ctl_data_field_line.f90 +++ b/src/Fortran_libraries/VIZ_src/fieldline/t_ctl_data_field_line.f90 @@ -78,6 +78,9 @@ module t_ctl_data_field_line ! ! type fline_ctl +!> Control block name + character(len = kchara) :: block_name = 'fieldline' +! type(read_character_item) :: fline_file_head_ctl type(read_character_item) :: fline_output_type_ctl ! @@ -208,6 +211,7 @@ subroutine dup_control_4_fline(org_fln, new_fln) call dup_control_array_i2(org_fln%seed_surface_ctl, & & new_fln%seed_surface_ctl) ! + new_fln%block_name = org_fln%block_name new_fln%i_vr_fline_ctl = org_fln%i_vr_fline_ctl ! end subroutine dup_control_4_fline diff --git a/src/Fortran_libraries/VIZ_src/map_rendering/Makefile b/src/Fortran_libraries/VIZ_src/map_rendering/Makefile index 1da1265d..ccd89cdb 100644 --- a/src/Fortran_libraries/VIZ_src/map_rendering/Makefile +++ b/src/Fortran_libraries/VIZ_src/map_rendering/Makefile @@ -15,12 +15,12 @@ dir_list: lib_name: -lib_tasks: libtarget lib_archve +lib_tasks: lib_archve @echo ' ''$$(RANLIB) $$@' >> $(MAKENAME) libtarget: -lib_archve: +lib_archve: libtarget @echo ' ''$$(AR)' '$$(ARFLUGS)' rcsv '$$@' '$$(MOD_MAP)' \ >> $(MAKENAME) diff --git a/src/Fortran_libraries/VIZ_src/map_rendering/Makefile.depends b/src/Fortran_libraries/VIZ_src/map_rendering/Makefile.depends index 465ba25d..223c964d 100644 --- a/src/Fortran_libraries/VIZ_src/map_rendering/Makefile.depends +++ b/src/Fortran_libraries/VIZ_src/map_rendering/Makefile.depends @@ -1,6 +1,8 @@ -bcast_maps_control_data.o: $(MAP_RENDERING_DIR)/bcast_maps_control_data.f90 m_precision.o m_constants.o m_machine_parameter.o calypso_mpi.o t_control_data_maps.o t_control_data_4_map.o calypso_mpi_int.o calypso_mpi_char.o transfer_to_long_integers.o bcast_control_arrays.o bcast_ctl_data_pvr_surfaces.o bcast_ctl_data_view_trans.o bcast_pvr_color_ctl.o +bcast_maps_control_data.o: $(MAP_RENDERING_DIR)/bcast_maps_control_data.f90 m_precision.o m_constants.o m_machine_parameter.o calypso_mpi.o t_control_data_maps.o t_control_data_4_map.o calypso_mpi_int.o calypso_mpi_char.o transfer_to_long_integers.o bcast_control_arrays.o bcast_ctl_data_pvr_surfaces.o bcast_ctl_data_view_trans.o bcast_pvr_color_ctl.o t_ctl_data_map_section.o bcast_section_control_data.o $(F90) -c $(F90OPTFLAGS) $< -ctl_data_map_rendering_IO.o: $(MAP_RENDERING_DIR)/ctl_data_map_rendering_IO.f90 m_precision.o m_constants.o m_machine_parameter.o skip_comment_f.o t_read_control_elements.o t_control_array_real.o t_control_array_character.o t_control_array_charareal.o t_control_data_4_map.o t_ctl_data_pvr_section.o calypso_mpi.o t_ctl_data_pvr_colormap_bar.o ctl_file_pvr_modelview_IO.o ctl_data_pvr_section_IO.o write_control_elements.o +ctl_data_map_rendering_IO.o: $(MAP_RENDERING_DIR)/ctl_data_map_rendering_IO.f90 m_precision.o m_constants.o m_machine_parameter.o skip_comment_f.o t_read_control_elements.o t_control_array_real.o t_control_array_character.o t_control_array_charareal.o t_control_data_4_map.o t_ctl_data_pvr_section.o calypso_mpi.o t_ctl_data_pvr_colormap_bar.o ctl_file_pvr_modelview_IO.o ctl_data_map_section_IO.o ctl_data_view_transfer_IO.o write_control_elements.o + $(F90) -c $(F90OPTFLAGS) $< +ctl_data_map_section_IO.o: $(MAP_RENDERING_DIR)/ctl_data_map_section_IO.f90 m_precision.o calypso_mpi.o m_machine_parameter.o t_read_control_elements.o t_control_data_4_psf_def.o t_control_array_real.o t_control_array_real2.o t_control_array_character.o t_ctl_data_map_section.o skip_comment_f.o ctl_file_section_def_IO.o write_control_elements.o ctl_data_section_def_IO.o $(F90) -c $(F90OPTFLAGS) $< ctl_file_map_renderings_IO.o: $(MAP_RENDERING_DIR)/ctl_file_map_renderings_IO.f90 m_precision.o m_machine_parameter.o t_control_data_4_map.o t_control_data_maps.o t_read_control_elements.o ctl_data_section_IO.o skip_comment_f.o write_control_elements.o ctl_data_map_rendering_IO.o $(F90) -c $(F90OPTFLAGS) $< @@ -26,15 +28,17 @@ set_scalar_on_xyz_plane.o: $(MAP_RENDERING_DIR)/set_scalar_on_xyz_plane.f90 m_pr $(F90) -c $(F90OPTFLAGS) $< set_xyz_plot_from_1patch.o: $(MAP_RENDERING_DIR)/set_xyz_plot_from_1patch.f90 m_precision.o m_constants.o t_geometry_data.o $(F90) -c $(F90OPTFLAGS) $< -t_control_data_4_map.o: $(MAP_RENDERING_DIR)/t_control_data_4_map.f90 m_precision.o m_constants.o m_machine_parameter.o skip_comment_f.o t_read_control_elements.o t_control_array_character.o t_ctl_data_pvr_section.o t_ctl_data_4_view_transfer.o t_ctl_data_pvr_colormap_bar.o t_control_array_character3.o add_nodal_fields_ctl.o +t_control_data_4_map.o: $(MAP_RENDERING_DIR)/t_control_data_4_map.f90 m_precision.o m_constants.o m_machine_parameter.o skip_comment_f.o t_read_control_elements.o t_control_array_character.o t_ctl_data_map_section.o t_ctl_data_4_view_transfer.o t_ctl_data_pvr_colormap_bar.o t_control_array_character3.o add_nodal_fields_ctl.o + $(F90) -c $(F90OPTFLAGS) $< +t_control_data_maps.o: $(MAP_RENDERING_DIR)/t_control_data_maps.f90 m_precision.o m_machine_parameter.o t_control_data_4_map.o ctl_data_map_rendering_IO.o t_control_array_character3.o $(F90) -c $(F90OPTFLAGS) $< -t_control_data_maps.o: $(MAP_RENDERING_DIR)/t_control_data_maps.f90 m_precision.o m_machine_parameter.o t_control_data_4_map.o t_control_array_character3.o +t_ctl_data_map_section.o: $(MAP_RENDERING_DIR)/t_ctl_data_map_section.f90 m_precision.o m_machine_parameter.o t_read_control_elements.o t_control_data_4_psf_def.o t_control_array_real.o t_control_array_real2.o t_control_array_integer.o t_control_array_character.o t_control_array_chara2real.o skip_comment_f.o $(F90) -c $(F90OPTFLAGS) $< t_map_patch_from_1patch.o: $(MAP_RENDERING_DIR)/t_map_patch_from_1patch.f90 m_precision.o m_constants.o m_phys_constants.o m_geometry_constants.o coordinate_converter.o aitoff.o $(F90) -c $(F90OPTFLAGS) $< t_map_projection.o: $(MAP_RENDERING_DIR)/t_map_projection.f90 calypso_mpi.o m_precision.o t_cross_section.o t_psf_results.o t_control_data_maps.o t_control_params_4_pvr.o t_pvr_colormap_parameter.o t_pvr_image_array.o t_map_rendering_data.o m_field_file_format.o set_map_control.o set_psf_control.o set_fields_for_psf.o find_node_and_patch_psf.o $(F90) -c $(F90OPTFLAGS) $< -t_map_rendering_data.o: $(MAP_RENDERING_DIR)/t_map_rendering_data.f90 calypso_mpi.o m_precision.o m_machine_parameter.o t_geometry_data.o t_phys_data.o t_control_params_4_pvr.o t_pvr_colormap_parameter.o t_control_array_character.o t_ctl_data_pvr_section.o t_ctl_data_4_projection.o skip_comment_f.o t_psf_patch_data.o t_pvr_image_array.o +t_map_rendering_data.o: $(MAP_RENDERING_DIR)/t_map_rendering_data.f90 calypso_mpi.o m_precision.o m_machine_parameter.o t_geometry_data.o t_phys_data.o t_control_params_4_pvr.o t_pvr_colormap_parameter.o t_control_array_character.o t_ctl_data_map_section.o t_ctl_data_4_projection.o skip_comment_f.o t_psf_patch_data.o t_pvr_image_array.o $(F90) -c $(F90OPTFLAGS) $< xyz_plane_rendering.o: $(MAP_RENDERING_DIR)/xyz_plane_rendering.f90 m_precision.o m_constants.o t_psf_patch_data.o t_time_data.o t_file_IO_parameter.o t_map_patch_from_1patch.o t_pvr_image_array.o t_map_rendering_data.o set_ucd_data_to_type.o ucd_IO_select.o draw_aitoff_map.o draw_lines_on_map.o draw_pvr_colorbar.o draw_pixels_on_map.o set_scalar_on_xyz_plane.o draw_xyz_plane_isolines.o cal_mesh_position.o $(F90) -c $(F90OPTFLAGS) $< diff --git a/src/Fortran_libraries/VIZ_src/map_rendering/bcast_maps_control_data.f90 b/src/Fortran_libraries/VIZ_src/map_rendering/bcast_maps_control_data.f90 index b7cddb99..ac3f9e23 100644 --- a/src/Fortran_libraries/VIZ_src/map_rendering/bcast_maps_control_data.f90 +++ b/src/Fortran_libraries/VIZ_src/map_rendering/bcast_maps_control_data.f90 @@ -21,7 +21,7 @@ module bcast_maps_control_data ! implicit none ! - private :: bcast_map_control_data + private :: bcast_map_control_data, bcast_map_section_ctl ! ! --------------------------------------------------------------------- ! @@ -38,16 +38,18 @@ subroutine bcast_files_4_map_ctl(map_ctls) use transfer_to_long_integers ! type(map_rendering_controls), intent(inout) :: map_ctls - integer (kind=kint) :: i_psf + integer (kind=kint) :: i_map ! ! + call calypso_mpi_bcast_character(map_ctls%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(map_ctls%num_map_ctl, 0) if(map_ctls%num_map_ctl .le. 0) return ! if(my_rank .gt. 0) call alloc_map_ctl_stract(map_ctls) ! - do i_psf = 1, map_ctls%num_map_ctl - call bcast_map_control_data(map_ctls%map_ctl_struct(i_psf)) + do i_map = 1, map_ctls%num_map_ctl + call bcast_map_control_data(map_ctls%map_ctl_struct(i_map)) end do call calypso_mpi_bcast_character(map_ctls%fname_map_ctl, & & cast_long(map_ctls%num_map_ctl*kchara), 0) @@ -71,6 +73,8 @@ subroutine bcast_map_control_data(map_c) type(map_ctl), intent(inout) :: map_c ! ! + call calypso_mpi_bcast_character(map_c%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(map_c%i_map_ctl, 0) call calypso_mpi_bcast_one_int(map_c%i_output_field, 0) call calypso_mpi_bcast_character(map_c%fname_mat_ctl, & @@ -81,7 +85,7 @@ subroutine bcast_map_control_data(map_c) call bcast_view_transfer_ctl(map_c%mat) call bcast_pvr_colorbar_ctl(map_c%cmap_cbar_c%cbar_ctl) call bcast_pvr_colordef_ctl(map_c%cmap_cbar_c%color) - call bcast_pvr_section_ctl(map_c%map_define_ctl) + call bcast_map_section_ctl(map_c%map_define_ctl) ! call bcast_ctl_type_c1(map_c%map_image_prefix_ctl) call bcast_ctl_type_c1(map_c%map_image_fmt_ctl) @@ -93,5 +97,40 @@ subroutine bcast_map_control_data(map_c) end subroutine bcast_map_control_data ! ! -------------------------------------------------------------------- +! + subroutine bcast_map_section_ctl(map_sect_ctl) +! + use t_ctl_data_map_section + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers + use bcast_control_arrays + use bcast_section_control_data +! + type(map_section_ctl), intent(inout) :: map_sect_ctl +! +! + call calypso_mpi_bcast_one_int(map_sect_ctl%i_map_sect_ctl, 0) + call calypso_mpi_bcast_character & + & (map_sect_ctl%block_name, cast_long(kchara), 0) + call calypso_mpi_bcast_character & + & (map_sect_ctl%fname_sect_ctl, cast_long(kchara), 0) +! + call bcast_section_def_control(map_sect_ctl%psf_def_c) +! + call bcast_ctl_type_c1(map_sect_ctl%zeroline_switch_ctl) + call bcast_ctl_type_c1(map_sect_ctl%isoline_color_mode) + call bcast_ctl_type_i1(map_sect_ctl%isoline_number_ctl) + call bcast_ctl_type_r2(map_sect_ctl%isoline_range_ctl) + call bcast_ctl_type_r1(map_sect_ctl%isoline_width_ctl) + call bcast_ctl_type_r1(map_sect_ctl%grid_width_ctl) +! + call bcast_ctl_type_c1(map_sect_ctl%tan_cyl_switch_ctl) + call bcast_ctl_type_r1(map_sect_ctl%tangent_cylinder_inner_ctl) + call bcast_ctl_type_r1(map_sect_ctl%tangent_cylinder_outer_ctl) +! + end subroutine bcast_map_section_ctl +! +! ----------------------------------------------------------------------- ! end module bcast_maps_control_data diff --git a/src/Fortran_libraries/VIZ_src/map_rendering/ctl_data_map_rendering_IO.f90 b/src/Fortran_libraries/VIZ_src/map_rendering/ctl_data_map_rendering_IO.f90 index 53319f61..4988d179 100644 --- a/src/Fortran_libraries/VIZ_src/map_rendering/ctl_data_map_rendering_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/map_rendering/ctl_data_map_rendering_IO.f90 @@ -7,6 +7,7 @@ !>@brief control ID data for surfacing module !! !!@verbatim +!! subroutine init_map_control_label(hd_block, map_c) !! subroutine s_read_map_control_data & !! & (id_control, hd_block, map_c, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -19,11 +20,6 @@ !! character(len=kchara), intent(in) :: hd_block !! type(map_ctl), intent(inout) :: map_c !! integer(kind = kint), intent(inout) :: level -!! -!! integer(kind = kint) function num_label_map_ctl() -!! integer(kind = kint) function num_label_map_ctl_w_dpl() -!! subroutine set_label_map_ctl(names) -!! subroutine set_label_map_ctl_w_dpl(names) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!! example of control for Kemo's surface rendering !! @@ -85,7 +81,7 @@ !! colorbar_switch_ctl ON !! colorbar_position_ctl 'left' or 'bottom' !! colorbar_scale_ctl ON -!! iflag_zeromarker ON +!! zeromarker_switch ON !! colorbar_range 0.0 1.0 !! font_size_ctl 3 !! num_grid_ctl 4 @@ -193,9 +189,6 @@ module ctl_data_map_rendering_IO & :: hd_map_projection = 'map_projection_ctl' character(len=kchara), parameter, private & & :: hd_map_colormap_file = 'map_color_ctl' -! - integer(kind = kint), parameter :: n_label_map_ctl = 9 - private :: n_label_map_ctl ! ! --------------------------------------------------------------------- ! @@ -208,7 +201,8 @@ subroutine s_read_map_control_data & ! use t_ctl_data_pvr_colormap_bar use ctl_file_pvr_modelview_IO - use ctl_data_pvr_section_IO + use ctl_data_map_section_IO + use ctl_data_view_transfer_IO ! integer(kind = kint), intent(in) :: id_control character(len=kchara), intent(in) :: hd_block @@ -217,8 +211,8 @@ subroutine s_read_map_control_data & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(map_c%i_map_ctl .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do call load_one_line_from_control(id_control, hd_block, c_buf) if(c_buf%iend .gt. 0) exit @@ -230,7 +224,7 @@ subroutine s_read_map_control_data & & (id_control, hd_map_colormap_file, map_c%fname_cmap_cbar_c, & & map_c%cmap_cbar_c, c_buf) ! - call read_pvr_section_ctl(id_control, hd_section_ctl, & + call read_map_section_ctl(id_control, hd_section_ctl, & & izero, map_c%map_define_ctl, c_buf) ! call read_chara_ctl_type(c_buf, hd_map_image_prefix, & @@ -259,7 +253,7 @@ subroutine write_map_control_data & ! use t_ctl_data_pvr_colormap_bar use ctl_file_pvr_modelview_IO - use ctl_data_pvr_section_IO + use ctl_data_map_section_IO use write_control_elements ! integer(kind = kint), intent(in) :: id_control @@ -282,20 +276,20 @@ subroutine write_map_control_data & ! level = write_begin_flag_for_ctl(id_control, level, hd_block) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_map_image_prefix, map_c%map_image_prefix_ctl) + & map_c%map_image_prefix_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_map_image_format, map_c%map_image_fmt_ctl) + & map_c%map_image_fmt_ctl) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_map_output_field, map_c%map_field_ctl) + & map_c%map_field_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_map_output_comp, map_c%map_comp_ctl) + & map_c%map_comp_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_map_isoline_field, map_c%isoline_field_ctl) + & map_c%isoline_field_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_map_isoline_comp, map_c%isoline_comp_ctl) + & map_c%isoline_comp_ctl) ! - call write_pvr_section_ctl(id_control, hd_section_ctl, & + call write_map_section_ctl(id_control, hd_section_ctl, & & map_c%map_define_ctl, level) ! call sel_write_ctl_modelview_file(id_control, hd_map_projection, & @@ -309,35 +303,42 @@ subroutine write_map_control_data & end subroutine write_map_control_data ! ! -------------------------------------------------------------------- -! -------------------------------------------------------------------- ! - integer(kind = kint) function num_label_map_ctl() - num_label_map_ctl = n_label_map_ctl - return - end function num_label_map_ctl + subroutine init_map_control_label(hd_block, map_c) ! -! ---------------------------------------------------------------------- + use t_ctl_data_pvr_colormap_bar + use ctl_file_pvr_modelview_IO + use ctl_data_view_transfer_IO + use ctl_data_map_section_IO ! - subroutine set_label_map_ctl(names) + character(len=kchara), intent(in) :: hd_block + type(map_ctl), intent(inout) :: map_c ! - character(len = kchara), intent(inout) & - & :: names(n_label_map_ctl) ! + map_c%block_name = hd_block + call init_map_section_ctl_label(hd_section_ctl, & + & map_c%map_define_ctl) + call init_pvr_cmap_cbar_label(hd_map_colormap_file, & + & map_c%cmap_cbar_c) + call init_view_transfer_ctl_label(hd_map_projection, map_c%mat) ! - call set_control_labels(hd_map_image_prefix, names( 1)) - call set_control_labels(hd_map_image_format, names( 2)) - call set_control_labels(hd_section_ctl, names( 3)) + call init_chara_ctl_item_label(hd_map_image_prefix, & + & map_c%map_image_prefix_ctl) + call init_chara_ctl_item_label(hd_map_image_format, & + & map_c%map_image_fmt_ctl) ! - call set_control_labels(hd_map_output_field, names( 4)) - call set_control_labels(hd_map_output_comp, names( 5)) - call set_control_labels(hd_map_isoline_field, names( 6)) - call set_control_labels(hd_map_isoline_comp, names( 7)) + call init_chara_ctl_item_label(hd_map_output_field, & + & map_c%map_field_ctl) + call init_chara_ctl_item_label(hd_map_output_comp, & + & map_c%map_comp_ctl) ! - call set_control_labels(hd_map_projection, names( 8)) - call set_control_labels(hd_map_colormap_file, names( 9)) + call init_chara_ctl_item_label(hd_map_isoline_field, & + & map_c%isoline_field_ctl) + call init_chara_ctl_item_label(hd_map_isoline_comp, & + & map_c%isoline_comp_ctl) ! - end subroutine set_label_map_ctl + end subroutine init_map_control_label ! -! --------------------------------------------------------------------- +! -------------------------------------------------------------------- ! end module ctl_data_map_rendering_IO diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_pvr_section_IO.f90 b/src/Fortran_libraries/VIZ_src/map_rendering/ctl_data_map_section_IO.f90 similarity index 59% rename from src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_pvr_section_IO.f90 rename to src/Fortran_libraries/VIZ_src/map_rendering/ctl_data_map_section_IO.f90 index b7308626..fa6aee6a 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_pvr_section_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/map_rendering/ctl_data_map_section_IO.f90 @@ -1,5 +1,5 @@ -!>@file ctl_data_pvr_section_IO.f90 -!!@brief module ctl_data_pvr_section_IO +!>@file ctl_data_map_section_IO.f90 +!!@brief module ctl_data_map_section_IO !! !!@author H. Matsui !!@date Programmed in 2006 @@ -7,21 +7,19 @@ !> @brief control data for parallel volume rendering !! !!@verbatim -!! subroutine read_pvr_section_ctl & -!! & (id_control, hd_block, icou, pvr_sect_ctl, c_buf) +!! subroutine init_map_section_ctl_label(hd_block, map_sect_ctl) +!! subroutine read_map_section_ctl & +!! & (id_control, hd_block, icou, map_sect_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block -!! type(pvr_section_ctl), intent(inout) :: pvr_sect_ctl +!! type(map_section_ctl), intent(inout) :: map_sect_ctl !! type(buffer_for_control), intent(inout) :: c_buf -!! subroutine write_pvr_section_ctl & -!! & (id_control, hd_block, pvr_sect_ctl, level) +!! subroutine write_map_section_ctl & +!! & (id_control, hd_block, map_sect_ctl, level) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block -!! type(pvr_section_ctl), intent(inout) :: pvr_sect_ctl +!! type(map_section_ctl), intent(inout) :: map_sect_ctl !! integer(kind = kint), intent(inout) :: level -!! -!! integer(kind = kint) function num_label_pvr_section() -!! subroutine set_label_pvr_section(names) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! begin section_ctl !! file surface_define ctl_psf_eq @@ -29,8 +27,6 @@ !! ... !! end surface_define !! -!! opacity_ctl 0.9 -!! !! zeroline_switch_ctl On !! isoline_color_mode color, white, or black !! isoline_number_ctl 20 @@ -46,7 +42,7 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!@endverbatim ! - module ctl_data_pvr_section_IO + module ctl_data_map_section_IO ! use m_precision use calypso_mpi @@ -57,19 +53,14 @@ module ctl_data_pvr_section_IO use t_control_array_real use t_control_array_real2 use t_control_array_character - use t_ctl_data_pvr_section + use t_ctl_data_map_section use skip_comment_f ! implicit none ! ! Labels - integer(kind = kint), parameter, private & - & :: n_label_pvr_section = 11 -! character(len=kchara), parameter, private & & :: hd_surface_define = 'surface_define' - character(len=kchara), parameter, private & - & :: hd_pvr_opacity = 'opacity_ctl' ! character(len=kchara), parameter, private & & :: hd_pvr_sec_zeroline = 'zeroline_switch_ctl' @@ -97,20 +88,20 @@ module ctl_data_pvr_section_IO ! ! ----------------------------------------------------------------------- ! - subroutine read_pvr_section_ctl & - & (id_control, hd_block, icou, pvr_sect_ctl, c_buf) + subroutine read_map_section_ctl & + & (id_control, hd_block, icou, map_sect_ctl, c_buf) ! use ctl_file_section_def_IO use write_control_elements ! integer(kind = kint), intent(in) :: id_control, icou character(len=kchara), intent(in) :: hd_block - type(pvr_section_ctl), intent(inout) :: pvr_sect_ctl + type(map_section_ctl), intent(inout) :: map_sect_ctl type(buffer_for_control), intent(inout) :: c_buf ! ! + if(map_sect_ctl%i_map_sect_ctl .gt. 0) return if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return - if(pvr_sect_ctl%i_pvr_sect_ctl .gt. 0) return do call load_one_line_from_control(id_control, hd_block, c_buf) if(c_buf%iend .gt. 0) exit @@ -121,55 +112,52 @@ subroutine read_pvr_section_ctl & call write_multi_ctl_file_message & & (hd_block, icou, c_buf%level) call sel_read_ctl_pvr_section_def(id_control, & - & hd_surface_define, pvr_sect_ctl%fname_sect_ctl, & - & pvr_sect_ctl%psf_def_c, c_buf) + & hd_surface_define, map_sect_ctl%fname_sect_ctl, & + & map_sect_ctl%psf_def_c, c_buf) end if ! - call read_real_ctl_type & - & (c_buf, hd_pvr_opacity, pvr_sect_ctl%opacity_ctl) call read_chara_ctl_type(c_buf, hd_pvr_sec_zeroline, & - & pvr_sect_ctl%zeroline_switch_ctl) + & map_sect_ctl%zeroline_switch_ctl) call read_chara_ctl_type(c_buf, hd_pvr_isoline_color, & - & pvr_sect_ctl%isoline_color_mode) + & map_sect_ctl%isoline_color_mode) call read_integer_ctl_type(c_buf, hd_isoline_number, & - & pvr_sect_ctl%isoline_number_ctl) + & map_sect_ctl%isoline_number_ctl) call read_real2_ctl_type(c_buf, hd_isoline_range, & - & pvr_sect_ctl%isoline_range_ctl) + & map_sect_ctl%isoline_range_ctl) call read_real_ctl_type(c_buf, hd_isoline_width, & - & pvr_sect_ctl%isoline_width_ctl) + & map_sect_ctl%isoline_width_ctl) call read_real_ctl_type(c_buf, hd_grid_width, & - & pvr_sect_ctl%grid_width_ctl) + & map_sect_ctl%grid_width_ctl) ! call read_chara_ctl_type(c_buf, hd_tangent_cylinder, & - & pvr_sect_ctl%tan_cyl_switch_ctl) + & map_sect_ctl%tan_cyl_switch_ctl) call read_real_ctl_type(c_buf, hd_tcyl_inner, & - & pvr_sect_ctl%tangent_cylinder_inner_ctl) + & map_sect_ctl%tangent_cylinder_inner_ctl) call read_real_ctl_type(c_buf, hd_tcyl_outer, & - & pvr_sect_ctl%tangent_cylinder_outer_ctl) + & map_sect_ctl%tangent_cylinder_outer_ctl) end do - pvr_sect_ctl%i_pvr_sect_ctl = 1 + map_sect_ctl%i_map_sect_ctl = 1 ! - end subroutine read_pvr_section_ctl + end subroutine read_map_section_ctl ! ! --------------------------------------------------------------------- ! - subroutine write_pvr_section_ctl & - & (id_control, hd_block, pvr_sect_ctl, level) + subroutine write_map_section_ctl & + & (id_control, hd_block, map_sect_ctl, level) ! use ctl_file_section_def_IO use write_control_elements ! integer(kind = kint), intent(in) :: id_control character(len=kchara), intent(in) :: hd_block - type(pvr_section_ctl), intent(in) :: pvr_sect_ctl + type(map_section_ctl), intent(in) :: map_sect_ctl integer(kind = kint), intent(inout) :: level ! integer(kind = kint) :: maxlen = 0 ! ! - if(pvr_sect_ctl%i_pvr_sect_ctl .le. 0) return - maxlen = len_trim(hd_pvr_opacity) - maxlen = max(maxlen,len_trim(hd_pvr_sec_zeroline)) + if(map_sect_ctl%i_map_sect_ctl .le. 0) return + maxlen = len_trim(hd_pvr_sec_zeroline) maxlen = max(maxlen,len_trim(hd_pvr_isoline_color)) maxlen = max(maxlen,len_trim(hd_isoline_number)) maxlen = max(maxlen,len_trim(hd_isoline_range)) @@ -181,66 +169,66 @@ subroutine write_pvr_section_ctl & ! level = write_begin_flag_for_ctl(id_control, level, hd_block) call sel_write_ctl_pvr_section_def(id_control, hd_surface_define, & - & pvr_sect_ctl%fname_sect_ctl, pvr_sect_ctl%psf_def_c, level) + & map_sect_ctl%fname_sect_ctl, map_sect_ctl%psf_def_c, level) ! - call write_real_ctl_type(id_control, level, maxlen, & - & hd_pvr_opacity, pvr_sect_ctl%opacity_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_pvr_sec_zeroline, pvr_sect_ctl%zeroline_switch_ctl) + & map_sect_ctl%zeroline_switch_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_pvr_isoline_color, pvr_sect_ctl%isoline_color_mode) + & map_sect_ctl%isoline_color_mode) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_isoline_number, pvr_sect_ctl%isoline_number_ctl) + & map_sect_ctl%isoline_number_ctl) call write_real2_ctl_type(id_control, level, maxlen, & - & hd_isoline_range, pvr_sect_ctl%isoline_range_ctl) + & map_sect_ctl%isoline_range_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_isoline_width, pvr_sect_ctl%isoline_width_ctl) + & map_sect_ctl%isoline_width_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_grid_width, pvr_sect_ctl%grid_width_ctl) + & map_sect_ctl%grid_width_ctl) ! - call write_chara_ctl_type & - & (id_control, level, maxlen, hd_tangent_cylinder, & - & pvr_sect_ctl%tan_cyl_switch_ctl) + call write_chara_ctl_type(id_control, level, maxlen, & + & map_sect_ctl%tan_cyl_switch_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_tcyl_inner, pvr_sect_ctl%tangent_cylinder_inner_ctl) + & map_sect_ctl%tangent_cylinder_inner_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_tcyl_outer, pvr_sect_ctl%tangent_cylinder_outer_ctl) + & map_sect_ctl%tangent_cylinder_outer_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! - end subroutine write_pvr_section_ctl -! -! --------------------------------------------------------------------- -! --------------------------------------------------------------------- -! - integer(kind = kint) function num_label_pvr_section() - num_label_pvr_section = n_label_pvr_section - return - end function num_label_pvr_section + end subroutine write_map_section_ctl ! ! --------------------------------------------------------------------- ! - subroutine set_label_pvr_section(names) -! - character(len = kchara), intent(inout) & - & :: names(n_label_pvr_section) -! + subroutine init_map_section_ctl_label(hd_block, map_sect_ctl) ! - call set_control_labels(hd_surface_define, names( 1)) - call set_control_labels(hd_pvr_opacity, names( 2)) + use ctl_data_section_def_IO ! - call set_control_labels(hd_pvr_sec_zeroline, names( 3)) - call set_control_labels(hd_pvr_isoline_color, names( 4)) - call set_control_labels(hd_isoline_number, names( 5)) - call set_control_labels(hd_isoline_range, names( 6)) - call set_control_labels(hd_isoline_width, names( 7)) - call set_control_labels(hd_grid_width, names( 8)) -! - call set_control_labels(hd_tangent_cylinder, names( 9)) - call set_control_labels(hd_tcyl_inner, names(10)) - call set_control_labels(hd_tcyl_outer, names(11)) -! - end subroutine set_label_pvr_section + character(len=kchara), intent(in) :: hd_block + type(map_section_ctl), intent(inout) :: map_sect_ctl +! + map_sect_ctl%block_name = hd_block + call init_psf_def_ctl_stract & + & (hd_surface_define, map_sect_ctl%psf_def_c) +! + call init_chara_ctl_item_label(hd_pvr_sec_zeroline, & + & map_sect_ctl%zeroline_switch_ctl) + call init_chara_ctl_item_label(hd_pvr_isoline_color, & + & map_sect_ctl%isoline_color_mode) + call init_int_ctl_item_label(hd_isoline_number, & + & map_sect_ctl%isoline_number_ctl) + call init_real2_ctl_item_label(hd_isoline_range, & + & map_sect_ctl%isoline_range_ctl) + call init_real_ctl_item_label(hd_isoline_width, & + & map_sect_ctl%isoline_width_ctl) + call init_real_ctl_item_label(hd_grid_width, & + & map_sect_ctl%grid_width_ctl) +! + call init_chara_ctl_item_label(hd_tangent_cylinder, & + & map_sect_ctl%tan_cyl_switch_ctl) + call init_real_ctl_item_label(hd_tcyl_inner, & + & map_sect_ctl%tangent_cylinder_inner_ctl) + call init_real_ctl_item_label(hd_tcyl_outer, & + & map_sect_ctl%tangent_cylinder_outer_ctl) +! + end subroutine init_map_section_ctl_label ! -! ---------------------------------------------------------------------- +! --------------------------------------------------------------------- ! - end module ctl_data_pvr_section_IO + end module ctl_data_map_section_IO diff --git a/src/Fortran_libraries/VIZ_src/map_rendering/ctl_file_map_renderings_IO.f90 b/src/Fortran_libraries/VIZ_src/map_rendering/ctl_file_map_renderings_IO.f90 index e5de3893..68c27001 100644 --- a/src/Fortran_libraries/VIZ_src/map_rendering/ctl_file_map_renderings_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/map_rendering/ctl_file_map_renderings_IO.f90 @@ -72,7 +72,7 @@ subroutine read_files_4_map_ctl & type(map_rendering_controls), intent(inout) :: map_ctls type(buffer_for_control), intent(inout) :: c_buf ! - integer :: i + integer(kind = kint) :: n_append ! if(check_array_flag(c_buf, hd_block) .eqv. .FALSE.) return if(allocated(map_ctls%map_ctl_struct)) return @@ -86,7 +86,8 @@ subroutine read_files_4_map_ctl & ! if(check_file_flag(c_buf, hd_block) & & .or. check_begin_flag(c_buf, hd_block)) then - call append_new_map_render_control(map_ctls) + n_append = map_ctls%num_map_ctl + call append_map_render_control(n_append, hd_block, map_ctls) ! call write_multi_ctl_file_message & & (hd_block, map_ctls%num_map_ctl, c_buf%level) @@ -211,7 +212,7 @@ subroutine sel_write_control_4_map_file(id_control, hd_block, & integer(kind = kint), intent(inout) :: level ! ! - if(cmp_no_case(file_name, 'NO_FILE')) then + if(no_file_flag(file_name)) then call write_map_control_data(id_control, hd_block, & & map_ctl_struct, level) else if(id_control .eq. id_monitor) then diff --git a/src/Fortran_libraries/VIZ_src/map_rendering/t_control_data_4_map.f90 b/src/Fortran_libraries/VIZ_src/map_rendering/t_control_data_4_map.f90 index 32112217..4c3c7afa 100644 --- a/src/Fortran_libraries/VIZ_src/map_rendering/t_control_data_4_map.f90 +++ b/src/Fortran_libraries/VIZ_src/map_rendering/t_control_data_4_map.f90 @@ -7,7 +7,6 @@ !>@brief control ID data for surfacing module !! !!@verbatim -!! subroutine init_map_ctl_stract(map_c) !! subroutine dealloc_cont_dat_4_map(map_c) !! type(map_ctl), intent(inout) :: map_c !! subroutine dup_control_4_map(org_map_c, new_map_c) @@ -95,7 +94,7 @@ !! colorbar_switch_ctl ON !! colorbar_position_ctl 'left' or 'bottom' !! colorbar_scale_ctl ON -!! iflag_zeromarker ON +!! zeromarker_switch ON !! colorbar_range 0.0 1.0 !! font_size_ctl 3 !! num_grid_ctl 4 @@ -167,7 +166,7 @@ module t_control_data_4_map use skip_comment_f use t_read_control_elements use t_control_array_character - use t_ctl_data_pvr_section + use t_ctl_data_map_section use t_ctl_data_4_view_transfer use t_ctl_data_pvr_colormap_bar ! @@ -175,8 +174,11 @@ module t_control_data_4_map ! ! type map_ctl +!> Control block name + character(len = kchara) :: block_name = 'cross_section_ctl' +! !> Structure of cross section definition - type(pvr_section_ctl) :: map_define_ctl + type(map_section_ctl) :: map_define_ctl ! !> Structure for file prefix type(read_character_item) :: map_image_prefix_ctl @@ -214,23 +216,13 @@ module t_control_data_4_map contains ! ! --------------------------------------------------------------------- -! - subroutine init_map_ctl_stract(map_c) -! - type(map_ctl), intent(inout) :: map_c -! - call init_psf_def_ctl_stract(map_c%map_define_ctl%psf_def_c) -! - end subroutine init_map_ctl_stract -! -! --------------------------------------------------------------------- ! subroutine dealloc_cont_dat_4_map(map_c) ! type(map_ctl), intent(inout) :: map_c ! ! - call dealloc_pvr_section_ctl(map_c%map_define_ctl) + call dealloc_map_section_ctl(map_c%map_define_ctl) call dealloc_view_transfer_ctl(map_c%mat) call deallocate_pvr_cmap_cbar(map_c%cmap_cbar_c) ! @@ -257,7 +249,7 @@ subroutine dup_control_4_map(org_map_c, new_map_c) type(map_ctl), intent(inout) :: new_map_c ! ! - call dup_pvr_section_ctl(org_map_c%map_define_ctl, & + call dup_map_section_ctl(org_map_c%map_define_ctl, & & new_map_c%map_define_ctl) call dup_view_transfer_ctl(org_map_c%mat, new_map_c%mat) call dup_pvr_cmap_cbar(org_map_c%cmap_cbar_c, & @@ -279,6 +271,7 @@ subroutine dup_control_4_map(org_map_c, new_map_c) new_map_c%fname_mat_ctl = org_map_c%fname_mat_ctl new_map_c%fname_cmap_cbar_c = org_map_c%fname_cmap_cbar_c ! + new_map_c%block_name = org_map_c%block_name new_map_c%i_map_ctl = org_map_c%i_map_ctl new_map_c%i_output_field = org_map_c%i_output_field ! diff --git a/src/Fortran_libraries/VIZ_src/map_rendering/t_control_data_maps.f90 b/src/Fortran_libraries/VIZ_src/map_rendering/t_control_data_maps.f90 index 6ef9cd2f..3ffa8021 100644 --- a/src/Fortran_libraries/VIZ_src/map_rendering/t_control_data_maps.f90 +++ b/src/Fortran_libraries/VIZ_src/map_rendering/t_control_data_maps.f90 @@ -8,9 +8,14 @@ !!@verbatim !! subroutine alloc_map_ctl_stract(map_ctls) !! subroutine dealloc_map_ctl_stract(map_ctls) +!! subroutine init_map_ctls_labels(hd_block, map_ctls) +!! character(len=kchara), intent(in) :: hd_block +!! type(map_rendering_controls), intent(inout) :: map_ctls !! -!! subroutine append_new_map_render_control(map_ctls) +!! subroutine append_map_render_control(idx_in, hd_block, map_ctls) +!! subroutine delete_map_render_control(idx_in, map_ctls) !! type(map_rendering_controls), intent(inout) :: map_ctls +!! !! subroutine add_fields_4_maps_to_fld_ctl(map_ctls, field_ctl) !! type(map_rendering_controls), intent(in) :: map_ctls !! type(ctl_array_c3), intent(inout) :: field_ctl @@ -32,14 +37,15 @@ module t_control_data_maps ! ! type map_rendering_controls +!> Control block name + character(len = kchara) :: block_name = 'map_rendering_ctl' +!> # of structure of sections control integer(kind = kint) :: num_map_ctl = 0 !> External section control file names character(len = kchara), allocatable :: fname_map_ctl(:) !> Structure of sections control type(map_ctl), allocatable :: map_ctl_struct(:) end type map_rendering_controls -! - private :: dup_control_4_maps ! ! -------------------------------------------------------------------- ! @@ -48,6 +54,8 @@ module t_control_data_maps ! --------------------------------------------------------------------- ! subroutine alloc_map_ctl_stract(map_ctls) +! + use ctl_data_map_rendering_IO ! type(map_rendering_controls), intent(inout) :: map_ctls integer(kind = kint) :: i @@ -55,15 +63,10 @@ subroutine alloc_map_ctl_stract(map_ctls) ! allocate(map_ctls%map_ctl_struct(map_ctls%num_map_ctl)) allocate(map_ctls%fname_map_ctl(map_ctls%num_map_ctl)) -! - do i = 1, map_ctls%num_map_ctl - call init_map_ctl_stract(map_ctls%map_ctl_struct(i)) - end do ! end subroutine alloc_map_ctl_stract ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- ! subroutine dealloc_map_ctl_stract(map_ctls) ! @@ -83,7 +86,19 @@ subroutine dealloc_map_ctl_stract(map_ctls) end subroutine dealloc_map_ctl_stract ! ! --------------------------------------------------------------------- -! -------------------------------------------------------------------- +! + subroutine init_map_ctls_labels(hd_block, map_ctls) +! + character(len=kchara), intent(in) :: hd_block + type(map_rendering_controls), intent(inout) :: map_ctls +! + map_ctls%num_map_ctl = 0 + map_ctls%block_name = hd_block +! + end subroutine init_map_ctls_labels +! +! --------------------------------------------------------------------- +! --------------------------------------------------------------------- ! subroutine add_fields_4_maps_to_fld_ctl(map_ctls, field_ctl) ! @@ -105,50 +120,92 @@ end subroutine add_fields_4_maps_to_fld_ctl ! --------------------------------------------------------------------- ! -------------------------------------------------------------------- ! - subroutine append_new_map_render_control(map_ctls) + subroutine append_map_render_control(idx_in, hd_block, map_ctls) +! + use ctl_data_map_rendering_IO ! + integer(kind = kint), intent(in) :: idx_in + character(len=kchara), intent(in) :: hd_block type(map_rendering_controls), intent(inout) :: map_ctls ! - type(map_rendering_controls) :: tmp_psf_c + type(map_rendering_controls) :: tmp_map_c + integer(kind = kint) :: i ! ! - tmp_psf_c%num_map_ctl = map_ctls%num_map_ctl - call alloc_map_ctl_stract(tmp_psf_c) - call dup_control_4_maps & - & (tmp_psf_c%num_map_ctl, map_ctls, tmp_psf_c) + if(idx_in.lt.0 .or. idx_in.gt.map_ctls%num_map_ctl) return ! - call dealloc_map_ctl_stract(map_ctls) + tmp_map_c%num_map_ctl = map_ctls%num_map_ctl + call alloc_map_ctl_stract(tmp_map_c) + do i = 1, tmp_map_c%num_map_ctl + call dup_control_4_map(map_ctls%map_ctl_struct(i), & + & tmp_map_c%map_ctl_struct(i)) + tmp_map_c%fname_map_ctl(i) = map_ctls%fname_map_ctl(i) + end do ! - map_ctls%num_map_ctl = tmp_psf_c%num_map_ctl + 1 + call dealloc_map_ctl_stract(map_ctls) + map_ctls%num_map_ctl = tmp_map_c%num_map_ctl + 1 call alloc_map_ctl_stract(map_ctls) ! - call dup_control_4_maps & - & (tmp_psf_c%num_map_ctl, tmp_psf_c, map_ctls) + do i = 1, idx_in + call dup_control_4_map(tmp_map_c%map_ctl_struct(i), & + & map_ctls%map_ctl_struct(i)) + map_ctls%fname_map_ctl(i) = tmp_map_c%fname_map_ctl(i) + end do + call init_map_control_label(hd_block, & + & map_ctls%map_ctl_struct(idx_in+1)) + map_ctls%fname_map_ctl(idx_in+1) = 'NO_FILE' + do i = idx_in+1, tmp_map_c%num_map_ctl + call dup_control_4_map(tmp_map_c%map_ctl_struct(i), & + & map_ctls%map_ctl_struct(i+1)) + map_ctls%fname_map_ctl(i+1) = tmp_map_c%fname_map_ctl(i) + end do ! - call dealloc_map_ctl_stract(tmp_psf_c) + call dealloc_map_ctl_stract(tmp_map_c) ! - end subroutine append_new_map_render_control + end subroutine append_map_render_control ! ! ----------------------------------------------------------------------- ! - subroutine dup_control_4_maps & - & (num_psf, org_psf_ctls, new_psf_ctls) + subroutine delete_map_render_control(idx_in, map_ctls) +! + use ctl_data_map_rendering_IO ! - integer(kind = kint), intent(in) :: num_psf - type(map_rendering_controls), intent(in) :: org_psf_ctls - type(map_rendering_controls), intent(inout) :: new_psf_ctls + integer(kind = kint), intent(in) :: idx_in + type(map_rendering_controls), intent(inout) :: map_ctls ! + type(map_rendering_controls) :: tmp_map_c integer(kind = kint) :: i ! - do i = 1, num_psf - call dup_control_4_map(org_psf_ctls%map_ctl_struct(i), & - new_psf_ctls%map_ctl_struct(i)) +! + if(idx_in.le.0 .or. idx_in.gt.map_ctls%num_map_ctl) return +! + tmp_map_c%num_map_ctl = map_ctls%num_map_ctl + call alloc_map_ctl_stract(tmp_map_c) + do i = 1, tmp_map_c%num_map_ctl + call dup_control_4_map(map_ctls%map_ctl_struct(i), & + & tmp_map_c%map_ctl_struct(i)) + tmp_map_c%fname_map_ctl(i) = map_ctls%fname_map_ctl(i) end do - new_psf_ctls%fname_map_ctl(1:num_psf) & - & = org_psf_ctls%fname_map_ctl(1:num_psf) ! - end subroutine dup_control_4_maps + call dealloc_map_ctl_stract(map_ctls) + map_ctls%num_map_ctl = tmp_map_c%num_map_ctl + 1 + call alloc_map_ctl_stract(map_ctls) ! -! --------------------------------------------------------------------- + do i = 1, idx_in-1 + call dup_control_4_map(tmp_map_c%map_ctl_struct(i), & + & map_ctls%map_ctl_struct(i)) + map_ctls%fname_map_ctl(i) = tmp_map_c%fname_map_ctl(i) + end do + do i = idx_in, map_ctls%num_map_ctl + call dup_control_4_map(tmp_map_c%map_ctl_struct(i+1), & + & map_ctls%map_ctl_struct(i)) + map_ctls%fname_map_ctl(i) = tmp_map_c%fname_map_ctl(i+1) + end do +! + call dealloc_map_ctl_stract(tmp_map_c) +! + end subroutine delete_map_render_control +! +! ----------------------------------------------------------------------- ! end module t_control_data_maps diff --git a/src/Fortran_libraries/VIZ_src/map_rendering/t_ctl_data_map_section.f90 b/src/Fortran_libraries/VIZ_src/map_rendering/t_ctl_data_map_section.f90 new file mode 100644 index 00000000..4e3ac830 --- /dev/null +++ b/src/Fortran_libraries/VIZ_src/map_rendering/t_ctl_data_map_section.f90 @@ -0,0 +1,151 @@ +!>@file t_ctl_data_map_section.f90 +!!@brief module t_ctl_data_map_section +!! +!!@author H. Matsui +!!@date Programmed in 2006 +! +!> @brief control data for parallel volume rendering +!! +!!@verbatim +!! subroutine dup_map_section_ctl(org_map_sect_c, new_map_sect_c) +!! type(map_section_ctl), intent(in) :: org_map_sect_c +!! type(map_section_ctl), intent(inout) :: new_map_sect_c +!! subroutine dealloc_map_section_ctl(map_sect_ctl) +!! type(map_section_ctl), intent(inout) :: map_sect_ctl +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! array section_ctl +!! file surface_define ctl_psf_eq +!! begin surface_define +!! ... +!! end surface_define +!! +!! zeroline_switch_ctl On +!! isoline_color_mode color, white, or black +!! isoline_number_ctl 20 +!! isoline_range_ctl -0.5 0.5 +!! isoline_width_ctl 1.5 +!! grid_width_ctl 1.0 +!! +!! tangent_cylinder_switch_ctl On +!! inner_radius_ctl 0.53846 +!! outer_radius_ctl 1.53846 +!! end array section_ctl +!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!@endverbatim +! + module t_ctl_data_map_section +! + use m_precision +! + use m_machine_parameter + use t_read_control_elements + use t_control_data_4_psf_def + use t_control_array_real + use t_control_array_real2 + use t_control_array_integer + use t_control_array_character + use t_control_array_chara2real + use skip_comment_f +! + implicit none +! + type map_section_ctl +!> Block name + character(len=kchara) :: block_name = 'surface_define' +! +!> File name of control file to define surface + character(len = kchara) :: fname_sect_ctl = 'NO_FILE' +!> Structure to define surface + type(psf_define_ctl) :: psf_def_c +! +!> Structure of zero line switch + type(read_character_item) :: zeroline_switch_ctl +!> Structure of isoline color mode + type(read_character_item) :: isoline_color_mode +!> Structure of number of isoline + type(read_integer_item) :: isoline_number_ctl +!> Structure of range of isoline + type(read_real2_item) :: isoline_range_ctl +!> Structure to isoline width + type(read_real_item) :: isoline_width_ctl +!> Structure to grid width + type(read_real_item) :: grid_width_ctl +! +!> Structure of tangent cylinder line switch + type(read_character_item) :: tan_cyl_switch_ctl +!> Structure to define outer bounday radius for tangent cylinder + type(read_real_item) :: tangent_cylinder_inner_ctl +!> Structure to define inner bounday radius for tangent cylinder + type(read_real_item) :: tangent_cylinder_outer_ctl +! + integer(kind = kint) :: i_map_sect_ctl = 0 + end type map_section_ctl +! +! --------------------------------------------------------------------- +! + contains +! +! ----------------------------------------------------------------------- +! + subroutine dup_map_section_ctl(org_map_sect_c, new_map_sect_c) +! + type(map_section_ctl), intent(in) :: org_map_sect_c + type(map_section_ctl), intent(inout) :: new_map_sect_c +! +! + new_map_sect_c%block_name = org_map_sect_c%block_name + new_map_sect_c%i_map_sect_ctl = org_map_sect_c%i_map_sect_ctl + new_map_sect_c%fname_sect_ctl = org_map_sect_c%fname_sect_ctl + call dup_control_4_psf_def & + & (org_map_sect_c%psf_def_c, new_map_sect_c%psf_def_c) +! + call copy_chara_ctl(org_map_sect_c%zeroline_switch_ctl, & + & new_map_sect_c%zeroline_switch_ctl) + call copy_chara_ctl(org_map_sect_c%isoline_color_mode, & + & new_map_sect_c%isoline_color_mode) + call copy_integer_ctl(org_map_sect_c%isoline_number_ctl, & + & new_map_sect_c%isoline_number_ctl) + call copy_real2_ctl(org_map_sect_c%isoline_range_ctl, & + & new_map_sect_c%isoline_range_ctl) + call copy_real_ctl(org_map_sect_c%isoline_width_ctl, & + & new_map_sect_c%isoline_width_ctl) + call copy_real_ctl(org_map_sect_c%grid_width_ctl, & + & new_map_sect_c%grid_width_ctl) +! + call copy_chara_ctl(org_map_sect_c%tan_cyl_switch_ctl, & + & new_map_sect_c%tan_cyl_switch_ctl) + call copy_real_ctl(org_map_sect_c%tangent_cylinder_inner_ctl, & + & new_map_sect_c%tangent_cylinder_inner_ctl) + call copy_real_ctl(org_map_sect_c%tangent_cylinder_outer_ctl, & + & new_map_sect_c%tangent_cylinder_outer_ctl) +! + end subroutine dup_map_section_ctl +! +! --------------------------------------------------------------------- +! + subroutine dealloc_map_section_ctl(map_sect_ctl) +! + type(map_section_ctl), intent(inout) :: map_sect_ctl +! +! + call dealloc_cont_dat_4_psf_def(map_sect_ctl%psf_def_c) +! + map_sect_ctl%zeroline_switch_ctl%iflag = 0 + map_sect_ctl%isoline_color_mode%iflag = 0 + map_sect_ctl%isoline_number_ctl%iflag = 0 + map_sect_ctl%isoline_range_ctl%iflag = 0 + map_sect_ctl%isoline_width_ctl%iflag = 0 + map_sect_ctl%grid_width_ctl%iflag = 0 +! + map_sect_ctl%tan_cyl_switch_ctl%iflag = 0 + map_sect_ctl%tangent_cylinder_inner_ctl%iflag = 0 + map_sect_ctl%tangent_cylinder_outer_ctl%iflag = 0 +! + map_sect_ctl%i_map_sect_ctl = 0 +! + end subroutine dealloc_map_section_ctl +! +! --------------------------------------------------------------------- +! + end module t_ctl_data_map_section diff --git a/src/Fortran_libraries/VIZ_src/map_rendering/t_map_rendering_data.f90 b/src/Fortran_libraries/VIZ_src/map_rendering/t_map_rendering_data.f90 index e36e9152..b9635015 100644 --- a/src/Fortran_libraries/VIZ_src/map_rendering/t_map_rendering_data.f90 +++ b/src/Fortran_libraries/VIZ_src/map_rendering/t_map_rendering_data.f90 @@ -12,7 +12,7 @@ !! & (proj_type_c, proj_c, map_define_ctl, map_data) !! type(read_character_item), intent(in) :: proj_type_c !! type(projection_ctl), intent(in) :: proj_c -!! type(pvr_section_ctl), intent(in) :: map_define_ctl +!! type(map_section_ctl), intent(in) :: map_define_ctl !! type(map_rendering_data), intent(inout) :: map_data !! subroutine init_map_rendering_data & !! & (view_param, pvr_rgb, map_data) @@ -91,13 +91,13 @@ subroutine set_ctl_map_rendering_param & & (proj_type_c, proj_c, map_define_ctl, map_data) ! use t_control_array_character - use t_ctl_data_pvr_section + use t_ctl_data_map_section use t_ctl_data_4_projection use skip_comment_f ! type(read_character_item), intent(in) :: proj_type_c type(projection_ctl), intent(in) :: proj_c - type(pvr_section_ctl), intent(in) :: map_define_ctl + type(map_section_ctl), intent(in) :: map_define_ctl type(map_rendering_data), intent(inout) :: map_data ! character(len = kchara) :: tmpchara diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/Makefile b/src/Fortran_libraries/VIZ_src/volume_rendering/Makefile index 763f3005..a6abbdca 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/Makefile +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/Makefile @@ -15,12 +15,12 @@ dir_list: lib_name: -lib_tasks: libtarget lib_archve +lib_tasks: lib_archve @echo ' ''$$(RANLIB) $$@' >> $(MAKENAME) libtarget: -lib_archve: +lib_archve: libtarget @echo ' ''$$(AR)' '$$(ARFLUGS)' rcsv '$$@' '$$(MOD_PVR)' \ >> $(MAKENAME) diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/Makefile.depends b/src/Fortran_libraries/VIZ_src/volume_rendering/Makefile.depends index 35f354b7..efaa40ec 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/Makefile.depends +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/Makefile.depends @@ -2,7 +2,7 @@ FEM_to_VIZ_bridge.o: $(PVR_DIR)/FEM_to_VIZ_bridge.f90 m_precision.o m_machine_pa $(F90) -c $(F90OPTFLAGS) $< anaglyph_volume_renderings.o: $(PVR_DIR)/anaglyph_volume_renderings.f90 m_precision.o calypso_mpi.o m_constants.o m_machine_parameter.o m_geometry_constants.o m_work_time.o m_elapsed_labels_4_VIZ.o t_mesh_data.o t_phys_data.o t_jacobians.o t_volume_rendering.o t_surf_grp_list_each_surf.o t_rendering_vr_image.o t_control_params_4_pvr.o t_surf_grp_4_pvr_domain.o t_pvr_ray_startpoints.o t_pvr_image_array.o t_pvr_field_data.o t_geometries_in_pvr_screen.o t_control_data_pvrs.o t_mesh_SR.o set_PVR_view_and_image.o each_volume_rendering.o each_anaglyph_PVR.o write_multi_PVR_image.o $(F90) -c $(F90OPTFLAGS) $< -bcast_control_data_4_pvr.o: $(PVR_DIR)/bcast_control_data_4_pvr.f90 m_precision.o calypso_mpi.o t_control_data_4_pvr.o calypso_mpi_int.o calypso_mpi_char.o bcast_control_arrays.o bcast_pvr_color_ctl.o bcast_ctl_data_view_trans.o bcast_ctl_data_pvr_surfaces.o transfer_to_long_integers.o t_ctl_data_4_view_transfer.o +bcast_control_data_4_pvr.o: $(PVR_DIR)/bcast_control_data_4_pvr.f90 m_precision.o calypso_mpi.o t_control_data_4_pvr.o calypso_mpi_int.o calypso_mpi_char.o bcast_control_arrays.o bcast_pvr_color_ctl.o bcast_ctl_data_view_trans.o bcast_ctl_data_pvr_surfaces.o transfer_to_long_integers.o $(F90) -c $(F90OPTFLAGS) $< bcast_control_data_pvrs.o: $(PVR_DIR)/bcast_control_data_pvrs.f90 m_precision.o m_machine_parameter.o t_control_data_pvrs.o calypso_mpi.o calypso_mpi_int.o calypso_mpi_char.o transfer_to_long_integers.o bcast_control_data_4_pvr.o $(F90) -c $(F90OPTFLAGS) $< @@ -10,11 +10,11 @@ bcast_ctl_data_pvr_surfaces.o: $(PVR_DIR)/bcast_ctl_data_pvr_surfaces.f90 m_prec $(F90) -c $(F90OPTFLAGS) $< bcast_ctl_data_view_trans.o: $(PVR_DIR)/bcast_ctl_data_view_trans.f90 m_precision.o calypso_mpi.o m_constants.o m_machine_parameter.o t_ctl_data_pvr_movie.o calypso_mpi_int.o calypso_mpi_char.o transfer_to_long_integers.o bcast_control_arrays.o t_ctl_data_quilt_image.o t_ctl_data_view_transfers.o t_ctl_data_4_view_transfer.o t_ctl_data_4_screen_pixel.o t_ctl_data_4_projection.o t_ctl_data_4_streo_view.o $(F90) -c $(F90OPTFLAGS) $< -bcast_ctl_data_viz3.o: $(PVR_DIR)/bcast_ctl_data_viz3.f90 m_precision.o m_machine_parameter.o calypso_mpi_int.o t_control_data_viz3.o bcast_control_arrays.o bcast_section_control_data.o bcast_maps_control_data.o bcast_ctl_data_field_line.o bcast_control_data_pvrs.o +bcast_ctl_data_viz3.o: $(PVR_DIR)/bcast_ctl_data_viz3.f90 m_precision.o m_machine_parameter.o calypso_mpi_int.o t_control_data_viz3.o transfer_to_long_integers.o calypso_mpi_char.o bcast_control_arrays.o bcast_section_control_data.o bcast_maps_control_data.o bcast_ctl_data_field_line.o bcast_control_data_pvrs.o $(F90) -c $(F90OPTFLAGS) $< bcast_ctl_data_viz4.o: $(PVR_DIR)/bcast_ctl_data_viz4.f90 m_precision.o m_machine_parameter.o calypso_mpi_int.o t_control_data_viz4.o bcast_control_arrays.o bcast_section_control_data.o bcast_maps_control_data.o bcast_ctl_data_field_line.o bcast_control_data_pvrs.o $(F90) -c $(F90OPTFLAGS) $< -bcast_pvr_color_ctl.o: $(PVR_DIR)/bcast_pvr_color_ctl.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_ctl_data_pvr_colormap.o calypso_mpi_int.o bcast_control_arrays.o t_ctl_data_pvr_light.o t_ctl_data_pvr_colorbar.o t_ctl_data_pvr_area.o +bcast_pvr_color_ctl.o: $(PVR_DIR)/bcast_pvr_color_ctl.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_ctl_data_pvr_colormap.o bcast_control_arrays.o calypso_mpi_int.o calypso_mpi_char.o transfer_to_long_integers.o t_ctl_data_pvr_light.o t_ctl_data_pvr_colorbar.o t_ctl_data_pvr_area.o $(F90) -c $(F90OPTFLAGS) $< cal_pvr_modelview_mat.o: $(PVR_DIR)/cal_pvr_modelview_mat.f90 m_precision.o m_constants.o m_machine_parameter.o t_control_params_4_pvr.o t_geometries_in_pvr_screen.o t_control_params_stereo_pvr.o t_surf_grp_4_pvr_domain.o cal_inverse_small_matrix.o small_mat_mat_product.o transform_mat_operations.o mag_of_field_smp.o cal_products_smp.o $(F90) -c $(F90OPTFLAGS) $< @@ -30,7 +30,7 @@ convert_real_rgb_2_bite.o: $(PVR_DIR)/convert_real_rgb_2_bite.f90 m_precision.o $(F90) -c $(F90OPTFLAGS) $< count_pvr_ray_start_point.o: $(PVR_DIR)/count_pvr_ray_start_point.f90 m_precision.o calypso_mpi.o m_constants.o m_geometry_constants.o t_control_params_4_pvr.o t_geometry_data.o t_surface_data.o set_position_pvr_screen.o cal_fline_in_cube.o $(F90) -c $(F90OPTFLAGS) $< -ctl_data_each_pvr_IO.o: $(PVR_DIR)/ctl_data_each_pvr_IO.f90 m_precision.o calypso_mpi.o m_machine_parameter.o t_read_control_elements.o t_ctl_data_4_view_transfer.o t_control_array_integer.o t_control_array_character.o t_control_array_chara2real.o t_ctl_data_pvr_colormap_bar.o t_ctl_data_pvr_light.o t_control_data_pvr_sections.o t_ctl_data_quilt_image.o t_ctl_data_pvr_movie.o t_control_data_pvr_isosurfs.o t_ctl_data_pvr_area.o t_control_data_4_pvr.o skip_comment_f.o ctl_file_pvr_modelview_IO.o ctl_file_pvr_light_IO.o ctl_data_pvr_movie_IO.o write_control_elements.o +ctl_data_each_pvr_IO.o: $(PVR_DIR)/ctl_data_each_pvr_IO.f90 m_precision.o calypso_mpi.o m_machine_parameter.o t_read_control_elements.o t_ctl_data_4_view_transfer.o t_control_array_integer.o t_control_array_character.o t_control_array_chara2real.o t_ctl_data_pvr_colormap_bar.o t_ctl_data_pvr_light.o t_control_data_pvr_sections.o t_ctl_data_quilt_image.o t_ctl_data_pvr_movie.o t_control_data_pvr_isosurfs.o t_ctl_data_pvr_area.o t_control_data_4_pvr.o skip_comment_f.o ctl_file_pvr_modelview_IO.o ctl_file_pvr_light_IO.o ctl_data_pvr_movie_IO.o ctl_data_view_transfer_IO.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< ctl_data_four_vizs_IO.o: $(PVR_DIR)/ctl_data_four_vizs_IO.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_control_data_viz4.o t_control_data_sections.o t_control_data_isosurfaces.o t_control_data_pvrs.o t_control_data_flines.o t_control_array_character.o t_control_array_real.o t_control_array_integer.o t_read_control_elements.o ctl_file_sections_IO.o ctl_file_isosurfaces_IO.o ctl_file_map_renderings_IO.o ctl_file_fieldlines_IO.o skip_comment_f.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< @@ -38,15 +38,13 @@ ctl_data_pvr_colorbar_IO.o: $(PVR_DIR)/ctl_data_pvr_colorbar_IO.f90 m_precision. $(F90) -c $(F90OPTFLAGS) $< ctl_data_pvr_colormap_IO.o: $(PVR_DIR)/ctl_data_pvr_colormap_IO.f90 m_precision.o calypso_mpi.o m_machine_parameter.o t_read_control_elements.o t_ctl_data_4_view_transfer.o t_control_array_character.o t_control_array_real.o t_control_array_real2.o t_control_array_real3.o t_ctl_data_pvr_colormap.o skip_comment_f.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< -ctl_data_pvr_movie_IO.o: $(PVR_DIR)/ctl_data_pvr_movie_IO.f90 m_precision.o calypso_mpi.o m_machine_parameter.o t_read_control_elements.o t_control_data_4_psf.o t_control_array_character.o t_control_array_integer.o t_control_array_real2.o t_control_array_integer2.o t_ctl_data_4_view_transfer.o t_ctl_data_view_transfers.o t_ctl_data_pvr_movie.o skip_comment_f.o ctl_file_pvr_modelview_IO.o write_control_elements.o - $(F90) -c $(F90OPTFLAGS) $< -ctl_data_pvr_section_IO.o: $(PVR_DIR)/ctl_data_pvr_section_IO.f90 m_precision.o calypso_mpi.o m_machine_parameter.o t_read_control_elements.o t_control_data_4_psf_def.o t_control_array_real.o t_control_array_real2.o t_control_array_character.o t_ctl_data_pvr_section.o skip_comment_f.o ctl_file_section_def_IO.o write_control_elements.o +ctl_data_pvr_movie_IO.o: $(PVR_DIR)/ctl_data_pvr_movie_IO.f90 m_precision.o calypso_mpi.o m_machine_parameter.o t_read_control_elements.o t_control_data_4_psf.o t_control_array_character.o t_control_array_integer.o t_control_array_real2.o t_control_array_integer2.o t_ctl_data_4_view_transfer.o t_ctl_data_view_transfers.o t_ctl_data_pvr_movie.o skip_comment_f.o ctl_file_pvr_modelview_IO.o write_control_elements.o ctl_data_view_transfer_IO.o $(F90) -c $(F90OPTFLAGS) $< ctl_data_three_vizs_IO.o: $(PVR_DIR)/ctl_data_three_vizs_IO.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_control_data_viz3.o t_control_data_sections.o t_control_data_isosurfaces.o t_control_data_pvrs.o t_control_data_flines.o t_control_array_character.o t_control_array_real.o t_control_array_integer.o t_read_control_elements.o ctl_file_sections_IO.o ctl_file_isosurfaces_IO.o ctl_file_map_renderings_IO.o ctl_file_fieldlines_IO.o skip_comment_f.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< ctl_data_view_transfer_IO.o: $(PVR_DIR)/ctl_data_view_transfer_IO.f90 m_precision.o m_constants.o m_machine_parameter.o t_read_control_elements.o t_control_array_real.o t_control_array_charareal.o t_control_array_chara2real.o t_ctl_data_4_screen_pixel.o t_ctl_data_4_projection.o t_ctl_data_4_streo_view.o t_ctl_data_4_view_transfer.o skip_comment_f.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< -ctl_file_each_pvr_IO.o: $(PVR_DIR)/ctl_file_each_pvr_IO.f90 m_precision.o calypso_mpi.o t_control_data_4_pvr.o ctl_data_each_pvr_IO.o bcast_control_data_4_pvr.o write_control_elements.o +ctl_file_each_pvr_IO.o: $(PVR_DIR)/ctl_file_each_pvr_IO.f90 m_precision.o t_control_data_4_pvr.o ctl_data_each_pvr_IO.o skip_comment_f.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< ctl_file_pvr_light_IO.o: $(PVR_DIR)/ctl_file_pvr_light_IO.f90 m_precision.o m_constants.o m_machine_parameter.o t_ctl_data_pvr_light.o t_read_control_elements.o write_control_elements.o ctl_data_view_transfer_IO.o skip_comment_f.o $(F90) -c $(F90OPTFLAGS) $< @@ -64,6 +62,8 @@ find_pvr_surf_domain.o: $(PVR_DIR)/find_pvr_surf_domain.f90 m_precision.o m_cons $(F90) -c $(F90OPTFLAGS) $< generate_vr_image.o: $(PVR_DIR)/generate_vr_image.f90 m_precision.o m_machine_parameter.o m_constants.o calypso_mpi.o t_control_params_4_pvr.o t_geometries_in_pvr_screen.o t_surf_grp_4_pvr_domain.o t_pvr_ray_startpoints.o t_pvr_image_array.o m_geometry_constants.o t_geometry_data.o t_surface_data.o set_position_pvr_screen.o find_pvr_surf_domain.o pvr_axis_label.o count_pvr_ray_start_point.o set_pvr_ray_start_point.o cal_field_on_surf_viz.o $(F90) -c $(F90OPTFLAGS) $< +m_pvr_control_labels.o: $(PVR_DIR)/m_pvr_control_labels.f90 m_precision.o m_constants.o t_control_array_character.o + $(F90) -c $(F90OPTFLAGS) $< mesh_outline_4_pvr.o: $(PVR_DIR)/mesh_outline_4_pvr.f90 m_precision.o m_constants.o m_machine_parameter.o calypso_mpi.o t_surf_grp_4_pvr_domain.o t_geometry_data.o calypso_mpi_real.o $(F90) -c $(F90OPTFLAGS) $< mpi_write_quilt_BMP_file.o: $(PVR_DIR)/mpi_write_quilt_BMP_file.F90 m_precision.o m_constants.o calypso_mpi.o t_MPI_quilt_bitmap_IO.o output_image_sel_4_png.o m_calypso_mpi_IO.o MPI_ascii_data_IO.o t_calypso_mpi_IO_param.o write_bmp_image.o t_buffer_4_gzip.o zlib_convert_text.o data_convert_by_zlib.o calypso_mpi_int8.o transfer_to_long_integers.o set_parallel_file_name.o @@ -76,7 +76,7 @@ pvr_axis_label.o: $(PVR_DIR)/pvr_axis_label.f90 m_precision.o m_constants.o t_ge $(F90) -c $(F90OPTFLAGS) $< pvr_font_texture.o: $(PVR_DIR)/pvr_font_texture.f90 m_constants.o m_precision.o $(F90) -c $(F90OPTFLAGS) $< -pvr_surface_enhancement.o: $(PVR_DIR)/pvr_surface_enhancement.f90 m_precision.o m_constants.o m_machine_parameter.o m_geometry_constants.o t_surface_data.o t_surf_grp_list_each_surf.o t_group_data.o t_surface_group_normals.o t_surface_group_connect.o t_control_params_4_pvr.o calypso_mpi.o skip_comment_f.o set_position_pvr_screen.o t_read_control_elements.o +pvr_surface_enhancement.o: $(PVR_DIR)/pvr_surface_enhancement.f90 m_precision.o m_constants.o m_machine_parameter.o m_geometry_constants.o t_surface_data.o t_surf_grp_list_each_surf.o t_group_data.o t_surface_group_normals.o t_surface_group_connect.o t_control_params_4_pvr.o calypso_mpi.o m_pvr_control_labels.o skip_comment_f.o set_position_pvr_screen.o $(F90) -c $(F90OPTFLAGS) $< ray_trace_4_each_image.o: $(PVR_DIR)/ray_trace_4_each_image.f90 m_precision.o m_constants.o m_geometry_constants.o calypso_mpi.o set_rgba_4_each_pixel.o t_mesh_data.o t_geometry_data.o t_surface_data.o t_group_data.o t_surf_grp_list_each_surf.o t_control_params_4_pvr.o t_pvr_colormap_parameter.o t_pvr_field_data.o t_geometries_in_pvr_screen.o t_pvr_ray_startpoints.o set_position_pvr_screen.o cal_field_on_surf_viz.o cal_fline_in_cube.o set_coefs_of_sections.o pvr_surface_enhancement.o $(F90) -c $(F90OPTFLAGS) $< @@ -92,11 +92,11 @@ set_color_4_pvr.o: $(PVR_DIR)/set_color_4_pvr.f90 m_precision.o set_rgb_colors.o $(F90) -c $(F90OPTFLAGS) $< set_composition_pe_range.o: $(PVR_DIR)/set_composition_pe_range.f90 m_precision.o t_rendering_vr_image.o t_pvr_image_array.o $(F90) -c $(F90OPTFLAGS) $< -set_control_each_pvr.o: $(PVR_DIR)/set_control_each_pvr.f90 m_precision.o m_constants.o m_error_IDs.o t_control_data_4_pvr.o calypso_mpi.o set_field_comp_for_viz.o output_image_sel_4_png.o t_control_params_4_pvr.o skip_comment_f.o t_control_array_character.o t_group_data.o t_pvr_colormap_parameter.o t_geometries_in_pvr_screen.o set_color_4_pvr.o set_rgba_4_each_pixel.o set_coefs_of_sections.o set_control_pvr_color.o t_ctl_data_pvr_area.o pvr_surface_enhancement.o set_area_4_viz.o t_control_data_pvr_sections.o t_control_data_pvr_isosurfs.o +set_control_each_pvr.o: $(PVR_DIR)/set_control_each_pvr.f90 m_precision.o m_constants.o m_error_IDs.o t_control_data_4_pvr.o calypso_mpi.o set_field_comp_for_viz.o output_image_sel_4_png.o t_control_params_4_pvr.o skip_comment_f.o t_control_array_character.o t_group_data.o t_pvr_colormap_parameter.o t_geometries_in_pvr_screen.o set_color_4_pvr.o set_rgba_4_each_pixel.o set_coefs_of_sections.o set_control_pvr_color.o t_ctl_data_pvr_area.o pvr_surface_enhancement.o set_area_4_viz.o t_control_data_pvr_sections.o t_control_data_pvr_isosurfs.o m_pvr_control_labels.o $(F90) -c $(F90OPTFLAGS) $< set_control_pvr_color.o: $(PVR_DIR)/set_control_pvr_color.f90 m_precision.o m_constants.o m_error_IDs.o calypso_mpi.o t_pvr_colormap_parameter.o skip_comment_f.o t_ctl_data_pvr_light.o set_color_4_pvr.o set_rgba_4_each_pixel.o t_ctl_data_pvr_colormap.o t_ctl_data_pvr_colorbar.o $(F90) -c $(F90OPTFLAGS) $< -set_control_pvr_movie.o: $(PVR_DIR)/set_control_pvr_movie.f90 m_precision.o m_constants.o m_error_IDs.o calypso_mpi.o t_ctl_data_pvr_movie.o t_control_params_4_pvr.o t_geometries_in_pvr_screen.o output_image_sel_4_png.o skip_comment_f.o +set_control_pvr_movie.o: $(PVR_DIR)/set_control_pvr_movie.f90 m_precision.o m_constants.o m_error_IDs.o calypso_mpi.o t_ctl_data_pvr_movie.o t_control_params_4_pvr.o t_geometries_in_pvr_screen.o m_pvr_control_labels.o output_image_sel_4_png.o skip_comment_f.o $(F90) -c $(F90OPTFLAGS) $< set_default_pvr_params.o: $(PVR_DIR)/set_default_pvr_params.f90 m_precision.o m_constants.o t_control_params_4_pvr.o t_pvr_colormap_parameter.o t_surf_grp_4_pvr_domain.o t_geometries_in_pvr_screen.o set_color_4_pvr.o $(F90) -c $(F90OPTFLAGS) $< @@ -120,19 +120,19 @@ t_MPI_quilt_bitmap_IO.o: $(PVR_DIR)/t_MPI_quilt_bitmap_IO.f90 m_precision.o m_co $(F90) -c $(F90OPTFLAGS) $< t_VIZ_mesh_field.o: $(PVR_DIR)/t_VIZ_mesh_field.f90 m_precision.o m_machine_parameter.o t_comm_table.o t_phys_data.o t_next_node_ele_4_node.o t_shape_functions.o t_jacobians.o t_VIZ_step_parameter.o $(F90) -c $(F90OPTFLAGS) $< -t_control_data_4_pvr.o: $(PVR_DIR)/t_control_data_4_pvr.f90 m_precision.o calypso_mpi.o m_machine_parameter.o t_read_control_elements.o t_ctl_data_4_view_transfer.o t_control_array_integer.o t_control_array_character.o t_control_array_chara2real.o t_ctl_data_pvr_colormap_bar.o t_ctl_data_pvr_light.o t_control_data_pvr_sections.o t_ctl_data_pvr_movie.o t_ctl_data_quilt_image.o t_control_data_pvr_isosurfs.o t_ctl_data_pvr_area.o skip_comment_f.o t_control_array_character3.o add_nodal_fields_ctl.o +t_control_data_4_pvr.o: $(PVR_DIR)/t_control_data_4_pvr.f90 m_precision.o calypso_mpi.o m_machine_parameter.o t_read_control_elements.o t_ctl_data_4_view_transfer.o t_control_array_integer.o t_control_array_character.o t_control_array_chara2real.o t_ctl_data_pvr_colormap_bar.o t_ctl_data_pvr_light.o t_control_data_pvr_sections.o t_ctl_data_pvr_movie.o t_ctl_data_quilt_image.o t_control_data_pvr_isosurfs.o t_ctl_data_pvr_area.o skip_comment_f.o t_control_array_character3.o add_nodal_fields_ctl.o bcast_control_arrays.o $(F90) -c $(F90OPTFLAGS) $< t_control_data_pvr_isosurfs.o: $(PVR_DIR)/t_control_data_pvr_isosurfs.f90 m_precision.o m_machine_parameter.o t_read_control_elements.o t_control_array_character.o t_control_array_real.o t_ctl_data_pvr_isosurface.o skip_comment_f.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< -t_control_data_pvr_sections.o: $(PVR_DIR)/t_control_data_pvr_sections.f90 m_precision.o m_machine_parameter.o t_read_control_elements.o t_control_data_4_psf_def.o t_control_array_real.o t_control_array_character.o t_control_array_chara2real.o t_ctl_data_pvr_section.o skip_comment_f.o ctl_data_pvr_section_IO.o write_control_elements.o +t_control_data_pvr_sections.o: $(PVR_DIR)/t_control_data_pvr_sections.f90 m_precision.o m_machine_parameter.o t_read_control_elements.o t_control_data_4_psf_def.o t_control_array_real.o t_control_array_character.o t_control_array_chara2real.o t_ctl_data_pvr_section.o skip_comment_f.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< -t_control_data_pvrs.o: $(PVR_DIR)/t_control_data_pvrs.f90 m_precision.o m_machine_parameter.o t_control_data_4_pvr.o t_read_control_elements.o skip_comment_f.o write_control_elements.o ctl_file_each_pvr_IO.o t_control_array_character3.o bcast_control_data_4_pvr.o +t_control_data_pvrs.o: $(PVR_DIR)/t_control_data_pvrs.f90 m_precision.o m_machine_parameter.o t_control_data_4_pvr.o t_read_control_elements.o skip_comment_f.o write_control_elements.o ctl_file_each_pvr_IO.o t_control_array_character3.o ctl_data_each_pvr_IO.o $(F90) -c $(F90OPTFLAGS) $< t_control_data_viz3.o: $(PVR_DIR)/t_control_data_viz3.f90 m_precision.o m_machine_parameter.o t_control_data_sections.o t_control_data_isosurfaces.o t_control_data_maps.o t_control_data_pvrs.o t_control_array_character.o t_control_array_real.o t_control_array_integer.o t_ctl_data_4_time_steps.o t_control_array_character3.o $(F90) -c $(F90OPTFLAGS) $< t_control_data_viz4.o: $(PVR_DIR)/t_control_data_viz4.f90 m_precision.o m_machine_parameter.o t_control_data_sections.o t_control_data_isosurfaces.o t_control_data_maps.o t_control_data_pvrs.o t_control_data_flines.o t_control_array_character.o t_control_array_real.o t_control_array_integer.o t_control_array_character3.o $(F90) -c $(F90OPTFLAGS) $< -t_control_params_4_pvr.o: $(PVR_DIR)/t_control_params_4_pvr.f90 m_precision.o m_constants.o output_image_sel_4_png.o t_read_control_elements.o +t_control_params_4_pvr.o: $(PVR_DIR)/t_control_params_4_pvr.f90 m_precision.o m_constants.o output_image_sel_4_png.o $(F90) -c $(F90OPTFLAGS) $< t_control_params_stereo_pvr.o: $(PVR_DIR)/t_control_params_stereo_pvr.f90 m_precision.o m_constants.o t_control_data_4_pvr.o set_area_4_viz.o skip_comment_f.o t_ctl_data_quilt_image.o $(F90) -c $(F90OPTFLAGS) $< @@ -158,7 +158,7 @@ t_ctl_data_pvr_light.o: $(PVR_DIR)/t_ctl_data_pvr_light.f90 m_precision.o m_mach $(F90) -c $(F90OPTFLAGS) $< t_ctl_data_pvr_movie.o: $(PVR_DIR)/t_ctl_data_pvr_movie.f90 m_precision.o m_machine_parameter.o t_read_control_elements.o t_control_data_4_psf.o t_control_array_character.o t_control_array_integer.o t_control_array_real2.o t_control_array_integer2.o t_ctl_data_4_view_transfer.o t_ctl_data_view_transfers.o skip_comment_f.o $(F90) -c $(F90OPTFLAGS) $< -t_ctl_data_pvr_section.o: $(PVR_DIR)/t_ctl_data_pvr_section.f90 m_precision.o m_machine_parameter.o t_read_control_elements.o t_control_data_4_psf_def.o t_control_array_real.o t_control_array_real2.o t_control_array_integer.o t_control_array_character.o t_control_array_chara2real.o skip_comment_f.o +t_ctl_data_pvr_section.o: $(PVR_DIR)/t_ctl_data_pvr_section.f90 m_precision.o m_machine_parameter.o t_read_control_elements.o t_control_data_4_psf_def.o t_control_array_real.o t_control_array_real2.o t_control_array_integer.o t_control_array_character.o t_control_array_chara2real.o skip_comment_f.o ctl_file_section_def_IO.o write_control_elements.o ctl_data_section_def_IO.o $(F90) -c $(F90OPTFLAGS) $< t_ctl_data_quilt_image.o: $(PVR_DIR)/t_ctl_data_quilt_image.f90 m_precision.o m_machine_parameter.o t_read_control_elements.o t_control_array_character.o t_control_array_integer.o t_control_array_integer2.o t_control_array_real2.o t_ctl_data_view_transfers.o skip_comment_f.o ctl_file_pvr_modelview_IO.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< @@ -192,7 +192,7 @@ t_surf_grp_4_pvr_domain.o: $(PVR_DIR)/t_surf_grp_4_pvr_domain.f90 m_precision.o $(F90) -c $(F90OPTFLAGS) $< t_three_visualizers.o: $(PVR_DIR)/t_three_visualizers.f90 m_precision.o m_machine_parameter.o m_work_time.o m_elapsed_labels_4_VIZ.o calypso_mpi.o t_VIZ_step_parameter.o t_time_data.o t_mesh_data.o t_comm_table.o t_phys_data.o t_next_node_ele_4_node.o t_VIZ_mesh_field.o t_mesh_SR.o t_control_data_viz3.o t_cross_section.o t_isosurface.o t_map_projection.o t_volume_rendering.o t_fieldline.o volume_rendering.o map_projection.o $(F90) -c $(F90OPTFLAGS) $< -t_volume_rendering.o: $(PVR_DIR)/t_volume_rendering.f90 m_precision.o calypso_mpi.o m_constants.o m_machine_parameter.o m_geometry_constants.o m_work_time.o m_elapsed_labels_4_VIZ.o t_mesh_data.o t_phys_data.o t_jacobians.o t_surf_grp_list_each_surf.o t_rendering_vr_image.o t_control_params_4_pvr.o t_surf_grp_4_pvr_domain.o t_pvr_ray_startpoints.o t_pvr_image_array.o t_pvr_field_data.o t_geometries_in_pvr_screen.o t_control_data_pvrs.o t_sort_PVRs_by_type.o each_volume_rendering.o t_control_data_pvr_sections.o set_pvr_control.o rendering_and_image_nums.o calypso_mpi_int.o ctl_file_each_pvr_IO.o skip_comment_f.o t_read_control_elements.o +t_volume_rendering.o: $(PVR_DIR)/t_volume_rendering.f90 m_precision.o calypso_mpi.o m_constants.o m_machine_parameter.o m_geometry_constants.o m_work_time.o m_elapsed_labels_4_VIZ.o t_mesh_data.o t_phys_data.o t_jacobians.o t_surf_grp_list_each_surf.o t_rendering_vr_image.o t_control_params_4_pvr.o t_surf_grp_4_pvr_domain.o t_pvr_ray_startpoints.o t_pvr_image_array.o t_pvr_field_data.o t_geometries_in_pvr_screen.o t_control_data_pvrs.o t_sort_PVRs_by_type.o each_volume_rendering.o t_control_data_pvr_sections.o set_pvr_control.o rendering_and_image_nums.o calypso_mpi_int.o bcast_control_data_4_pvr.o ctl_file_each_pvr_IO.o skip_comment_f.o t_read_control_elements.o $(F90) -c $(F90OPTFLAGS) $< viz4_step_ctls_to_time_ctl.o: $(PVR_DIR)/viz4_step_ctls_to_time_ctl.f90 m_precision.o m_constants.o t_control_data_viz4.o t_ctl_data_4_time_steps.o t_control_array_real.o t_control_array_character.o t_control_array_integer.o $(F90) -c $(F90OPTFLAGS) $< diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_control_data_4_pvr.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_control_data_4_pvr.f90 index ea89508b..6608d8b0 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_control_data_4_pvr.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_control_data_4_pvr.f90 @@ -9,10 +9,6 @@ !!@verbatim !! subroutine bcast_vr_psf_ctl(pvr) !! type(pvr_parameter_ctl), intent(inout) :: pvr -!! subroutine dup_pvr_ctl(org_pvr, new_pvr) -!! subroutine copy_pvr_update_flag(org_pvr, new_pvr) -!! type(pvr_parameter_ctl), intent(in) :: org_pvr -!! type(pvr_parameter_ctl), intent(inout) :: new_pvr !!@end verbatim ! ! @@ -45,6 +41,8 @@ subroutine bcast_vr_psf_ctl(pvr) ! ! call calypso_mpi_bcast_one_int(pvr%i_pvr_ctl, 0) + call calypso_mpi_bcast_character(pvr%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_character(pvr%fname_mat_ctl, & & cast_long(kchara), 0) call calypso_mpi_bcast_character(pvr%fname_cmap_cbar_c, & @@ -59,6 +57,9 @@ subroutine bcast_vr_psf_ctl(pvr) call bcast_pvr_sections_ctl(pvr%pvr_scts_c) ! call bcast_lighting_ctl(pvr%light) + + call calypso_mpi_bcast_character(pvr%cmap_cbar_c%block_name, & + & cast_long(kchara), 0) call bcast_pvr_colorbar_ctl(pvr%cmap_cbar_c%cbar_ctl) call bcast_pvr_colordef_ctl(pvr%cmap_cbar_c%color) ! @@ -94,62 +95,5 @@ subroutine bcast_pvr_update_flag(pvr) end subroutine bcast_pvr_update_flag ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- -! - subroutine dup_pvr_ctl(org_pvr, new_pvr) -! - use t_ctl_data_4_view_transfer - use bcast_control_arrays -! - type(pvr_parameter_ctl), intent(in) :: org_pvr - type(pvr_parameter_ctl), intent(inout) :: new_pvr -! -! - new_pvr%i_pvr_ctl = org_pvr%i_pvr_ctl - new_pvr%fname_mat_ctl = org_pvr%fname_mat_ctl - new_pvr%fname_cmap_cbar_c = org_pvr%fname_cmap_cbar_c - new_pvr%fname_pvr_light_c = org_pvr%fname_pvr_light_c -! - call dup_view_transfer_ctl(org_pvr%mat, new_pvr%mat) -! - call dup_pvr_isosurfs_ctl(org_pvr%pvr_isos_c, new_pvr%pvr_isos_c) - call dup_pvr_sections_ctl(org_pvr%pvr_scts_c, new_pvr%pvr_scts_c) -! - call dup_lighting_ctl(org_pvr%light, new_pvr%light) - call dup_pvr_cmap_cbar(org_pvr%cmap_cbar_c, new_pvr%cmap_cbar_c) -! - call dup_quilt_image_ctl(org_pvr%quilt_c, new_pvr%quilt_c) - call dup_pvr_movie_control_flags(org_pvr%movie, new_pvr%movie) - call dup_pvr_render_area_ctl(org_pvr%render_area_c, & - & new_pvr%render_area_c) -! - call copy_chara_ctl(org_pvr%updated_ctl, new_pvr%updated_ctl) - call copy_chara_ctl(org_pvr%file_head_ctl, new_pvr%file_head_ctl) - call copy_chara_ctl(org_pvr%file_fmt_ctl, new_pvr%file_fmt_ctl) - call copy_chara_ctl(org_pvr%monitoring_ctl, & - & new_pvr%monitoring_ctl) -! - call copy_chara_ctl(org_pvr%streo_ctl, new_pvr%streo_ctl) - call copy_chara_ctl(org_pvr%anaglyph_ctl, new_pvr%anaglyph_ctl) - call copy_chara_ctl(org_pvr%quilt_ctl, new_pvr%quilt_ctl) -! - call copy_chara_ctl(org_pvr%pvr_field_ctl, new_pvr%pvr_field_ctl) - call copy_chara_ctl(org_pvr%pvr_comp_ctl, new_pvr%pvr_comp_ctl) -! - end subroutine dup_pvr_ctl -! -! --------------------------------------------------------------------- -! - subroutine copy_pvr_update_flag(org_pvr, new_pvr) -! - type(pvr_parameter_ctl), intent(in) :: org_pvr - type(pvr_parameter_ctl), intent(inout) :: new_pvr -! -! - call copy_chara_ctl(org_pvr%updated_ctl, new_pvr%updated_ctl) -! - end subroutine copy_pvr_update_flag -! -! --------------------------------------------------------------------- ! end module bcast_control_data_4_pvr diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_control_data_pvrs.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_control_data_pvrs.f90 index 4e3d39a5..4e132c29 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_control_data_pvrs.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_control_data_pvrs.f90 @@ -37,6 +37,8 @@ subroutine bcast_files_4_pvr_ctl(pvr_ctls) type(volume_rendering_controls), intent(inout) :: pvr_ctls ! ! + call calypso_mpi_bcast_character(pvr_ctls%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(pvr_ctls%num_pvr_ctl, 0) if(pvr_ctls%num_pvr_ctl .le. 0) return ! diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_ctl_data_pvr_surfaces.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_ctl_data_pvr_surfaces.f90 index 55a6c8e1..5cd8e2a0 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_ctl_data_pvr_surfaces.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_ctl_data_pvr_surfaces.f90 @@ -8,7 +8,7 @@ !! !!@verbatim !! subroutine bcast_pvr_sections_ctl(pvr_scts_c) -!! type(pvr_section_ctl), intent(inout) :: pvr_scts_c +!! type(pvr_sections_ctl), intent(inout) :: pvr_scts_c !! subroutine bcast_pvr_isosurfs_ctl(pvr_isos_c) !! type(pvr_isosurfs_ctl), intent(inout) :: pvr_isos_c !! subroutine bcast_pvr_section_ctl(pvr_scts_c) @@ -44,7 +44,10 @@ subroutine bcast_pvr_sections_ctl(pvr_scts_c) integer(kind = kint) :: i ! ! + call calypso_mpi_bcast_character & + & (pvr_scts_c%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(pvr_scts_c%num_pvr_sect_ctl, 0) +! if(pvr_scts_c%num_pvr_sect_ctl .gt. 0 .and. my_rank .gt. 0) then allocate(pvr_scts_c%pvr_sect_ctl(pvr_scts_c%num_pvr_sect_ctl)) end if @@ -60,8 +63,10 @@ end subroutine bcast_pvr_sections_ctl subroutine bcast_pvr_isosurfs_ctl(pvr_isos_c) ! use t_control_data_pvr_isosurfs - use calypso_mpi_int use bcast_control_arrays + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(pvr_isosurfs_ctl), intent(inout) :: pvr_isos_c ! @@ -69,6 +74,9 @@ subroutine bcast_pvr_isosurfs_ctl(pvr_isos_c) ! ! call calypso_mpi_bcast_one_int(pvr_isos_c%num_pvr_iso_ctl, 0) + call calypso_mpi_bcast_character & + & (pvr_isos_c%block_name, cast_long(kchara), 0) +! if(pvr_isos_c%num_pvr_iso_ctl .gt. 0 .and. my_rank .gt. 0) then call alloc_pvr_isosurfs_ctl(pvr_isos_c) end if @@ -100,7 +108,7 @@ end subroutine bcast_pvr_isosurfs_ctl ! --------------------------------------------------------------------- ! --------------------------------------------------------------------- ! - subroutine bcast_pvr_section_ctl(pvr_scts_c) + subroutine bcast_pvr_section_ctl(pvr_sct_c) ! use t_ctl_data_pvr_section use calypso_mpi_int @@ -109,26 +117,18 @@ subroutine bcast_pvr_section_ctl(pvr_scts_c) use bcast_control_arrays use bcast_section_control_data ! - type(pvr_section_ctl), intent(inout) :: pvr_scts_c + type(pvr_section_ctl), intent(inout) :: pvr_sct_c ! ! - call calypso_mpi_bcast_one_int(pvr_scts_c%i_pvr_sect_ctl, 0) + call calypso_mpi_bcast_one_int(pvr_sct_c%i_pvr_sect_ctl, 0) call calypso_mpi_bcast_character & - & (pvr_scts_c%fname_sect_ctl, cast_long(kchara), 0) -! - call bcast_section_def_control(pvr_scts_c%psf_def_c) - call bcast_ctl_type_r1(pvr_scts_c%opacity_ctl) -! - call bcast_ctl_type_c1(pvr_scts_c%zeroline_switch_ctl) - call bcast_ctl_type_c1(pvr_scts_c%isoline_color_mode) - call bcast_ctl_type_i1(pvr_scts_c%isoline_number_ctl) - call bcast_ctl_type_r2(pvr_scts_c%isoline_range_ctl) - call bcast_ctl_type_r1(pvr_scts_c%isoline_width_ctl) - call bcast_ctl_type_r1(pvr_scts_c%grid_width_ctl) + & (pvr_sct_c%block_name, cast_long(kchara), 0) + call calypso_mpi_bcast_character & + & (pvr_sct_c%fname_sect_ctl, cast_long(kchara), 0) ! - call bcast_ctl_type_c1(pvr_scts_c%tan_cyl_switch_ctl) - call bcast_ctl_type_r1(pvr_scts_c%tangent_cylinder_inner_ctl) - call bcast_ctl_type_r1(pvr_scts_c%tangent_cylinder_outer_ctl) + call bcast_section_def_control(pvr_sct_c%psf_def_c) + call bcast_ctl_type_r1(pvr_sct_c%opacity_ctl) + call bcast_ctl_type_c1(pvr_sct_c%zeroline_switch_ctl) ! end subroutine bcast_pvr_section_ctl ! @@ -138,16 +138,19 @@ subroutine bcast_pvr_isosurface_ctl(pvr_iso_ctl) ! use t_ctl_data_pvr_isosurface use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers use bcast_control_arrays ! type(pvr_isosurf_ctl), intent(inout) :: pvr_iso_ctl ! ! call calypso_mpi_bcast_one_int(pvr_iso_ctl%i_pvr_isosurf_ctl, 0) - call bcast_ctl_type_c1 & - & (pvr_iso_ctl%isosurf_type_ctl) - call bcast_ctl_type_r1 & - & (pvr_iso_ctl%iso_value_ctl) + call calypso_mpi_bcast_character & + & (pvr_iso_ctl%block_name, cast_long(kchara), 0) +! + call bcast_ctl_type_c1(pvr_iso_ctl%isosurf_type_ctl) + call bcast_ctl_type_r1(pvr_iso_ctl%iso_value_ctl) call bcast_ctl_type_r1(pvr_iso_ctl%opacity_ctl) ! end subroutine bcast_pvr_isosurface_ctl diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_ctl_data_view_trans.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_ctl_data_view_trans.f90 index 5b9d2c74..a027a741 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_ctl_data_view_trans.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_ctl_data_view_trans.f90 @@ -12,7 +12,7 @@ !! subroutine bcast_quilt_image_ctl(quilt_c) !! type(quilt_image_ctl), intent(inout) :: quilt_c !! subroutine bcast_mul_view_trans_ctl(mul_mats_c) -!! type(multi_modeview_ctl), intent(inout) :: mul_mats_c +!! type(multi_modelview_ctl), intent(inout) :: mul_mats_c !! subroutine bcast_view_transfer_ctl(mat) !! type(modeview_ctl), intent(inout) :: mat !! @@ -56,6 +56,8 @@ subroutine bcast_pvr_moving_view_ctl(movie) ! ! call calypso_mpi_bcast_one_int(movie%i_pvr_rotation, 0) + call calypso_mpi_bcast_character(movie%block_name, & + & cast_long(kchara), 0) ! call bcast_ctl_type_c1(movie%movie_mode_ctl) call bcast_ctl_type_i1(movie%num_frames_ctl) @@ -90,6 +92,8 @@ subroutine bcast_quilt_image_ctl(quilt_c) ! ! call calypso_mpi_bcast_one_int(quilt_c%i_quilt_image, 0) + call calypso_mpi_bcast_character(quilt_c%block_name, & + & cast_long(kchara), 0) ! call bcast_ctl_type_i2(quilt_c%num_column_row_ctl) call bcast_ctl_type_i2(quilt_c%num_row_column_ctl) @@ -108,12 +112,15 @@ subroutine bcast_mul_view_trans_ctl(mul_mats_c) use calypso_mpi_char use transfer_to_long_integers ! - type(multi_modeview_ctl), intent(inout) :: mul_mats_c + type(multi_modelview_ctl), intent(inout) :: mul_mats_c ! integer(kind = kint) :: i, num ! ! call calypso_mpi_bcast_one_int(mul_mats_c%num_modelviews_c, 0) + call calypso_mpi_bcast_character(mul_mats_c%block_name, & + & cast_long(kchara), 0) +! if(mul_mats_c%num_modelviews_c .gt. 0 .and. my_rank .gt. 0) then num = mul_mats_c%num_modelviews_c call alloc_multi_modeview_ctl(mul_mats_c) @@ -132,12 +139,16 @@ end subroutine bcast_mul_view_trans_ctl subroutine bcast_view_transfer_ctl(mat) ! use t_ctl_data_4_view_transfer - use calypso_mpi_int use bcast_control_arrays + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(modeview_ctl), intent(inout) :: mat ! ! + call calypso_mpi_bcast_character(mat%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(mat%i_view_transform, 0) ! call bcast_ctl_array_cr(mat%lookpoint_ctl) @@ -167,12 +178,16 @@ end subroutine bcast_view_transfer_ctl subroutine bcast_image_size_ctl(pixel) ! use t_ctl_data_4_screen_pixel - use calypso_mpi_int use bcast_control_arrays + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(screen_pixel_ctl), intent(inout) :: pixel ! ! + call calypso_mpi_bcast_character(pixel%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(pixel%i_image_size, 0) ! call bcast_ctl_type_i1(pixel%num_xpixel_ctl) @@ -185,12 +200,16 @@ end subroutine bcast_image_size_ctl subroutine bcast_projection_mat_ctl(proj) ! use t_ctl_data_4_projection - use calypso_mpi_int use bcast_control_arrays + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(projection_ctl), intent(inout) :: proj ! ! + call calypso_mpi_bcast_character(proj%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(proj%i_project_mat, 0) ! call bcast_ctl_type_r1(proj%perspective_angle_ctl) @@ -208,12 +227,16 @@ end subroutine bcast_projection_mat_ctl subroutine bcast_stereo_view_ctl(streo) ! use t_ctl_data_4_streo_view - use calypso_mpi_int use bcast_control_arrays + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(streo_view_ctl), intent(inout) :: streo ! ! + call calypso_mpi_bcast_character(streo%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(streo%i_stereo_view, 0) ! call bcast_ctl_type_r1(streo%focalpoint_ctl) diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_ctl_data_viz3.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_ctl_data_viz3.f90 index 26e6fba0..9b9e98b2 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_ctl_data_viz3.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_ctl_data_viz3.f90 @@ -28,6 +28,8 @@ module bcast_ctl_data_viz3 subroutine bcast_viz3_controls(viz3_ctls) ! use t_control_data_viz3 + use transfer_to_long_integers + use calypso_mpi_char use calypso_mpi_int use bcast_control_arrays use bcast_section_control_data @@ -59,6 +61,8 @@ subroutine bcast_viz3_controls(viz3_ctls) ! call bcast_ctl_type_c1(viz3_ctls%output_field_file_fmt_ctl) ! + call calypso_mpi_bcast_character & + & (viz3_ctls%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(viz3_ctls%i_viz_control, 0) ! end subroutine bcast_viz3_controls diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_pvr_color_ctl.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_pvr_color_ctl.f90 index 9dc8931c..1606340c 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_pvr_color_ctl.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/bcast_pvr_color_ctl.f90 @@ -35,18 +35,20 @@ module bcast_pvr_color_ctl subroutine bcast_pvr_colordef_ctl(color) ! use t_ctl_data_pvr_colormap - use calypso_mpi_int use bcast_control_arrays + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(pvr_colormap_ctl), intent(inout) :: color ! ! + call calypso_mpi_bcast_character(color%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(color%i_pvr_colordef, 0) ! call bcast_ctl_array_r2(color%colortbl_ctl) call bcast_ctl_array_r2(color%linear_opacity_ctl) -! - call bcast_ctl_array_r3(color%step_opacity_ctl) ! call bcast_ctl_type_c1(color%lic_color_fld_ctl) call bcast_ctl_type_c1(color%lic_color_comp_ctl) @@ -69,15 +71,20 @@ end subroutine bcast_pvr_colordef_ctl subroutine bcast_lighting_ctl(light) ! use t_ctl_data_pvr_light - use calypso_mpi_int use bcast_control_arrays + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(pvr_light_ctl), intent(inout) :: light ! ! + call calypso_mpi_bcast_character(light%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(light%i_pvr_lighting, 0) ! call bcast_ctl_array_r3(light%light_position_ctl) + call bcast_ctl_array_r3(light%light_sph_posi_ctl) ! call bcast_ctl_type_r1(light%ambient_coef_ctl ) call bcast_ctl_type_r1(light%diffuse_coef_ctl ) @@ -90,12 +97,16 @@ end subroutine bcast_lighting_ctl subroutine bcast_pvr_colorbar_ctl(cbar_ctl) ! use t_ctl_data_pvr_colorbar - use calypso_mpi_int use bcast_control_arrays + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(pvr_colorbar_ctl), intent(inout) :: cbar_ctl ! ! + call calypso_mpi_bcast_character(cbar_ctl%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(cbar_ctl%i_pvr_colorbar, 0) ! call bcast_ctl_type_i1(cbar_ctl%font_size_ctl) @@ -120,12 +131,16 @@ end subroutine bcast_pvr_colorbar_ctl subroutine bcast_pvr_render_area_ctl(render_area_c) ! use t_ctl_data_pvr_area - use calypso_mpi_int use bcast_control_arrays + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(pvr_render_area_ctl), intent(inout) :: render_area_c ! ! + call calypso_mpi_bcast_character(render_area_c%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(render_area_c%i_plot_area, 0) ! call bcast_ctl_array_c1(render_area_c%pvr_area_ctl) diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_each_pvr_IO.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_each_pvr_IO.f90 index a3488109..55765547 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_each_pvr_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_each_pvr_IO.f90 @@ -8,6 +8,7 @@ !! !!@verbatim !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! subroutine init_pvr_ctl_label(hd_block, pvr_ctl) !! subroutine read_pvr_ctl(id_control, hd_block, pvr_ctl, c_buf) !! subroutine read_pvr_update_flag & !! & (id_control, hd_block, pvr_ctl, c_buf) @@ -21,10 +22,6 @@ !! character(len=kchara), intent(in) :: hd_block !! type(pvr_parameter_ctl), intent(in) :: pvr_ctl !! integer(kind = kint), intent(inout) :: level -!! -!! integer(kind = kint) function num_label_pvr_ctl() -!! integer(kind = kint) function num_label_pvr_ctl_w_dup() -!! subroutine set_label_pvr_ctl_w_dup(names) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! example of control for Kemo's volume rendering !! @@ -34,7 +31,7 @@ !! pvr_output_format PNG !! monitoring_mode YES !! -!! streo_imaging YES +!! stereo_imaging YES !! anaglyph_switch NO !! quilt_3d_imaging YES !!! @@ -125,7 +122,7 @@ module ctl_data_each_pvr_IO & :: hd_pvr_monitor = 'monitoring_mode' ! character(len=kchara), parameter, private & - & :: hd_pvr_streo = 'streo_imaging' + & :: hd_pvr_stereo = 'stereo_imaging' character(len=kchara), parameter, private & & :: hd_anaglyph_switch = 'anaglyph_switch' character(len=kchara), parameter, private & @@ -168,11 +165,8 @@ module ctl_data_each_pvr_IO & :: hd_pvr_out_type = 'pvr_output_type' character(len=kchara), parameter, private & & :: hd_pvr_rotation = 'image_rotation_ctl' -! - integer(kind = kint), parameter :: n_label_pvr_ctl = 19 - integer(kind = kint), parameter :: n_label_pvr_ctl_w_dup = 22 -! - private :: n_label_pvr_ctl, n_label_pvr_ctl_w_dup + character(len=kchara), parameter, private & + & :: hd_pvr_streo = 'streo_imaging' ! ! --------------------------------------------------------------------- ! @@ -185,6 +179,7 @@ subroutine read_pvr_ctl(id_control, hd_block, pvr_ctl, c_buf) use ctl_file_pvr_modelview_IO use ctl_file_pvr_light_IO use ctl_data_pvr_movie_IO + use ctl_data_view_transfer_IO ! integer(kind = kint), intent(in) :: id_control character(len=kchara), intent(in) :: hd_block @@ -193,8 +188,8 @@ subroutine read_pvr_ctl(id_control, hd_block, pvr_ctl, c_buf) type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(pvr_ctl%i_pvr_ctl .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return ! do call load_one_line_from_control(id_control, hd_block, c_buf) @@ -242,7 +237,10 @@ subroutine read_pvr_ctl(id_control, hd_block, pvr_ctl, c_buf) & (c_buf, hd_pvr_monitor, pvr_ctl%monitoring_ctl) ! call read_chara_ctl_type & + & (c_buf, hd_pvr_stereo, pvr_ctl%streo_ctl) + call read_chara_ctl_type & & (c_buf, hd_pvr_streo, pvr_ctl%streo_ctl) +! call read_chara_ctl_type & & (c_buf, hd_anaglyph_switch, pvr_ctl%anaglyph_ctl) call read_chara_ctl_type & @@ -309,33 +307,33 @@ subroutine write_pvr_ctl & maxlen = max(maxlen, len_trim(hd_pvr_out_format)) maxlen = max(maxlen, len_trim(hd_pvr_monitor)) maxlen = max(maxlen, len_trim(hd_anaglyph_switch)) - maxlen = max(maxlen, len_trim(hd_pvr_streo)) + maxlen = max(maxlen, len_trim(hd_pvr_stereo)) maxlen = max(maxlen, len_trim(hd_pvr_quilt_3d)) maxlen = max(maxlen, len_trim(hd_output_field_def)) maxlen = max(maxlen, len_trim(hd_output_comp_def)) ! level = write_begin_flag_for_ctl(id_control, level, hd_block) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_pvr_updated, pvr_ctl%updated_ctl) + & pvr_ctl%updated_ctl) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_pvr_file_prefix, pvr_ctl%file_head_ctl) + & pvr_ctl%file_head_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_pvr_out_format, pvr_ctl%file_fmt_ctl) + & pvr_ctl%file_fmt_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_pvr_monitor, pvr_ctl%monitoring_ctl) + & pvr_ctl%monitoring_ctl) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_pvr_streo, pvr_ctl%streo_ctl) + & pvr_ctl%streo_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_anaglyph_switch, pvr_ctl%anaglyph_ctl) + & pvr_ctl%anaglyph_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_pvr_quilt_3d, pvr_ctl%quilt_ctl) + & pvr_ctl%quilt_ctl) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_output_field_def, pvr_ctl%pvr_field_ctl) + & pvr_ctl%pvr_field_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_output_comp_def, pvr_ctl%pvr_comp_ctl) + & pvr_ctl%pvr_comp_ctl) ! call sel_write_ctl_modelview_file(id_control, hd_view_transform, & & pvr_ctl%fname_mat_ctl, pvr_ctl%mat, level) @@ -362,61 +360,60 @@ subroutine write_pvr_ctl & end subroutine write_pvr_ctl ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- -! - integer(kind = kint) function num_label_pvr_ctl() - num_label_pvr_ctl = n_label_pvr_ctl - return - end function num_label_pvr_ctl -! -! --------------------------------------------------------------------- ! - integer(kind = kint) function num_label_pvr_ctl_w_dup() - num_label_pvr_ctl_w_dup = n_label_pvr_ctl_w_dup - return - end function num_label_pvr_ctl_w_dup -! -! --------------------------------------------------------------------- + subroutine init_pvr_ctl_label(hd_block, pvr_ctl) ! - subroutine set_label_pvr_ctl_w_dup(names) -! - use t_read_control_elements -! - character(len = kchara), intent(inout) & - & :: names(n_label_pvr_ctl_w_dup) -! -! - call set_control_labels(hd_pvr_updated, names( 1)) -! - call set_control_labels(hd_pvr_file_prefix, names( 2)) - call set_control_labels(hd_pvr_out_format, names( 3)) - call set_control_labels(hd_pvr_monitor, names( 4)) -! - call set_control_labels(hd_pvr_streo, names( 5)) - call set_control_labels(hd_anaglyph_switch, names( 6)) - call set_control_labels(hd_pvr_quilt_3d, names( 7)) -! - call set_control_labels(hd_output_field_def, names( 8)) - call set_control_labels(hd_output_comp_def, names( 9)) -! - call set_control_labels(hd_plot_area, names(10)) - call set_control_labels(hd_view_transform, names(11)) - call set_control_labels(hd_colormap_file, names(12)) - call set_control_labels(hd_colormap, names(13)) - call set_control_labels(hd_pvr_lighting, names(14)) - call set_control_labels(hd_pvr_colorbar, names(15)) + use ctl_file_pvr_modelview_IO + use ctl_file_pvr_light_IO + use ctl_data_pvr_movie_IO + use ctl_data_view_transfer_IO ! - call set_control_labels(hd_pvr_sections, names(16)) - call set_control_labels(hd_pvr_isosurf, names(17)) - call set_control_labels(hd_quilt_image, names(18)) - call set_control_labels(hd_snapshot_movie, names(19)) + character(len=kchara), intent(in) :: hd_block + type(pvr_parameter_ctl), intent(inout) :: pvr_ctl ! - call set_control_labels(hd_pvr_file_head, names(20)) - call set_control_labels(hd_pvr_out_type, names(21)) - call set_control_labels(hd_pvr_rotation, names(22)) ! - end subroutine set_label_pvr_ctl_w_dup + pvr_ctl%block_name = hd_block + call int_pvr_render_area_ctl(hd_plot_area, pvr_ctl%render_area_c) + call init_pvr_cmap_cbar_label(hd_colormap_file, & + & pvr_ctl%cmap_cbar_c) + call init_view_transfer_ctl_label(hd_view_transform, pvr_ctl%mat) + call init_lighting_ctl_label(hd_pvr_lighting, pvr_ctl%light) + call init_pvr_sections_ctl(hd_pvr_sections, pvr_ctl%pvr_scts_c) + call init_pvr_isosurfs_ctl(hd_pvr_isosurf, pvr_ctl%pvr_isos_c) + call init_quilt_image_ctl_label(hd_quilt_image, pvr_ctl%quilt_c) + call init_pvr_rotation_ctl_label(hd_snapshot_movie, & + & pvr_ctl%movie) +! + call init_chara_ctl_item_label & + & (hd_pvr_updated, pvr_ctl%updated_ctl) +! + call init_chara_ctl_item_label & + & (hd_pvr_file_prefix, pvr_ctl%file_head_ctl) + call init_chara_ctl_item_label & + & (hd_pvr_file_head, pvr_ctl%file_head_ctl) +! + call init_chara_ctl_item_label & + & (hd_pvr_out_format, pvr_ctl%file_fmt_ctl) + call init_chara_ctl_item_label & + & (hd_pvr_out_type, pvr_ctl%file_fmt_ctl) +! + call init_chara_ctl_item_label & + & (hd_pvr_monitor, pvr_ctl%monitoring_ctl) +! + call init_chara_ctl_item_label & + & (hd_pvr_stereo, pvr_ctl%streo_ctl) + call init_chara_ctl_item_label & + & (hd_anaglyph_switch, pvr_ctl%anaglyph_ctl) + call init_chara_ctl_item_label & + & (hd_pvr_quilt_3d, pvr_ctl%quilt_ctl) +! + call init_chara_ctl_item_label & + & (hd_output_field_def, pvr_ctl%pvr_field_ctl) + call init_chara_ctl_item_label & + & (hd_output_comp_def, pvr_ctl%pvr_comp_ctl) +! + end subroutine init_pvr_ctl_label ! -! ---------------------------------------------------------------------- +! --------------------------------------------------------------------- ! end module ctl_data_each_pvr_IO diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_four_vizs_IO.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_four_vizs_IO.f90 index 32f0ef42..28e54aff 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_four_vizs_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_four_vizs_IO.f90 @@ -145,8 +145,13 @@ subroutine s_read_viz4_controls & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(viz_ctls%i_viz_control .gt. 0) return + call init_psf_ctls_labels(hd_section_ctl, viz_ctls%psf_ctls) + call init_iso_ctls_labels(hd_isosurf_ctl, viz_ctls%iso_ctls) + call init_map_ctls_labels(hd_map_rendering, viz_ctls%map_ctls) + call init_pvr_ctls_labels(hd_pvr_ctl, viz_ctls%pvr_ctls) + call init_fline_ctl_struct(hd_fline_ctl, viz_ctls%fline_ctls) + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do call load_one_line_from_control(id_control, hd_block, c_buf) if(c_buf%iend .gt. 0) exit @@ -238,46 +243,46 @@ subroutine write_viz4_controls & ! level = write_begin_flag_for_ctl(id_control, level, hd_block) call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_section, viz_ctls%delta_t_psf_v_ctl) + & viz_ctls%delta_t_psf_v_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_section, viz_ctls%i_step_psf_v_ctl) + & viz_ctls%i_step_psf_v_ctl) call write_files_4_psf_ctl(id_control, hd_section_ctl, & & viz_ctls%psf_ctls, level) ! call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_isosurf, viz_ctls%delta_t_iso_v_ctl) + & viz_ctls%delta_t_iso_v_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_isosurf, viz_ctls%i_step_iso_v_ctl) + & viz_ctls%i_step_iso_v_ctl) call write_files_4_iso_ctl(id_control, hd_isosurf_ctl, & & viz_ctls%iso_ctls, level) ! call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_map_projection, viz_ctls%delta_t_map_v_ctl) + & viz_ctls%delta_t_map_v_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_map_projection, viz_ctls%i_step_map_v_ctl) + & viz_ctls%i_step_map_v_ctl) call write_files_4_map_ctl(id_control, hd_map_rendering, & & viz_ctls%map_ctls, level) ! call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_pvr, viz_ctls%delta_t_pvr_v_ctl) + & viz_ctls%delta_t_pvr_v_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_pvr, viz_ctls%i_step_pvr_v_ctl) + & viz_ctls%i_step_pvr_v_ctl) call write_files_4_pvr_ctl(id_control, hd_pvr_ctl, & & viz_ctls%pvr_ctls, level) ! call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_fline, viz_ctls%delta_t_fline_v_ctl) + & viz_ctls%delta_t_fline_v_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_fline, viz_ctls%i_step_fline_v_ctl) + & viz_ctls%i_step_fline_v_ctl) call write_files_4_fline_ctl(id_control, hd_fline_ctl, & & viz_ctls%fline_ctls, level) ! call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_ucd, viz_ctls%delta_t_ucd_v_ctl) + & viz_ctls%delta_t_ucd_v_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_ucd, viz_ctls%i_step_ucd_v_ctl) + & viz_ctls%i_step_ucd_v_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_output_fld_file_fmt, viz_ctls%output_field_file_fmt_ctl) + & viz_ctls%output_field_file_fmt_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_viz4_controls diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_pvr_colorbar_IO.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_pvr_colorbar_IO.f90 index 885ab022..d6f5efa5 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_pvr_colorbar_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_pvr_colorbar_IO.f90 @@ -7,6 +7,7 @@ !> @brief colormap control data for parallel volume rendering !! !!@verbatim +!! subroutine init_pvr_colorbar_ctl_label(hd_block, cbar_ctl) !! subroutine read_pvr_colorbar_ctl & !! & (id_control, hd_block, cbar_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -19,9 +20,6 @@ !! character(len=kchara), intent(in) :: hd_block !! type(pvr_colorbar_ctl), intent(in) :: cbar_ctl !! integer(kind = kint), intent(inout) :: level -!! -!! integer(kind = kint) function num_label_pvr_colorbar() -!! subroutine set_label_pvr_colorbar(names) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! example of color control for Kemo's volume rendering !! @@ -30,7 +28,7 @@ !! colorbar_switch_ctl ON !! colorbar_scale_ctl ON !! colorbar_position_ctl 'side' or 'bottom' -!! iflag_zeromarker ON +!! zeromarker_switch ON !! colorbar_range 0.0 1.0 !! font_size_ctl 3 !! num_grid_ctl 4 @@ -70,7 +68,7 @@ module ctl_data_pvr_colorbar_IO character(len=kchara), parameter, private & & :: hd_pvr_numgrid_cbar = 'num_grid_ctl' character(len=kchara), parameter, private & - & :: hd_zeromarker_flag = 'iflag_zeromarker' + & :: hd_zeromarker_switch = 'zeromarker_switch' character(len=kchara), parameter, private & & :: hd_cbar_range = 'colorbar_range' ! @@ -81,7 +79,9 @@ module ctl_data_pvr_colorbar_IO character(len=kchara), parameter, private & & :: hd_mapgrid_switch = 'map_grid_switch' ! - integer(kind = kint), parameter :: n_label_pvr_colorbar = 10 +! Deprecated label + character(len=kchara), parameter, private & + & :: hd_zeromarker_flag = 'iflag_zeromarker' ! ! --------------------------------------------------------------------- ! @@ -118,6 +118,9 @@ subroutine read_pvr_colorbar_ctl & & cbar_ctl%colorbar_scale_ctl) call read_chara_ctl_type(c_buf, hd_cbar_position, & & cbar_ctl%colorbar_position_ctl) +! + call read_chara_ctl_type(c_buf, hd_zeromarker_switch, & + & cbar_ctl%zeromarker_flag_ctl) call read_chara_ctl_type(c_buf, hd_zeromarker_flag, & & cbar_ctl%zeromarker_flag_ctl) ! @@ -158,7 +161,7 @@ subroutine write_pvr_colorbar_ctl & maxlen = max(maxlen, len_trim(hd_pvr_numgrid_cbar)) maxlen = max(maxlen, len_trim(hd_colorbar_scale)) maxlen = max(maxlen, len_trim(hd_cbar_position)) - maxlen = max(maxlen, len_trim(hd_zeromarker_flag)) + maxlen = max(maxlen, len_trim(hd_zeromarker_switch)) maxlen = max(maxlen, len_trim(hd_axis_switch)) maxlen = max(maxlen, len_trim(hd_time_switch)) maxlen = max(maxlen, len_trim(hd_mapgrid_switch)) @@ -167,61 +170,67 @@ subroutine write_pvr_colorbar_ctl & level = write_begin_flag_for_ctl(id_control, level, hd_block) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_colorbar_switch, cbar_ctl%colorbar_switch_ctl) + & cbar_ctl%colorbar_switch_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_colorbar_scale, cbar_ctl%colorbar_scale_ctl) + & cbar_ctl%colorbar_scale_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_cbar_position, cbar_ctl%colorbar_position_ctl) + & cbar_ctl%colorbar_position_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_zeromarker_flag, cbar_ctl%zeromarker_flag_ctl) + & cbar_ctl%zeromarker_flag_ctl) call write_real2_ctl_type(id_control, level, maxlen, & - & hd_cbar_range, cbar_ctl%cbar_range_ctl) + & cbar_ctl%cbar_range_ctl) ! call write_integer_ctl_type(id_control, level, maxlen, & - & hd_pvr_font_size, cbar_ctl%font_size_ctl) + & cbar_ctl%font_size_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_pvr_numgrid_cbar, cbar_ctl%ngrid_cbar_ctl) + & cbar_ctl%ngrid_cbar_ctl) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_axis_switch, cbar_ctl%axis_switch_ctl) + & cbar_ctl%axis_switch_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_time_switch, cbar_ctl%time_switch_ctl) + & cbar_ctl%time_switch_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_mapgrid_switch, cbar_ctl%mapgrid_switch_ctl) + & cbar_ctl%mapgrid_switch_ctl) ! level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_pvr_colorbar_ctl ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- ! - integer(kind = kint) function num_label_pvr_colorbar() - num_label_pvr_colorbar = n_label_pvr_colorbar - return - end function num_label_pvr_colorbar + subroutine init_pvr_colorbar_ctl_label(hd_block, cbar_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(pvr_colorbar_ctl), intent(inout) :: cbar_ctl ! -! ---------------------------------------------------------------------- ! - subroutine set_label_pvr_colorbar(names) + cbar_ctl%block_name = hd_block + call init_int_ctl_item_label & + & (hd_pvr_font_size, cbar_ctl%font_size_ctl) + call init_int_ctl_item_label(hd_pvr_numgrid_cbar, & + & cbar_ctl%ngrid_cbar_ctl) ! - character(len = kchara), intent(inout) & - & :: names(n_label_pvr_colorbar) ! + call init_chara_ctl_item_label(hd_colorbar_switch, & + & cbar_ctl%colorbar_switch_ctl) + call init_chara_ctl_item_label(hd_colorbar_scale, & + & cbar_ctl%colorbar_scale_ctl) + call init_chara_ctl_item_label(hd_cbar_position, & + & cbar_ctl%colorbar_position_ctl) + call init_chara_ctl_item_label(hd_zeromarker_switch, & + & cbar_ctl%zeromarker_flag_ctl) ! - call set_control_labels(hd_colorbar_switch, names( 1)) - call set_control_labels(hd_colorbar_scale, names( 2)) - call set_control_labels(hd_cbar_position, names( 3)) - call set_control_labels(hd_pvr_font_size, names( 4)) - call set_control_labels(hd_pvr_numgrid_cbar, names( 5)) - call set_control_labels(hd_zeromarker_flag, names( 6)) - call set_control_labels(hd_cbar_range, names( 7)) + call init_chara_ctl_item_label(hd_axis_switch, & + & cbar_ctl%axis_switch_ctl) + call init_chara_ctl_item_label(hd_time_switch, & + & cbar_ctl%time_switch_ctl) + call init_chara_ctl_item_label(hd_mapgrid_switch, & + & cbar_ctl%mapgrid_switch_ctl) ! - call set_control_labels(hd_axis_switch, names( 8)) - call set_control_labels(hd_time_switch, names( 9)) - call set_control_labels(hd_mapgrid_switch, names(10)) + call init_real2_ctl_item_label & + & (hd_cbar_range, cbar_ctl%cbar_range_ctl) ! - end subroutine set_label_pvr_colorbar + end subroutine init_pvr_colorbar_ctl_label ! ! --------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_pvr_colormap_IO.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_pvr_colormap_IO.f90 index 8358e32a..0586d5a6 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_pvr_colormap_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_pvr_colormap_IO.f90 @@ -7,6 +7,7 @@ !> @brief colormap control data for parallel volume rendering !! !!@verbatim +!! subroutine init_pvr_colordef_ctl_labels(hd_block, color) !! subroutine read_pvr_colordef_ctl & !! & (id_control, hd_block, color, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -19,11 +20,6 @@ !! character(len=kchara), intent(in) :: hd_block !! type(pvr_colormap_ctl), intent(in) :: color !! integer(kind = kint), intent(inout) :: level -!! -!! integer(kind = kint) function num_label_pvr_colormap() -!! integer(kind = kint) function num_label_LIC_colormap() -!! subroutine set_label_pvr_colormap(names) -!! subroutine set_label_LIC_colormap(names) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! example of color control for Kemo's volume rendering !! @@ -54,16 +50,6 @@ !! linear_opacity_ctl 0.85 0.01 !! linear_opacity_ctl 0.95 0.001 !! end array linear_opacity_ctl -!! -!! array step_opacity_ctl 7 -!! step_opacity_ctl 0.0 0.01 0.01 -!! step_opacity_ctl 0.01 0.2 0.015 -!! step_opacity_ctl 0.2 0.35 0.02 -!! step_opacity_ctl 0.6 0.7 0.04 -!! step_opacity_ctl 0.7 0.85 0.03 -!! step_opacity_ctl 0.85 0.95 0.01 -!! step_opacity_ctl 0.95 1.0 0.001 -!! end array step_opacity_ctl !! constant_opacity_ctl 0.003 !!! !! range_min_ctl 0.0 @@ -120,13 +106,6 @@ module ctl_data_pvr_colormap_IO & :: hd_constant_opacity = 'constant_opacity_ctl' character(len=kchara), parameter, private & & :: hd_linear_opacity = 'linear_opacity_ctl' - character(len=kchara), parameter, private & - & :: hd_opacity_def = 'step_opacity_ctl' -! - integer(kind = kint), parameter :: n_label_pvr_colormap = 10 - integer(kind = kint), parameter :: n_label_lic_colormap = 14 -! - private :: n_label_pvr_colormap, n_label_lic_colormap ! ! --------------------------------------------------------------------- ! @@ -156,9 +135,6 @@ subroutine read_pvr_colordef_ctl & & color%colortbl_ctl, c_buf) call read_control_array_r2(id_control, hd_linear_opacity, & & color%linear_opacity_ctl, c_buf) -! - call read_control_array_r3(id_control, hd_opacity_def, & - & color%step_opacity_ctl, c_buf) ! call read_chara_ctl_type & & (c_buf, hd_lic_color_fld, color%lic_color_fld_ctl) @@ -221,109 +197,79 @@ subroutine write_pvr_colordef_ctl & ! level = write_begin_flag_for_ctl(id_control, level, hd_block) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_colormap_mode, color%colormap_mode_ctl) + & color%colormap_mode_ctl) call write_real3_ctl_type(id_control, level, maxlen, & - & hd_background_color, color%background_color_ctl) + & color%background_color_ctl) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_lic_color_fld, color%lic_color_fld_ctl) + & color%lic_color_fld_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_lic_color_comp, color%lic_color_comp_ctl) + & color%lic_color_comp_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_lic_opacity_fld, color%lic_opacity_fld_ctl) + & color%lic_opacity_fld_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_lic_opacity_comp, color%lic_opacity_comp_ctl) + & color%lic_opacity_comp_ctl) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_data_mapping, color%data_mapping_ctl) + & color%data_mapping_ctl) call write_control_array_r2(id_control, level, & - & hd_colortable, color%colortbl_ctl) + & color%colortbl_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_opacity_style, color%opacity_style_ctl) + & color%opacity_style_ctl) call write_control_array_r2(id_control, level, & - & hd_linear_opacity, color%linear_opacity_ctl) - call write_control_array_r3(id_control, level, & - & hd_opacity_def, color%step_opacity_ctl) + & color%linear_opacity_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_constant_opacity, color%fix_opacity_ctl) + & color%fix_opacity_ctl) ! call write_real_ctl_type(id_control, level, maxlen, & - & hd_pvr_range_min, color%range_min_ctl) + & color%range_min_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_pvr_range_max, color%range_max_ctl) + & color%range_max_ctl) ! level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_pvr_colordef_ctl ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- -! - integer(kind = kint) function num_label_pvr_colormap() - num_label_pvr_colormap = n_label_pvr_colormap - return - end function num_label_pvr_colormap -! -! --------------------------------------------------------------------- -! - integer(kind = kint) function num_label_LIC_colormap() - num_label_LIC_colormap = n_label_lic_colormap - return - end function num_label_LIC_colormap -! -! ---------------------------------------------------------------------- -! - subroutine set_label_pvr_colormap(names) -! - character(len = kchara), intent(inout) & - & :: names(n_label_pvr_colormap) -! -! - call set_control_labels(hd_colormap_mode, names( 1)) ! - call set_control_labels(hd_data_mapping, names( 2)) - call set_control_labels(hd_pvr_range_min, names( 3)) - call set_control_labels(hd_pvr_range_max, names( 4)) - call set_control_labels(hd_colortable, names( 5)) -! - call set_control_labels(hd_opacity_style, names( 6)) - call set_control_labels(hd_constant_opacity, names( 7)) - call set_control_labels(hd_linear_opacity, names( 8)) - call set_control_labels(hd_opacity_def, names( 9)) -! - call set_control_labels(hd_background_color, names(10)) -! - end subroutine set_label_pvr_colormap -! -! ---------------------------------------------------------------------- -! - subroutine set_label_LIC_colormap(names) -! - character(len = kchara), intent(inout) & - & :: names(n_label_lic_colormap) -! -! - call set_control_labels(hd_colormap_mode, names( 1)) -! - call set_control_labels(hd_lic_color_fld, names( 2)) - call set_control_labels(hd_lic_color_comp, names( 3)) - call set_control_labels(hd_lic_opacity_fld, names( 4)) - call set_control_labels(hd_lic_opacity_comp, names( 5)) + subroutine init_pvr_colordef_ctl_labels(hd_block, color) ! + character(len=kchara), intent(in) :: hd_block + type(pvr_colormap_ctl), intent(inout) :: color ! - call set_control_labels(hd_data_mapping, names( 6)) - call set_control_labels(hd_pvr_range_min, names( 7)) - call set_control_labels(hd_pvr_range_max, names( 8)) - call set_control_labels(hd_colortable, names( 9)) ! - call set_control_labels(hd_opacity_style, names(10)) - call set_control_labels(hd_constant_opacity, names(11)) - call set_control_labels(hd_linear_opacity, names(12)) - call set_control_labels(hd_opacity_def, names(13)) + color%block_name = hd_block + call init_r2_ctl_array_label(hd_colortable, & + & color%colortbl_ctl) + call init_r2_ctl_array_label(hd_linear_opacity, & + & color%linear_opacity_ctl) +! + call init_chara_ctl_item_label & + & (hd_lic_color_fld, color%lic_color_fld_ctl) + call init_chara_ctl_item_label & + & (hd_lic_color_comp, color%lic_color_comp_ctl) + call init_chara_ctl_item_label & + & (hd_lic_opacity_fld, color%lic_opacity_fld_ctl) + call init_chara_ctl_item_label & + & (hd_lic_opacity_comp, color%lic_opacity_comp_ctl) +! + call init_chara_ctl_item_label & + & (hd_colormap_mode, color%colormap_mode_ctl) + call init_chara_ctl_item_label & + & (hd_data_mapping, color%data_mapping_ctl) + call init_chara_ctl_item_label(hd_opacity_style, & + & color%opacity_style_ctl) ! - call set_control_labels(hd_background_color, names(14)) + call init_real_ctl_item_label(hd_pvr_range_min, & + & color%range_min_ctl) + call init_real_ctl_item_label(hd_pvr_range_max, & + & color%range_max_ctl) + call init_real_ctl_item_label(hd_constant_opacity, & + & color%fix_opacity_ctl) + call init_real3_ctl_item_label & + & (hd_background_color, color%background_color_ctl) ! - end subroutine set_label_LIC_colormap + end subroutine init_pvr_colordef_ctl_labels ! ! --------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_pvr_movie_IO.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_pvr_movie_IO.f90 index adbeb210..808dad58 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_pvr_movie_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_pvr_movie_IO.f90 @@ -8,6 +8,7 @@ !! !!@verbatim !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! subroutine init_pvr_rotation_ctl_label(hd_block, movie) !! subroutine read_pvr_rotation_ctl & !! & (id_control, hd_block, movie, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -20,11 +21,6 @@ !! character(len=kchara), intent(in) :: hd_block !! type(pvr_movie_ctl), intent(in) :: movie !! integer(kind = kint), intent(inout) :: level -!! -!! integer(kind = kint) function num_label_pvr_movie() -!! integer(kind = kint) function num_label_LIC_movie() -!! subroutine set_label_pvr_movie(names) -!! subroutine set_label_LIC_movie(names) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! Avaiable parameters for movie_mode_ctl: !! rotation, zoom, view_matrices, LIC_kernel, looking_glass @@ -101,11 +97,6 @@ module ctl_data_pvr_movie_IO & :: hd_apature_range = 'apature_range' character(len=kchara), parameter, private & & :: hd_LIC_kernel_peak = 'LIC_kernel_peak_range' -! - integer(kind = kint), parameter :: n_label_pvr_movie = 8 - integer(kind = kint), parameter :: n_label_LIC_movie = 9 -! - private :: n_label_pvr_movie, n_label_LIC_movie ! ! --------------------------------------------------------------------- ! @@ -118,6 +109,7 @@ subroutine read_pvr_rotation_ctl & ! use ctl_file_pvr_modelview_IO use write_control_elements + use ctl_data_view_transfer_IO ! integer(kind = kint), intent(in) :: id_control character(len=kchara), intent(in) :: hd_block @@ -125,8 +117,8 @@ subroutine read_pvr_rotation_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! + if(movie%i_pvr_rotation.gt.0) return if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return - if (movie%i_pvr_rotation.gt.0) return do call load_one_line_from_control(id_control, hd_block, c_buf) if(c_buf%iend .gt. 0) exit @@ -188,12 +180,12 @@ subroutine write_pvr_rotation_ctl & ! level = write_begin_flag_for_ctl(id_control, level, hd_block) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_movie_mode, movie%movie_mode_ctl) + & movie%movie_mode_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_movie_num_frame, movie%num_frames_ctl) + & movie%num_frames_ctl) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_movie_rot_axis, movie%rotation_axis_ctl) + & movie%rotation_axis_ctl) ! write(*,'(2a)', ADVANCE='NO') '! ', trim(hd_start_view_control) call sel_write_ctl_modelview_file & @@ -208,76 +200,51 @@ subroutine write_pvr_rotation_ctl & & (id_control, hd_mview_transform, movie%mul_mmats_c, level) ! call write_real2_ctl_type(id_control, level, maxlen, & - & hd_angle_range, movie%angle_range_ctl) + & movie%angle_range_ctl) call write_real2_ctl_type(id_control, level, maxlen, & - & hd_apature_range, movie%apature_range_ctl) + & movie%apature_range_ctl) call write_real2_ctl_type(id_control, level, maxlen, & - & hd_LIC_kernel_peak, movie%LIC_kernel_peak_range_ctl) + & movie%LIC_kernel_peak_range_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_pvr_rotation_ctl ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- -! - integer(kind = kint) function num_label_pvr_movie() - num_label_pvr_movie = n_label_pvr_movie - return - end function num_label_pvr_movie -! -! --------------------------------------------------------------------- -! - integer(kind = kint) function num_label_LIC_movie() - num_label_LIC_movie = n_label_LIC_movie - return - end function num_label_LIC_movie -! -! --------------------------------------------------------------------- -! - subroutine set_label_pvr_movie(names) -! - character(len = kchara), intent(inout) & - & :: names(n_label_pvr_movie) -! -! - call set_control_labels(hd_movie_mode, names( 1)) - call set_control_labels(hd_movie_num_frame, names( 2)) -! - call set_control_labels(hd_movie_rot_axis, names( 3)) ! - call set_control_labels(hd_start_view_control, names( 4)) - call set_control_labels(hd_end_view_control, names( 5)) - call set_control_labels(hd_mview_transform, names( 6)) + subroutine init_pvr_rotation_ctl_label(hd_block, movie) ! - call set_control_labels(hd_angle_range, names( 7)) - call set_control_labels(hd_apature_range, names( 8)) -! - end subroutine set_label_pvr_movie -! -! ---------------------------------------------------------------------- -! - subroutine set_label_LIC_movie(names) -! - character(len = kchara), intent(inout) & - & :: names(n_label_LIC_movie) + use ctl_file_pvr_modelview_IO + use ctl_data_view_transfer_IO ! + character(len=kchara), intent(in) :: hd_block + type(pvr_movie_ctl), intent(inout) :: movie ! - call set_control_labels(hd_movie_mode, names( 1)) - call set_control_labels(hd_movie_num_frame, names( 2)) ! - call set_control_labels(hd_movie_rot_axis, names( 3)) + movie%block_name = hd_block + call init_view_transfer_ctl_label(hd_start_view_control, & + & movie%view_start_ctl) + call init_view_transfer_ctl_label(hd_end_view_control, & + & movie%view_end_ctl) + call init_multi_modeview_ctl(hd_mview_transform, & + & movie%mul_mmats_c) ! - call set_control_labels(hd_start_view_control, names( 4)) - call set_control_labels(hd_end_view_control, names( 5)) - call set_control_labels(hd_mview_transform, names( 6)) + call init_chara_ctl_item_label(hd_movie_mode, & + & movie%movie_mode_ctl) ! - call set_control_labels(hd_angle_range, names( 7)) - call set_control_labels(hd_apature_range, names( 8)) + call init_int_ctl_item_label(hd_movie_num_frame, & + & movie%num_frames_ctl) + call init_chara_ctl_item_label(hd_movie_rot_axis, & + & movie%rotation_axis_ctl) ! - call set_control_labels(hd_LIC_kernel_peak, names( 9)) + call init_real2_ctl_item_label(hd_angle_range, & + & movie%angle_range_ctl) + call init_real2_ctl_item_label(hd_apature_range, & + & movie%apature_range_ctl) + call init_real2_ctl_item_label(hd_LIC_kernel_peak, & + & movie%LIC_kernel_peak_range_ctl) ! - end subroutine set_label_LIC_movie + end subroutine init_pvr_rotation_ctl_label ! -! ---------------------------------------------------------------------- +! --------------------------------------------------------------------- ! end module ctl_data_pvr_movie_IO diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_three_vizs_IO.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_three_vizs_IO.f90 index d04bf530..a4fd4be8 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_three_vizs_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_three_vizs_IO.f90 @@ -7,6 +7,7 @@ !> @brief Control data structure for visualization controls !! !!@verbatim +!! subroutine init_viz3_ctl_label(hd_block, viz3_ctls) !! subroutine s_read_viz3_controls(id_control, viz3_ctls, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block @@ -130,8 +131,12 @@ subroutine s_read_viz3_controls & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(viz3_ctls%i_viz_control .gt. 0) return + call init_psf_ctls_labels(hd_section_ctl, viz3_ctls%psf_ctls) + call init_iso_ctls_labels(hd_isosurf_ctl, viz3_ctls%iso_ctls) + call init_map_ctls_labels(hd_map_rendering, viz3_ctls%map_ctls) + call init_pvr_ctls_labels(hd_pvr_ctl, viz3_ctls%pvr_ctls) + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do call load_one_line_from_control(id_control, hd_block, c_buf) if(c_buf%iend .gt. 0) exit @@ -213,42 +218,88 @@ subroutine write_viz3_controls & ! level = write_begin_flag_for_ctl(id_control, level, hd_block) call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_section, viz3_ctls%delta_t_psf_v_ctl) + & viz3_ctls%delta_t_psf_v_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_section, viz3_ctls%i_step_psf_v_ctl) + & viz3_ctls%i_step_psf_v_ctl) call write_files_4_psf_ctl(id_control, hd_section_ctl, & & viz3_ctls%psf_ctls, level) ! call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_isosurf, viz3_ctls%delta_t_iso_v_ctl) + & viz3_ctls%delta_t_iso_v_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_isosurf, viz3_ctls%i_step_iso_v_ctl) + & viz3_ctls%i_step_iso_v_ctl) ! call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_map_projection, viz3_ctls%delta_t_map_v_ctl) + & viz3_ctls%delta_t_map_v_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_map_projection, viz3_ctls%i_step_map_v_ctl) + & viz3_ctls%i_step_map_v_ctl) call write_files_4_map_ctl(id_control, hd_map_rendering, & & viz3_ctls%map_ctls, level) ! call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_pvr, viz3_ctls%delta_t_pvr_v_ctl) + & viz3_ctls%delta_t_pvr_v_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_pvr, viz3_ctls%i_step_pvr_v_ctl) + & viz3_ctls%i_step_pvr_v_ctl) call write_files_4_pvr_ctl(id_control, hd_pvr_ctl, & & viz3_ctls%pvr_ctls, level) ! call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_ucd, viz3_ctls%delta_t_ucd_v_ctl) + & viz3_ctls%delta_t_ucd_v_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_ucd, viz3_ctls%i_step_ucd_v_ctl) + & viz3_ctls%i_step_ucd_v_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_output_fld_file_fmt, viz3_ctls%output_field_file_fmt_ctl) + & viz3_ctls%output_field_file_fmt_ctl) ! level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_viz3_controls ! ! --------------------------------------------------------------------- +! + subroutine init_viz3_ctl_label(hd_block, viz3_ctls) +! + use ctl_file_sections_IO + use ctl_file_isosurfaces_IO + use ctl_file_map_renderings_IO + use ctl_file_fieldlines_IO +! + character(len=kchara), intent(in) :: hd_block + type(vis3_controls), intent(inout) :: viz3_ctls +! +! + viz3_ctls%block_name = hd_block + call init_psf_ctls_labels(hd_section_ctl, viz3_ctls%psf_ctls) + call init_iso_ctls_labels(hd_isosurf_ctl, viz3_ctls%iso_ctls) + call init_map_ctls_labels(hd_map_rendering, viz3_ctls%map_ctls) + call init_pvr_ctls_labels(hd_pvr_ctl, viz3_ctls%pvr_ctls) +! + call init_int_ctl_item_label(hd_i_step_section, & + & viz3_ctls%i_step_psf_v_ctl) + call init_int_ctl_item_label(hd_i_step_isosurf, & + & viz3_ctls%i_step_iso_v_ctl) + call init_int_ctl_item_label(hd_i_step_map_projection, & + & viz3_ctls%i_step_map_v_ctl) + call init_int_ctl_item_label(hd_i_step_pvr, & + & viz3_ctls%i_step_pvr_v_ctl) + call init_int_ctl_item_label(hd_i_step_ucd, & + & viz3_ctls%i_step_ucd_v_ctl) +! + call init_real_ctl_item_label(hd_delta_t_section, & + & viz3_ctls%delta_t_psf_v_ctl) + call init_real_ctl_item_label(hd_delta_t_isosurf, & + & viz3_ctls%delta_t_iso_v_ctl) + call init_real_ctl_item_label(hd_delta_t_map_projection, & + & viz3_ctls%delta_t_map_v_ctl) + call init_real_ctl_item_label(hd_delta_t_pvr, & + & viz3_ctls%delta_t_pvr_v_ctl) + call init_real_ctl_item_label(hd_delta_t_ucd, & + & viz3_ctls%delta_t_ucd_v_ctl) +! + call init_chara_ctl_item_label(hd_output_fld_file_fmt, & + & viz3_ctls%output_field_file_fmt_ctl) +! + end subroutine init_viz3_ctl_label +! +! --------------------------------------------------------------------- ! end module ctl_data_three_vizs_IO diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_view_transfer_IO.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_view_transfer_IO.f90 index 64de15f3..4fba282d 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_view_transfer_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_data_view_transfer_IO.f90 @@ -7,6 +7,7 @@ !>@brief Control inputs for PVR view parameter !! !!@verbatim +!! subroutine init_view_transfer_ctl_label(hd_block, mat) !! subroutine read_view_transfer_ctl & !! & (id_control, hd_block, mat, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -20,8 +21,6 @@ !! type(modeview_ctl), intent(in) :: mat !! integer(kind = kint), intent(inout) :: level !! -!! integer(kind = kint) function num_label_pvr_modelview() -!! subroutine set_label_pvr_modelview(names) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! Input example ! @@ -165,9 +164,6 @@ module ctl_data_view_transfer_IO & :: hd_view_point = 'viewpoint_ctl' character(len=kchara), parameter, private & & :: hd_viewpt_in_view = 'viewpoint_in_viewer_ctl' -! - integer(kind = kint), parameter :: n_label_pvr_modelview = 13 - private :: n_label_pvr_modelview ! ! --------------------------------------------------------------------- ! @@ -185,8 +181,8 @@ subroutine read_view_transfer_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(mat%i_view_transform .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do call load_one_line_from_control(id_control, hd_block, c_buf) if(c_buf%iend .gt. 0) exit @@ -259,7 +255,7 @@ subroutine write_view_transfer_ctl & ! level = write_begin_flag_for_ctl(id_control, level, hd_block) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_projection_type, mat%projection_type_ctl) + & mat%projection_type_ctl) call write_projection_mat_ctl & & (id_control, hd_project_mat, mat%proj, level) call write_image_size_ctl & @@ -268,66 +264,77 @@ subroutine write_view_transfer_ctl & & (id_control, hd_stereo_view, mat%streo, level) ! call write_control_array_c_r(id_control, level, & - & hd_look_point, mat%lookpoint_ctl) + & mat%lookpoint_ctl) call write_control_array_c_r(id_control, level, & - & hd_eye_position, mat%viewpoint_ctl) + & mat%viewpoint_ctl) call write_control_array_c_r(id_control, level, & - & hd_up_dir, mat%up_dir_ctl) + & mat%up_dir_ctl) ! call write_control_array_c_r(id_control, level, & - & hd_view_rot_dir, mat%view_rot_vec_ctl) + & mat%view_rot_vec_ctl) call write_control_array_c_r(id_control, level, & - & hd_scale_fac_dir, mat%scale_vector_ctl) + & mat%scale_vector_ctl) call write_control_array_c_r(id_control, level, & - & hd_eye_in_view, mat%viewpt_in_viewer_ctl) + & mat%viewpt_in_viewer_ctl) ! call write_control_array_c2_r(id_control, level, & - & hd_model_mat, mat%modelview_mat_ctl) + & mat%modelview_mat_ctl) ! call write_real_ctl_type(id_control, level, maxlen, & - & hd_view_rot_deg, mat%view_rotation_deg_ctl) + & mat%view_rotation_deg_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_scale_factor, mat%scale_factor_ctl) + & mat%scale_factor_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_view_transfer_ctl ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- ! - integer(kind = kint) function num_label_pvr_modelview() - num_label_pvr_modelview = n_label_pvr_modelview - return - end function num_label_pvr_modelview + subroutine init_view_transfer_ctl_label(hd_block, mat) ! -! --------------------------------------------------------------------- + character(len=kchara), intent(in) :: hd_block ! - subroutine set_label_pvr_modelview(names) + type(modeview_ctl), intent(inout) :: mat ! - character(len = kchara), intent(inout) & - & :: names(n_label_pvr_modelview) ! + mat%block_name = hd_block + call init_image_size_ctl_label(hd_image_size, mat%pixel) + call init_projection_mat_ctl_label(hd_project_mat, mat%proj) + call init_stereo_view_ctl_label(hd_stereo_view, mat%streo) ! - call set_control_labels(hd_image_size, names( 1)) + call init_c_r_ctl_array_label & + & (hd_look_point, mat%lookpoint_ctl) ! - call set_control_labels(hd_look_point, names( 2)) - call set_control_labels(hd_eye_position, names( 3)) - call set_control_labels(hd_up_dir, names( 4)) - call set_control_labels(hd_view_rot_dir, names( 5)) - call set_control_labels(hd_view_rot_deg, names( 6)) + call init_c_r_ctl_array_label & + & (hd_eye_position, mat%viewpoint_ctl) + call init_c_r_ctl_array_label & + & (hd_view_point, mat%viewpoint_ctl) ! - call set_control_labels(hd_scale_factor, names( 7)) - call set_control_labels(hd_scale_fac_dir, names( 8)) - call set_control_labels(hd_eye_in_view, names( 9)) + call init_c_r_ctl_array_label & + & (hd_up_dir, mat%up_dir_ctl) ! - call set_control_labels(hd_project_mat, names(10)) - call set_control_labels(hd_model_mat, names(11)) + call init_c_r_ctl_array_label & + & (hd_view_rot_dir, mat%view_rot_vec_ctl) + call init_c_r_ctl_array_label & + & (hd_scale_fac_dir, mat%scale_vector_ctl) ! - call set_control_labels(hd_stereo_view, names(12)) - call set_control_labels(hd_projection_type, names(13)) + call init_c_r_ctl_array_label & + & (hd_eye_in_view, mat%viewpt_in_viewer_ctl) + call init_c_r_ctl_array_label & + & (hd_viewpt_in_view, mat%viewpt_in_viewer_ctl) ! - end subroutine set_label_pvr_modelview + call init_c2_r_ctl_array_label & + & (hd_model_mat, mat%modelview_mat_ctl) ! -! ---------------------------------------------------------------------- + call init_real_ctl_item_label(hd_view_rot_deg, & + & mat%view_rotation_deg_ctl) + call init_real_ctl_item_label(hd_scale_factor, & + & mat%scale_factor_ctl) + call init_chara_ctl_item_label(hd_projection_type, & + & mat%projection_type_ctl) +! + end subroutine init_view_transfer_ctl_label +! +! --------------------------------------------------------------------- ! end module ctl_data_view_transfer_IO diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_file_each_pvr_IO.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_file_each_pvr_IO.f90 index a3822ac1..bc31a156 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_file_each_pvr_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_file_each_pvr_IO.f90 @@ -31,7 +31,6 @@ module ctl_file_each_pvr_IO ! use m_precision - use calypso_mpi ! use t_control_data_4_pvr ! @@ -106,7 +105,7 @@ subroutine read_control_pvr_update(id_control, fname_pvr_ctl, & & hd_pvr_ctl, pvr_ctl_type) ! use ctl_data_each_pvr_IO - use bcast_control_data_4_pvr + use skip_comment_f ! integer(kind = kint), intent(in) :: id_control character(len = kchara), intent(in) :: fname_pvr_ctl @@ -115,7 +114,7 @@ subroutine read_control_pvr_update(id_control, fname_pvr_ctl, & ! type(buffer_for_control) :: c_buf1 ! - if(fname_pvr_ctl .eq. 'NO_FILE') return + if(no_file_flag(fname_pvr_ctl)) return ! c_buf1%level = 0 open(id_control, file=fname_pvr_ctl, status='old') @@ -130,12 +129,7 @@ subroutine read_control_pvr_update(id_control, fname_pvr_ctl, & if(pvr_ctl_type%i_pvr_ctl .gt. 0) exit end do close(id_control) -! - call bcast_pvr_update_flag(pvr_ctl_type) -! - if(c_buf1%iend .gt. 0) then - call calypso_MPI_abort(c_buf1%iend, 'control file is broken') - end if + if(c_buf1%iend .gt. 0) pvr_ctl_type%i_pvr_ctl = - c_buf1%iend ! end subroutine read_control_pvr_update ! @@ -147,6 +141,7 @@ subroutine sel_write_control_pvr(id_control, hd_pvr_ctl, & ! use ctl_data_each_pvr_IO use write_control_elements + use skip_comment_f ! integer(kind = kint), intent(in) :: id_control character(len = kchara), intent(in) :: fname_pvr_ctl @@ -155,7 +150,7 @@ subroutine sel_write_control_pvr(id_control, hd_pvr_ctl, & integer(kind = kint), intent(inout) :: level ! ! - if(cmp_no_case(fname_pvr_ctl, 'NO_FILE')) then + if(no_file_flag(fname_pvr_ctl)) then write(*,'(a)') ' is included.' call write_pvr_ctl(id_control, hd_pvr_ctl, & & pvr_ctl_type, level) diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_file_pvr_light_IO.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_file_pvr_light_IO.f90 index 57343b43..5eb8f2ff 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_file_pvr_light_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_file_pvr_light_IO.f90 @@ -79,7 +79,7 @@ subroutine sel_read_ctl_pvr_light_file & ! call write_one_ctl_file_message & & (hd_block, c_buf%level, file_name) - call read_control_pvr_light_file(id_control+1, file_name, & + call read_control_pvr_light_file(id_control+2, file_name, & & hd_block, light, c_buf) else if(check_begin_flag(c_buf, hd_block)) then file_name = 'NO_FILE' @@ -105,7 +105,7 @@ subroutine sel_write_ctl_pvr_light_file & integer(kind = kint), intent(inout) :: level ! ! - if(cmp_no_case(file_name, 'NO_FILE')) then + if(no_file_flag(file_name)) then call write_lighting_ctl(id_control, hd_block, light, level) else if(id_control .eq. id_monitor) then write(*,'(4a)') '! ', trim(hd_block), & @@ -114,7 +114,7 @@ subroutine sel_write_ctl_pvr_light_file & else write(*,'(4a)') 'Write file for ', trim(hd_block), & & ' ... ', trim(file_name) - call write_control_pvr_light_file(id_control+1, file_name, & + call write_control_pvr_light_file(id_control+2, file_name, & & hd_block, light) call write_file_name_for_ctl_line(id_control, level, & & hd_block, file_name) diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_file_pvr_modelview_IO.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_file_pvr_modelview_IO.f90 index effb9528..71f7874e 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_file_pvr_modelview_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/ctl_file_pvr_modelview_IO.f90 @@ -149,7 +149,7 @@ subroutine sel_read_ctl_modelview_file & ! call write_multi_ctl_file_message(hd_block, icou, c_buf%level) write(*,'(2a)') ' is read from ... ', trim(file_name) - call read_control_modelview_file(id_control+1, file_name, & + call read_control_modelview_file(id_control+2, file_name, & & hd_block, mat, c_buf) else if(check_begin_flag(c_buf, hd_block)) then file_name = 'NO_FILE' @@ -176,7 +176,7 @@ subroutine sel_write_ctl_modelview_file & integer(kind = kint), intent(inout) :: level ! ! - if(cmp_no_case(file_name, 'NO_FILE')) then + if(no_file_flag(file_name)) then write(*,'(3a)') '! ', trim(hd_block), ' is included' call write_view_transfer_ctl(id_control, hd_block, mat, level) else if(id_control .eq. id_monitor) then @@ -186,7 +186,7 @@ subroutine sel_write_ctl_modelview_file & else write(*,'(4a)') 'Write file for ', trim(hd_block), & & '... ', trim(file_name) - call write_control_modelview_file(id_control+1, file_name, & + call write_control_modelview_file(id_control+2, file_name, & & hd_block, mat) call write_file_name_for_ctl_line(id_control, level, & & hd_block, file_name) diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/draw_pvr_colorbar.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/draw_pvr_colorbar.f90 index 0a5217a3..231150c1 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/draw_pvr_colorbar.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/draw_pvr_colorbar.f90 @@ -25,8 +25,6 @@ module draw_pvr_colorbar ! implicit none ! -! - integer(kind = kint), parameter, private :: BAR_WIDTH = 12 ! private :: draw_bottom_pvr_colorbar, gen_bottom_colormark private :: draw_left_pvr_colorbar, gen_right_colormark @@ -50,16 +48,9 @@ subroutine set_pvr_timelabel(time, num_pixel, n_pvr_pixel, & ! real(kind = kreal), intent(inout) :: rgba_gl(4,num_pixel) ! -! - integer(kind = kint):: isleeve_bar -! -! - isleeve_bar = BAR_WIDTH + 6 + 8 * 9 * cbar_param%iscale_font - isleeve_bar = isleeve_bar + ithree & - & - mod((isleeve_bar-ione),ifour) ! call gen_time_label(cbar_param%iscale_font, time, & - & n_pvr_pixel, isleeve_bar, num_pixel, rgba_gl) + & n_pvr_pixel, num_pixel, rgba_gl) ! end subroutine set_pvr_timelabel ! @@ -128,7 +119,7 @@ subroutine draw_bottom_pvr_colorbar & integer(kind = kint):: isleeve_bar ! ! - isleeve_bar = BAR_WIDTH + 6 + 8 * 9 + isleeve_bar = l_bar_width() + 6 + 8 * 9 isleeve_bar = isleeve_bar + 8 & & - mod((isleeve_bar-ione),ifour) ! @@ -173,7 +164,7 @@ subroutine draw_left_pvr_colorbar & integer(kind = kint):: isleeve_bar ! ! - isleeve_bar = BAR_WIDTH + 6 + 8 * 9 * iscale + isleeve_bar = (l_bar_width() + 6 + 8 * 9) * iscale isleeve_bar = isleeve_bar + ithree & & - mod((isleeve_bar-ione),ifour) ! @@ -215,7 +206,7 @@ subroutine gen_bottom_colormark & ! real(kind = kreal) :: anb_opacity, opa_current real(kind = kreal) :: value, color(3) - integer(kind = kint) :: i, j, k + integer(kind = kint) :: i, j, inod integer(kind = kint) :: num_of_features ! integer(kind = kint) :: ist_h, jst_h, ied_h, jed_h @@ -245,31 +236,34 @@ subroutine gen_bottom_colormark & & color_param%num_pvr_datamap_pnt, & & color_param%pvr_datamap_param, value, color) ! - do j = jst_h, jst_h+BAR_WIDTH/2-1 - k = (j-1)*npix_img(1) + i - dimage(1:3,k) = color(1:3) * opa_current - dimage(4,k) = one + do j = jst_h, jst_h+iscale*l_bar_width()/2-1 + inod = (j-1)*npix_img(1) + i + dimage(1:3,inod) = color(1:3) * opa_current + dimage(4,inod) = one end do - do j = jst_h+BAR_WIDTH/2, jst_h+BAR_WIDTH - k = (j-1)*npix_img(1) + i - dimage(1:3,k) = color(1:3) - dimage(4,k) = one + do j = jst_h+iscale*l_bar_width()/2, jst_h+iscale*l_bar_width() + inod = (j-1)*npix_img(1) + i + dimage(1:3,inod) = color(1:3) + dimage(4,inod) = one end do end do ! - do j = jst_h, jed_h - k = (j-1)*npix_img(1) + ist_h - dimage(1:4,k) = one - k = (j-1)*npix_img(1) + ied_h - dimage(1:4,k) = one + do i = -iscale/4, (iscale+1)/4 + do j = jst_h, jed_h + inod = (j-1)*npix_img(1) + ist_h+i + dimage(1:4,inod) = one + inod = (j-1)*npix_img(1) + ied_h+i + dimage(1:4,inod) = one + end do end do ! - do i = ist_h, ied_h - j = jst_h - k = i + (jst_h-1)*npix_img(1) - dimage(1:4,k) = one - k = i + (jed_h+1)*npix_img(1) - dimage(1:4,k) = one + do j = -iscale/4, (iscale+1)/4 + do i = ist_h, ied_h + inod = i + (jst_h+j-1)*npix_img(1) + dimage(1:4,inod) = one + inod = i + (jed_h+j+1)*npix_img(1) + dimage(1:4,inod) = one + end do end do ! end subroutine gen_bottom_colormark @@ -296,7 +290,7 @@ subroutine gen_right_colormark & ! real(kind = kreal) :: anb_opacity, opa_current real(kind = kreal) :: value, color(3) - integer(kind = kint) :: i, j, k + integer(kind = kint) :: i, j, inod integer(kind = kint) :: num_of_features integer(kind = kint) :: ist, jst, ied, jed ! @@ -325,31 +319,34 @@ subroutine gen_right_colormark & & color_param%num_pvr_datamap_pnt, & & color_param%pvr_datamap_param, value, color) ! - do i = ist, ist+BAR_WIDTH/2-1 - k = j*npix_img(1) + i + 1 - dimage(1:3,k) = color(1:3) - dimage(4,k) = one + do i = ist, ist+iscale*l_bar_width()/2-1 + inod = j*npix_img(1) + i + 1 + dimage(1:3,inod) = color(1:3) + dimage(4,inod) = one end do - do i = ist+BAR_WIDTH/2, ist+BAR_WIDTH-1 - k = j*npix_img(1) + i + 1 - dimage(1:3,k) = color(1:3) * opa_current - dimage(4,k) = one + do i = ist+iscale*l_bar_width()/2, ist+iscale*l_bar_width()-1 + inod = j*npix_img(1) + i + 1 + dimage(1:3,inod) = color(1:3) * opa_current + dimage(4,inod) = one end do end do ! - do j = jst, jed - k = j*npix_img(1) + ist - dimage(1:4,k) = one - k = j*npix_img(1) + ied + 1 - dimage(1:4,k) = one + do i = -iscale/4, (iscale+1)/4 + do j = jst, jed + inod = j*npix_img(1) + ist + i + dimage(1:4,inod) = one + inod = j*npix_img(1) + ied + i + 1 + dimage(1:4,inod) = one + end do end do ! - do i = ist-1, ied - j = jst - k = jst*npix_img(1) + i + 1 - dimage(1:4,k) = one - k = jed*npix_img(1) + i + 1 - dimage(1:4,k) = one + do j = -iscale/4, (iscale+1)/4 + do i = ist-1, ied + inod = (jst+j)*npix_img(1) + i + 1 + dimage(1:4,inod) = one + inod = (jed+j)*npix_img(1) + i + 1 + dimage(1:4,inod) = one + end do end do ! end subroutine gen_right_colormark diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/draw_pvr_colorbar_nums.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/draw_pvr_colorbar_nums.f90 index 94eaebd5..bf460d87 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/draw_pvr_colorbar_nums.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/draw_pvr_colorbar_nums.f90 @@ -8,6 +8,7 @@ !>@brief Construct number bitmaps !! !!@verbatim +!! integer(kind = kint) function l_bar_width() !! subroutine corners_4_right_colorbar & !! & (iscale, npix_img, isleeve_bar, ist, jst, ied, jed) !! subroutine corners_4_bottom_colorbar & @@ -23,7 +24,7 @@ !! & isleeve_bar, ntot_pix, dimage) !! !! subroutine gen_time_label(iscale, time, npix_img, & -!! & isleeve_bar, ntot_pix, dimage) +!! & ntot_pix, dimage) !! subroutine set_one_label(char1, iscale, ist_px, ist_py, & !! & npix_img, ntot_pix, dimage) !!@endverbatim @@ -39,7 +40,7 @@ module draw_pvr_colorbar_nums ! integer(kind = kint), parameter, private :: BAR_WIDTH = iten integer(kind = kint), parameter, private :: NUM_LENGTH = inine - integer(kind = kint), parameter, private :: NUM_TLABEL = 14 + integer(kind = kint), parameter, private :: NUM_TIMELABEL = 14 ! private :: set_numeric_labels ! @@ -48,6 +49,12 @@ module draw_pvr_colorbar_nums contains ! ! --------------------------------------------------------------------- +! + integer(kind = kint) function l_bar_width() + l_bar_width = BAR_WIDTH + end function l_bar_width +! +! --------------------------------------------------------------------- ! subroutine corners_4_right_colorbar & & (iscale, npix_img, isleeve_bar, ist, jst, ied, jed) @@ -59,7 +66,7 @@ subroutine corners_4_right_colorbar & integer(kind = kint), intent(inout) :: ist, jst, ied, jed ! ist = npix_img(1) - isleeve_bar - ied = ist + BAR_WIDTH + ied = ist + BAR_WIDTH*iscale jst = (npix_img(2) - 20) / 10 + 10 - 6*iscale jed = (npix_img(2) - 20) / 10*5 + jst ! @@ -77,10 +84,10 @@ subroutine corners_4_bottom_colorbar & integer(kind = kint), intent(inout) :: ist, jst, ied, jed ! ! - ist = 1.5 * isleeve_bar - ied = npix_img(1) - 1.5 * isleeve_bar + ist = 1.5 * isleeve_bar*iscale + ied = npix_img(1) - 1.5 * isleeve_bar*iscale jst = 16 + 12*iscale + 20 - jed = jst + BAR_WIDTH + jed = jst + BAR_WIDTH*iscale ! end subroutine corners_4_bottom_colorbar ! @@ -99,7 +106,7 @@ subroutine gen_right_cbar_label(iscale, num_of_scale, c_minmax, & ! real(kind = kreal) :: value real(kind = kreal) :: rhgt - integer(kind = kint) :: i, j, k + integer(kind = kint) :: i, j, k, inod integer(kind = kint) :: ist, jst, ied, jed integer(kind = kint) :: start_px(2) character(len=NUM_LENGTH) :: numeric @@ -112,16 +119,18 @@ subroutine gen_right_cbar_label(iscale, num_of_scale, c_minmax, & & * dble(k-1) / dble(num_of_scale-1) + c_minmax(1) ! rhgt = dble(jed-jst) * dble(k-1) / dble(num_of_scale-1) - start_px(1) = ist + BAR_WIDTH + ithree + start_px(1) = ist + iscale * BAR_WIDTH + ithree start_px(2) = jst + int(rhgt, KIND(start_px(1))) ! write(numeric,'(1pe9.2)') value call set_numeric_labels(NUM_LENGTH, numeric, iscale, start_px, & & npix_img, ntot_pix, dimage) ! - do i = ist, ied + 4 - j = (start_px(2) * npix_img(1)) + i + 1 - dimage(1:4,j) = one + do j = -iscale/4, (iscale+1)/4 + do i = ist, ied + 4 + inod = (start_px(2)+j) * npix_img(1) + i + 1 + dimage(1:4,inod) = one + end do end do end do ! @@ -140,7 +149,7 @@ subroutine gen_right_zero_label(iscale, c_minmax, npix_img, & ! real(kind = kreal) :: zero_rgb real(kind = kreal) :: rhgt - integer(kind = kint) :: i, k + integer(kind = kint) :: i, j, inod integer(kind = kint) :: ist, jst, ied, jed integer(kind = kint) :: start_px(2) character(len=NUM_LENGTH) :: numeric @@ -152,16 +161,18 @@ subroutine gen_right_zero_label(iscale, c_minmax, npix_img, & zero_rgb = (zero - c_minmax(1)) / (c_minmax(2) - c_minmax(1)) ! rhgt = zero_rgb * dble(jed-jst) - start_px(1) = ist + BAR_WIDTH + ithree + start_px(1) = ist + iscale * BAR_WIDTH + ithree start_px(2) = jst + int(rhgt, KIND(ntot_pix)) ! write(numeric,'(1pe9.2)') zero call set_numeric_labels(NUM_LENGTH, numeric, iscale, start_px, & & npix_img, ntot_pix, dimage) ! - do i = ist, ied + 4 - k = (start_px(2) * npix_img(1)) + i + 1 - dimage(1:4,k) = one + do j = -iscale/4, (iscale+1)/4 + do i = ist, ied + 4 + inod = (j+start_px(2)) * npix_img(1) + i + 1 + dimage(1:4,inod) = one + end do end do ! end subroutine gen_right_zero_label @@ -181,7 +192,7 @@ subroutine gen_bottom_cbar_label(iscale, num_of_scale, c_minmax, & ! real(kind = kreal) :: value real(kind = kreal) :: rhgt - integer(kind = kint) :: i, j, k + integer(kind = kint) :: i, j, k, inod integer(kind = kint) :: ist_h, jst_h, ied_h, jed_h integer(kind = kint) :: start_px(2) character(len=NUM_LENGTH) :: numeric @@ -203,10 +214,12 @@ subroutine gen_bottom_cbar_label(iscale, num_of_scale, c_minmax, & call set_numeric_labels(NUM_LENGTH, numeric, iscale, start_px, & & npix_img, ntot_pix, dimage) ! - do i = jst_h-4, jed_h - j = (i-1) * npix_img(1) & - & + ist_h + int(rhgt, KIND(start_px(1))) - dimage(1:4,j) = one + do i = -iscale/4, (iscale+1)/4 + do j = jst_h-4, jed_h + inod = (j-1) * npix_img(1) & + & + ist_h + i + int(rhgt, KIND(start_px(1))) + dimage(1:4,inod) = one + end do end do end do ! @@ -225,7 +238,7 @@ subroutine gen_bottom_zero_label(iscale, c_minmax, npix_img, & ! real(kind = kreal) :: zero_rgb real(kind = kreal) :: rhgt - integer(kind = kint) :: i, k + integer(kind = kint) :: j, i, inod integer(kind = kint) :: ist_h, jst_h, ied_h, jed_h integer(kind = kint) :: start_px(2) character(len=NUM_LENGTH) :: numeric @@ -245,10 +258,12 @@ subroutine gen_bottom_zero_label(iscale, c_minmax, npix_img, & call set_numeric_labels(NUM_LENGTH, numeric, iscale, start_px, & & npix_img, ntot_pix, dimage) ! - do i = jst_h-4, jed_h - k = (i-1) * npix_img(1) & - & + ist_h + int(rhgt, KIND(start_px(1))) - dimage(1:4,k) = one + do i = -iscale/4, (iscale+1)/4 + do j = jst_h-4, jed_h + inod = (j-1) * npix_img(1) & + & + ist_h + i + int(rhgt, KIND(start_px(1))) + dimage(1:4,inod) = one + end do end do ! end subroutine gen_bottom_zero_label @@ -257,24 +272,24 @@ end subroutine gen_bottom_zero_label ! --------------------------------------------------------------------- ! subroutine gen_time_label(iscale, time, npix_img, & - & isleeve_bar, ntot_pix, dimage) + & ntot_pix, dimage) ! real(kind = kreal), intent(in) :: time - integer(kind = kint), intent(in) :: iscale, isleeve_bar + integer(kind = kint), intent(in) :: iscale integer(kind = kint), intent(in) :: npix_img(2) integer(kind = kint), intent(in) :: ntot_pix real(kind = kreal), intent(inout) :: dimage(4,ntot_pix) ! integer(kind = kint) :: start_px(2) - character(len=NUM_TLABEL) :: t_label + character(len=NUM_TIMELABEL) :: t_label ! ! - start_px(1) = npix_img(1) - 8 * (NUM_TLABEL+1) * iscale + start_px(1) = npix_img(1) - 8 * (NUM_TIMELABEL+1) * iscale start_px(2) = npix_img(2) - iten - 12 * iscale ! write(t_label,'(a3,1pe11.4)') 't =', time - call set_numeric_labels(NUM_TLABEL, t_label, iscale, start_px, & - & npix_img, ntot_pix, dimage) + call set_numeric_labels(NUM_TIMELABEL, t_label, iscale, & + & start_px, npix_img, ntot_pix, dimage) ! end subroutine gen_time_label ! diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/m_pvr_control_labels.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/m_pvr_control_labels.f90 new file mode 100644 index 00000000..d7937266 --- /dev/null +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/m_pvr_control_labels.f90 @@ -0,0 +1,120 @@ +!>@file m_pvr_control_labels.f90 +!! module m_pvr_control_labels +!! +!!@author H. Matsui +!!@date Programmed in May. 2006 +! +!> @brief Structures for parameteres for volume rendering +!! +!!@verbatim +!! subroutine pvr_isosurf_dir_list_array(array_c) +!! subroutine pvr_surf_enhance_mode_array(array_c) +!! +!! subroutine pvr_movie_mode_list_array(array_c) +!! subroutine lic_movie_mode_list_array(array_c) +!! type(ctl_array_chara), intent(inout) :: array_c +!!@endverbatim +! + module m_pvr_control_labels +! + use m_precision + use m_constants +! + implicit none +! + character(len = kchara), parameter & + & :: LABEL_INCREASE = 'increase' + character(len = kchara), parameter & + & :: LABEL_DECREASE = 'decrease' +! +! + character(len = kchara), parameter :: LABEL_EDGE = 'boarder' + character(len = kchara), parameter & + & :: LABEL_FORWARD = 'forward_surface' + character(len = kchara), parameter & + & :: LABEL_REVERSE = 'reverse_surface' + character(len = kchara), parameter & + & :: LABEL_BOTH = 'both_surface' +! +! + character(len=kchara), parameter :: FLAG_ZOOM = 'zoom' + character(len=kchara), parameter & + & :: FLAG_ROTATE_MOVIE = 'rotation' + character(len=kchara), parameter & + & :: FLAG_START_END_VIEW = 'view_matrices' + character(len=kchara), parameter & + & :: FLAG_LIC_KERNEL = 'LIC_kernel' +! +! --------------------------------------------------------------------- +! + contains +! +! --------------------------------------------------------------------- +! + subroutine pvr_isosurf_dir_list_array(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + array_c%array_name = ' ' + array_c%num = 0 + call alloc_control_array_chara(array_c) +! + call append_c_to_ctl_array(LABEL_INCREASE, array_c) + call append_c_to_ctl_array(LABEL_DECREASE, array_c) +! + end subroutine pvr_isosurf_dir_list_array +! +! ---------------------------------------------------------------------- +! + subroutine pvr_surf_enhance_mode_array(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + array_c%array_name = ' ' + array_c%num = 0 + call alloc_control_array_chara(array_c) +! + call append_c_to_ctl_array(LABEL_BOTH, array_c) + call append_c_to_ctl_array(LABEL_FORWARD, array_c) + call append_c_to_ctl_array(LABEL_REVERSE, array_c) + call append_c_to_ctl_array(LABEL_EDGE, array_c) +! + end subroutine pvr_surf_enhance_mode_array +! +! ---------------------------------------------------------------------- +! --------------------------------------------------------------------- +! + subroutine pvr_movie_mode_list_array(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + array_c%array_name = ' ' + array_c%num = 0 + call alloc_control_array_chara(array_c) +! + call append_c_to_ctl_array(FLAG_ROTATE_MOVIE, array_c) + call append_c_to_ctl_array(FLAG_ZOOM, array_c) + call append_c_to_ctl_array(FLAG_START_END_VIEW, array_c) +! + end subroutine pvr_movie_mode_list_array +! +! ---------------------------------------------------------------------- +! + subroutine lic_movie_mode_list_array(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + array_c%array_name = ' ' + array_c%num = 0 + call alloc_control_array_chara(array_c) +! + call append_c_to_ctl_array(FLAG_ROTATE_MOVIE, array_c) + call append_c_to_ctl_array(FLAG_ZOOM, array_c) + call append_c_to_ctl_array(FLAG_START_END_VIEW, array_c) + call append_c_to_ctl_array(FLAG_LIC_KERNEL, array_c) +! + end subroutine lic_movie_mode_list_array +! +! ---------------------------------------------------------------------- +! + end module m_pvr_control_labels diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/pvr_axis_label.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/pvr_axis_label.f90 index a71f9f63..91fcc659 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/pvr_axis_label.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/pvr_axis_label.f90 @@ -9,9 +9,10 @@ !!@verbatim !! subroutine axis_direction_in_screen(pvr_screen) !! type(pvr_projected_position), intent(inout) :: pvr_screen -!! subroutine set_pvr_axislabel & -!! & (num_pixel, n_pvr_pixel, pvr_screen, rgba_gl) +!! subroutine set_pvr_axislabel(num_pixel, n_pvr_pixel, iscale, & +!! & pvr_screen, rgba_gl) !! integer(kind = kint), intent(in) :: num_pixel +!! integer(kind = kint), intent(in) :: iscale !! integer(kind = kint), intent(in) :: n_pvr_pixel(2) !! type(pvr_projected_position), intent(in) :: pvr_screen !! real(kind = kreal), intent(inout) :: rgba_gl(4,num_pixel) @@ -57,8 +58,8 @@ end subroutine axis_direction_in_screen ! ! --------------------------------------------------------------------- ! - subroutine set_pvr_axislabel & - & (num_pixel, n_pvr_pixel, pvr_screen, rgba_gl) + subroutine set_pvr_axislabel(num_pixel, n_pvr_pixel, iscale, & + & pvr_screen, rgba_gl) ! use t_control_params_4_pvr use t_geometries_in_pvr_screen @@ -66,13 +67,15 @@ subroutine set_pvr_axislabel & use draw_pvr_colorbar_nums ! integer(kind = kint), intent(in) :: num_pixel + integer(kind = kint), intent(in) :: iscale integer(kind = kint), intent(in) :: n_pvr_pixel(2) ! type(pvr_projected_position), intent(in) :: pvr_screen ! real(kind = kreal), intent(inout) :: rgba_gl(4,num_pixel) ! - integer(kind = kint) :: i, j, k, l, n, m, length, ist_px, ist_py + integer(kind = kint) :: i, j, l, n, m, i2, j2 + integer(kind = kint) :: length, ist_px, ist_py, inod real(kind = kreal) :: rlen, rhgt real(kind = kreal) :: r, rmax ! @@ -85,28 +88,32 @@ subroutine set_pvr_axislabel & rmax = max(rmax,r) end do ! - length = 30 + length = 30 * iscale ! length = int(0.13 * rmax * min(n_pvr_pixel(1),n_pvr_pixel(2))) rmax = one / rmax do m = 1, 3 ist_px = int(length * 1.3, KIND(ist_px)) ist_py = int(length * 1.3, KIND(ist_py)) n = pvr_screen%axis_order(m) - do l = 0, length - rlen = l * pvr_screen%axis_view(n,1) * rmax - rhgt = l * pvr_screen%axis_view(n,2) * rmax - i = ist_px + int(rlen, KIND(i)) - j = ist_py + int(rhgt, KIND(j)) - k = j*n_pvr_pixel(1) + i + 1 - rgba_gl(n,k) = one - rgba_gl(4,k) = one + do j2 = -iscale/4, (iscale+1)/4 + do i2 = -iscale/4, (iscale+1)/4 + do l = 0, length + rlen = l * pvr_screen%axis_view(n,1) * rmax + rhgt = l * pvr_screen%axis_view(n,2) * rmax + i = ist_px + int(rlen, KIND(i)) + j = ist_py + int(rhgt, KIND(j)) + inod = (j+j2)*n_pvr_pixel(1) + (i+i2) + 1 + rgba_gl(n,inod) = one + rgba_gl(4,inod) = one + end do + end do end do rlen = (length+10) * pvr_screen%axis_view(n,1) * rmax rhgt = (length+12) * pvr_screen%axis_view(n,2) * rmax ist_px = ist_px + int(rlen, KIND(ist_px)) ist_py = ist_py + int(rhgt, KIND(ist_py)) ! - call set_one_label(axis_label(n), ione, ist_px, ist_py, & + call set_one_label(axis_label(n), iscale, ist_px, ist_py, & & n_pvr_pixel, num_pixel, rgba_gl) end do ! diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/pvr_surface_enhancement.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/pvr_surface_enhancement.f90 index 290c00dd..a683775a 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/pvr_surface_enhancement.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/pvr_surface_enhancement.f90 @@ -16,9 +16,6 @@ !! type(surface_data), intent(in) :: surf !! type(surface_group_data), intent(in) :: surf_grp !! type(sf_grp_list_each_surf), intent(in) :: sf_grp_4_sf -!! -!! integer(kind = kint) function num_flag_pvr_isosurf_dir() -!! subroutine set_flag_pvr_isosurf_dir(names) !!@endverbatim ! module pvr_surface_enhancement @@ -37,21 +34,6 @@ module pvr_surface_enhancement use calypso_mpi ! implicit none -! - character(len = kchara), parameter & - & :: LABEL_INCREASE = 'increase' - character(len = kchara), parameter & - & :: LABEL_DECREASE = 'decrease' -! - character(len = kchara), parameter :: LABEL_EDGE = 'boarder' - character(len = kchara), parameter & - & :: LABEL_FORWARD = 'forward_surface' - character(len = kchara), parameter & - & :: LABEL_REVERSE = 'reverse_surface' - character(len = kchara), parameter & - & :: LABEL_BOTH = 'both_surface' -! - integer(kind = kint), parameter :: n_flag_pvr_isosurf_dir = 3 ! integer(kind = kint), parameter :: IFLAG_NONE = 0 integer(kind = kint), parameter :: IFLAG_SHOW_EDGE = 2 @@ -72,6 +54,7 @@ subroutine set_pvr_bc_enhanse_flag & & fixed_opacity, iflag_enhanse, enhansed_opacity) ! use t_control_params_4_pvr + use m_pvr_control_labels use skip_comment_f ! type(surface_group_data), intent(in) :: surf_grp @@ -173,29 +156,5 @@ real(kind = kreal) function opacity_by_surf_grp & end function opacity_by_surf_grp ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- -! - integer(kind = kint) function num_flag_pvr_isosurf_dir() - num_flag_pvr_isosurf_dir = n_flag_pvr_isosurf_dir - return - end function num_flag_pvr_isosurf_dir -! -! --------------------------------------------------------------------- -! - subroutine set_flag_pvr_isosurf_dir(names) -! - use t_read_control_elements -! - character(len = kchara), intent(inout) & - & :: names(n_flag_pvr_isosurf_dir) -! -! - call set_control_labels(LABEL_FORWARD, names( 1)) - call set_control_labels(LABEL_REVERSE, names( 2)) - call set_control_labels(LABEL_EDGE, names( 3)) -! - end subroutine set_flag_pvr_isosurf_dir -! -! ---------------------------------------------------------------------- ! end module pvr_surface_enhancement diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/rendering_vr_image.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/rendering_vr_image.f90 index c659a86d..ddf4d61e 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/rendering_vr_image.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/rendering_vr_image.f90 @@ -244,7 +244,7 @@ subroutine rendering_image(istep_pvr, time, mesh, group, & if(cbar_param%flag_pvr_axis) then call set_pvr_axislabel & & (pvr_rgb%num_pixel_xy, pvr_rgb%num_pixels, & - & pvr_screen, pvr_rgb%rgba_real_gl) + & cbar_param%iscale_font, pvr_screen, pvr_rgb%rgba_real_gl) end if if(iflag_PVR_time) call end_elapsed_time(ist_elapsed_PVR+3) end if diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/set_control_each_pvr.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/set_control_each_pvr.f90 index 563addc7..45106aed 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/set_control_each_pvr.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/set_control_each_pvr.f90 @@ -249,6 +249,7 @@ subroutine set_control_pvr_isosurf(pvr_isos_c, draw_param) ! use t_control_data_pvr_isosurfs use t_geometries_in_pvr_screen + use m_pvr_control_labels use pvr_surface_enhancement ! type(pvr_isosurfs_ctl), intent(in) :: pvr_isos_c diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/set_control_pvr_color.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/set_control_pvr_color.f90 index 18b68caf..eb1b70b6 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/set_control_pvr_color.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/set_control_pvr_color.f90 @@ -45,7 +45,8 @@ subroutine set_control_pvr_lighting(light, color_param) ! type(pvr_colormap_parameter), intent(inout) :: color_param ! - integer(kind = kint) :: i + integer(kind = kint) :: i, icou + real(kind = kreal) :: r, t, p ! ! if(light%ambient_coef_ctl%iflag .gt. 0) then @@ -70,16 +71,26 @@ subroutine set_control_pvr_lighting(light, color_param) end if ! ! + color_param%num_pvr_lights = 0 if(light%light_position_ctl%num .gt. 0) then - color_param%num_pvr_lights = light%light_position_ctl%num - else - color_param%num_pvr_lights = 1 + color_param%num_pvr_lights = color_param%num_pvr_lights & + & + light%light_position_ctl%num + end if +! + if(light%light_sph_posi_ctl%num .gt. 0) then + color_param%num_pvr_lights = color_param%num_pvr_lights & + & + light%light_sph_posi_ctl%num end if + if(color_param%num_pvr_lights .eq. 0) & + & color_param%num_pvr_lights = 1 ! call alloc_light_posi_in_view(color_param) ! + i = 0 if(light%light_position_ctl%num .gt. 0) then - do i = 1, color_param%num_pvr_lights +!$omp parallel do private(icou,i) + do icou = 1, light%light_position_ctl%num + i = icou + 1 color_param%xyz_pvr_lights(1,i) & & = light%light_position_ctl%vec1(i) color_param%xyz_pvr_lights(2,i) & @@ -87,6 +98,23 @@ subroutine set_control_pvr_lighting(light, color_param) color_param%xyz_pvr_lights(3,i) & & = light%light_position_ctl%vec3(i) end do +!$omp end parallel do + end if + if(light%light_sph_posi_ctl%num .gt. 0) then +!$omp parallel do private(icou,i,r,t,p) + do icou = 1, light%light_sph_posi_ctl%num + i = icou + 1 + r = light%light_sph_posi_ctl%vec1(i) + t = light%light_sph_posi_ctl%vec2(i) * atan(one) / 45.0 + p = light%light_sph_posi_ctl%vec3(i) * atan(one) / 45.0 + color_param%xyz_pvr_lights(1,i) = r * sin(t) * cos(p) + color_param%xyz_pvr_lights(2,i) = r * sin(t) * sin(p) + color_param%xyz_pvr_lights(3,i) = r * cos(t) + end do +!$omp end parallel do + end if + + if(i .gt. 0) then color_param%iflag_pvr_lights = 1 else color_param%xyz_pvr_lights(1,1) = one @@ -191,19 +219,7 @@ subroutine set_control_pvr_colormap(color, color_param) ! if (cmp_no_case(tmpchara, hd_intensity) then ! color_param%id_pvr_color(3) = iflag_intense ! end if - if (cmp_no_case(tmpchara, hd_pointdelta)) then - if( color%step_opacity_ctl%num .gt. 0) then - color_param%id_pvr_color(3) = iflag_pointdelta - color_param%num_opacity_pnt = color%step_opacity_ctl%num - end if -! - else if(cmp_no_case(tmpchara, hd_pointrange)) then - if( color%step_opacity_ctl%num .gt. 0) then - color_param%id_pvr_color(3) = iflag_pointrange - color_param%num_opacity_pnt = color%step_opacity_ctl%num - end if -! - else if(cmp_no_case(tmpchara, hd_pointlinear)) then + if(cmp_no_case(tmpchara, hd_pointlinear)) then if( color%linear_opacity_ctl%num .gt. 0) then color_param%id_pvr_color(3) = iflag_pointlinear color_param%num_opacity_pnt = color%linear_opacity_ctl%num @@ -213,21 +229,7 @@ subroutine set_control_pvr_colormap(color, color_param) ! call alloc_pvr_opacity_list(color_param) ! - if (color_param%id_pvr_color(3) .eq. iflag_pointdelta & - & .or. color_param%id_pvr_color(3) .eq. iflag_pointrange) then - do i = 1, color_param%num_opacity_pnt - color_param%pvr_opacity_param(1,i) & - & = color%step_opacity_ctl%vec1(i) - color_param%pvr_opacity_param(2,i) & - & = color%step_opacity_ctl%vec2(i) - color_param%pvr_opacity_param(3,i) & - & = color%step_opacity_ctl%vec3(i) - color_param%pvr_max_opacity & - & = max(color_param%pvr_max_opacity, & - & color_param%pvr_opacity_param(3,i)) - end do -! - else if(color_param%id_pvr_color(3) .eq. iflag_pointlinear) then + if(color_param%id_pvr_color(3) .eq. iflag_pointlinear) then do i = 1, color_param%num_opacity_pnt color_param%pvr_opacity_param(1,i) & & = color%linear_opacity_ctl%vec1(i) diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/set_control_pvr_movie.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/set_control_pvr_movie.f90 index d34745fd..33e7ccab 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/set_control_pvr_movie.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/set_control_pvr_movie.f90 @@ -32,6 +32,7 @@ subroutine s_set_control_pvr_movie(movie_ctl, movie_def) use t_ctl_data_pvr_movie use t_control_params_4_pvr use t_geometries_in_pvr_screen + use m_pvr_control_labels use output_image_sel_4_png use skip_comment_f ! diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/set_pvr_control.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/set_pvr_control.f90 index 45a64620..f7db9d26 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/set_pvr_control.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/set_pvr_control.f90 @@ -171,7 +171,7 @@ subroutine init_multi_view_parameters(num_views, mul_mmats_c, & use set_pvr_modelview_matrix ! integer(kind = kint), intent(in) :: num_views - type(multi_modeview_ctl), intent(in) :: mul_mmats_c + type(multi_modelview_ctl), intent(in) :: mul_mmats_c ! type(PVR_control_params), intent(inout) :: pvr_param ! diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/set_rgba_4_each_pixel.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/set_rgba_4_each_pixel.f90 index 4bf6d36a..a711aed2 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/set_rgba_4_each_pixel.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/set_rgba_4_each_pixel.f90 @@ -46,15 +46,9 @@ module set_rgba_4_each_pixel character(len = kchara), parameter & & :: hd_intensity = 'intense_chenge' character(len = kchara), parameter & - & :: hd_pointdelta = 'point_delta' - character(len = kchara), parameter & - & :: hd_pointrange = 'point_ranges' - character(len = kchara), parameter & & :: hd_pointlinear = 'point_linear' integer(kind = kint), parameter :: iflag_anbient = 1 integer(kind = kint), parameter :: iflag_intense = 2 - integer(kind = kint), parameter :: iflag_pointdelta = 3 - integer(kind = kint), parameter :: iflag_pointrange = 4 integer(kind = kint), parameter :: iflag_pointlinear = 5 ! ! ---------------------------------------------------------------------- @@ -258,32 +252,6 @@ subroutine compute_opacity(transfer_function_style, opa_value, & opacity_local = zero if (transfer_function_style .eq. iflag_anbient) then opacity_local = opa_value - else if(transfer_function_style .eq. iflag_pointdelta) then - mint = 1.0d-17 - do i = 1, num_of_features - t = abs(value - fea_point(1,i)) - if(t .lt. mint) then - mint = t - min_type = i - end if - if(mint .lt. fea_point(2,min_type)) then - opacity_local = opa_value + fea_point(3,min_type) & - & * (fea_point(2,min_type)-mint) & - & / fea_point(2,min_type) - else - opacity_local = opa_value - end if - end do -! - else if(transfer_function_style .eq. iflag_pointrange) then - opacity_local = opa_value - do i = 1, num_of_features - if(value.ge.fea_point(1,i) & - & .and. value.le.fea_point(2,i)) then - opacity_local = fea_point(3,i) - end if - end do -! else if(transfer_function_style .eq. iflag_pointlinear) then opacity_local = opa_value do i = 1, num_of_features-1 diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_4_pvr.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_4_pvr.f90 index 81ecf14b..57716fd5 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_4_pvr.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_4_pvr.f90 @@ -15,6 +15,11 @@ !! subroutine add_field_4_pvr_to_fld_ctl(pvr_ctl, field_ctl) !! type(pvr_parameter_ctl), intent(in) :: pvr_ctl !! type(ctl_array_c3), intent(inout) :: field_ctl +!! +!! subroutine dup_pvr_ctl(org_pvr, new_pvr) +!! subroutine copy_pvr_update_flag(org_pvr, new_pvr) +!! type(pvr_parameter_ctl), intent(in) :: org_pvr +!! type(pvr_parameter_ctl), intent(inout) :: new_pvr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! example of control for Kemo's volume rendering !! @@ -101,6 +106,9 @@ module t_control_data_4_pvr ! !> Structure of control data for PVR rendering type pvr_parameter_ctl +!> Control block name + character(len = kchara) :: block_name = 'volume_rendering' +! !> file name for modelview matrix character(len=kchara) :: fname_mat_ctl = 'NO_FILE' !> Structure for modelview marices @@ -220,5 +228,63 @@ subroutine add_field_4_pvr_to_fld_ctl(pvr_ctl, field_ctl) end subroutine add_field_4_pvr_to_fld_ctl ! ! --------------------------------------------------------------------- +! --------------------------------------------------------------------- +! + subroutine dup_pvr_ctl(org_pvr, new_pvr) +! + use t_ctl_data_4_view_transfer + use bcast_control_arrays +! + type(pvr_parameter_ctl), intent(in) :: org_pvr + type(pvr_parameter_ctl), intent(inout) :: new_pvr +! +! + new_pvr%block_name = org_pvr%block_name + new_pvr%i_pvr_ctl = org_pvr%i_pvr_ctl + new_pvr%fname_mat_ctl = org_pvr%fname_mat_ctl + new_pvr%fname_cmap_cbar_c = org_pvr%fname_cmap_cbar_c + new_pvr%fname_pvr_light_c = org_pvr%fname_pvr_light_c +! + call dup_view_transfer_ctl(org_pvr%mat, new_pvr%mat) +! + call dup_pvr_isosurfs_ctl(org_pvr%pvr_isos_c, new_pvr%pvr_isos_c) + call dup_pvr_sections_ctl(org_pvr%pvr_scts_c, new_pvr%pvr_scts_c) +! + call dup_lighting_ctl(org_pvr%light, new_pvr%light) + call dup_pvr_cmap_cbar(org_pvr%cmap_cbar_c, new_pvr%cmap_cbar_c) +! + call dup_quilt_image_ctl(org_pvr%quilt_c, new_pvr%quilt_c) + call dup_pvr_movie_control_flags(org_pvr%movie, new_pvr%movie) + call dup_pvr_render_area_ctl(org_pvr%render_area_c, & + & new_pvr%render_area_c) +! + call copy_chara_ctl(org_pvr%updated_ctl, new_pvr%updated_ctl) + call copy_chara_ctl(org_pvr%file_head_ctl, new_pvr%file_head_ctl) + call copy_chara_ctl(org_pvr%file_fmt_ctl, new_pvr%file_fmt_ctl) + call copy_chara_ctl(org_pvr%monitoring_ctl, & + & new_pvr%monitoring_ctl) +! + call copy_chara_ctl(org_pvr%streo_ctl, new_pvr%streo_ctl) + call copy_chara_ctl(org_pvr%anaglyph_ctl, new_pvr%anaglyph_ctl) + call copy_chara_ctl(org_pvr%quilt_ctl, new_pvr%quilt_ctl) +! + call copy_chara_ctl(org_pvr%pvr_field_ctl, new_pvr%pvr_field_ctl) + call copy_chara_ctl(org_pvr%pvr_comp_ctl, new_pvr%pvr_comp_ctl) +! + end subroutine dup_pvr_ctl +! +! --------------------------------------------------------------------- +! + subroutine copy_pvr_update_flag(org_pvr, new_pvr) +! + type(pvr_parameter_ctl), intent(in) :: org_pvr + type(pvr_parameter_ctl), intent(inout) :: new_pvr +! +! + call copy_chara_ctl(org_pvr%updated_ctl, new_pvr%updated_ctl) +! + end subroutine copy_pvr_update_flag +! +! --------------------------------------------------------------------- ! end module t_control_data_4_pvr diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_pvr_isosurfs.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_pvr_isosurfs.f90 index f8460787..71e95134 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_pvr_isosurfs.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_pvr_isosurfs.f90 @@ -22,13 +22,20 @@ !! integer(kind = kint), intent(inout) :: level !! subroutine alloc_pvr_isosurfs_ctl(pvr_isos_c) !! subroutine dealloc_pvr_isosurfs_ctl(pvr_isos_c) +!! subroutine init_pvr_isosurfs_ctl(hd_block, pvr_isos_c) !! type(buffer_for_control), intent(inout) :: c_buf !! !! subroutine dup_pvr_isosurfs_ctl(org_pvr_iso_c, new_pvr_isos_c) !! type(pvr_isosurfs_ctl), intent(in) :: org_pvr_iso_c !! type(pvr_isosurfs_ctl), intent(inout) :: new_pvr_isos_c +!! +!! subroutine append_pvr_isosurf_ctl(idx_in, hd_block, pvr_isos_c) +!! subroutine delete_pvr_isosurf_ctl(idx_in, pvr_isos_c) +!! integer(kind = kint), intent(in) :: idx_in +!! character(len=kchara), intent(in) :: hd_block +!! type(pvr_isosurfs_ctl), intent(inout) :: pvr_isos_c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! array isosurface_ctl 2 +!! array isosurface_ctl !! begin isosurface_ctl !! isosurf_value 0.3 !! opacity_ctl 0.9 @@ -55,12 +62,14 @@ module t_control_data_pvr_isosurfs ! ! type pvr_isosurfs_ctl +!> Control block name + character(len = kchara) :: block_name = 'isosurface_ctl' +! integer(kind = kint) :: num_pvr_iso_ctl = 0 type(pvr_isosurf_ctl), allocatable :: pvr_iso_ctl(:) end type pvr_isosurfs_ctl ! - private :: append_new_pvr_isosurf_ctl - private :: copy_pvr_isosurfs_ctl, reset_pvr_isosurfs_ctl + private :: reset_pvr_isosurfs_ctl ! ! --------------------------------------------------------------------- ! @@ -75,11 +84,12 @@ subroutine read_pvr_isosurfs_ctl & character(len=kchara), intent(in) :: hd_block type(pvr_isosurfs_ctl), intent(inout) :: pvr_isos_c type(buffer_for_control), intent(inout) :: c_buf +! + integer(kind = kint) :: n_append ! ! if(check_array_flag(c_buf, hd_block) .eqv. .FALSE.) return if(allocated(pvr_isos_c%pvr_iso_ctl)) return - pvr_isos_c%num_pvr_iso_ctl = 0 call alloc_pvr_isosurfs_ctl(pvr_isos_c) ! do @@ -88,7 +98,8 @@ subroutine read_pvr_isosurfs_ctl & if(check_end_array_flag(c_buf, hd_block)) exit ! if(check_begin_flag(c_buf, hd_block)) then - call append_new_pvr_isosurf_ctl(pvr_isos_c) + n_append = pvr_isos_c%num_pvr_iso_ctl + call append_pvr_isosurf_ctl(n_append, hd_block, pvr_isos_c) call read_pvr_isosurface_ctl(id_control, hd_block, & & pvr_isos_c%pvr_iso_ctl(pvr_isos_c%num_pvr_iso_ctl), & & c_buf) @@ -154,64 +165,115 @@ subroutine alloc_pvr_isosurfs_ctl(pvr_isos_c) end subroutine alloc_pvr_isosurfs_ctl ! ! --------------------------------------------------------------------- +! + subroutine init_pvr_isosurfs_ctl(hd_block, pvr_isos_c) +! + character(len=kchara), intent(in) :: hd_block + type(pvr_isosurfs_ctl), intent(inout) :: pvr_isos_c +! +! + pvr_isos_c%block_name = hd_block + pvr_isos_c%num_pvr_iso_ctl = 0 +! + end subroutine init_pvr_isosurfs_ctl +! +! ----------------------------------------------------------------------- ! ----------------------------------------------------------------------- ! - subroutine append_new_pvr_isosurf_ctl(pvr_isos_c) + subroutine append_pvr_isosurf_ctl(idx_in, hd_block, pvr_isos_c) ! + integer(kind = kint), intent(in) :: idx_in + character(len=kchara), intent(in) :: hd_block type(pvr_isosurfs_ctl), intent(inout) :: pvr_isos_c ! type(pvr_isosurfs_ctl) :: tmp_pvr_isos + integer(kind = kint) :: i +! ! + if(idx_in.lt.0 .or. idx_in.gt.pvr_isos_c%num_pvr_iso_ctl) return ! tmp_pvr_isos%num_pvr_iso_ctl = pvr_isos_c%num_pvr_iso_ctl call alloc_pvr_isosurfs_ctl(tmp_pvr_isos) - call copy_pvr_isosurfs_ctl(tmp_pvr_isos%num_pvr_iso_ctl, & - & pvr_isos_c, tmp_pvr_isos) + do i = 1, tmp_pvr_isos%num_pvr_iso_ctl + call dup_pvr_isosurface_ctl(pvr_isos_c%pvr_iso_ctl(i), & + & tmp_pvr_isos%pvr_iso_ctl(i)) + end do ! call dealloc_pvr_isosurfs_ctl(pvr_isos_c) -! pvr_isos_c%num_pvr_iso_ctl = tmp_pvr_isos%num_pvr_iso_ctl + 1 call alloc_pvr_isosurfs_ctl(pvr_isos_c) ! - call copy_pvr_isosurfs_ctl(tmp_pvr_isos%num_pvr_iso_ctl, & - & tmp_pvr_isos, pvr_isos_c) + do i = 1, idx_in + call dup_pvr_isosurface_ctl(tmp_pvr_isos%pvr_iso_ctl(i), & + & pvr_isos_c%pvr_iso_ctl(i)) + end do + call init_pvr_isosurface_ctl_label(hd_block, & + & pvr_isos_c%pvr_iso_ctl(idx_in+1)) + do i = idx_in+1, tmp_pvr_isos%num_pvr_iso_ctl + call dup_pvr_isosurface_ctl(tmp_pvr_isos%pvr_iso_ctl(i), & + & pvr_isos_c%pvr_iso_ctl(i+1)) + end do ! call dealloc_pvr_isosurfs_ctl(tmp_pvr_isos) ! - end subroutine append_new_pvr_isosurf_ctl + end subroutine append_pvr_isosurf_ctl ! ! ----------------------------------------------------------------------- ! - subroutine dup_pvr_isosurfs_ctl(org_pvr_iso_c, new_pvr_isos_c) + subroutine delete_pvr_isosurf_ctl(idx_in, pvr_isos_c) ! - type(pvr_isosurfs_ctl), intent(in) :: org_pvr_iso_c - type(pvr_isosurfs_ctl), intent(inout) :: new_pvr_isos_c + integer(kind = kint), intent(in) :: idx_in + type(pvr_isosurfs_ctl), intent(inout) :: pvr_isos_c ! + type(pvr_isosurfs_ctl) :: tmp_pvr_isos + integer(kind = kint) :: i ! - new_pvr_isos_c%num_pvr_iso_ctl = org_pvr_iso_c%num_pvr_iso_ctl - call alloc_pvr_isosurfs_ctl(new_pvr_isos_c) - call copy_pvr_isosurfs_ctl(org_pvr_iso_c%num_pvr_iso_ctl, & - & org_pvr_iso_c, new_pvr_isos_c) ! - end subroutine dup_pvr_isosurfs_ctl + if(idx_in.le.0 .or. idx_in.gt.pvr_isos_c%num_pvr_iso_ctl) return ! -! --------------------------------------------------------------------- + tmp_pvr_isos%num_pvr_iso_ctl = pvr_isos_c%num_pvr_iso_ctl + call alloc_pvr_isosurfs_ctl(tmp_pvr_isos) + do i = 1, tmp_pvr_isos%num_pvr_iso_ctl + call dup_pvr_isosurface_ctl(pvr_isos_c%pvr_iso_ctl(i), & + & tmp_pvr_isos%pvr_iso_ctl(i)) + end do +! + call dealloc_pvr_isosurfs_ctl(pvr_isos_c) + pvr_isos_c%num_pvr_iso_ctl = tmp_pvr_isos%num_pvr_iso_ctl - 1 + call alloc_pvr_isosurfs_ctl(pvr_isos_c) ! - subroutine copy_pvr_isosurfs_ctl & - & (num_pvr_iso, org_pvr_isos_c, new_pvr_isos_c) + do i = 1, idx_in-1 + call dup_pvr_isosurface_ctl(tmp_pvr_isos%pvr_iso_ctl(i), & + & pvr_isos_c%pvr_iso_ctl(i)) + end do + do i = idx_in, tmp_pvr_isos%num_pvr_iso_ctl + call dup_pvr_isosurface_ctl(tmp_pvr_isos%pvr_iso_ctl(i+1), & + & pvr_isos_c%pvr_iso_ctl(i)) + end do +! + call dealloc_pvr_isosurfs_ctl(tmp_pvr_isos) +! + end subroutine delete_pvr_isosurf_ctl +! +! ----------------------------------------------------------------------- +! + subroutine dup_pvr_isosurfs_ctl(org_pvr_isos_c, new_pvr_isos_c) ! - integer(kind = kint), intent(in) :: num_pvr_iso type(pvr_isosurfs_ctl), intent(in) :: org_pvr_isos_c type(pvr_isosurfs_ctl), intent(inout) :: new_pvr_isos_c ! integer(kind = kint) :: i ! - do i = 1, num_pvr_iso +! + new_pvr_isos_c%block_name = org_pvr_isos_c%block_name + new_pvr_isos_c%num_pvr_iso_ctl = org_pvr_isos_c%num_pvr_iso_ctl + call alloc_pvr_isosurfs_ctl(new_pvr_isos_c) + do i = 1, org_pvr_isos_c%num_pvr_iso_ctl call dup_pvr_isosurface_ctl(org_pvr_isos_c%pvr_iso_ctl(i), & & new_pvr_isos_c%pvr_iso_ctl(i)) end do ! - end subroutine copy_pvr_isosurfs_ctl + end subroutine dup_pvr_isosurfs_ctl ! ! --------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_pvr_sections.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_pvr_sections.f90 index 5b194418..e280dd1f 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_pvr_sections.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_pvr_sections.f90 @@ -8,6 +8,11 @@ !! !!@verbatim !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! subroutine alloc_pvr_sections_ctl(pvr_scts_c) +!! subroutine dealloc_pvr_sections_ctl(pvr_scts_c) +!! subroutine init_pvr_sections_ctl(hd_block, pvr_scts_c) +!! type(pvr_sections_ctl), intent(inout) :: pvr_scts_c +!! !! subroutine read_pvr_sections_ctl & !! & (id_control, hd_block, pvr_scts_c, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -21,11 +26,11 @@ !! type(pvr_sections_ctl), intent(in) :: pvr_scts_c !! integer(kind = kint), intent(inout) :: level !! -!! subroutine append_new_pvr_section_ctl(pvr_scts_c) +!! subroutine append_pvr_section_ctl(idx_in, hd_block, & +!! & pvr_scts_c) +!! subroutine delete_pvr_section_ctl(idx_in, pvr_scts_c) !! type(pvr_sections_ctl), intent(inout) :: pvr_scts_c !! subroutine dup_pvr_sections_ctl(org_pvr_scts_c, new_pvr_scts_c) -!! subroutine copy_pvr_sections_ctl & -!! & (num_pvr_sect, org_pvr_sect_c, new_pvr_sect_c) !! type(pvr_section_ctl), intent(in) & !! & :: org_pvr_sect_c(num_pvr_sect) !! type(pvr_section_ctl), intent(inout) & @@ -64,6 +69,9 @@ module t_control_data_pvr_sections ! ! type pvr_sections_ctl +!> Control block name + character(len = kchara) :: block_name = 'section_ctl' +! integer(kind = kint) :: num_pvr_sect_ctl = 0 type(pvr_section_ctl), allocatable :: pvr_sect_ctl(:) end type pvr_sections_ctl @@ -105,22 +113,33 @@ subroutine alloc_pvr_sections_ctl(pvr_scts_c) end subroutine alloc_pvr_sections_ctl ! ! ----------------------------------------------------------------------- +! + subroutine init_pvr_sections_ctl(hd_block, pvr_scts_c) +! + character(len=kchara), intent(in) :: hd_block + type(pvr_sections_ctl), intent(inout) :: pvr_scts_c +! +! + pvr_scts_c%block_name = hd_block + pvr_scts_c%num_pvr_sect_ctl = 0 +! + end subroutine init_pvr_sections_ctl +! +! ----------------------------------------------------------------------- ! --------------------------------------------------------------------- ! subroutine read_pvr_sections_ctl & & (id_control, hd_block, pvr_scts_c, c_buf) -! - use ctl_data_pvr_section_IO ! integer(kind = kint), intent(in) :: id_control character(len=kchara), intent(in) :: hd_block type(pvr_sections_ctl), intent(inout) :: pvr_scts_c type(buffer_for_control), intent(inout) :: c_buf ! + integer(kind = kint) :: n_append ! if(check_array_flag(c_buf, hd_block) .eqv. .FALSE.) return if(allocated(pvr_scts_c%pvr_sect_ctl)) return - pvr_scts_c%num_pvr_sect_ctl = 0 call alloc_pvr_sections_ctl(pvr_scts_c) ! do @@ -129,7 +148,8 @@ subroutine read_pvr_sections_ctl & if(check_end_array_flag(c_buf, hd_block)) exit ! if(check_begin_flag(c_buf, hd_block)) then - call append_new_pvr_section_ctl(pvr_scts_c) + n_append = pvr_scts_c%num_pvr_sect_ctl + call append_pvr_section_ctl(n_append, hd_block, pvr_scts_c) ! call read_pvr_section_ctl & & (id_control, hd_block, pvr_scts_c%num_pvr_sect_ctl, & @@ -145,7 +165,6 @@ end subroutine read_pvr_sections_ctl subroutine write_pvr_sections_ctl & & (id_control, hd_block, pvr_scts_c, level) ! - use ctl_data_pvr_section_IO use write_control_elements ! integer(kind = kint), intent(in) :: id_control @@ -172,47 +191,80 @@ end subroutine write_pvr_sections_ctl ! --------------------------------------------------------------------- ! --------------------------------------------------------------------- ! - subroutine copy_pvr_sections_ctl & - & (num_pvr_sect, org_pvr_scts_c, new_pvr_scts_c) + subroutine append_pvr_section_ctl(idx_in, hd_block, pvr_scts_c) ! - integer(kind = kint), intent(in) :: num_pvr_sect - type(pvr_sections_ctl), intent(in) :: org_pvr_scts_c - type(pvr_sections_ctl), intent(inout) :: new_pvr_scts_c + integer(kind = kint), intent(in) :: idx_in + character(len=kchara), intent(in) :: hd_block + type(pvr_sections_ctl), intent(inout) :: pvr_scts_c ! + type(pvr_sections_ctl) :: tmp_pvr_scts integer(kind = kint) :: i ! - do i = 1, num_pvr_sect - call dup_pvr_section_ctl(org_pvr_scts_c%pvr_sect_ctl(i), & - & new_pvr_scts_c%pvr_sect_ctl(i)) +! + if(idx_in.lt.0 .or. idx_in.gt.pvr_scts_c%num_pvr_sect_ctl) return +! + tmp_pvr_scts%num_pvr_sect_ctl = pvr_scts_c%num_pvr_sect_ctl + call alloc_pvr_sections_ctl(tmp_pvr_scts) + do i = 1, tmp_pvr_scts%num_pvr_sect_ctl + call dup_pvr_section_ctl(pvr_scts_c%pvr_sect_ctl(i), & + & tmp_pvr_scts%pvr_sect_ctl(i)) + end do +! + call dealloc_pvr_sections_ctl(pvr_scts_c) + pvr_scts_c%num_pvr_sect_ctl = tmp_pvr_scts%num_pvr_sect_ctl + 1 + call alloc_pvr_sections_ctl(pvr_scts_c) +! + do i = 1, idx_in + call dup_pvr_section_ctl(tmp_pvr_scts%pvr_sect_ctl(i), & + & pvr_scts_c%pvr_sect_ctl(i)) + end do + call init_pvr_section_ctl_label(hd_block, & + & pvr_scts_c%pvr_sect_ctl(idx_in+1)) + do i = idx_in+1, tmp_pvr_scts%num_pvr_sect_ctl + call dup_pvr_section_ctl(tmp_pvr_scts%pvr_sect_ctl(i), & + & pvr_scts_c%pvr_sect_ctl(i+1)) end do ! - end subroutine copy_pvr_sections_ctl + call dealloc_pvr_sections_ctl(tmp_pvr_scts) +! + end subroutine append_pvr_section_ctl ! ! ----------------------------------------------------------------------- ! - subroutine append_new_pvr_section_ctl(pvr_scts_c) + subroutine delete_pvr_section_ctl(idx_in, pvr_scts_c) ! + integer(kind = kint), intent(in) :: idx_in type(pvr_sections_ctl), intent(inout) :: pvr_scts_c ! type(pvr_sections_ctl) :: tmp_pvr_scts + integer(kind = kint) :: i ! +! + if(idx_in.le.0 .or. idx_in.gt.pvr_scts_c%num_pvr_sect_ctl) return ! tmp_pvr_scts%num_pvr_sect_ctl = pvr_scts_c%num_pvr_sect_ctl call alloc_pvr_sections_ctl(tmp_pvr_scts) - call copy_pvr_sections_ctl(tmp_pvr_scts%num_pvr_sect_ctl, & - & pvr_scts_c, tmp_pvr_scts) + do i = 1, tmp_pvr_scts%num_pvr_sect_ctl + call dup_pvr_section_ctl(pvr_scts_c%pvr_sect_ctl(i), & + & tmp_pvr_scts%pvr_sect_ctl(i)) + end do ! call dealloc_pvr_sections_ctl(pvr_scts_c) -! - pvr_scts_c%num_pvr_sect_ctl = tmp_pvr_scts%num_pvr_sect_ctl + 1 + pvr_scts_c%num_pvr_sect_ctl = tmp_pvr_scts%num_pvr_sect_ctl - 1 call alloc_pvr_sections_ctl(pvr_scts_c) ! - call copy_pvr_sections_ctl(tmp_pvr_scts%num_pvr_sect_ctl, & - & tmp_pvr_scts, pvr_scts_c) + do i = 1, idx_in-1 + call dup_pvr_section_ctl(tmp_pvr_scts%pvr_sect_ctl(i), & + & pvr_scts_c%pvr_sect_ctl(i)) + end do + do i = idx_in, pvr_scts_c%num_pvr_sect_ctl + call dup_pvr_section_ctl(tmp_pvr_scts%pvr_sect_ctl(i+1), & + & pvr_scts_c%pvr_sect_ctl(i)) + end do ! call dealloc_pvr_sections_ctl(tmp_pvr_scts) ! - end subroutine append_new_pvr_section_ctl + end subroutine delete_pvr_section_ctl ! ! ----------------------------------------------------------------------- ! @@ -221,11 +273,16 @@ subroutine dup_pvr_sections_ctl(org_pvr_scts_c, new_pvr_scts_c) type(pvr_sections_ctl), intent(in) :: org_pvr_scts_c type(pvr_sections_ctl), intent(inout) :: new_pvr_scts_c ! + integer(kind = kint) :: i ! + new_pvr_scts_c%block_name = org_pvr_scts_c%block_name new_pvr_scts_c%num_pvr_sect_ctl = org_pvr_scts_c%num_pvr_sect_ctl call alloc_pvr_sections_ctl(new_pvr_scts_c) - call copy_pvr_sections_ctl(org_pvr_scts_c%num_pvr_sect_ctl, & - & org_pvr_scts_c, new_pvr_scts_c) +! + do i = 1, org_pvr_scts_c%num_pvr_sect_ctl + call dup_pvr_section_ctl(org_pvr_scts_c%pvr_sect_ctl(i), & + & new_pvr_scts_c%pvr_sect_ctl(i)) + end do ! end subroutine dup_pvr_sections_ctl ! diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_pvrs.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_pvrs.f90 index 32877bfc..8f9e4a46 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_pvrs.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_pvrs.f90 @@ -8,6 +8,11 @@ !! !!@verbatim !! subroutine alloc_pvr_ctl_struct(pvr_ctls) +!! subroutine dealloc_pvr_ctl_struct(pvr_ctls) +!! subroutine init_pvr_ctls_labels(hd_pvr_ctl, pvr_ctls) +!! character(len = kchara), intent(in) :: hd_pvr_ctl +!! type(volume_rendering_controls), intent(inout) :: pvr_ctls +!! !! subroutine read_files_4_pvr_ctl & !! & (id_control, hd_pvr_ctl, pvr_ctls, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -25,6 +30,11 @@ !! type(volume_rendering_controls), intent(in) :: pvr_ctls !! type(ctl_array_c3), intent(inout) :: field_ctl !! +!! subroutine append_pvr_ctl_struct(idx_in, hd_block, pvr_ctls) +!! subroutine delete_pvr_ctl_struct(idx_in, hd_block, pvr_ctls) +!! integer(kind = kint), intent(in) :: idx_in +!! character(len=kchara), intent(in) :: hd_block +!! type(volume_rendering_controls), intent(inout) :: pvr_ctls !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! array volume_rendering 1 !! file volume_rendering 'ctl_pvr_temp' @@ -42,12 +52,13 @@ module t_control_data_pvrs implicit none ! type volume_rendering_controls +!> Control block name + character(len = kchara) :: block_name = 'volume_rendering' +! integer(kind = kint) :: num_pvr_ctl = 0 character(len = kchara), allocatable :: fname_pvr_ctl(:) type(pvr_parameter_ctl), allocatable :: pvr_ctl_type(:) end type volume_rendering_controls -! - private :: append_new_pvr_ctl_struct, dup_pvr_ctl_struct ! ! -------------------------------------------------------------------- ! @@ -86,6 +97,19 @@ subroutine dealloc_pvr_ctl_struct(pvr_ctls) end subroutine dealloc_pvr_ctl_struct ! ! --------------------------------------------------------------------- +! + subroutine init_pvr_ctls_labels(hd_pvr_ctl, pvr_ctls) +! + character(len = kchara), intent(in) :: hd_pvr_ctl + type(volume_rendering_controls), intent(inout) :: pvr_ctls +! +! + pvr_ctls%block_name = hd_pvr_ctl + pvr_ctls%num_pvr_ctl = 0 +! + end subroutine init_pvr_ctls_labels +! +! --------------------------------------------------------------------- ! --------------------------------------------------------------------- ! subroutine read_files_4_pvr_ctl & @@ -101,11 +125,12 @@ subroutine read_files_4_pvr_ctl & ! type(volume_rendering_controls), intent(inout) :: pvr_ctls type(buffer_for_control), intent(inout) :: c_buf +! + integer(kind = kint) :: n_append ! ! if(check_array_flag(c_buf, hd_pvr_ctl) .eqv. .FALSE.) return if(allocated(pvr_ctls%fname_pvr_ctl)) return - pvr_ctls%num_pvr_ctl = 0 call alloc_pvr_ctl_struct(pvr_ctls) ! do @@ -115,7 +140,8 @@ subroutine read_files_4_pvr_ctl & ! if(check_file_flag(c_buf, hd_pvr_ctl) & & .or. check_begin_flag(c_buf, hd_pvr_ctl)) then - call append_new_pvr_ctl_struct(pvr_ctls) + n_append = pvr_ctls%num_pvr_ctl + call append_pvr_ctl_struct(n_append, hd_pvr_ctl, pvr_ctls) ! call write_multi_ctl_file_message & & (hd_pvr_ctl, pvr_ctls%num_pvr_ctl, c_buf%level) @@ -181,47 +207,91 @@ end subroutine add_fields_4_pvrs_to_fld_ctl ! --------------------------------------------------------------------- ! -------------------------------------------------------------------- ! - subroutine append_new_pvr_ctl_struct(pvr_ctls) + subroutine append_pvr_ctl_struct(idx_in, hd_block, pvr_ctls) ! + use ctl_data_each_pvr_IO +! + integer(kind = kint), intent(in) :: idx_in + character(len=kchara), intent(in) :: hd_block type(volume_rendering_controls), intent(inout) :: pvr_ctls ! type(volume_rendering_controls) :: tmp_pvrs_c + integer(kind = kint) :: i +! ! + if(idx_in.lt.0 .or. idx_in.gt.pvr_ctls%num_pvr_ctl) return ! tmp_pvrs_c%num_pvr_ctl = pvr_ctls%num_pvr_ctl call alloc_pvr_ctl_struct(tmp_pvrs_c) - call dup_pvr_ctl_struct & - & (pvr_ctls%num_pvr_ctl, pvr_ctls, tmp_pvrs_c) - call dealloc_pvr_ctl_struct(pvr_ctls) + do i = 1, pvr_ctls%num_pvr_ctl + call dup_pvr_ctl(pvr_ctls%pvr_ctl_type(i), & + & tmp_pvrs_c%pvr_ctl_type(i)) + tmp_pvrs_c%fname_pvr_ctl(i) = pvr_ctls%fname_pvr_ctl(i) + end do ! + call dealloc_pvr_ctl_struct(pvr_ctls) pvr_ctls%num_pvr_ctl = tmp_pvrs_c%num_pvr_ctl + 1 call alloc_pvr_ctl_struct(pvr_ctls) - call dup_pvr_ctl_struct & - & (tmp_pvrs_c%num_pvr_ctl, tmp_pvrs_c, pvr_ctls) +! + do i = 1, idx_in + call dup_pvr_ctl(tmp_pvrs_c%pvr_ctl_type(i), & + & pvr_ctls%pvr_ctl_type(i)) + pvr_ctls%fname_pvr_ctl(i) = tmp_pvrs_c%fname_pvr_ctl(i) + end do +! + call init_pvr_ctl_label(hd_block, & + & pvr_ctls%pvr_ctl_type(idx_in+1)) + pvr_ctls%fname_pvr_ctl(idx_in+1) = 'NO_FILE' +! + do i = idx_in+1, tmp_pvrs_c%num_pvr_ctl + call dup_pvr_ctl(tmp_pvrs_c%pvr_ctl_type(i), & + & pvr_ctls%pvr_ctl_type(i+1)) + pvr_ctls%fname_pvr_ctl(i+1) = tmp_pvrs_c%fname_pvr_ctl(i) + end do +! call dealloc_pvr_ctl_struct(tmp_pvrs_c) ! - end subroutine append_new_pvr_ctl_struct + end subroutine append_pvr_ctl_struct ! ! --------------------------------------------------------------------- ! - subroutine dup_pvr_ctl_struct(num_pvr, org_pvrs_c, new_pvrs_c) -! - use bcast_control_data_4_pvr + subroutine delete_pvr_ctl_struct(idx_in, pvr_ctls) ! - integer(kind = kint), intent(in) :: num_pvr - type(volume_rendering_controls), intent(in) :: org_pvrs_c - type(volume_rendering_controls), intent(inout) :: new_pvrs_c + integer(kind = kint), intent(in) :: idx_in + type(volume_rendering_controls), intent(inout) :: pvr_ctls ! + type(volume_rendering_controls) :: tmp_pvrs_c integer(kind = kint) :: i ! ! - do i = 1, num_pvr - new_pvrs_c%fname_pvr_ctl(i) = org_pvrs_c%fname_pvr_ctl(i) - call dup_pvr_ctl(org_pvrs_c%pvr_ctl_type(i), & - & new_pvrs_c%pvr_ctl_type(i)) + if(idx_in.le.0 .or. idx_in.gt.pvr_ctls%num_pvr_ctl) return +! + tmp_pvrs_c%num_pvr_ctl = pvr_ctls%num_pvr_ctl + call alloc_pvr_ctl_struct(tmp_pvrs_c) + do i = 1, pvr_ctls%num_pvr_ctl + call dup_pvr_ctl(pvr_ctls%pvr_ctl_type(i), & + & tmp_pvrs_c%pvr_ctl_type(i)) + tmp_pvrs_c%fname_pvr_ctl(i) = pvr_ctls%fname_pvr_ctl(i) end do ! - end subroutine dup_pvr_ctl_struct + call dealloc_pvr_ctl_struct(pvr_ctls) + pvr_ctls%num_pvr_ctl = tmp_pvrs_c%num_pvr_ctl + 1 + call alloc_pvr_ctl_struct(pvr_ctls) +! + do i = 1, idx_in-1 + call dup_pvr_ctl(tmp_pvrs_c%pvr_ctl_type(i), & + & pvr_ctls%pvr_ctl_type(i)) + pvr_ctls%fname_pvr_ctl(i) = tmp_pvrs_c%fname_pvr_ctl(i) + end do + do i = idx_in, pvr_ctls%num_pvr_ctl + call dup_pvr_ctl(tmp_pvrs_c%pvr_ctl_type(i+1), & + & pvr_ctls%pvr_ctl_type(i)) + pvr_ctls%fname_pvr_ctl(i) = tmp_pvrs_c%fname_pvr_ctl(i+1) + end do +! + call dealloc_pvr_ctl_struct(tmp_pvrs_c) +! + end subroutine delete_pvr_ctl_struct ! ! --------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_viz3.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_viz3.f90 index 97e68628..accae989 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_viz3.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_data_viz3.f90 @@ -62,6 +62,9 @@ module t_control_data_viz3 ! !> Structures of visualization controls type vis3_controls +!> Block name + character(len=kchara) :: block_name = 'visual_control' +! !> Structures of setioning controls type(section_controls) :: psf_ctls !> Structures of isosurface controls diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_params_4_pvr.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_params_4_pvr.f90 index f652fdc9..97a37fda 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_params_4_pvr.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_control_params_4_pvr.f90 @@ -10,11 +10,6 @@ !! subroutine alloc_pvr_element_group(pvr_area) !! subroutine dealloc_pvr_element_group(pvr_area) !! type(viz_area_parameter), intent(inout) :: pvr_area -!! -!! integer(kind = kint) function num_flag_pvr_movie_mode() -!! integer(kind = kint) function num_flag_LIC_movie_mode() -!! subroutine set_flag_pvr_movie_mode(names) -!! subroutine set_flag_LIC_movie_mode(names) !!@endverbatim ! module t_control_params_4_pvr @@ -28,16 +23,6 @@ module t_control_params_4_pvr ! real(kind = kreal), parameter :: SMALL_RAY_TRACE = 0.1d0 real(kind = kreal), parameter :: SMALL_NORM = -0.1d0 -! - integer(kind = kint), parameter :: n_flag_pvr_movie_mode = 3 - integer(kind = kint), parameter :: n_flag_LIC_movie_mode = 4 - character(len=kchara), parameter & - & :: FLAG_ROTATE_MOVIE = 'rotation' - character(len=kchara), parameter :: FLAG_ZOOM = 'zoom' - character(len=kchara), parameter & - & :: FLAG_START_END_VIEW = 'view_matrices' - character(len=kchara), parameter & - & :: FLAG_LIC_KERNEL = 'LIC_kernel' ! integer(kind = kint), parameter :: IFLAG_NO_MOVIE = 0 integer(kind = kint), parameter :: I_ROTATE_MOVIE = 1 @@ -170,53 +155,5 @@ subroutine dealloc_pvr_element_group(pvr_area) end subroutine dealloc_pvr_element_group ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- -! - integer(kind = kint) function num_flag_pvr_movie_mode() - num_flag_pvr_movie_mode = n_flag_pvr_movie_mode - return - end function num_flag_pvr_movie_mode -! -! --------------------------------------------------------------------- -! - integer(kind = kint) function num_flag_LIC_movie_mode() - num_flag_LIC_movie_mode = n_flag_LIC_movie_mode - return - end function num_flag_LIC_movie_mode -! -! --------------------------------------------------------------------- -! - subroutine set_flag_pvr_movie_mode(names) -! - use t_read_control_elements -! - character(len = kchara), intent(inout) & - & :: names(n_flag_pvr_movie_mode) -! -! - call set_control_labels(FLAG_ROTATE_MOVIE, names( 1)) - call set_control_labels(FLAG_ZOOM, names( 2)) - call set_control_labels(FLAG_START_END_VIEW, names( 3)) -! - end subroutine set_flag_pvr_movie_mode -! -! ---------------------------------------------------------------------- -! - subroutine set_flag_LIC_movie_mode(names) -! - use t_read_control_elements -! - character(len = kchara), intent(inout) & - & :: names(n_flag_LIC_movie_mode) -! -! - call set_control_labels(FLAG_ROTATE_MOVIE, names( 1)) - call set_control_labels(FLAG_ZOOM, names( 2)) - call set_control_labels(FLAG_START_END_VIEW, names( 3)) - call set_control_labels(FLAG_LIC_KERNEL, names( 4)) -! - end subroutine set_flag_LIC_movie_mode -! -! ---------------------------------------------------------------------- ! end module t_control_params_4_pvr diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_4_projection.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_4_projection.f90 index e902f538..45b32282 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_4_projection.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_4_projection.f90 @@ -7,6 +7,7 @@ !>@brief Control inputs for PVR projection and streo parameter !! !!@verbatim +!! subroutine init_projection_mat_ctl_label(hd_block, proj) !! subroutine read_projection_mat_ctl & !! & (id_control, hd_block, proj, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -24,9 +25,8 @@ !! subroutine copy_projection_mat_ctl(org_proj, new_proj) !! type(projection_ctl), intent(in) :: org_proj !! type(projection_ctl), intent(inout) :: new_proj -!! -!! integer(kind = kint) function num_label_pvr_projection() -!! subroutine set_label_pvr_projection(names) +!! logical function cmp_projection_ctl(proj1, proj2) +!! type(projection_ctl), intent(in) :: proj1, proj2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! Input example !! @@ -53,13 +53,14 @@ module t_ctl_data_4_projection use t_read_control_elements use t_control_array_real use t_control_array_real2 - use skip_comment_f ! implicit none ! ! !> Structure of projection parameters type projection_ctl +!> Control block name + character(len = kchara) :: block_name = 'projection_matrix_ctl' !> Structure of perspective view angle type(read_real_item) :: perspective_angle_ctl !> Structure of aspect ration of screen @@ -78,8 +79,6 @@ module t_ctl_data_4_projection end type projection_ctl ! ! 4th level for projection_matrix - integer(kind = kint), parameter, private & - & :: n_label_pvr_projection = 6 character(len=kchara), parameter, private & & :: hd_perspect_angle = 'perspective_angle_ctl' character(len=kchara), parameter, private & @@ -102,6 +101,8 @@ module t_ctl_data_4_projection ! subroutine read_projection_mat_ctl & & (id_control, hd_block, proj, c_buf) +! + use skip_comment_f ! integer(kind = kint), intent(in) :: id_control character(len=kchara), intent(in) :: hd_block @@ -162,23 +163,86 @@ subroutine write_projection_mat_ctl & ! level = write_begin_flag_for_ctl(id_control, level, hd_block) call write_real_ctl_type(id_control, level, maxlen, & - & hd_perspect_angle, proj%perspective_angle_ctl) + & proj%perspective_angle_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_perspect_xy, proj%perspective_xy_ratio_ctl) + & proj%perspective_xy_ratio_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_perspect_near, proj%perspective_near_ctl) + & proj%perspective_near_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_perspect_far, proj%perspective_far_ctl) + & proj%perspective_far_ctl) ! call write_real2_ctl_type(id_control, level, maxlen, & - & hd_horizontal_range, proj%horizontal_range_ctl) + & proj%horizontal_range_ctl) call write_real2_ctl_type(id_control, level, maxlen, & - & hd_vertical_range, proj%vertical_range_ctl) + & proj%vertical_range_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_projection_mat_ctl ! ! --------------------------------------------------------------------- +! + subroutine init_projection_mat_ctl_label(hd_block, proj) +! + character(len=kchara), intent(in) :: hd_block +! + type(projection_ctl), intent(inout) :: proj +! +! + proj%block_name = hd_block + call init_real_ctl_item_label(hd_perspect_angle, & + & proj%perspective_angle_ctl) + call init_real_ctl_item_label(hd_perspect_xy, & + & proj%perspective_xy_ratio_ctl) + call init_real_ctl_item_label(hd_perspect_near, & + & proj%perspective_near_ctl) + call init_real_ctl_item_label(hd_perspect_far, & + & proj%perspective_far_ctl) +! + call init_real2_ctl_item_label(hd_horizontal_range, & + & proj%horizontal_range_ctl) + call init_real2_ctl_item_label(hd_vertical_range, & + & proj%vertical_range_ctl) +! + end subroutine init_projection_mat_ctl_label +! +! --------------------------------------------------------------------- +! + logical function cmp_projection_ctl(proj1, proj2) +! + use skip_comment_f +! + type(projection_ctl), intent(in) :: proj1, proj2 +! + cmp_projection_ctl = .FALSE. + if(proj1%i_project_mat .ne. proj2%i_project_mat) return + if(cmp_no_case(trim(proj1%block_name), & + & trim(proj2%block_name)) .eqv. .FALSE.) return +! + if(cmp_read_real_item(proj1%perspective_angle_ctl, & + & proj2%perspective_angle_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_real_item(proj1%perspective_xy_ratio_ctl, & + & proj2%perspective_xy_ratio_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_real_item(proj1%perspective_near_ctl, & + & proj2%perspective_near_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_real_item(proj1%perspective_far_ctl, & + & proj2%perspective_far_ctl) & + & .eqv. .FALSE.) return +! + if(cmp_read_real2_item(proj1%horizontal_range_ctl, & + & proj2%horizontal_range_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_real2_item(proj1%vertical_range_ctl, & + & proj2%vertical_range_ctl) & + & .eqv. .FALSE.) return + cmp_projection_ctl = .TRUE. +! + end function cmp_projection_ctl +! +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- ! subroutine reset_projection_view_ctl(proj) ! @@ -204,6 +268,7 @@ subroutine copy_projection_mat_ctl(org_proj, new_proj) type(projection_ctl), intent(inout) :: new_proj ! ! + new_proj%block_name = org_proj%block_name new_proj%i_project_mat = org_proj%i_project_mat ! call copy_real_ctl(org_proj%perspective_angle_ctl, & @@ -223,31 +288,5 @@ subroutine copy_projection_mat_ctl(org_proj, new_proj) end subroutine copy_projection_mat_ctl ! ! --------------------------------------------------------------------- -! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_label_pvr_projection() - num_label_pvr_projection = n_label_pvr_projection - return - end function num_label_pvr_projection -! -! ---------------------------------------------------------------------- -! - subroutine set_label_pvr_projection(names) -! - character(len = kchara), intent(inout) & - & :: names(n_label_pvr_projection) -! -! - call set_control_labels(hd_perspect_angle, names( 1)) - call set_control_labels(hd_perspect_xy, names( 2)) - call set_control_labels(hd_perspect_near, names( 3)) - call set_control_labels(hd_perspect_far, names( 4)) -! - call set_control_labels(hd_horizontal_range, names( 5)) - call set_control_labels(hd_vertical_range, names( 6)) -! - end subroutine set_label_pvr_projection -! -! ---------------------------------------------------------------------- ! end module t_ctl_data_4_projection diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_4_screen_pixel.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_4_screen_pixel.f90 index a71e64f0..5a02ea98 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_4_screen_pixel.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_4_screen_pixel.f90 @@ -7,6 +7,7 @@ !>@brief Control inputs for PVR projection and streo parameter !! !!@verbatim +!! subroutine init_image_size_ctl_label(hd_block, pixel) !! subroutine read_image_size_ctl & !! & (id_control, hd_block, pixel, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -19,13 +20,12 @@ !! character(len=kchara), intent(in) :: hd_block !! type(screen_pixel_ctl), intent(in) :: pixel !! integer(kind = kint), intent(inout) :: level +!! logical function cmp_screen_pixel_ctl(pixel1, pixel2) +!! type(screen_pixel_ctl), intent(in) :: pixel1, pixel2 !! subroutine reset_image_size_ctl(pixel) !! subroutine copy_image_size_ctl(org_pixel, new_pixel) !! type(screen_pixel_ctl), intent(in) :: org_pixel !! type(screen_pixel_ctl), intent(inout) :: new_pixel -!! -!! integer(kind = kint) function num_label_pvr_pixels() -!! subroutine set_label_pvr_pixels(names) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! Input example !! @@ -46,7 +46,6 @@ module t_ctl_data_4_screen_pixel use m_machine_parameter use t_read_control_elements use t_control_array_integer - use skip_comment_f ! implicit none ! @@ -54,6 +53,8 @@ module t_ctl_data_4_screen_pixel ! !> Structure of screen resolution type screen_pixel_ctl +!> Control block name + character(len = kchara) :: block_name = 'image_size_ctl' !> Structure of number of horizontal pixels type(read_integer_item) :: num_xpixel_ctl !> Structure of number of vertical pixels @@ -64,8 +65,6 @@ module t_ctl_data_4_screen_pixel end type screen_pixel_ctl ! ! 4th level for image size - integer(kind = kint), parameter, private & - & :: n_label_pvr_pixels = 2 character(len=kchara), parameter, private & & :: hd_x_pixel = 'x_pixel_ctl' character(len=kchara), parameter, private & @@ -79,6 +78,8 @@ module t_ctl_data_4_screen_pixel ! subroutine read_image_size_ctl & & (id_control, hd_block, pixel, c_buf) +! + use skip_comment_f ! integer(kind = kint), intent(in) :: id_control character(len=kchara), intent(in) :: hd_block @@ -126,14 +127,52 @@ subroutine write_image_size_ctl & ! level = write_begin_flag_for_ctl(id_control, level, hd_block) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_x_pixel, pixel%num_xpixel_ctl) + & pixel%num_xpixel_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_y_pixel, pixel%num_ypixel_ctl) + & pixel%num_ypixel_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_image_size_ctl ! ! --------------------------------------------------------------------- +! + subroutine init_image_size_ctl_label(hd_block, pixel) +! + character(len=kchara), intent(in) :: hd_block + type(screen_pixel_ctl), intent(inout) :: pixel +! +! + pixel%block_name = hd_block + call init_int_ctl_item_label(hd_x_pixel, pixel%num_xpixel_ctl) + call init_int_ctl_item_label(hd_y_pixel, pixel%num_ypixel_ctl) +! + end subroutine init_image_size_ctl_label +! +! --------------------------------------------------------------------- +! + logical function cmp_screen_pixel_ctl(pixel1, pixel2) +! + use skip_comment_f +! + type(screen_pixel_ctl), intent(in) :: pixel1, pixel2 +! + cmp_screen_pixel_ctl = .FALSE. + if(pixel1%i_image_size .ne. pixel2%i_image_size) return + if(cmp_no_case(trim(pixel1%block_name), & + & trim(pixel2%block_name)) .eqv. .FALSE.) return +! + if(cmp_read_integer_item(pixel1%num_xpixel_ctl, & + & pixel2%num_xpixel_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_integer_item(pixel1%num_ypixel_ctl, & + & pixel2%num_ypixel_ctl) & + & .eqv. .FALSE.) return + cmp_screen_pixel_ctl = .TRUE. +! + end function cmp_screen_pixel_ctl +! +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- ! subroutine reset_image_size_ctl(pixel) ! @@ -155,6 +194,7 @@ subroutine copy_image_size_ctl(org_pixel, new_pixel) type(screen_pixel_ctl), intent(inout) :: new_pixel ! ! + new_pixel%block_name = org_pixel%block_name new_pixel%i_image_size = org_pixel%i_image_size ! call copy_integer_ctl(org_pixel%num_xpixel_ctl, & @@ -164,27 +204,6 @@ subroutine copy_image_size_ctl(org_pixel, new_pixel) ! end subroutine copy_image_size_ctl ! -! --------------------------------------------------------------------- -! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_label_pvr_pixels() - num_label_pvr_pixels = n_label_pvr_pixels - return - end function num_label_pvr_pixels -! -! ---------------------------------------------------------------------- -! - subroutine set_label_pvr_pixels(names) -! - character(len = kchara), intent(inout) & - & :: names(n_label_pvr_pixels) -! -! - call set_control_labels(hd_x_pixel, names( 1)) - call set_control_labels(hd_y_pixel, names( 2)) -! - end subroutine set_label_pvr_pixels -! ! ---------------------------------------------------------------------- ! end module t_ctl_data_4_screen_pixel diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_4_streo_view.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_4_streo_view.f90 index d82d467f..b952e1e0 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_4_streo_view.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_4_streo_view.f90 @@ -7,6 +7,7 @@ !>@brief Control inputs for PVR streo parameter !! !!@verbatim +!! subroutine init_stereo_view_ctl_label(hd_block, streo) !! subroutine read_stereo_view_ctl & !! & (id_control, hd_block, streo, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -19,14 +20,14 @@ !! character(len=kchara), intent(in) :: hd_block !! type(streo_view_ctl), intent(in) :: streo !! integer(kind = kint), intent(inout) :: level +!! logical function cmp_streo_view_ctl(streo1, streo2) +!! type(streo_view_ctl), intent(in) :: streo1, streo2 +!! !! subroutine reset_stereo_view_ctl(streo) !! type(streo_view_ctl), intent(inout) :: streo !! subroutine copy_stereo_view_ctl(org_streo, new_streo) !! type(streo_view_ctl), intent(in) :: org_streo !! type(streo_view_ctl), intent(inout) :: new_streo -!! -!! integer(kind = kint) function num_label_pvr_streo() -!! subroutine set_label_pvr_streo(names) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! Input example !! @@ -50,12 +51,14 @@ module t_ctl_data_4_streo_view use t_read_control_elements use t_control_array_character use t_control_array_real - use skip_comment_f ! implicit none ! !> Structure of streo view parameters type streo_view_ctl +!> Control block name + character(len = kchara) :: block_name & + & = 'stereo_view_parameter_ctl' !> Structure of focal point type(read_real_item) :: focalpoint_ctl !> Structure of eye separation @@ -69,8 +72,6 @@ module t_ctl_data_4_streo_view end type streo_view_ctl ! ! 4th level for stereo view - integer(kind = kint), parameter, private & - & :: n_label_pvr_streo = 4 character(len=kchara), parameter, private & & :: hd_focaldistance = 'focal_distance_ctl' character(len=kchara), parameter, private & @@ -92,6 +93,8 @@ module t_ctl_data_4_streo_view ! subroutine read_stereo_view_ctl & & (id_control, hd_block, streo, c_buf) +! + use skip_comment_f ! integer(kind = kint), intent(in) :: id_control character(len=kchara), intent(in) :: hd_block @@ -149,19 +152,73 @@ subroutine write_stereo_view_ctl & ! level = write_begin_flag_for_ctl(id_control, level, hd_block) call write_real_ctl_type(id_control, level, maxlen, & - & hd_focaldistance, streo%focalpoint_ctl) + & streo%focalpoint_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_eye_separation, streo%eye_separation_ctl) + & streo%eye_separation_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_eye_sep_angle, streo%eye_sep_angle_ctl) + & streo%eye_sep_angle_ctl) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_eye_step_mode, streo%step_eye_sep_angle_ctl) + & streo%step_eye_sep_angle_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_stereo_view_ctl ! ! --------------------------------------------------------------------- +! + subroutine init_stereo_view_ctl_label(hd_block, streo) +! + character(len=kchara), intent(in) :: hd_block + type(streo_view_ctl), intent(inout) :: streo +! +! + streo%block_name = hd_block + call init_real_ctl_item_label(hd_focaldistance, & + & streo%focalpoint_ctl) + call init_real_ctl_item_label(hd_focalpoint, & + & streo%focalpoint_ctl) +! + call init_real_ctl_item_label(hd_eye_separation, & + & streo%eye_separation_ctl) + call init_real_ctl_item_label(hd_eye_sep_angle, & + & streo%eye_sep_angle_ctl) +! + call init_chara_ctl_item_label(hd_eye_step_mode, & + & streo%step_eye_sep_angle_ctl) +! + end subroutine init_stereo_view_ctl_label +! +! --------------------------------------------------------------------- +! + logical function cmp_streo_view_ctl(streo1, streo2) +! + use skip_comment_f +! + type(streo_view_ctl), intent(in) :: streo1, streo2 +! + cmp_streo_view_ctl = .FALSE. + if(streo1%i_stereo_view .ne. streo2%i_stereo_view) return + if(cmp_no_case(trim(streo1%block_name), & + & trim(streo2%block_name)) .eqv. .FALSE.) return +! + if(cmp_read_real_item(streo1%focalpoint_ctl, & + & streo2%focalpoint_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_real_item(streo1%eye_separation_ctl, & + & streo2%eye_separation_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_real_item(streo1%eye_sep_angle_ctl, & + & streo2%eye_sep_angle_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_chara_item(streo1%step_eye_sep_angle_ctl, & + & streo2%step_eye_sep_angle_ctl) & + & .eqv. .FALSE.) return + cmp_streo_view_ctl = .TRUE. +! + end function cmp_streo_view_ctl +! +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- ! subroutine reset_stereo_view_ctl(streo) ! @@ -185,6 +242,7 @@ subroutine copy_stereo_view_ctl(org_streo, new_streo) type(streo_view_ctl), intent(inout) :: new_streo ! ! + new_streo%block_name = org_streo%block_name new_streo%i_stereo_view = org_streo%i_stereo_view ! call copy_real_ctl(org_streo%focalpoint_ctl, & @@ -199,28 +257,5 @@ subroutine copy_stereo_view_ctl(org_streo, new_streo) end subroutine copy_stereo_view_ctl ! ! --------------------------------------------------------------------- -! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_label_pvr_streo() - num_label_pvr_streo = n_label_pvr_streo - return - end function num_label_pvr_streo -! -! ---------------------------------------------------------------------- -! - subroutine set_label_pvr_streo(names) -! - character(len = kchara), intent(inout) & - & :: names(n_label_pvr_streo) -! -! - call set_control_labels(hd_focaldistance, names( 1)) - call set_control_labels(hd_eye_separation, names( 2)) - call set_control_labels(hd_eye_sep_angle, names( 3)) - call set_control_labels(hd_eye_step_mode, names( 4)) -! - end subroutine set_label_pvr_streo -! -! ---------------------------------------------------------------------- ! end module t_ctl_data_4_streo_view diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_4_view_transfer.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_4_view_transfer.f90 index 1a001258..006f866f 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_4_view_transfer.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_4_view_transfer.f90 @@ -12,6 +12,8 @@ !! subroutine dup_view_transfer_ctl(org_mat, new_mat) !! type(modeview_ctl), intent(in) :: org_mat !! type(modeview_ctl), intent(inout) :: new_mat +!! logical function cmp_modeview_ctl(mat1, mat2) +!! type(modeview_ctl), intent(in) :: mat1, mat2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! Input example ! @@ -128,8 +130,8 @@ module t_ctl_data_4_view_transfer ! !> Structure for modelview marices type modeview_ctl -!> File name for external control file - character(len=kchara) :: mat_ctl_fname +!> Control block name + character(len = kchara) :: block_name = 'view_transform_ctl' ! !> Structure of screen resolution type(screen_pixel_ctl) :: pixel @@ -182,8 +184,11 @@ module t_ctl_data_4_view_transfer !> Structure for projection type for 2D plot type(read_character_item) :: projection_type_ctl ! -!> entry label for this block +!> loaded flag integer (kind=kint) :: i_view_transform = 0 +! +!> Consistency check flag + logical :: flag_checked = .FALSE. end type modeview_ctl ! ! --------------------------------------------------------------------- @@ -246,6 +251,7 @@ subroutine dup_view_transfer_ctl(org_mat, new_mat) type(modeview_ctl), intent(inout) :: new_mat ! ! + new_mat%block_name = org_mat%block_name new_mat%i_view_transform = org_mat%i_view_transform ! call dup_control_array_c_r(org_mat%lookpoint_ctl, & @@ -280,5 +286,57 @@ subroutine dup_view_transfer_ctl(org_mat, new_mat) end subroutine dup_view_transfer_ctl ! ! --------------------------------------------------------------------- +! + logical function cmp_modeview_ctl(mat1, mat2) +! + type(modeview_ctl), intent(in) :: mat1, mat2 +! + cmp_modeview_ctl = .FALSE. + if(mat1%i_view_transform .ne. mat2%i_view_transform) return + if(cmp_no_case(trim(mat1%block_name), & + & trim(mat2%block_name)) .eqv. .FALSE.) return +! + if(cmp_screen_pixel_ctl(mat1%pixel, mat2%pixel) & + & .eqv. .FALSE.) return + if(cmp_projection_ctl(mat1%proj, mat2%proj) .eqv. .FALSE.) return + if(cmp_streo_view_ctl(mat1%streo, mat2%streo) & + & .eqv. .FALSE.) return +! + if(cmp_control_array_c2_r(mat1%modelview_mat_ctl, & + & mat2%modelview_mat_ctl) & + & .eqv. .FALSE.) return +! + if(cmp_control_array_c_r(mat1%lookpoint_ctl, mat2%lookpoint_ctl) & + & .eqv. .FALSE.) return + if(cmp_control_array_c_r(mat1%viewpoint_ctl, mat2%viewpoint_ctl) & + & .eqv. .FALSE.) return + if(cmp_control_array_c_r(mat1%up_dir_ctl, mat2%up_dir_ctl) & + & .eqv. .FALSE.) return + if(cmp_control_array_c_r(mat1%view_rot_vec_ctl, & + & mat2%view_rot_vec_ctl) & + & .eqv. .FALSE.) return + if(cmp_control_array_c_r(mat1%scale_vector_ctl, & + & mat2%scale_vector_ctl) & + & .eqv. .FALSE.) return + if(cmp_control_array_c_r(mat1%viewpt_in_viewer_ctl, & + & mat2%viewpt_in_viewer_ctl) & + & .eqv. .FALSE.) return +! + if(cmp_read_real_item(mat1%view_rotation_deg_ctl, & + & mat2%view_rotation_deg_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_real_item(mat1%scale_factor_ctl, & + & mat2%scale_factor_ctl) & + & .eqv. .FALSE.) return +! + if(cmp_read_chara_item(mat1%projection_type_ctl, & + & mat2%projection_type_ctl) & + & .eqv. .FALSE.) return +! + cmp_modeview_ctl = .TRUE. +! + end function cmp_modeview_ctl +! +! -------------------------------------------------------------------- ! end module t_ctl_data_4_view_transfer diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_area.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_area.f90 index b8f34c29..594aefbc 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_area.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_area.f90 @@ -8,6 +8,7 @@ !! !!@verbatim !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! subroutine int_pvr_render_area_ctl(hd_block, render_area_c) !! subroutine read_pvr_render_area_ctl & !! & (id_control, hd_block, render_area_c, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -25,9 +26,6 @@ !! type(pvr_render_area_ctl), intent(inout) :: new_rarea_c !! subroutine dealloc_pvr_render_area_ctl(render_area_c) !! type(pvr_render_area_ctl), intent(inout) :: render_area_c -!! -!! integer(kind = kint) function num_label_pvr_area() -!! subroutine set_label_pvr_area(names) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! !! begin plot_area_ctl @@ -58,6 +56,9 @@ module t_ctl_data_pvr_area ! ! type pvr_render_area_ctl +!> Control block name + character(len = kchara) :: block_name = 'FEM_sleeve_ctl' +! type(ctl_array_chara) :: pvr_area_ctl type(ctl_array_c2r) :: surf_enhanse_ctl ! @@ -69,9 +70,7 @@ module t_ctl_data_pvr_area character(len=kchara) :: hd_plot_grp = 'chosen_ele_grp_ctl' character(len=kchara) :: hd_sf_enhanse = 'surface_enhanse_ctl' ! - integer(kind = kint), parameter :: n_label_pvr_area = 2 -! - private :: hd_plot_grp, hd_sf_enhanse, n_label_pvr_area + private :: hd_plot_grp, hd_sf_enhanse ! ! --------------------------------------------------------------------- ! @@ -122,14 +121,30 @@ subroutine write_pvr_render_area_ctl & ! level = write_begin_flag_for_ctl(id_control, level, hd_block) call write_control_array_c1(id_control, level, & - & hd_plot_grp, render_area_c%pvr_area_ctl) + & render_area_c%pvr_area_ctl) call write_control_array_c2_r(id_control, level, & - & hd_sf_enhanse, render_area_c%surf_enhanse_ctl) + & render_area_c%surf_enhanse_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_pvr_render_area_ctl ! ! --------------------------------------------------------------------- +! + subroutine int_pvr_render_area_ctl(hd_block, render_area_c) +! + character(len=kchara), intent(in) :: hd_block + type(pvr_render_area_ctl), intent(inout) :: render_area_c +! +! + render_area_c%block_name = hd_block + call init_chara_ctl_array_label(hd_plot_grp, & + & render_area_c%pvr_area_ctl) + call init_c2_r_ctl_array_label(hd_sf_enhanse, & + & render_area_c%surf_enhanse_ctl) +! + end subroutine int_pvr_render_area_ctl +! +! --------------------------------------------------------------------- ! --------------------------------------------------------------------- ! subroutine dup_pvr_render_area_ctl(org_rarea_c, new_rarea_c) @@ -144,6 +159,7 @@ subroutine dup_pvr_render_area_ctl(org_rarea_c, new_rarea_c) & new_rarea_c%surf_enhanse_ctl) ! new_rarea_c%i_plot_area = org_rarea_c%i_plot_area + new_rarea_c%block_name = org_rarea_c%block_name ! end subroutine dup_pvr_render_area_ctl ! @@ -164,26 +180,5 @@ subroutine dealloc_pvr_render_area_ctl(render_area_c) end subroutine dealloc_pvr_render_area_ctl ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- -! - integer(kind = kint) function num_label_pvr_area() - num_label_pvr_area = n_label_pvr_area - return - end function num_label_pvr_area -! -! --------------------------------------------------------------------- -! - subroutine set_label_pvr_area(names) -! - character(len = kchara), intent(inout) & - & :: names(n_label_pvr_area) -! -! - call set_control_labels(hd_plot_grp, names( 1)) - call set_control_labels(hd_sf_enhanse, names( 2)) -! - end subroutine set_label_pvr_area -! -! ---------------------------------------------------------------------- ! end module t_ctl_data_pvr_area diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_colorbar.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_colorbar.f90 index 3ceccffe..5fed87d7 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_colorbar.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_colorbar.f90 @@ -12,6 +12,8 @@ !! subroutine copy_pvr_colorbar_ctl(org_cbar_c, new_cbar_c) !! type(pvr_colorbar_ctl), intent(in) :: org_cbar_c !! type(pvr_colorbar_ctl), intent(inout) :: new_cbar_c +!! logical function cmp_pvr_colorbar_ctl(cbar_ctl1, cbar_ctl2) +!! type(read_character_item), intent(in) :: cbar_ctl1, cbar_ctl2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! example of color control for Kemo's volume rendering !! @@ -20,7 +22,7 @@ !! colorbar_switch_ctl ON !! colorbar_scale_ctl ON !! colorbar_position_ctl 'side' or 'bottom' -!! iflag_zeromarker ON +!! zeromarker_switch ON !! colorbar_range 0.0 1.0 !! font_size_ctl 3 !! num_grid_ctl 4 @@ -43,11 +45,13 @@ module t_ctl_data_pvr_colorbar use t_control_array_character use t_control_array_integer use t_control_array_real2 - use skip_comment_f ! implicit none ! type pvr_colorbar_ctl +!> Control block name + character(len = kchara) :: block_name = 'colorbar_ctl' +! type(read_character_item) :: colorbar_switch_ctl type(read_character_item) :: colorbar_scale_ctl type(read_character_item) :: colorbar_position_ctl @@ -125,5 +129,55 @@ subroutine copy_pvr_colorbar_ctl(org_cbar_c, new_cbar_c) end subroutine copy_pvr_colorbar_ctl ! ! --------------------------------------------------------------------- +! + logical function cmp_pvr_colorbar_ctl(cbar_ctl1, cbar_ctl2) +! + use skip_comment_f +! + type(pvr_colorbar_ctl), intent(in) :: cbar_ctl1, cbar_ctl2 +! + cmp_pvr_colorbar_ctl = .FALSE. + if(cbar_ctl1%i_pvr_colorbar .ne. cbar_ctl2%i_pvr_colorbar) return + if(cmp_no_case(trim(cbar_ctl1%block_name), & + & trim(cbar_ctl2%block_name)) .eqv. .FALSE.) return + if(cmp_read_chara_item(cbar_ctl1%colorbar_switch_ctl, & + & cbar_ctl2%colorbar_switch_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_chara_item(cbar_ctl1%colorbar_scale_ctl, & + & cbar_ctl2%colorbar_scale_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_chara_item(cbar_ctl1%colorbar_position_ctl, & + & cbar_ctl2%colorbar_position_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_chara_item(cbar_ctl1%zeromarker_flag_ctl, & + & cbar_ctl2%zeromarker_flag_ctl) & + & .eqv. .FALSE.) return +! +! + if(cmp_read_integer_item(cbar_ctl1%font_size_ctl, & + & cbar_ctl2%font_size_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_integer_item(cbar_ctl1%ngrid_cbar_ctl, & + & cbar_ctl2%ngrid_cbar_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_real2_item(cbar_ctl1%cbar_range_ctl, & + & cbar_ctl2%cbar_range_ctl) & + & .eqv. .FALSE.) return +! + if(cmp_read_chara_item(cbar_ctl1%axis_switch_ctl, & + & cbar_ctl2%axis_switch_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_chara_item(cbar_ctl1%time_switch_ctl, & + & cbar_ctl2%time_switch_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_chara_item(cbar_ctl1%mapgrid_switch_ctl, & + & cbar_ctl2%mapgrid_switch_ctl) & + & .eqv. .FALSE.) return +! + cmp_pvr_colorbar_ctl = .TRUE. +! + end function cmp_pvr_colorbar_ctl +! +! -------------------------------------------------------------------- ! end module t_ctl_data_pvr_colorbar diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_colormap.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_colormap.f90 index 74c2886d..8444506e 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_colormap.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_colormap.f90 @@ -13,6 +13,8 @@ !! subroutine dup_pvr_colordef_ctl(org_color, new_color) !! type(pvr_colormap_ctl), intent(in) :: org_color !! type(pvr_colormap_ctl), intent(inout) :: new_color +!! logical function cmp_pvr_colormap_ctl(color1, color2) +!! type(pvr_colormap_ctl), intent(in) :: color1, color2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! example of color control for Kemo's volume rendering !! @@ -43,16 +45,6 @@ !! linear_opacity_ctl 0.85 0.01 !! linear_opacity_ctl 0.95 0.001 !! end array linear_opacity_ctl -!! -!! array step_opacity_ctl 7 -!! step_opacity_ctl 0.0 0.01 0.01 -!! step_opacity_ctl 0.01 0.2 0.015 -!! step_opacity_ctl 0.2 0.35 0.02 -!! step_opacity_ctl 0.6 0.7 0.04 -!! step_opacity_ctl 0.7 0.85 0.03 -!! step_opacity_ctl 0.85 0.95 0.01 -!! step_opacity_ctl 0.95 1.0 0.001 -!! end array step_opacity_ctl !! constant_opacity_ctl 0.003 !!! !! range_min_ctl 0.0 @@ -73,12 +65,14 @@ module t_ctl_data_pvr_colormap use t_control_array_real use t_control_array_real2 use t_control_array_real3 - use skip_comment_f ! implicit none ! ! type pvr_colormap_ctl +!> Control block name + character(len = kchara) :: block_name = 'colormap_ctl' +!! type(read_character_item) :: lic_color_fld_ctl type(read_character_item) :: lic_color_comp_ctl type(read_character_item) :: lic_opacity_fld_ctl @@ -101,11 +95,6 @@ module t_ctl_data_pvr_colormap !!@n linear_opacity_ctl%vec1: field value to define opacity !!@n linear_opacity_ctl%vec3: Opacity at this point type(ctl_array_r2) :: linear_opacity_ctl -!> Structure for opacity controls -!!@n step_opacity_ctl%vec1: Minimum value for one opacity -!!@n step_opacity_ctl%vec2: Maximum value for one opacity -!!@n step_opacity_ctl%vec3: Opacity for each level - type(ctl_array_r3) :: step_opacity_ctl ! !> Structure for background color (R,G,B) type(read_real3_item) :: background_color_ctl @@ -151,14 +140,11 @@ subroutine dealloc_pvr_color_crl(color) ! ! call reset_pvr_colormap_flags(color) - call dealloc_control_array_r3(color%step_opacity_ctl) call dealloc_control_array_r2(color%linear_opacity_ctl) call dealloc_control_array_r2(color%colortbl_ctl) ! color%colortbl_ctl%num = 0 color%colortbl_ctl%icou = 0 - color%step_opacity_ctl%num = 0 - color%step_opacity_ctl%icou = 0 color%linear_opacity_ctl%num = 0 color%linear_opacity_ctl%icou = 0 ! @@ -173,15 +159,13 @@ subroutine dup_pvr_colordef_ctl(org_color, new_color) type(pvr_colormap_ctl), intent(inout) :: new_color ! ! + new_color%block_name = org_color%block_name new_color%i_pvr_colordef = org_color%i_pvr_colordef ! call dup_control_array_r2(org_color%colortbl_ctl, & & new_color%colortbl_ctl) call dup_control_array_r2(org_color%linear_opacity_ctl, & & new_color%linear_opacity_ctl) -! - call dup_control_array_r3(org_color%step_opacity_ctl, & - & new_color%step_opacity_ctl) ! call copy_chara_ctl(org_color%lic_color_fld_ctl, & & new_color%lic_color_fld_ctl) @@ -210,5 +194,65 @@ subroutine dup_pvr_colordef_ctl(org_color, new_color) end subroutine dup_pvr_colordef_ctl ! ! --------------------------------------------------------------------- +! + logical function cmp_pvr_colormap_ctl(color1, color2) +! + use skip_comment_f +! + type(pvr_colormap_ctl), intent(in) :: color1, color2 +! + cmp_pvr_colormap_ctl = .FALSE. + if(color1%i_pvr_colordef .ne. color2%i_pvr_colordef) return + if(cmp_no_case(trim(color1%block_name), & + & trim(color2%block_name)) .eqv. .FALSE.) return + if(cmp_read_chara_item(color1%lic_color_fld_ctl, & + & color2%lic_color_fld_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_chara_item(color1%lic_color_comp_ctl, & + & color2%lic_color_comp_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_chara_item(color1%lic_opacity_fld_ctl, & + & color2%lic_opacity_fld_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_chara_item(color1%lic_opacity_comp_ctl, & + & color2%lic_opacity_comp_ctl) & + & .eqv. .FALSE.) return +! + if(cmp_read_chara_item(color1%colormap_mode_ctl, & + & color2%colormap_mode_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_chara_item(color1%data_mapping_ctl, & + & color2%data_mapping_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_chara_item(color1%opacity_style_ctl, & + & color2%opacity_style_ctl) & + & .eqv. .FALSE.) return +! + if(cmp_read_real_item(color1%range_min_ctl, & + & color2%range_min_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_real_item(color1%range_max_ctl, & + & color2%range_max_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_real_item(color1%fix_opacity_ctl, & + & color2%fix_opacity_ctl) & + & .eqv. .FALSE.) return +! + if(cmp_control_array_r2(color1%colortbl_ctl, & + & color2%colortbl_ctl) & + & .eqv. .FALSE.) return + if(cmp_control_array_r2(color1%linear_opacity_ctl, & + & color2%linear_opacity_ctl) & + & .eqv. .FALSE.) return +! + if(cmp_read_real3_item(color1%background_color_ctl, & + & color2%background_color_ctl) & + & .eqv. .FALSE.) return +! + cmp_pvr_colormap_ctl = .TRUE. +! + end function cmp_pvr_colormap_ctl +! +! -------------------------------------------------------------------- ! end module t_ctl_data_pvr_colormap diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_colormap_bar.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_colormap_bar.f90 index 35c39753..62bc6985 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_colormap_bar.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_colormap_bar.f90 @@ -7,6 +7,7 @@ !> @brief colormap control data for parallel volume rendering !! !!@verbatim +!! subroutine init_pvr_cmap_cbar_label(hd_block, cmap_cbar_c) !! subroutine sel_read_ctl_pvr_colormap_file & !! & (id_control, hd_block, file_name, cmap_cbar_c, c_buf) !! subroutine read_pvr_cmap_cbar & @@ -30,15 +31,17 @@ !! type(pvr_colormap_bar_ctl), intent(in) :: cmap_cbar_c !! integer(kind = kint), intent(inout) :: level !! +!! logical function cmp_pvr_colormap_bar_ctl(cmap_cbar1, & +!! & cmap_cbar2) +!! type(pvr_colormap_bar_ctl), intent(in) :: cmap_cbar1 +!! type(pvr_colormap_bar_ctl), intent(in) :: cmap_cbar2 +!! !! subroutine deallocate_pvr_cmap_cbar(cmap_cbar_c) !! type(pvr_colormap_bar_ctl), intent(inout) :: cmap_cbar_c !! !! subroutine dup_pvr_cmap_cbar(org_cmap_cbar_c, new_cmap_cbar_c) !! type(pvr_colormap_bar_ctl), intent(in) :: org_cmap_cbar_c !! type(pvr_colormap_bar_ctl), intent(inout) :: new_cmap_cbar_c -!! -!! integer(kind = kint) function num_label_pvr_cmap_bar() -!! subroutine set_label_pvr_cmap_bar(names) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! example of color control for Kemo's volume rendering !! @@ -70,16 +73,6 @@ !! linear_opacity_ctl 0.85 0.01 !! linear_opacity_ctl 0.95 0.001 !! end array linear_opacity_ctl -!! -!! array step_opacity_ctl -!! step_opacity_ctl 0.0 0.01 0.01 -!! step_opacity_ctl 0.01 0.2 0.015 -!! step_opacity_ctl 0.2 0.35 0.02 -!! step_opacity_ctl 0.6 0.7 0.04 -!! step_opacity_ctl 0.7 0.85 0.03 -!! step_opacity_ctl 0.85 0.95 0.01 -!! step_opacity_ctl 0.95 1.0 0.001 -!! end array step_opacity_ctl !! constant_opacity_ctl 0.003 !!! !! range_min_ctl 0.0 @@ -90,7 +83,7 @@ !! colorbar_switch_ctl ON !! colorbar_position_ctl 'left' or 'bottom' !! colorbar_scale_ctl ON -!! iflag_zeromarker ON +!! zeromarker_switch ON !! colorbar_range 0.0 1.0 !! font_size_ctl 3 !! num_grid_ctl 4 @@ -117,9 +110,11 @@ module t_ctl_data_pvr_colormap_bar ! !> Structure of control data for PVR colormap and colorbar type pvr_colormap_bar_ctl -!> Structure for colormap +!> Control block name + character(len = kchara) :: block_name = 'pvr_color_ctl' +!> Structure for colormap type(pvr_colormap_ctl) :: color -!> Structure for colorbar +!> Structure for colorbar type(pvr_colorbar_ctl) :: cbar_ctl ! integer (kind=kint) :: i_cmap_cbar = 0 @@ -131,9 +126,8 @@ module t_ctl_data_pvr_colormap_bar ! character(len=kchara) :: hd_colormap = 'colormap_ctl' character(len=kchara) :: hd_pvr_colorbar = 'colorbar_ctl' - integer(kind = kint), parameter :: n_label_pvr_cmap_bar = 2 ! - private :: hd_colormap, hd_pvr_colorbar, n_label_pvr_cmap_bar + private :: hd_colormap, hd_pvr_colorbar private :: hd_colormap_file ! private :: read_control_pvr_colormap_file @@ -165,7 +159,13 @@ subroutine sel_read_ctl_pvr_colormap_file & call write_one_ctl_file_message & & (hd_block, c_buf%level, file_name) call read_control_pvr_colormap_file & - & (id_control+1, file_name, hd_block, cmap_cbar_c, c_buf) + & (id_control+2, file_name, hd_block, cmap_cbar_c, c_buf) +! + else if(check_begin_flag(c_buf, hd_block)) then + file_name = 'NO_FILE' + call write_included_message(hd_block, c_buf%level) + call read_pvr_cmap_cbar(id_control, hd_block, & + & cmap_cbar_c, c_buf) else if(cmap_cbar_c%i_cmap_cbar .eq. 0) then file_name = 'NO_FILE' ! @@ -184,6 +184,8 @@ end subroutine sel_read_ctl_pvr_colormap_file ! subroutine read_control_pvr_colormap_file & & (id_control, file_name, hd_block, cmap_cbar_c, c_buf) +! + use skip_comment_f ! integer(kind = kint), intent(in) :: id_control character(len = kchara), intent(in) :: file_name @@ -192,7 +194,7 @@ subroutine read_control_pvr_colormap_file & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(file_name .eq. 'NO_FILE') then + if(no_file_flag(file_name)) then write(*,*) 'Colormap control is included' return end if @@ -233,8 +235,8 @@ subroutine read_pvr_cmap_cbar & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(cmap_cbar_c%i_cmap_cbar .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do call load_one_line_from_control(id_control, hd_block, c_buf) if(c_buf%iend .gt. 0) exit @@ -250,6 +252,25 @@ subroutine read_pvr_cmap_cbar & end subroutine read_pvr_cmap_cbar ! ! --------------------------------------------------------------------- +! + subroutine init_pvr_cmap_cbar_label(hd_block, cmap_cbar_c) +! + use ctl_data_pvr_colorbar_IO + use ctl_data_pvr_colormap_IO +! + character(len=kchara), intent(in) :: hd_block + type(pvr_colormap_bar_ctl), intent(inout) :: cmap_cbar_c +! +! + cmap_cbar_c%block_name = hd_block + call init_pvr_colordef_ctl_labels(hd_colormap, & + & cmap_cbar_c%color) + call init_pvr_colorbar_ctl_label(hd_pvr_colorbar, & + & cmap_cbar_c%cbar_ctl) +! + end subroutine init_pvr_cmap_cbar_label +! +! --------------------------------------------------------------------- ! --------------------------------------------------------------------- ! subroutine sel_write_ctl_pvr_colormap_file & @@ -274,7 +295,7 @@ subroutine sel_write_ctl_pvr_colormap_file & call write_pvr_colorbar_ctl(id_control, hd_pvr_colorbar, & & cmap_cbar_c%cbar_ctl, level) else if(id_control .eq. id_monitor) then - write(*,'(4a)') '! ', trim(hd_block), & + write(*,'(4a)') '! ', trim(hd_block), & & ' should be written to file ... ', trim(file_name) call write_pvr_colorbar_ctl(id_control, hd_pvr_colorbar, & & cmap_cbar_c%cbar_ctl, level) @@ -284,7 +305,7 @@ subroutine sel_write_ctl_pvr_colormap_file & call write_file_name_for_ctl_line(id_control, level, & & hd_block, file_name) call write_control_pvr_colormap_file & - & (id_control+1, file_name, hd_block, cmap_cbar_c) + & (id_control+2, file_name, hd_block, cmap_cbar_c) end if ! end subroutine sel_write_ctl_pvr_colormap_file @@ -302,7 +323,7 @@ subroutine write_control_pvr_colormap_file & integer(kind = kint) :: level ! ! - if(file_name .eq. 'NO_FILE') return + if(no_file_flag(file_name)) return ! level = 0 open(id_control, file = file_name) @@ -340,6 +361,27 @@ subroutine write_pvr_cmap_cbar(id_control, hd_block, & end subroutine write_pvr_cmap_cbar ! ! --------------------------------------------------------------------- +! + logical function cmp_pvr_colormap_bar_ctl(cmap_cbar1, & + & cmap_cbar2) +! + type(pvr_colormap_bar_ctl), intent(in) :: cmap_cbar1 + type(pvr_colormap_bar_ctl), intent(in) :: cmap_cbar2 +! + cmp_pvr_colormap_bar_ctl = .FALSE. + if(cmap_cbar1%i_cmap_cbar .ne. cmap_cbar2%i_cmap_cbar) return + if(cmp_no_case(trim(cmap_cbar1%block_name), & + & trim(cmap_cbar2%block_name)) .eqv. .FALSE.) return + if(cmp_pvr_colormap_ctl(cmap_cbar1%color, cmap_cbar2%color) & + & .eqv. .FALSE.) return + if(cmp_pvr_colorbar_ctl(cmap_cbar1%cbar_ctl, cmap_cbar2%cbar_ctl) & + & .eqv. .FALSE.) return +! + cmp_pvr_colormap_bar_ctl = .TRUE. +! + end function cmp_pvr_colormap_bar_ctl +! +! -------------------------------------------------------------------- ! --------------------------------------------------------------------- ! subroutine deallocate_pvr_cmap_cbar(cmap_cbar_c) @@ -362,6 +404,7 @@ subroutine dup_pvr_cmap_cbar(org_cmap_cbar_c, new_cmap_cbar_c) type(pvr_colormap_bar_ctl), intent(inout) :: new_cmap_cbar_c ! ! + new_cmap_cbar_c%block_name = org_cmap_cbar_c%block_name new_cmap_cbar_c%i_cmap_cbar = org_cmap_cbar_c%i_cmap_cbar ! call dup_pvr_colordef_ctl(org_cmap_cbar_c%color, & @@ -372,26 +415,5 @@ subroutine dup_pvr_cmap_cbar(org_cmap_cbar_c, new_cmap_cbar_c) end subroutine dup_pvr_cmap_cbar ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- -! - integer(kind = kint) function num_label_pvr_cmap_bar() - num_label_pvr_cmap_bar = n_label_pvr_cmap_bar - return - end function num_label_pvr_cmap_bar -! -! --------------------------------------------------------------------- -! - subroutine set_label_pvr_cmap_bar(names) -! - character(len = kchara), intent(inout) & - & :: names(n_label_pvr_cmap_bar) -! -! - call set_control_labels(hd_colormap, names( 1)) - call set_control_labels(hd_pvr_colorbar, names( 2)) -! - end subroutine set_label_pvr_cmap_bar -! -! ---------------------------------------------------------------------- ! end module t_ctl_data_pvr_colormap_bar diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_isosurface.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_isosurface.f90 index afd01083..daf7e818 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_isosurface.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_isosurface.f90 @@ -8,6 +8,7 @@ !! !!@verbatim !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! subroutine init_pvr_isosurface_ctl_label(hd_block, pvr_iso_ctl) !! subroutine read_pvr_isosurface_ctl & !! & (id_control, hd_block, pvr_iso_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -26,9 +27,6 @@ !! type(pvr_isosurf_ctl), intent(inout) :: new_pvr_iso_c !! subroutine reset_pvr_isosurface_ctl(pvr_iso_ctl) !! type(pvr_isosurf_ctl), intent(inout) :: pvr_iso_ctl -!! -!! integer(kind = kint) function num_label_pvr_isosurface() -!! subroutine set_label_pvr_isosurface(names) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! begin isosurface_ctl !! isosurf_value 0.3 @@ -53,6 +51,9 @@ module t_ctl_data_pvr_isosurface ! ! type pvr_isosurf_ctl +!> Control block name + character(len = kchara) :: block_name = 'isosurface_ctl' +! type(read_character_item) :: isosurf_type_ctl type(read_real_item) :: iso_value_ctl type(read_real_item) :: opacity_ctl @@ -64,11 +65,8 @@ module t_ctl_data_pvr_isosurface character(len=kchara) :: hd_isosurf_value = 'isosurf_value' character(len=kchara) :: hd_pvr_opacity = 'opacity_ctl' character(len=kchara) :: hd_iso_direction = 'surface_direction' -! - integer(kind = kint), parameter :: n_label_pvr_isosurface = 3 ! private :: hd_isosurf_value, hd_pvr_opacity, hd_iso_direction - private :: n_label_pvr_isosurface ! ! --------------------------------------------------------------------- ! @@ -124,16 +122,34 @@ subroutine write_pvr_isosurface_ctl & ! level = write_begin_flag_for_ctl(id_control, level, hd_block) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_iso_direction, pvr_iso_ctl%isosurf_type_ctl) + & pvr_iso_ctl%isosurf_type_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_isosurf_value, pvr_iso_ctl%iso_value_ctl) + & pvr_iso_ctl%iso_value_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_pvr_opacity, pvr_iso_ctl%opacity_ctl) + & pvr_iso_ctl%opacity_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_pvr_isosurface_ctl ! ! --------------------------------------------------------------------- +! + subroutine init_pvr_isosurface_ctl_label(hd_block, pvr_iso_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(pvr_isosurf_ctl), intent(inout) :: pvr_iso_ctl +! +! + pvr_iso_ctl%block_name = hd_block + call init_chara_ctl_item_label(hd_iso_direction, & + & pvr_iso_ctl%isosurf_type_ctl) + call init_real_ctl_item_label & + & (hd_isosurf_value, pvr_iso_ctl%iso_value_ctl) + call init_real_ctl_item_label & + & (hd_pvr_opacity, pvr_iso_ctl%opacity_ctl) +! + end subroutine init_pvr_isosurface_ctl_label +! +! --------------------------------------------------------------------- ! ----------------------------------------------------------------------- ! subroutine dup_pvr_isosurface_ctl(org_pvr_iso_c, new_pvr_iso_c) @@ -167,27 +183,5 @@ subroutine reset_pvr_isosurface_ctl(pvr_iso_ctl) end subroutine reset_pvr_isosurface_ctl ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- -! - integer(kind = kint) function num_label_pvr_isosurface() - num_label_pvr_isosurface = n_label_pvr_isosurface - return - end function num_label_pvr_isosurface -! -! --------------------------------------------------------------------- -! - subroutine set_label_pvr_isosurface(names) -! - character(len = kchara), intent(inout) & - & :: names(n_label_pvr_isosurface) -! -! - call set_control_labels(hd_isosurf_value, names( 1)) - call set_control_labels(hd_pvr_opacity, names( 2)) - call set_control_labels(hd_iso_direction, names( 3)) -! - end subroutine set_label_pvr_isosurface -! -! ---------------------------------------------------------------------- ! end module t_ctl_data_pvr_isosurface diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_light.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_light.f90 index 404cf118..5d3b2abb 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_light.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_light.f90 @@ -7,6 +7,7 @@ !> @brief colormap control data for parallel volume rendering !! !!@verbatim +!! subroutine init_lighting_ctl_label(hd_block, light) !! subroutine read_lighting_ctl(id_control, hd_block, light, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block @@ -18,6 +19,9 @@ !! character(len=kchara), intent(in) :: hd_block !! type(pvr_light_ctl), intent(in) :: light !! integer(kind = kint), intent(inout) :: level +!! logical function cmp_pvr_light_ctl(light1, light2) +!! type(pvr_light_ctl), intent(in) :: light1, light2 +!! !! subroutine reset_pvr_light_flags(light) !! subroutine dealloc_pvr_light_crl(light) !! type(pvr_light_ctl), intent(inout) :: light @@ -36,6 +40,13 @@ !! position_of_lights 0.0 10.0 0.0 end !! end array position_of_lights !!! +!! array sph_position_of_lights +!! sph_position_of_lights 10.0 0.0 0.0 end +!! sph_position_of_lights 10.0 30.0 -45.0 end +!! sph_position_of_lights 10.0 30.0 45.0 end +!! sph_position_of_lights 10.0 -45.0 180.0 end +!! end array sph_position_of_lights +!!! !! ambient_coef_ctl 0.5 !! diffuse_coef_ctl 5.6 !! specular_coef_ctl 0.8 @@ -58,6 +69,9 @@ module t_ctl_data_pvr_light ! ! type pvr_light_ctl +!> Control block name + character(len = kchara) :: block_name = 'lighting_ctl' +! type(read_real_item) :: ambient_coef_ctl type(read_real_item) :: diffuse_coef_ctl type(read_real_item) :: specular_coef_ctl @@ -67,6 +81,11 @@ module t_ctl_data_pvr_light !!@n light_position_ctl%vec2: Y-component of light position !!@n light_position_ctl%vec3: Z-component of light position type(ctl_array_r3) :: light_position_ctl +!> Structure for light positions +!!@n light_sph_posi_ctl%vec1: r-component of light position +!!@n light_sph_posi_ctl%vec2: theta-component of light position +!!@n light_sph_posi_ctl%vec3: phi-component of light position + type(ctl_array_r3) :: light_sph_posi_ctl ! integer (kind=kint) :: i_pvr_lighting = 0 end type pvr_light_ctl @@ -77,12 +96,11 @@ module t_ctl_data_pvr_light character(len=kchara) :: hd_ambient = 'ambient_coef_ctl' character(len=kchara) :: hd_diffuse = 'diffuse_coef_ctl' character(len=kchara) :: hd_specular = 'specular_coef_ctl' - character(len=kchara) :: hd_light_param = 'position_of_lights' -! - integer(kind = kint), parameter :: n_label_pvr_light = 4 + character(len=kchara) :: hd_light_xyz = 'position_of_lights' + character(len=kchara) :: hd_light_sph = 'sph_position_of_lights' ! - private :: hd_ambient, hd_diffuse, hd_specular, hd_light_param - private :: n_label_pvr_light + private :: hd_ambient, hd_diffuse, hd_specular + private :: hd_light_xyz, hd_light_sph ! ! --------------------------------------------------------------------- ! @@ -107,7 +125,9 @@ subroutine read_lighting_ctl(id_control, hd_block, light, c_buf) if(check_end_flag(c_buf, hd_block)) exit ! call read_control_array_r3(id_control, & - & hd_light_param, light%light_position_ctl, c_buf) + & hd_light_xyz, light%light_position_ctl, c_buf) + call read_control_array_r3(id_control, & + & hd_light_sph, light%light_sph_posi_ctl, c_buf) ! call read_real_ctl_type & & (c_buf, hd_ambient, light%ambient_coef_ctl ) @@ -144,19 +164,75 @@ subroutine write_lighting_ctl & ! level = write_begin_flag_for_ctl(id_control, level, hd_block) call write_control_array_r3(id_control, level, & - & hd_light_param, light%light_position_ctl) + & light%light_position_ctl) + call write_control_array_r3(id_control, level, & + & light%light_sph_posi_ctl) ! call write_real_ctl_type(id_control, level, maxlen, & - & hd_ambient, light%ambient_coef_ctl ) + & light%ambient_coef_ctl ) call write_real_ctl_type(id_control, level, maxlen, & - & hd_diffuse, light%diffuse_coef_ctl) + & light%diffuse_coef_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_specular, light%specular_coef_ctl) + & light%specular_coef_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_lighting_ctl ! ! --------------------------------------------------------------------- +! + subroutine init_lighting_ctl_label(hd_block, light) +! + character(len=kchara), intent(in) :: hd_block + type(pvr_light_ctl), intent(inout) :: light +! +! + light%block_name = hd_block + call init_r3_ctl_array_label & + & (hd_light_xyz, light%light_position_ctl) + call init_r3_ctl_array_label & + & (hd_light_sph, light%light_sph_posi_ctl) +! + call init_real_ctl_item_label & + & (hd_ambient, light%ambient_coef_ctl) + call init_real_ctl_item_label & + & (hd_diffuse, light%diffuse_coef_ctl) + call init_real_ctl_item_label & + & (hd_specular, light%specular_coef_ctl) +! + end subroutine init_lighting_ctl_label +! +! --------------------------------------------------------------------- +! + logical function cmp_pvr_light_ctl(light1, light2) +! + type(pvr_light_ctl), intent(in) :: light1, light2 +! + cmp_pvr_light_ctl = .FALSE. + if(light1%i_pvr_lighting .ne. light2%i_pvr_lighting) return + if(cmp_no_case(trim(light1%block_name), & + & trim(light2%block_name)) .eqv. .FALSE.) return +! + if(cmp_read_real_item(light1%ambient_coef_ctl, & + & light2%ambient_coef_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_real_item(light1%diffuse_coef_ctl, & + & light2%diffuse_coef_ctl) & + & .eqv. .FALSE.) return + if(cmp_read_real_item(light1%specular_coef_ctl, & + & light2%specular_coef_ctl) & + & .eqv. .FALSE.) return +! + if(cmp_control_array_r3(light1%light_position_ctl, & + & light2%light_position_ctl) & + & .eqv. .FALSE.) return + if(cmp_control_array_r3(light1%light_sph_posi_ctl, & + & light2%light_sph_posi_ctl) & + & .eqv. .FALSE.) return + cmp_pvr_light_ctl = .TRUE. +! + end function cmp_pvr_light_ctl +! +! -------------------------------------------------------------------- ! --------------------------------------------------------------------- ! subroutine reset_pvr_light_flags(light) @@ -177,7 +253,10 @@ subroutine dealloc_pvr_light_crl(light) ! type(pvr_light_ctl), intent(inout) :: light ! + call dealloc_control_array_r3(light%light_sph_posi_ctl) call dealloc_control_array_r3(light%light_position_ctl) + light%light_sph_posi_ctl%num = 0 + light%light_sph_posi_ctl%icou = 0 light%light_position_ctl%num = 0 light%light_position_ctl%icou = 0 ! @@ -192,10 +271,13 @@ subroutine dup_lighting_ctl(org_light, new_light) type(pvr_light_ctl), intent(inout) :: new_light ! ! + new_light%block_name = org_light%block_name new_light%i_pvr_lighting = org_light%i_pvr_lighting ! call dup_control_array_r3(org_light%light_position_ctl, & & new_light%light_position_ctl) + call dup_control_array_r3(org_light%light_sph_posi_ctl, & + & new_light%light_sph_posi_ctl) ! call copy_real_ctl(org_light%ambient_coef_ctl, & & new_light%ambient_coef_ctl) @@ -207,28 +289,5 @@ subroutine dup_lighting_ctl(org_light, new_light) end subroutine dup_lighting_ctl ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- -! - integer(kind = kint) function num_label_pvr_light() - num_label_pvr_light = n_label_pvr_light - return - end function num_label_pvr_light -! -! ---------------------------------------------------------------------- -! - subroutine set_label_pvr_light(names) -! - character(len = kchara), intent(inout) & - & :: names(n_label_pvr_light) -! -! - call set_control_labels(hd_light_param, names( 1)) - call set_control_labels(hd_ambient, names( 2)) - call set_control_labels(hd_diffuse, names( 3)) - call set_control_labels(hd_specular, names( 4)) -! - end subroutine set_label_pvr_light -! -! --------------------------------------------------------------------- ! end module t_ctl_data_pvr_light diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_movie.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_movie.f90 index 4f150d4d..4238ae8f 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_movie.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_movie.f90 @@ -65,6 +65,9 @@ module t_ctl_data_pvr_movie ! ! type pvr_movie_ctl +!> Control block name + character(len = kchara) :: block_name = 'snapshot_movie_ctl' +! !> Structure of movie mode control type(read_character_item) :: movie_mode_ctl !> Structure of number of flame control @@ -82,16 +85,16 @@ module t_ctl_data_pvr_movie type(read_real2_item) :: LIC_kernel_peak_range_ctl ! !> file name for start modelview matrix - character(len=kchara) :: fname_view_start_ctl + character(len=kchara) :: fname_view_start_ctl = 'NO_FILE' !> file name for end modelview matrix - character(len=kchara) :: fname_view_end_ctl + character(len=kchara) :: fname_view_end_ctl = 'NO_FILE' !> Structure for start modelview marices type(modeview_ctl) :: view_start_ctl !> Structure for end modelview marices type(modeview_ctl) :: view_end_ctl ! ! Lists of multiple view parameters - type(multi_modeview_ctl) :: mul_mmats_c + type(multi_modelview_ctl) :: mul_mmats_c ! ! 2nd level for volume rendering integer (kind=kint) :: i_pvr_rotation = 0 @@ -135,6 +138,7 @@ subroutine dup_pvr_movie_control_flags(org_movie, new_movie) & new_movie%view_end_ctl) ! new_movie%i_pvr_rotation = org_movie%i_pvr_rotation + new_movie%block_name = org_movie%block_name ! end subroutine dup_pvr_movie_control_flags ! diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_section.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_section.f90 index 8a034678..69d2bdde 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_section.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_pvr_section.f90 @@ -12,6 +12,20 @@ !! type(pvr_section_ctl), intent(inout) :: new_pvr_sect_c !! subroutine dealloc_pvr_section_ctl(pvr_sect_ctl) !! type(pvr_section_ctl), intent(inout) :: pvr_sect_ctl +!! +!! subroutine init_pvr_section_ctl_label(hd_block, pvr_sect_ctl) +!! subroutine read_pvr_section_ctl & +!! & (id_control, hd_block, icou, pvr_sect_ctl, c_buf) +!! integer(kind = kint), intent(in) :: id_control +!! character(len=kchara), intent(in) :: hd_block +!! type(pvr_section_ctl), intent(inout) :: pvr_sect_ctl +!! type(buffer_for_control), intent(inout) :: c_buf +!! subroutine write_pvr_section_ctl & +!! & (id_control, hd_block, pvr_sect_ctl, level) +!! integer(kind = kint), intent(in) :: id_control +!! character(len=kchara), intent(in) :: hd_block +!! type(pvr_section_ctl), intent(inout) :: pvr_sect_ctl +!! integer(kind = kint), intent(inout) :: level !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! array section_ctl !! file surface_define ctl_psf_eq @@ -53,35 +67,27 @@ module t_ctl_data_pvr_section implicit none ! type pvr_section_ctl +!> Block name + character(len=kchara) :: block_name = 'surface_define' +! !> File name of control file to define surface - character(len = kchara) :: fname_sect_ctl + character(len = kchara) :: fname_sect_ctl = 'NO_FILE' !> Structure to define surface type(psf_define_ctl) :: psf_def_c !> Structure to define opacity of surface type(read_real_item) :: opacity_ctl -! !> Structure of zero line switch type(read_character_item) :: zeroline_switch_ctl -!> Structure of isoline color mode - type(read_character_item) :: isoline_color_mode -!> Structure of number of isoline - type(read_integer_item) :: isoline_number_ctl -!> Structure of range of isoline - type(read_real2_item) :: isoline_range_ctl -!> Structure to isoline width - type(read_real_item) :: isoline_width_ctl -!> Structure to grid width - type(read_real_item) :: grid_width_ctl -! -!> Structure of tangent cylinder line switch - type(read_character_item) :: tan_cyl_switch_ctl -!> Structure to define outer bounday radius for tangent cylinder - type(read_real_item) :: tangent_cylinder_inner_ctl -!> Structure to define inner bounday radius for tangent cylinder - type(read_real_item) :: tangent_cylinder_outer_ctl -! integer(kind = kint) :: i_pvr_sect_ctl = 0 end type pvr_section_ctl +! + character(len=kchara), parameter, private & + & :: hd_surface_define = 'surface_define' + character(len=kchara), parameter, private & + & :: hd_pvr_opacity = 'opacity_ctl' +! + character(len=kchara), parameter, private & + & :: hd_pvr_sec_zeroline = 'zeroline_switch_ctl' ! ! --------------------------------------------------------------------- ! @@ -95,6 +101,7 @@ subroutine dup_pvr_section_ctl(org_pvr_sect_c, new_pvr_sect_c) type(pvr_section_ctl), intent(inout) :: new_pvr_sect_c ! ! + new_pvr_sect_c%block_name = org_pvr_sect_c%block_name new_pvr_sect_c%i_pvr_sect_ctl = org_pvr_sect_c%i_pvr_sect_ctl new_pvr_sect_c%fname_sect_ctl = org_pvr_sect_c%fname_sect_ctl call dup_control_4_psf_def & @@ -102,26 +109,8 @@ subroutine dup_pvr_section_ctl(org_pvr_sect_c, new_pvr_sect_c) ! call copy_real_ctl(org_pvr_sect_c%opacity_ctl, & & new_pvr_sect_c%opacity_ctl) -! call copy_chara_ctl(org_pvr_sect_c%zeroline_switch_ctl, & & new_pvr_sect_c%zeroline_switch_ctl) - call copy_chara_ctl(org_pvr_sect_c%isoline_color_mode, & - & new_pvr_sect_c%isoline_color_mode) - call copy_integer_ctl(org_pvr_sect_c%isoline_number_ctl, & - & new_pvr_sect_c%isoline_number_ctl) - call copy_real2_ctl(org_pvr_sect_c%isoline_range_ctl, & - & new_pvr_sect_c%isoline_range_ctl) - call copy_real_ctl(org_pvr_sect_c%isoline_width_ctl, & - & new_pvr_sect_c%isoline_width_ctl) - call copy_real_ctl(org_pvr_sect_c%grid_width_ctl, & - & new_pvr_sect_c%grid_width_ctl) -! - call copy_chara_ctl(org_pvr_sect_c%tan_cyl_switch_ctl, & - & new_pvr_sect_c%tan_cyl_switch_ctl) - call copy_real_ctl(org_pvr_sect_c%tangent_cylinder_inner_ctl, & - & new_pvr_sect_c%tangent_cylinder_inner_ctl) - call copy_real_ctl(org_pvr_sect_c%tangent_cylinder_outer_ctl, & - & new_pvr_sect_c%tangent_cylinder_outer_ctl) ! end subroutine dup_pvr_section_ctl ! @@ -134,22 +123,104 @@ subroutine dealloc_pvr_section_ctl(pvr_sect_ctl) ! call dealloc_cont_dat_4_psf_def(pvr_sect_ctl%psf_def_c) pvr_sect_ctl%opacity_ctl%iflag = 0 -! pvr_sect_ctl%zeroline_switch_ctl%iflag = 0 - pvr_sect_ctl%isoline_color_mode%iflag = 0 - pvr_sect_ctl%isoline_number_ctl%iflag = 0 - pvr_sect_ctl%isoline_range_ctl%iflag = 0 - pvr_sect_ctl%isoline_width_ctl%iflag = 0 - pvr_sect_ctl%grid_width_ctl%iflag = 0 -! - pvr_sect_ctl%tan_cyl_switch_ctl%iflag = 0 - pvr_sect_ctl%tangent_cylinder_inner_ctl%iflag = 0 - pvr_sect_ctl%tangent_cylinder_outer_ctl%iflag = 0 ! pvr_sect_ctl%i_pvr_sect_ctl = 0 ! end subroutine dealloc_pvr_section_ctl ! ! --------------------------------------------------------------------- +! --------------------------------------------------------------------- +! + subroutine read_pvr_section_ctl & + & (id_control, hd_block, icou, pvr_sect_ctl, c_buf) +! + use ctl_file_section_def_IO + use write_control_elements +! + integer(kind = kint), intent(in) :: id_control, icou + character(len=kchara), intent(in) :: hd_block + type(pvr_section_ctl), intent(inout) :: pvr_sect_ctl + type(buffer_for_control), intent(inout) :: c_buf +! +! + if(pvr_sect_ctl%i_pvr_sect_ctl .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return + do + call load_one_line_from_control(id_control, hd_block, c_buf) + if(c_buf%iend .gt. 0) exit + if(check_end_flag(c_buf, hd_block)) exit +! + if(check_file_flag(c_buf, hd_surface_define) & + & .or. check_begin_flag(c_buf, hd_surface_define)) then + call write_multi_ctl_file_message & + & (hd_block, icou, c_buf%level) + call sel_read_ctl_pvr_section_def(id_control, & + & hd_surface_define, pvr_sect_ctl%fname_sect_ctl, & + & pvr_sect_ctl%psf_def_c, c_buf) + end if +! + call read_real_ctl_type & + & (c_buf, hd_pvr_opacity, pvr_sect_ctl%opacity_ctl) + call read_chara_ctl_type(c_buf, hd_pvr_sec_zeroline, & + & pvr_sect_ctl%zeroline_switch_ctl) + end do + pvr_sect_ctl%i_pvr_sect_ctl = 1 +! + end subroutine read_pvr_section_ctl +! +! --------------------------------------------------------------------- +! + subroutine write_pvr_section_ctl & + & (id_control, hd_block, pvr_sect_ctl, level) +! + use ctl_file_section_def_IO + use write_control_elements +! + integer(kind = kint), intent(in) :: id_control + character(len=kchara), intent(in) :: hd_block + type(pvr_section_ctl), intent(in) :: pvr_sect_ctl + integer(kind = kint), intent(inout) :: level +! + integer(kind = kint) :: maxlen = 0 +! +! + if(pvr_sect_ctl%i_pvr_sect_ctl .le. 0) return + maxlen = len_trim(hd_pvr_opacity) + maxlen = max(maxlen,len_trim(hd_pvr_sec_zeroline)) +! + level = write_begin_flag_for_ctl(id_control, level, hd_block) + call sel_write_ctl_pvr_section_def(id_control, hd_surface_define, & + & pvr_sect_ctl%fname_sect_ctl, pvr_sect_ctl%psf_def_c, level) +! + call write_real_ctl_type(id_control, level, maxlen, & + & pvr_sect_ctl%opacity_ctl) + call write_chara_ctl_type(id_control, level, maxlen, & + & pvr_sect_ctl%zeroline_switch_ctl) + level = write_end_flag_for_ctl(id_control, level, hd_block) +! + end subroutine write_pvr_section_ctl +! +! --------------------------------------------------------------------- +! + subroutine init_pvr_section_ctl_label(hd_block, pvr_sect_ctl) +! + use ctl_data_section_def_IO +! + character(len=kchara), intent(in) :: hd_block + type(pvr_section_ctl), intent(inout) :: pvr_sect_ctl +! + pvr_sect_ctl%block_name = hd_block + call init_psf_def_ctl_stract & + & (hd_surface_define, pvr_sect_ctl%psf_def_c) +! + call init_real_ctl_item_label & + & (hd_pvr_opacity, pvr_sect_ctl%opacity_ctl) + call init_chara_ctl_item_label(hd_pvr_sec_zeroline, & + & pvr_sect_ctl%zeroline_switch_ctl) +! + end subroutine init_pvr_section_ctl_label +! +! --------------------------------------------------------------------- ! end module t_ctl_data_pvr_section diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_quilt_image.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_quilt_image.f90 index 887c86da..4d0968b5 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_quilt_image.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_quilt_image.f90 @@ -8,6 +8,7 @@ !! !!@verbatim !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! subroutine init_quilt_image_ctl_label(hd_block, quilt_c) !! subroutine read_quilt_image_ctl & !! & (id_control, hd_block, quilt_c, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -25,9 +26,6 @@ !! type(quilt_image_ctl), intent(inout) :: new_quilt !! subroutine reset_quilt_image_ctl(quilt_c) !! type(quilt_image_ctl), intent(inout) :: quilt_c -!! -!! integer(kind = kint) function num_label_quilt_image() -!! subroutine set_label_quilt_image(names) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! !! begin quilt_image_ctl @@ -62,13 +60,16 @@ module t_ctl_data_quilt_image ! !> Structure of quilt image controls type quilt_image_ctl +!> Control block name + character(len = kchara) :: block_name = 'quilt_image_ctl' +! !> Structure of number of columns and row of image type(read_int2_item) :: num_column_row_ctl !> Structure of number of row and columns of image type(read_int2_item) :: num_row_column_ctl ! ! Lists of multiple view parameters - type(multi_modeview_ctl) :: mul_qmats_c + type(multi_modelview_ctl) :: mul_qmats_c ! ! integer flag of used block integer (kind=kint) :: i_quilt_image = 0 @@ -82,9 +83,6 @@ module t_ctl_data_quilt_image & :: hd_row_column = 'num_row_column_ctl' character(len=kchara), parameter, private & & :: hd_qview_transform = 'view_transform_ctl' -! - integer(kind = kint), parameter :: n_label_quilt_ctl = 3 - private :: n_label_quilt_ctl ! ! --------------------------------------------------------------------- ! @@ -103,8 +101,8 @@ subroutine read_quilt_image_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if (quilt_c%i_quilt_image.gt.0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do call load_one_line_from_control(id_control, hd_block, c_buf) if(c_buf%iend .gt. 0) exit @@ -146,9 +144,9 @@ subroutine write_quilt_image_ctl & ! level = write_begin_flag_for_ctl(id_control, level, hd_block) call write_integer2_ctl_type(id_control, level, maxlen, & - & hd_column_row, quilt_c%num_column_row_ctl) + & quilt_c%num_column_row_ctl) call write_integer2_ctl_type(id_control, level, maxlen, & - & hd_row_column, quilt_c%num_row_column_ctl) + & quilt_c%num_row_column_ctl) ! call write_mul_view_transfer_ctl & & (id_control, hd_qview_transform, quilt_c%mul_qmats_c, level) @@ -157,6 +155,27 @@ subroutine write_quilt_image_ctl & end subroutine write_quilt_image_ctl ! ! --------------------------------------------------------------------- +! + subroutine init_quilt_image_ctl_label(hd_block, quilt_c) +! + use ctl_file_pvr_modelview_IO +! + character(len=kchara), intent(in) :: hd_block + type(quilt_image_ctl), intent(inout) :: quilt_c +! +! + quilt_c%block_name = hd_block + call init_multi_modeview_ctl(hd_qview_transform, & + & quilt_c%mul_qmats_c) +! + call init_integer2_ctl_item_label(hd_column_row, & + & quilt_c%num_column_row_ctl) + call init_integer2_ctl_item_label(hd_row_column, & + & quilt_c%num_row_column_ctl) +! + end subroutine init_quilt_image_ctl_label +! +! --------------------------------------------------------------------- ! --------------------------------------------------------------------- ! subroutine dup_quilt_image_ctl(org_quilt, new_quilt) @@ -174,6 +193,7 @@ subroutine dup_quilt_image_ctl(org_quilt, new_quilt) & new_quilt%num_row_column_ctl) ! new_quilt%i_quilt_image = org_quilt%i_quilt_image + new_quilt%block_name = org_quilt%block_name ! end subroutine dup_quilt_image_ctl ! @@ -194,27 +214,5 @@ subroutine reset_quilt_image_ctl(quilt_c) end subroutine reset_quilt_image_ctl ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- -! - integer(kind = kint) function num_label_quilt_image() - num_label_quilt_image = n_label_quilt_ctl - return - end function num_label_quilt_image -! -! --------------------------------------------------------------------- -! - subroutine set_label_quilt_image(names) -! - character(len = kchara), intent(inout) & - & :: names(n_label_quilt_ctl) -! -! - call set_control_labels(hd_column_row, names( 1)) - call set_control_labels(hd_row_column, names( 2)) - call set_control_labels(hd_qview_transform, names( 3)) -! - end subroutine set_label_quilt_image -! -! ---------------------------------------------------------------------- ! end module t_ctl_data_quilt_image diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_view_transfers.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_view_transfers.f90 index 08deaab0..ff2868c6 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_view_transfers.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_ctl_data_view_transfers.f90 @@ -9,27 +9,29 @@ !!@verbatim !! subroutine alloc_multi_modeview_ctl(mul_mats_c) !! subroutine dealloc_multi_modeview_ctl(mul_mats_c) +!! subroutine init_multi_modeview_ctl(hd_block, mul_mats_c) +!! !! subroutine read_mul_view_transfer_ctl & !! & (id_control, hd_block, mul_mats_c, c_buf) -!! type(multi_modeview_ctl), intent(inout) :: mul_mats_c +!! type(multi_modelview_ctl), intent(inout) :: mul_mats_c !! type(buffer_for_control), intent(inout) :: c_buf !! subroutine write_mul_view_transfer_ctl & !! & (id_control, hd_block, mul_mats_c, level) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block -!! type(multi_modeview_ctl), intent(in) :: mul_mats_c +!! type(multi_modelview_ctl), intent(in) :: mul_mats_c !! integer(kind = kint), intent(inout) :: level !! -!! subroutine append_mul_view_trans_ctl(mul_mats_c) -!! type(multi_modeview_ctl), intent(inout) :: mul_mats_c +!! subroutine append_mul_view_trans_ctl(idx_in, hd_block, & +!! & mul_mats_c) +!! subroutine delete_mul_view_trans_ctl(idx_in, mul_mats_c) +!! integer(kind = kint), intent(in) :: idx_in +!! character(len=kchara), intent(in) :: hd_block +!! type(multi_modelview_ctl), intent(inout) :: mul_mats_c !! subroutine dup_mul_view_trans_ctl(org_mul_mats_c, & !! & new_mul_mats_c) -!! type(multi_modeview_ctl), intent(in) :: org_mul_mats_c -!! type(multi_modeview_ctl), intent(inout) :: new_mul_mats_c -!! subroutine copy_mul_view_trans_ctl & -!! & (num_mat, org_mul_mats_c, new_mul_mats_c) -!! type(multi_modeview_ctl), intent(in) :: org_mul_mats_c -!! type(multi_modeview_ctl), intent(inout) :: new_mul_mats_c +!! type(multi_modelview_ctl), intent(in) :: org_mul_mats_c +!! type(multi_modelview_ctl), intent(inout) :: new_mul_mats_c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! array view_transform_ctl !! file view_transform_ctl control_view @@ -56,14 +58,17 @@ module t_ctl_data_view_transfers ! ! !> Structure of modelview parameters or file names to load - type multi_modeview_ctl + type multi_modelview_ctl +!> Control block name + character(len = kchara) :: block_name = 'isosurface_ctl' +! !> Number of modelview parameter block integer(kind = kint) :: num_modelviews_c = 0 !> File name for external control file character(len=kchara), allocatable :: fname_mat_ctl(:) !> Lists of view parameters type(modeview_ctl), allocatable :: matrices(:) - end type multi_modeview_ctl + end type multi_modelview_ctl ! ! --------------------------------------------------------------------- ! @@ -73,7 +78,7 @@ module t_ctl_data_view_transfers ! subroutine dealloc_multi_modeview_ctl(mul_mats_c) ! - type(multi_modeview_ctl), intent(inout) :: mul_mats_c + type(multi_modelview_ctl), intent(inout) :: mul_mats_c ! ! if(allocated(mul_mats_c%matrices)) then @@ -90,7 +95,7 @@ end subroutine dealloc_multi_modeview_ctl ! subroutine alloc_multi_modeview_ctl(mul_mats_c) ! - type(multi_modeview_ctl), intent(inout) :: mul_mats_c + type(multi_modelview_ctl), intent(inout) :: mul_mats_c ! ! allocate(mul_mats_c%matrices(mul_mats_c%num_modelviews_c)) @@ -99,6 +104,19 @@ subroutine alloc_multi_modeview_ctl(mul_mats_c) end subroutine alloc_multi_modeview_ctl ! ! ----------------------------------------------------------------------- +! + subroutine init_multi_modeview_ctl(hd_block, mul_mats_c) +! + character(len=kchara), intent(in) :: hd_block + type(multi_modelview_ctl), intent(inout) :: mul_mats_c +! +! + mul_mats_c%block_name = hd_block + mul_mats_c%num_modelviews_c = 0 +! + end subroutine init_multi_modeview_ctl +! +! ----------------------------------------------------------------------- ! --------------------------------------------------------------------- ! subroutine read_mul_view_transfer_ctl & @@ -109,13 +127,14 @@ subroutine read_mul_view_transfer_ctl & ! integer(kind = kint), intent(in) :: id_control character(len=kchara), intent(in) :: hd_block - type(multi_modeview_ctl), intent(inout) :: mul_mats_c + type(multi_modelview_ctl), intent(inout) :: mul_mats_c type(buffer_for_control), intent(inout) :: c_buf +! + integer(kind = kint) :: n_append ! ! if(check_array_flag(c_buf, hd_block) .eqv. .FALSE.) return if(allocated(mul_mats_c%matrices)) return - mul_mats_c%num_modelviews_c = 0 call alloc_multi_modeview_ctl(mul_mats_c) ! do @@ -125,7 +144,9 @@ subroutine read_mul_view_transfer_ctl & ! if(check_file_flag(c_buf, hd_block) & & .or. check_begin_flag(c_buf, hd_block)) then - call append_mul_view_trans_ctl(mul_mats_c) + n_append = mul_mats_c%num_modelviews_c + call append_mul_view_trans_ctl(n_append, hd_block, & + & mul_mats_c) ! call sel_read_ctl_modelview_file & & (id_control, hd_block, mul_mats_c%num_modelviews_c, & @@ -147,7 +168,7 @@ subroutine write_mul_view_transfer_ctl & ! integer(kind = kint), intent(in) :: id_control character(len=kchara), intent(in) :: hd_block - type(multi_modeview_ctl), intent(in) :: mul_mats_c + type(multi_modelview_ctl), intent(in) :: mul_mats_c integer(kind = kint), intent(inout) :: level ! integer(kind = kint) :: i @@ -167,25 +188,49 @@ end subroutine write_mul_view_transfer_ctl ! --------------------------------------------------------------------- ! --------------------------------------------------------------------- ! - subroutine append_mul_view_trans_ctl(mul_mats_c) + subroutine append_mul_view_trans_ctl(idx_in, hd_block, & + & mul_mats_c) +! + use ctl_data_view_transfer_IO +! + integer(kind = kint), intent(in) :: idx_in + character(len=kchara), intent(in) :: hd_block + type(multi_modelview_ctl), intent(inout) :: mul_mats_c ! - type(multi_modeview_ctl), intent(inout) :: mul_mats_c + type(multi_modelview_ctl) :: tmp_mul_qmats + integer(kind = kint) :: i ! - type(multi_modeview_ctl) :: tmp_mul_qmats ! + if(idx_in.lt.0 .or. idx_in.gt.mul_mats_c%num_modelviews_c) return ! tmp_mul_qmats%num_modelviews_c = mul_mats_c%num_modelviews_c call alloc_multi_modeview_ctl(tmp_mul_qmats) - call copy_mul_view_trans_ctl(tmp_mul_qmats%num_modelviews_c, & - & mul_mats_c, tmp_mul_qmats) ! - call dealloc_multi_modeview_ctl(mul_mats_c) + do i = 1, tmp_mul_qmats%num_modelviews_c + call dup_view_transfer_ctl(mul_mats_c%matrices(i), & + & tmp_mul_qmats%matrices(i)) + tmp_mul_qmats%fname_mat_ctl(i) = mul_mats_c%fname_mat_ctl(i) + end do ! + call dealloc_multi_modeview_ctl(mul_mats_c) mul_mats_c%num_modelviews_c = tmp_mul_qmats%num_modelviews_c + 1 call alloc_multi_modeview_ctl(mul_mats_c) ! - call copy_mul_view_trans_ctl(tmp_mul_qmats%num_modelviews_c, & - & tmp_mul_qmats, mul_mats_c) + do i = 1, idx_in + call dup_view_transfer_ctl(tmp_mul_qmats%matrices(i), & + & mul_mats_c%matrices(i)) + mul_mats_c%fname_mat_ctl(i) = tmp_mul_qmats%fname_mat_ctl(i) + end do +! + call init_view_transfer_ctl_label(hd_block, & + & mul_mats_c%matrices(idx_in+1)) + mul_mats_c%fname_mat_ctl(idx_in+1) = 'NO_FILE' +! + do i = idx_in+1, tmp_mul_qmats%num_modelviews_c + call dup_view_transfer_ctl(tmp_mul_qmats%matrices(i), & + & mul_mats_c%matrices(i+1)) + mul_mats_c%fname_mat_ctl(i+1) = tmp_mul_qmats%fname_mat_ctl(i) + end do ! call dealloc_multi_modeview_ctl(tmp_mul_qmats) ! @@ -193,40 +238,68 @@ end subroutine append_mul_view_trans_ctl ! ! ----------------------------------------------------------------------- ! - subroutine dup_mul_view_trans_ctl(org_mul_mats_c, & - & new_mul_mats_c) + subroutine delete_mul_view_trans_ctl(idx_in, mul_mats_c) ! - type(multi_modeview_ctl), intent(in) :: org_mul_mats_c - type(multi_modeview_ctl), intent(inout) :: new_mul_mats_c + integer(kind = kint), intent(in) :: idx_in + type(multi_modelview_ctl), intent(inout) :: mul_mats_c ! + type(multi_modelview_ctl) :: tmp_mul_qmats + integer(kind = kint) :: i ! - new_mul_mats_c%num_modelviews_c & - & = org_mul_mats_c%num_modelviews_c - call alloc_multi_modeview_ctl(new_mul_mats_c) - call copy_mul_view_trans_ctl(new_mul_mats_c%num_modelviews_c, & - & org_mul_mats_c, new_mul_mats_c) ! - end subroutine dup_mul_view_trans_ctl + if(idx_in.le.0 .or. idx_in.gt.mul_mats_c%num_modelviews_c) return ! -! --------------------------------------------------------------------- + tmp_mul_qmats%num_modelviews_c = mul_mats_c%num_modelviews_c + call alloc_multi_modeview_ctl(tmp_mul_qmats) ! - subroutine copy_mul_view_trans_ctl & - & (num_mat, org_mul_mats_c, new_mul_mats_c) + do i = 1, tmp_mul_qmats%num_modelviews_c + call dup_view_transfer_ctl(mul_mats_c%matrices(i), & + & tmp_mul_qmats%matrices(i)) + tmp_mul_qmats%fname_mat_ctl(i) = mul_mats_c%fname_mat_ctl(i) + end do ! - integer(kind = kint), intent(in) :: num_mat - type(multi_modeview_ctl), intent(in) :: org_mul_mats_c - type(multi_modeview_ctl), intent(inout) :: new_mul_mats_c + call dealloc_multi_modeview_ctl(mul_mats_c) + mul_mats_c%num_modelviews_c = tmp_mul_qmats%num_modelviews_c + 1 + call alloc_multi_modeview_ctl(mul_mats_c) +! + do i = 1, idx_in-1 + call dup_view_transfer_ctl(tmp_mul_qmats%matrices(i), & + & mul_mats_c%matrices(i)) + mul_mats_c%fname_mat_ctl(i) = tmp_mul_qmats%fname_mat_ctl(i) + end do + do i = idx_in, mul_mats_c%num_modelviews_c + call dup_view_transfer_ctl(tmp_mul_qmats%matrices(i+1), & + & mul_mats_c%matrices(i)) + mul_mats_c%fname_mat_ctl(i) = tmp_mul_qmats%fname_mat_ctl(i+1) + end do +! + call dealloc_multi_modeview_ctl(tmp_mul_qmats) +! + end subroutine delete_mul_view_trans_ctl +! +! ----------------------------------------------------------------------- +! + subroutine dup_mul_view_trans_ctl(org_mul_mats_c, & + & new_mul_mats_c) +! + type(multi_modelview_ctl), intent(in) :: org_mul_mats_c + type(multi_modelview_ctl), intent(inout) :: new_mul_mats_c ! integer(kind = kint) :: i ! - do i = 1, num_mat + new_mul_mats_c%block_name = org_mul_mats_c%block_name + new_mul_mats_c%num_modelviews_c & + & = org_mul_mats_c%num_modelviews_c + call alloc_multi_modeview_ctl(new_mul_mats_c) +! + do i = 1, new_mul_mats_c%num_modelviews_c call dup_view_transfer_ctl(org_mul_mats_c%matrices(i), & & new_mul_mats_c%matrices(i)) + new_mul_mats_c%fname_mat_ctl(i) & + & = org_mul_mats_c%fname_mat_ctl(i) end do - new_mul_mats_c%fname_mat_ctl(1:num_mat) & - & = org_mul_mats_c%fname_mat_ctl(1:num_mat) ! - end subroutine copy_mul_view_trans_ctl + end subroutine dup_mul_view_trans_ctl ! ! --------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/t_volume_rendering.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/t_volume_rendering.f90 index 5ffced31..0e5c648a 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/t_volume_rendering.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/t_volume_rendering.f90 @@ -166,6 +166,7 @@ subroutine check_PVR_update & & (id_control, pvr_ctls, pvr, iflag_redraw) ! use calypso_mpi_int + use bcast_control_data_4_pvr use ctl_file_each_pvr_IO use skip_comment_f ! @@ -194,6 +195,12 @@ subroutine check_PVR_update & end if call reset_pvr_update_flags(pvr_ctls%pvr_ctl_type(1)) end if +! + call bcast_pvr_update_flag(pvr_ctls%pvr_ctl_type(1)) + if(pvr_ctls%pvr_ctl_type(1)%i_pvr_ctl .lt. 0) then + call calypso_MPI_abort(pvr_ctls%pvr_ctl_type(1)%i_pvr_ctl, & + & 'control file is broken') + end if ! call calypso_mpi_bcast_one_int(iflag_redraw, 0) call calypso_mpi_barrier @@ -221,7 +228,7 @@ subroutine read_ctl_pvr_files_4_update(id_control, & if(my_rank .ne. 0) return c_buf1%level = 0 do i_pvr = 1, pvr_ctls%num_pvr_ctl - if(pvr_ctls%fname_pvr_ctl(i_pvr) .ne. 'NO_FILE') then + if(.not. no_file_flag(pvr_ctls%fname_pvr_ctl(i_pvr))) then call read_control_pvr_file & & (id_control, pvr_ctls%fname_pvr_ctl(i_pvr), hd_pvr_ctl, & & pvr_ctls%pvr_ctl_type(i_pvr), c_buf1) diff --git a/src/Fortran_libraries/VIZ_src/volume_rendering/volume_rendering.f90 b/src/Fortran_libraries/VIZ_src/volume_rendering/volume_rendering.f90 index 3bcbff1e..d5f85c30 100644 --- a/src/Fortran_libraries/VIZ_src/volume_rendering/volume_rendering.f90 +++ b/src/Fortran_libraries/VIZ_src/volume_rendering/volume_rendering.f90 @@ -97,7 +97,7 @@ subroutine PVR_initialize(increment_pvr, geofem, nod_fld, & call dealloc_pvr_ctl_struct(pvr_ctls) if(iflag_PVR_time) call end_elapsed_time(ist_elapsed_PVR+6) ! do i_pvr = 1, pvr_ctls%num_pvr_ctl -! if(pvr_ctls%fname_pvr_ctl(i_pvr) .ne. 'NO_FILE' & +! if((no_file_flag(pvr_ctls%fname_pvr_ctl(i_pvr)) .eqv. .FALSE.) & ! & .or. my_rank .ne. 0) then ! call deallocate_cont_dat_pvr(pvr_ctls%pvr_ctl_type(i_pvr)) ! end if diff --git a/src/programs/data_utilities/SNAPSHOT_MHD/main_control_MHD_viz_check.f90 b/src/programs/data_utilities/SNAPSHOT_MHD/main_control_MHD_viz_check.f90 index e0a1c80b..dfd96ae5 100644 --- a/src/programs/data_utilities/SNAPSHOT_MHD/main_control_MHD_viz_check.f90 +++ b/src/programs/data_utilities/SNAPSHOT_MHD/main_control_MHD_viz_check.f90 @@ -20,8 +20,6 @@ program control_MHD_w_viz_check ! !> File name for control file character(len=kchara) :: MHD_ctl_name - character(len=kchara), parameter & - & :: hd_mhd_ctl = 'MHD_control' ! type(mhd_simulation_control) :: MHD_ctl1 type(add_vizs_sph_mhd_ctl) :: add_VMHD_ctl1 @@ -43,7 +41,7 @@ program control_MHD_w_viz_check write(id_monitor,'(a)') '! ' write(id_monitor,'(a)') '! Checked control data' write(id_monitor,'(a)') '! ' - call write_sph_mhd_ctl_w_vizs(id_monitor, hd_mhd_ctl, & + call write_sph_mhd_ctl_w_vizs(id_monitor, & & MHD_ctl1, add_VMHD_ctl1, c_buf1%level) ! stop '***** program finished *****' diff --git a/src/programs/data_utilities/VIZ_only/t_control_data_three_vizs.f90 b/src/programs/data_utilities/VIZ_only/t_control_data_three_vizs.f90 index 586bf201..cdada1a4 100644 --- a/src/programs/data_utilities/VIZ_only/t_control_data_three_vizs.f90 +++ b/src/programs/data_utilities/VIZ_only/t_control_data_three_vizs.f90 @@ -50,6 +50,8 @@ module t_control_data_three_vizs ! !> Structure for visulization program type control_data_three_vizs +!> Block name + character(len=kchara) :: block_name = 'visualizer' !> Structure for file settings type(platform_data_control) :: viz_plt !> Structure for time stepping control @@ -98,6 +100,7 @@ subroutine read_control_file_three_vizs(file_name, & ! ! c_buf%level = c_buf%level + 1 + call init_three_vizs_control_label(hd_viz_only_file, viz3_c) open (viz_ctl_file_code, file=file_name, status='old') do call load_one_line_from_control(viz_ctl_file_code, & @@ -165,8 +168,8 @@ subroutine read_three_vizs_control_data & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(viz3_c%i_viz_only_file .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do call load_one_line_from_control(id_control, hd_block, c_buf) if(c_buf%iend .gt. 0) exit @@ -208,7 +211,7 @@ subroutine write_three_vizs_control_data & call write_control_platforms & & (id_control, hd_platform, viz3_c%viz_plt, level) call write_control_time_step_data & - & (id_control, hd_time_step, viz3_c%t_viz_ctl, level) + & (id_control, viz3_c%t_viz_ctl, level) ! call write_viz3_controls(id_control, hd_viz_control, & & viz3_c%viz3_ctl, level) @@ -217,6 +220,25 @@ subroutine write_three_vizs_control_data & end subroutine write_three_vizs_control_data ! ! -------------------------------------------------------------------- +! + subroutine init_three_vizs_control_label(hd_block, viz3_c) +! + use ctl_data_platforms_IO + use ctl_data_4_time_steps_IO + use ctl_data_three_vizs_IO +! + character(len=kchara), intent(in) :: hd_block + type(control_data_three_vizs), intent(inout) :: viz3_c +! +! + viz3_c%block_name = hd_block + call init_platforms_labels(hd_platform, viz3_c%viz_plt) + call init_ctl_time_step_label(hd_time_step, viz3_c%t_viz_ctl) + call init_viz3_ctl_label(hd_viz_control, viz3_c%viz3_ctl) +! + end subroutine init_three_vizs_control_label +! +! -------------------------------------------------------------------- ! subroutine dealloc_three_vizs_control_data(viz3_c) !