diff --git a/doc/CALYPSO.pdf b/doc/CALYPSO.pdf index 0b991830..b13464d2 100644 Binary files a/doc/CALYPSO.pdf and b/doc/CALYPSO.pdf differ diff --git a/doc/Images/Editor_notebook.pdf b/doc/Images/Editor_notebook.pdf new file mode 100644 index 00000000..1bade2ef Binary files /dev/null and b/doc/Images/Editor_notebook.pdf differ diff --git a/doc/Images/vim_folding.pdf b/doc/Images/vim_folding.pdf new file mode 100644 index 00000000..de9dc8af Binary files /dev/null and b/doc/Images/vim_folding.pdf differ diff --git a/doc/tex_src/controls_CALYPSO.tex b/doc/tex_src/controls_CALYPSO.tex index 7c16c1cc..19fdf98e 100644 --- a/doc/tex_src/controls_CALYPSO.tex +++ b/doc/tex_src/controls_CALYPSO.tex @@ -51,7 +51,7 @@ \subsection{Block {\tt data\_files\_def}} \paragraph{\tt sph\_file\_fmt\_ctl} \label{href_t:sph_file_fmt_ctl} \verb|[sph_formayt]| \\ -File format of spherical harmonics indexing and FEM mesh file \verb|[sph_format]| is defined by text. Following data formats can be defined. Extensions of each data format is listed in Table \ref{table:mesh_format}. +File format of spherical harmonics indexing and FEM mesh file \verb|[sph_format]| is defined by text. Following data formats can be defined. Flags of each data format is listed in Table \ref{table:mesh_format}. % \begin{description} \item{\tt ascii: } Distributed ASCII data @@ -73,7 +73,7 @@ \subsection{Block {\tt data\_files\_def}} \paragraph{\tt restart\_file\_fmt\_ctl} \label{href_t:restart_file_fmt_ctl} \verb|[rst_format]| \\ -File format of restart files \verb|[rst_format]| is defined by text. Following data formats can be defined. Extensions of each data format is listed in Table \ref{table:restart_format}. +File format of restart files \verb|[rst_format]| is defined by text. Following data formats can be defined. Flags of each data format is listed in Table \ref{table:restart_format}. % \begin{description} \item{\tt ascii: } Distributed ASCII data @@ -144,7 +144,7 @@ \subsubsection{\tt num\_domain\_ctl} \paragraph{\tt num\_horizontal\_domain\_ctl} \label{href_t:num_horizontal_domain_ctl} \verb|[Ndomain]| \\ -Number of subdomains in the horizontal direction. The number will be the number of subdomains for the meridional directios for the spherical grid $(r, \theta, \phi)$ and Fourier transform $(r, \theta, m)$. For Legendre transform $(r, \theta, m)$ and $(r, l, m)$, the number will be the number of subdomains for the h.armonics ordedr $m$. +Number of subdomains in the horizontal direction. The number will be the number of subdomains for the meridional directios for the spherical grid $(r, \theta, \phi)$ and Fourier transform $(r, \theta, m)$. For Legendre transform $(r, \theta, m)$ and $(r, l, m)$, the number will be the number of subdomains for the harmonics ordedr $m$. \paragraph{\color{magenta} \tt num\_domain\_sph\_grid [Direction] [Ndomain]} @@ -163,24 +163,44 @@ \subsubsection{\tt num\_domain\_ctl} Definition of number of subdomains for spectrum data in $(r, l, m)$. Direction {\tt modes} is set in the \verb|[Direction]| field, and number of subdomains \verb|[Ndomain]| are defined in the integer field. -\subsubsection{\tt num\_grid\_sph} +\subsubsection{{\tt shell\_define\_ctl} (Previously {\tt num\_grid\_sph})} \label{href_t:num_grid_sph} -Spatial resolution of the spherical shell is defined in this block. \\ +Spatial resolution of the spherical shell is defined in this block. Old block name \verb|num_grid_sph| is also accept as this block label.\\ \hyperref[href_i:num_grid_sph]{(Back to {\tt control\_sph\_shell})} +\paragraph{\tt sph\_center\_coef\_ctl} +\label{href_t:sph_center_coef_ctl} +\verb|[TYPE]| \\ +Set flag \verb|with_center| into \verb|[type]| to include spherical harmonics coefficient for $l = m = 0$. This fliag is required when temperature or composition is solved to the center. + +\paragraph{\tt sph\_grid\_type\_ctl} +\label{href_t:sph_grid_type_ctl} +\verb|[TYPE]| \\ +Set spherical shell grid type for visualization. The follwing types are avaiable. Default value is \verb|no_pole|. The following flags are avaiable. +% +\begin{description} + \item{\tt no\_pole} Spherical shell grid is only generated from grids on Gauss-Legendle points on latitude. Corequently, small empty tube (circle on a sphere surface) has to be made in visualization. + \item{\tt with\_pole} Grid points are added at poles in the grids. There is still empty sphere in the whole sphre grid. + \item{\tt with\_center} Grid at poles and centere is added in the grid. The mesh inceludes center is degenerated from hexahedral mesh to pyramid mesh. This mode increases initialization time. +\end{description} +% + \paragraph{\tt truncation\_level\_ctl} \label{href_t:truncation_level_ctl} \verb|[Lmax]| \\ Truncation level $L$ is defined by integer. Spherical harmonics is truncated by triangular $0 \le l \le L$ and $0 1.5 L$.\paragraph{\tt ngrid\_zonal\_ctl} \label{href_t:ngrid_zonal_ctl} \verb|[Nphi]| \\ -Number of grid in the zonal direction \verb|[Nphi]| is defined by integer. +Number of grid in the zonal direction $N_{\phi}$ is defined by integer [Nphi]. $N_{\phi}$ needs to satisfy $N_{\phi} = 2 N_{\theta}$. \paragraph{\tt raidal\_grid\_type\_ctl} \label{href_t:radial_grid_type_ctl} @@ -188,9 +208,9 @@ \subsubsection{\tt num\_grid\_sph} Type of the radial grid spacing is defined by text. The following types are supported in Calypso. % \begin{description} - \item{\tt explicit} Equi-distance grid \item{\tt Chebyshev} Chebyshev collocation points - \item{\tt equi\_distance} Set explicitly by \verb|r_layer| array + \item{\tt equi\_distance} Equi-distance grid + \item{\tt explicit} Set explicitly by \verb|r_layer| array \end{description} % @@ -224,12 +244,17 @@ \subsubsection{\tt num\_grid\_sph} (This option works with \verb|radial_grid_type_ctl| is {\tt explicit} or {\tt Chebyshev}.) Maximum radius of the domains \verb|[Rmax]| is defined by real. If this value is not defined, CMB becomes outer boundary of the domain. -\paragraph{\tt r\_layer} +\paragraph{\tt array r\_layer} \label{href_t:r_layer} \verb|[Layer #] [Radius]| \\ (This option works with \verb|[radial_grid_type_ctl]| is {\tt explicit}.) List of the radial grid points in the simulation domain. Index of the radial point \verb|[Layer #]| is defined by integer, and radius \verb|[Radius]| is defined by real. +\paragraph{\tt array add\_external\_layer} +\label{href_t:add_external_layer} +\verb|[Radius]| \\ +List of additional radial grid points. More grid points can be added in the Chebyshev or equi-distance grid. Radius of the additional points \verb|[Radius]| is defined by real. + \paragraph{\tt array boundaries\_ctl} \verb|[Boundary_name] [Layer #]| \\ \label{href_t:boundaries_ctl} @@ -296,7 +321,7 @@ \subsection{\tt phys\_values\_ctl} \hline \hline \tt viscous\_diffusion & Viscous diffusion & $-\nu \nabla \times \nabla \times \bvec{u}$ \\ -\tt inertia & Inertia term & $ \bvec{\omega} \times \bvec{u} $ \\ +\tt inertia & Inertia term & $ -\bvec{\omega} \times \bvec{u} $ \\ \tt buoyancy & Thermal buoyancy & $ -\alpha_{T} T \bvec{g} $ \\ \tt composite\_buoyancy & Compositional buoyancy & $ -\alpha_{C} C\bvec{g} $\\ \tt Lorentz\_force & Lorentz force & $ \bvec{J} \times \bvec{B} $ \\ @@ -332,7 +357,7 @@ \subsection{\tt phys\_values\_ctl} \begin{tabular}{|c|c|c|} \hline \tt [Name] & field name & Description \\ \hline \hline -\tt rot\_inertia & Curl of inertia & $ \nabla \times \left(\bvec{\omega} \times \bvec{u}\right) $ \\ +\tt rot\_inertia & Curl of inertia & $ -\nabla \times \left(\bvec{\omega} \times \bvec{u}\right) $ \\ \tt rot\_Lorentz\_force & Curl of Lorentz force & $ \nabla \times \left(\bvec{J} \times \bvec{B}\right) $ \\ \tt rot\_Coriolis\_force & Curl of Coriolis force & $ -2 \Omega \nabla \times \left(\hat{z} \times \bvec{u} \right) $ \\ \tt rot\_buoyancy & Curl of thermal buoyancy & $ - \nabla \times \left(\alpha_{T} T \bvec{g}\right) $ \\ diff --git a/doc/tex_src/install_CALYPSO.tex b/doc/tex_src/install_CALYPSO.tex index 12faca71..f58d59e9 100644 --- a/doc/tex_src/install_CALYPSO.tex +++ b/doc/tex_src/install_CALYPSO.tex @@ -219,9 +219,10 @@ \subsubsection{Compile} sph_add_initial_field* sph_mhd* tests/ sph_initial_field* sph_snapshot* utilities/ $ ls -F utilities/ -assemble_sph* make_f90depends* t_ave_monitor_data* -field_to_VTK* sectioning* three_vizualizations* -gen_sph_grids* section_to_vtk* +./ field_to_VTK* sectioning* +../ gen_sph_grids* t_ave_monitor_data* +assemble_sph* make_f90depends* three_vizualizations* +check_control_mhd* section_to_vtk* \end{verbatim} % % @@ -241,6 +242,8 @@ \subsubsection{Compile} \begin{description} \item{\tt assemble\_sph: }\\ Data transfer program to change number of subdomains. +\item{\tt check\_control\_mhd: }\\ + Quick check program for control data consistency. \item{\tt gen\_sph\_grids: }\\ Preprocessing program for data transfer for spherical harmonics transform \item{\tt t\_ave\_monitor\_data: }\\ @@ -306,11 +309,13 @@ \subsubsection{Distclean} % make distclean \end{verbatim} + \subsubsection{Install} The executive files are copied to the install directory \verb|$(INSTDIR)/bin|. The install directory \verb|$(INSTDIR)| is defined in Makefile, and can also set by \verb|${--prefix}| option for \verb|configure| command. Alternatively, you can use the programs in \verb|${SRCDIR}/bin| directory without running \verb|make install|. If directory \verb|${PREFIX}| does not exist, \verb|make install | creates \verb|${PREFIX}|, \verb|${PREFIX}/lib|, \verb|${PREFIX}/bin|, and \verb|${PREFIX}/include| directories. No files are installed in \verb|${PREFIX}/lib| and \verb|${PREFIX}/include|. + \subsubsection{Construct dependecies (only for developper)} -The build process of Calypso consists of three steps: +Actual build process of Calypso by \verb|% make| consists of three steps: % \begin{enumerate} \item Construct dependency of source files {\tt Makefile.depends} in each directory by {\tt make depends} command. @@ -318,8 +323,6 @@ \subsubsection{Construct dependecies (only for developper)} \item Move into {\tt [WORKDIR]} and run {\tt make} command in {\tt [WORKDIR]} directory ({\tt cd [WORKDIR]; make}) \end{enumerate} % -gmake supports parallel build by using {\tt -j [\# of process]} option, but the step 1 and 2 do not work correctly under the parallel build, but the step 3 (build under {\tt [WORKDIR} support the parallel build. Consequently, build time can be significantly reduced by run the step 3 sepalately with {\tt -j} option. -{\color{red} (Caution) Many large computer system does not recommend to use parallel build on the login nodes. Please check the computer center's documentations} Fortran90 routines need to be build after modules which are used in the routines. C source files also need dependency among include files. Consequently, list of dependency of source files are saved in the file \verb|Makefile.depends| in each directory. When you modify the source files with changing the module usage, \verb|Makefile.depends| files need to be updated. To update the \verb|Makefile.depends|files, use the \verb|make| command at the \verb|[CALYPSO_HOME]| directory as \\ % @@ -329,6 +332,11 @@ \subsubsection{Construct dependecies (only for developper)} This process generate dependencies of the Fortran modules by program \verb|make_f90depends|. For C source files, the dependency is generated by the gcc with \verb|-MM -w -DDEPENDENCY_CHECK| option. Consequently, the dependencies need to be generated by the environment with gcc or compatible compiler. After generating the dependency, you can transfer the modified package and build without using gcc. +\subsection{Parallel build} +gmake supports parallel build by using {\tt -j [\# of process]} option. Calypso's build process supports purallel build. it may reduce the compile time. (We checked on Ubuntu and Mac OS.) \\ +{\color{red} (Caution) Many large computer centers do not recommend to use parallel build on their login nodes. Please check the computer center's if you can use parallel builds} + + \subsection{Install without using configure} \label{section:no_configure} It is possible to compile Calypso without using the \verb|configure| command. To do this, you need to edit the \verb|Makefile|. First, copy \verb|Makefile| from template \verb|Makefile.in| as diff --git a/doc/tex_src/programs_CALYPSO.log b/doc/tex_src/programs_CALYPSO.log deleted file mode 100644 index e69de29b..00000000 diff --git a/doc/tex_src/programs_CALYPSO.tex b/doc/tex_src/programs_CALYPSO.tex index 252c234d..1905b11c 100644 --- a/doc/tex_src/programs_CALYPSO.tex +++ b/doc/tex_src/programs_CALYPSO.tex @@ -565,7 +565,10 @@ \subsubsection{Spatial resolution definition block} % \item Block \hyperref[href_t:num_grid_sph]{\tt num\_grid\_sph} \begin{itemize} \label{href_i:num_grid_sph} + \item \hyperref[href_t:sph_center_coef_ctl]{\tt sph\_center\_coef\_ctl [TYPE]} + \item \hyperref[href_t:sph_grid_type_ctl]{\tt sph\_grid\_type\_ctl [TYPE]} \item \hyperref[href_t:truncation_level_ctl]{\tt truncation\_level\_ctl [Lmax]} + \item \hyperref[href_t:longitude_symmetry_ctl]{\tt longitude\_symmetry\_ctl [M\_sym]} \item \hyperref[href_t:ngrid_meridonal_ctl]{\tt ngrid\_meridonal\_ctl [Ntheta]} \item \hyperref[href_t:ngrid_zonal_ctl]{\tt ngrid\_zonal\_ctl [Nphi]} % @@ -582,6 +585,7 @@ \subsubsection{Spatial resolution definition block} % \\ \item Array \hyperref[href_t:r_layer]{\tt r\_layer [Layer \#] [Radius]} + \item Array \hyperref[href_t:add_external_layer]{\tt add\_external\_layer [Radius]} % \item Array \hyperref[href_t:boundaries_ctl]{\tt boundaries\_ctl [Boundary\_name] [Layer \#]} \end{itemize} @@ -1045,7 +1049,7 @@ \subsection{Cross section data (Parallel Surfacing module)} \end{table} % \paragraph{Control data} \label{section:section_control} -The format of the control file or block for cross sections is described below. The detail of each block is described in section \ref{section:def_control}. \verb|cross_section_ctl| block can be read from an external file. +The format of the control file or block for cross sections is described below. The detail of each block is described in section \ref{section:def_control}. \verb|cross_section_ctl| and \verb|output_field| block can be read from an external file and share with different cross section controls. See \verb|tests/snapshot_test| for an example of shared \verb|output_field| block. To define the external file name, as \verb|file cross_section_ctl [file name]| in \verb|control_MHD| or \verb|control_snapshot|. \\ \\ @@ -1057,7 +1061,7 @@ \subsection{Cross section data (Parallel Surfacing module)} {\tt section\_file\_prefix [section\_prefix]} \item \hyperref[href_t:psf_output_type] {\tt psf\_output\_type [file\_format]} - \item Block \hyperref[href_t:surface_define]{\tt surface\_define} + \item File or Block \hyperref[href_t:surface_define]{\tt surface\_define [File\_Name]} \begin{itemize} \item \hyperref[href_t:section_method] {\tt section\_method [METHOD]} @@ -1075,7 +1079,7 @@ \subsection{Cross section data (Parallel Surfacing module)} {\tt section\_area\_ctl [AREA\_NAME]} \end{itemize} % - \item \hyperref[href_t:output_field_define]{\tt output\_field\_define} + \item File or Block \hyperref[href_t:output_field_define]{\tt output\_field\_define [File\_Name]} \begin{itemize} \item Array \hyperref[href_t:psf_output_field] {\tt output\_field [FIELD] [COMPONENT]} @@ -1109,7 +1113,7 @@ \subsection{Isosurface data} % Calypso can also output isosurface data for visualization. Generally, data size of the isosurface is much larger than the sectioning data. The isosurface data is also written as a unstructured grid data with VTK format. The isosurface also consists of triangle patches. -To output cross sectioning, increment of the surface output data should be defined by \verb|i_step_isosurface_ctl| in \verb|time_step_ctl| block. And, array block \verb|isosurface_ctl| in \verb|visual_control| section is required to define cross sections. Each \verb|isosurface_ctl| block defines one cross section. Each cross section can also define by an external file by specifying external file name with \verb|file| label. +To output cross sectioning, increment of the surface output data should be defined by \verb|i_step_isosurface_ctl| in \verb|time_step_ctl| block. And, array block \verb|isosurface_ctl| in \verb|visual_control| section is required to define cross sections. Each \verb|isosurface_ctl| block defines one cross section. % \paragraph{Control data} \label{section:isosurface_control} The format of the control file or block for isosurfaces is described below. The detail of each block is described in section \ref{section:def_control}. \verb|isosurface_ctl| block can be read from an external file. To define the external file name, as \verb|file isosurface_ctl [file name]| in \verb|control_MHD| or \verb|control_snapshot|. \\ @@ -1134,7 +1138,7 @@ \subsection{Isosurface data} {\tt isosurf\_area\_ctl [AREA\_NAME]} \end{itemize} % - \item Block \hyperref[href_t:field_on_isosurf]{\tt field\_on\_isosurf} + \item Block \hyperref[href_t:field_on_isosurf]{\tt field\_on\_isosurf [File\_Name]} \begin{itemize} \item \hyperref[href_t:result_type]{\tt result\_type [TYPE]} \item \hyperref[href_t:result_value]{\tt result\_value [VALUE]} @@ -1726,6 +1730,64 @@ \subsubsection{Data output for Field along with a circle} \section{Utility programs} Calypso includes some utility programs. These programs are useful to data analysis and debugging the simulation programs. +\subsection{Control file Editor} +This program is a simple Jupyter notebook (\url{https://jupyterbook.org/en/stable/intro.html#}) to edit control files. There are two Jupter notebook files \\ +(\verb|Calypso_control_editor.ipynb| and \verb|Calypso_control_glossary.ipynb|) in \verb|[CALYPSO_DIR]/src/Jupyter/| folder. \verb|Calypso_control_editor.ipynb| is the notebook to edit control files, and \verb|Calypso_control_glossary.ipynb| is the document of the control data based on the Section \label{section:def_control}. Using JupyterLab (\url{https://jupyter.org}) is recommended because JupyterLab can open the editor \\ +\verb|Calypso_control_editor.ipynb| and document \\ +\verb|Calypso_control_glossary.ipynb| side by side as showin in Figure{fig:notebook}. +% +\begin{figure}[htbp] +\begin{center} +\includegraphics*[width=110mm]{Images/Editor_notebook} +\end{center} +\caption{Example of control editor on JupyterLab.} +\label{fig:notebook} +\end{figure} +% + +If JupyterLab starts at the \verb|[CALYPSO_DIR]| directory, and you can find the notebook files under \verb|src/Jupyter/| directory. On JupyterLab, two notebooks can be opened side by side. After opening either notebook file, you can split the view by choosing \verb|File -> New View for Notebook|. Then, another file can be opened on the either side of view. This editor supports drag and drop from another notebook or programs. The instruction of usege of the editor is written in \\ + \verb|Calypso_control_editor.ipynb|. + +\subsection{Vim scripts for folding the control files} +This Vim scripts add the folding the control blocks and concurrent comment lines. +After starting the vim, this scripts can be loaded by the following command: \\ +\\ +\\ +\verb|: source [CALYPSO_DIR]/src/Vim_script/Folding_Calypso.vim| +\\ +\\ +% +\begin{figure}[htbp] +\begin{center} +\includegraphics*[width=90mm]{Images/vim_folding} +\end{center} +\caption{Example of data folding on Vim.} +\label{fig:vim_folding} +\end{figure} +% +After loading the script, the control data will already be folded. The basic commands for the folding are the following: +% +\begin{description} +\item{\tt za: } Toggles the current fold open or closed. – The most useful command to know of all of these. +\item{\tt zA: } Same as \verb|za| except it toggles all folds beneath as well. Since folds can be nested (such as with indent folding), this will toggle the state of all the folds underneath of it, not just the current fold. +\item{\tt zc: } Close the current fold. +\item{\tt zC: } Same as \verb|zc|, but closes folds nested underneath as well. +\item{\tt zo: } Open the current fold. +\item{\tt zO: } Same as \verb|zo|, but opens folds nested underneath as well. +\end{description} +% + +The \verb|vi| in Mac OS is equivalent to the \verb|vim|, so the this script works on Mac OS without any instllation. However, the full featured vim may be refquired on Linux. You can check the avaiable feature by \verb|vi (or vim) --version| command. On Ubuntu, you can install large version of vim by \verb|% apt install vim|. + + +\subsection{Control file consistency check ({\tt check\_control\_mhd})} +This small program checks if the control file \verb|control_MHD| and its external files can be read correctly by using Calypso's IO routines. The program will start by the following command:\\ +\\ +\verb|% [CALYPSO_DIR]/bin/check_control_mhd control_MHD| +\\ +If the control files read successfully, the program outputs read control data on screeen. If program stopped with error, or missing control parameters in the output, please check the control files. + + \subsection{Data transform program ({\tt sph\_snapshot})} \label{section:sph_snapshot} % diff --git a/src/C_libraries/BASE/Makefile b/src/C_libraries/BASE/Makefile index 52f91388..158403cb 100644 --- a/src/C_libraries/BASE/Makefile +++ b/src/C_libraries/BASE/Makefile @@ -16,7 +16,9 @@ dir_list: lib_name: -lib_archve: +libtarget: + +lib_archve: libtarget @echo ' ''$$(AR)' '$$(ARFLUGS)' rcsv '$$@' '$$(OBJ_BASE_C)' >> $(MAKENAME) diff --git a/src/External_libs/FFTPACK5.1D/Makefile b/src/External_libs/FFTPACK5.1D/Makefile index d47a5b18..2b61925e 100644 --- a/src/External_libs/FFTPACK5.1D/Makefile +++ b/src/External_libs/FFTPACK5.1D/Makefile @@ -26,14 +26,14 @@ lib_name: @echo 'LIB_FFTPACK_FILE = $(LIB_FFTPACK_FILE)' >> $(MAKENAME) @echo >> $(MAKENAME) -lib_tasks: libtarget lib_archve +lib_tasks: lib_archve @echo ' ''$$(RANLIB) $$@' >> $(MAKENAME) libtarget: @echo '' >> $(MAKENAME) @echo '$$(LIB_FFTPACK_FILE): $$(MOD_FFTPACK)'>> $(MAKENAME) -lib_archve: +lib_archve: libtarget @echo ' $$(AR) $$(ARFLUGS) rcsv $$@ $$(MOD_FFTPACK)' >> $(MAKENAME) mod_list: diff --git a/src/Fortran_libraries/MHD_src/IO/Makefile b/src/Fortran_libraries/MHD_src/IO/Makefile index ae01ab41..f3d1895d 100644 --- a/src/Fortran_libraries/MHD_src/IO/Makefile +++ b/src/Fortran_libraries/MHD_src/IO/Makefile @@ -13,7 +13,9 @@ MOD_MHD_IO = $(addsuffix .o,$(basename $(SOURCES)) ) dir_list: @echo 'MHD_IO_DIR = $(MHD_IO_DIR)' >> $(MAKENAME) -lib_archve: +libtarget: + +lib_archve: libtarget @echo ' ''$$(AR)' '$$(ARFLUGS)' rcsv '$$@' '$$(MOD_MHD_IO)' \ >> $(MAKENAME) diff --git a/src/Fortran_libraries/MHD_src/IO/Makefile.depends b/src/Fortran_libraries/MHD_src/IO/Makefile.depends index 6412c4d7..76d8d04f 100644 --- a/src/Fortran_libraries/MHD_src/IO/Makefile.depends +++ b/src/Fortran_libraries/MHD_src/IO/Makefile.depends @@ -4,21 +4,21 @@ add_sph_MHD_fields_2_ctl.o: $(MHD_IO_DIR)/add_sph_MHD_fields_2_ctl.f90 m_precisi $(F90) -c $(F90OPTFLAGS) $< bcast_control_sph_MHD.o: $(MHD_IO_DIR)/bcast_control_sph_MHD.f90 m_precision.o calypso_mpi.o m_machine_parameter.o t_ctl_data_MHD.o t_ctl_data_sph_MHD_w_psf.o calypso_mpi_int.o calypso_mpi_char.o transfer_to_long_integers.o bcast_4_platform_ctl.o bcast_4_field_ctl.o bcast_4_sph_monitor_ctl.o bcast_4_sphere_ctl.o bcast_ctl_MHD_model.o bcast_monitor_data_ctl.o t_ctl_data_SPH_MHD_control.o bcast_4_time_step_ctl.o bcast_ctl_data_mhd_time_rst.o t_ctl_data_crust_filter.o bcast_control_arrays.o $(F90) -c $(F90OPTFLAGS) $< -bcast_ctl_MHD_model.o: $(MHD_IO_DIR)/bcast_ctl_MHD_model.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_ctl_data_MHD_model.o calypso_mpi_int.o bcast_4_field_ctl.o bcast_ctl_data_mhd_evo.o bcast_ctl_data_mhd_forces.o t_ctl_data_dimless_numbers.o bcast_control_arrays.o t_ctl_data_mhd_normalize.o t_ctl_data_termal_norm.o t_ctl_data_momentum_norm.o t_ctl_data_induct_norm.o +bcast_ctl_MHD_model.o: $(MHD_IO_DIR)/bcast_ctl_MHD_model.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_ctl_data_MHD_model.o calypso_mpi_char.o calypso_mpi_int.o bcast_4_field_ctl.o bcast_ctl_data_mhd_evo.o bcast_ctl_data_mhd_forces.o transfer_to_long_integers.o t_ctl_data_dimless_numbers.o bcast_control_arrays.o t_ctl_data_mhd_normalize.o t_ctl_data_termal_norm.o t_ctl_data_momentum_norm.o t_ctl_data_induct_norm.o $(F90) -c $(F90OPTFLAGS) $< -bcast_ctl_data_mhd_evo.o: $(MHD_IO_DIR)/bcast_ctl_data_mhd_evo.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_ctl_data_mhd_evolution.o calypso_mpi_int.o bcast_control_arrays.o t_ctl_data_mhd_evo_area.o t_ctl_data_node_boundary.o t_ctl_data_surf_boundary.o +bcast_ctl_data_mhd_evo.o: $(MHD_IO_DIR)/bcast_ctl_data_mhd_evo.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_ctl_data_mhd_evolution.o calypso_mpi_int.o calypso_mpi_char.o transfer_to_long_integers.o bcast_control_arrays.o t_ctl_data_mhd_evo_area.o t_ctl_data_node_boundary.o t_ctl_data_surf_boundary.o $(F90) -c $(F90OPTFLAGS) $< -bcast_ctl_data_mhd_forces.o: $(MHD_IO_DIR)/bcast_ctl_data_mhd_forces.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_ctl_data_mhd_forces.o calypso_mpi_int.o bcast_control_arrays.o t_ctl_data_gravity.o t_ctl_data_coriolis_force.o t_ctl_data_mhd_magne.o t_ctl_data_magnetic_scale.o t_ctl_data_temp_model.o t_ctl_data_stratified_model.o +bcast_ctl_data_mhd_forces.o: $(MHD_IO_DIR)/bcast_ctl_data_mhd_forces.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_ctl_data_mhd_forces.o transfer_to_long_integers.o calypso_mpi_int.o calypso_mpi_char.o bcast_control_arrays.o t_ctl_data_gravity.o t_ctl_data_coriolis_force.o t_ctl_data_mhd_magne.o t_ctl_data_magnetic_scale.o t_ctl_data_temp_model.o t_ctl_data_stratified_model.o $(F90) -c $(F90OPTFLAGS) $< -bcast_ctl_data_mhd_time_rst.o: $(MHD_IO_DIR)/bcast_ctl_data_mhd_time_rst.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_ctl_data_mhd_evo_scheme.o calypso_mpi_int.o bcast_control_arrays.o t_ctl_data_mhd_restart.o +bcast_ctl_data_mhd_time_rst.o: $(MHD_IO_DIR)/bcast_ctl_data_mhd_time_rst.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_ctl_data_mhd_evo_scheme.o transfer_to_long_integers.o calypso_mpi_char.o calypso_mpi_int.o bcast_control_arrays.o t_ctl_data_mhd_restart.o $(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 calypso_mpi_int.o bcast_control_arrays.o bcast_section_control_data.o bcast_control_sph_MHD.o +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_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 calypso_mpi_int.o bcast_control_arrays.o +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) $< check_read_bc_file.o: $(MHD_IO_DIR)/check_read_bc_file.f90 m_precision.o t_bc_data_list.o t_control_parameter.o calypso_mpi.o t_physical_property.o $(F90) -c $(F90OPTFLAGS) $< -ctl_data_MHD_model_IO.o: $(MHD_IO_DIR)/ctl_data_MHD_model_IO.f90 m_precision.o m_machine_parameter.o t_read_control_elements.o t_ctl_data_4_fields.o t_ctl_data_mhd_evolution.o t_ctl_data_mhd_evo_area.o t_ctl_data_node_boundary.o t_ctl_data_surf_boundary.o t_ctl_data_mhd_normalize.o t_ctl_data_mhd_forces.o t_ctl_data_coriolis_force.o t_ctl_data_gravity.o t_ctl_data_mhd_magne.o t_ctl_data_magnetic_scale.o t_ctl_data_temp_model.o t_ctl_data_dimless_numbers.o t_ctl_data_MHD_model.o skip_comment_f.o write_control_elements.o ctl_data_temp_model_IO.o ctl_data_comp_model_IO.o ctl_data_node_boundary_IO.o ctl_data_surf_boundary_IO.o +ctl_data_MHD_model_IO.o: $(MHD_IO_DIR)/ctl_data_MHD_model_IO.f90 m_precision.o m_machine_parameter.o t_read_control_elements.o t_ctl_data_4_fields.o t_ctl_data_mhd_evolution.o t_ctl_data_mhd_evo_area.o t_ctl_data_node_boundary.o t_ctl_data_surf_boundary.o t_ctl_data_mhd_normalize.o t_ctl_data_mhd_forces.o t_ctl_data_coriolis_force.o t_ctl_data_gravity.o t_ctl_data_mhd_magne.o t_ctl_data_magnetic_scale.o t_ctl_data_temp_model.o t_ctl_data_dimless_numbers.o t_ctl_data_MHD_model.o skip_comment_f.o write_control_elements.o ctl_data_node_boundary_IO.o ctl_data_surf_boundary_IO.o ctl_data_temp_model_IO.o ctl_data_comp_model_IO.o $(F90) -c $(F90OPTFLAGS) $< ctl_data_comp_model_IO.o: $(MHD_IO_DIR)/ctl_data_comp_model_IO.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_temp_model.o skip_comment_f.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< @@ -34,29 +34,31 @@ init_sph_MHD_elapsed_label.o: $(MHD_IO_DIR)/init_sph_MHD_elapsed_label.F90 m_pre $(F90) -c $(F90OPTFLAGS) $(F90CPPFLAGS) $< m_boundary_condition_IDs.o: $(MHD_IO_DIR)/m_boundary_condition_IDs.f90 m_precision.o $(F90) -c $(F90OPTFLAGS) $< -m_force_control_labels.o: $(MHD_IO_DIR)/m_force_control_labels.f90 m_precision.o t_base_force_labels.o m_base_force_labels.o +m_fem_node_group_types.o: $(MHD_IO_DIR)/m_fem_node_group_types.f90 m_precision.o m_boundary_condition_IDs.o m_sph_node_group_types.o skip_comment_f.o t_control_array_character.o + $(F90) -c $(F90OPTFLAGS) $< +m_force_control_labels.o: $(MHD_IO_DIR)/m_force_control_labels.f90 m_precision.o t_base_force_labels.o m_base_force_labels.o t_control_array_character.o + $(F90) -c $(F90OPTFLAGS) $< +m_sph_node_group_types.o: $(MHD_IO_DIR)/m_sph_node_group_types.f90 m_precision.o m_boundary_condition_IDs.o skip_comment_f.o t_control_array_character.o $(F90) -c $(F90OPTFLAGS) $< output_viz_file_control.o: $(MHD_IO_DIR)/output_viz_file_control.f90 m_machine_parameter.o m_precision.o m_constants.o t_IO_step_parameter.o t_MHD_step_parameter.o t_flex_delta_t_parameter.o t_time_data.o $(F90) -c $(F90OPTFLAGS) $< set_control_4_MHD_coefs.o: $(MHD_IO_DIR)/set_control_4_MHD_coefs.f90 m_precision.o m_machine_parameter.o calypso_mpi.o m_error_IDs.o t_physical_property.o t_powers_4_coefficients.o t_ctl_data_mhd_normalize.o t_ctl_data_termal_norm.o t_ctl_data_momentum_norm.o t_ctl_data_induct_norm.o $(F90) -c $(F90OPTFLAGS) $< -set_control_4_composition.o: $(MHD_IO_DIR)/set_control_4_composition.f90 m_precision.o calypso_mpi.o m_machine_parameter.o t_physical_property.o t_control_array_chara2real.o t_bc_data_list.o set_node_group_types.o set_surface_group_types.o +set_control_4_composition.o: $(MHD_IO_DIR)/set_control_4_composition.f90 m_precision.o calypso_mpi.o m_machine_parameter.o m_sph_node_group_types.o t_physical_property.o t_control_array_chara2real.o t_bc_data_list.o m_fem_node_group_types.o set_surface_group_types.o $(F90) -c $(F90OPTFLAGS) $< set_control_4_force.o: $(MHD_IO_DIR)/set_control_4_force.f90 m_precision.o m_constants.o m_error_IDs.o m_machine_parameter.o m_force_control_labels.o t_control_parameter.o t_ctl_data_mhd_forces.o t_ctl_data_mhd_magne.o t_ctl_data_gravity.o t_ctl_data_coriolis_force.o skip_comment_f.o t_physical_property.o calypso_mpi.o $(F90) -c $(F90OPTFLAGS) $< -set_control_4_magne.o: $(MHD_IO_DIR)/set_control_4_magne.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_physical_property.o t_control_array_chara2real.o t_bc_data_list.o set_node_group_types.o set_surface_group_types.o - $(F90) -c $(F90OPTFLAGS) $< -set_control_4_model.o: $(MHD_IO_DIR)/set_control_4_model.f90 m_precision.o m_constants.o m_error_IDs.o m_machine_parameter.o t_ctl_data_mhd_evo_scheme.o t_control_parameter.o calypso_mpi.o t_ctl_data_mhd_evolution.o t_ctl_data_temp_model.o t_reference_scalar_param.o m_base_field_labels.o t_control_array_real.o +set_control_4_magne.o: $(MHD_IO_DIR)/set_control_4_magne.f90 m_precision.o m_machine_parameter.o m_sph_node_group_types.o calypso_mpi.o t_physical_property.o t_control_array_chara2real.o t_bc_data_list.o m_fem_node_group_types.o set_surface_group_types.o $(F90) -c $(F90OPTFLAGS) $< -set_control_4_press.o: $(MHD_IO_DIR)/set_control_4_press.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_physical_property.o t_control_array_chara2real.o t_bc_data_list.o set_node_group_types.o set_surface_group_types.o +set_control_4_model.o: $(MHD_IO_DIR)/set_control_4_model.f90 m_precision.o m_constants.o m_error_IDs.o m_machine_parameter.o t_ctl_data_mhd_evo_scheme.o t_control_parameter.o calypso_mpi.o t_ctl_data_mhd_evolution.o t_ctl_data_temp_model.o t_reference_scalar_param.o m_base_field_labels.o set_reference_scalar_param.o t_control_array_real.o $(F90) -c $(F90OPTFLAGS) $< -set_control_4_temp.o: $(MHD_IO_DIR)/set_control_4_temp.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_physical_property.o t_control_array_chara2real.o t_bc_data_list.o set_node_group_types.o set_surface_group_types.o +set_control_4_press.o: $(MHD_IO_DIR)/set_control_4_press.f90 m_precision.o m_machine_parameter.o m_sph_node_group_types.o calypso_mpi.o t_physical_property.o t_control_array_chara2real.o t_bc_data_list.o m_fem_node_group_types.o set_surface_group_types.o $(F90) -c $(F90OPTFLAGS) $< -set_control_4_velo.o: $(MHD_IO_DIR)/set_control_4_velo.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_physical_property.o t_control_array_chara2real.o t_bc_data_list.o set_node_group_types.o set_surface_group_types.o skip_comment_f.o +set_control_4_temp.o: $(MHD_IO_DIR)/set_control_4_temp.f90 m_precision.o m_machine_parameter.o m_sph_node_group_types.o calypso_mpi.o t_physical_property.o t_control_array_chara2real.o t_bc_data_list.o m_fem_node_group_types.o set_surface_group_types.o $(F90) -c $(F90OPTFLAGS) $< -set_node_group_types.o: $(MHD_IO_DIR)/set_node_group_types.f90 m_precision.o m_boundary_condition_IDs.o skip_comment_f.o +set_control_4_velo.o: $(MHD_IO_DIR)/set_control_4_velo.f90 m_precision.o m_machine_parameter.o m_sph_node_group_types.o calypso_mpi.o t_physical_property.o t_control_array_chara2real.o t_bc_data_list.o m_fem_node_group_types.o set_surface_group_types.o skip_comment_f.o $(F90) -c $(F90OPTFLAGS) $< -set_surface_group_types.o: $(MHD_IO_DIR)/set_surface_group_types.f90 m_precision.o m_boundary_condition_IDs.o set_node_group_types.o skip_comment_f.o +set_surface_group_types.o: $(MHD_IO_DIR)/set_surface_group_types.f90 m_precision.o m_boundary_condition_IDs.o m_fem_node_group_types.o skip_comment_f.o m_sph_node_group_types.o t_control_array_character.o $(F90) -c $(F90OPTFLAGS) $< sph_mhd_rst_IO_control.o: $(MHD_IO_DIR)/sph_mhd_rst_IO_control.f90 m_precision.o m_machine_parameter.o calypso_mpi.o m_file_format_switch.o t_time_data.o t_IO_step_parameter.o t_phys_address.o t_phys_data.o t_MHD_file_parameter.o t_file_IO_parameter.o t_field_data_IO.o field_IO_select.o set_sph_restart_IO.o t_spheric_parameter.o r_interpolate_sph_data.o copy_rj_phys_data_4_IO.o const_global_element_ids.o t_spheric_rj_data.o $(F90) -c $(F90OPTFLAGS) $< diff --git a/src/Fortran_libraries/MHD_src/IO/bcast_control_sph_MHD.f90 b/src/Fortran_libraries/MHD_src/IO/bcast_control_sph_MHD.f90 index d6f458c7..516acbc5 100644 --- a/src/Fortran_libraries/MHD_src/IO/bcast_control_sph_MHD.f90 +++ b/src/Fortran_libraries/MHD_src/IO/bcast_control_sph_MHD.f90 @@ -68,7 +68,10 @@ subroutine bcast_sph_mhd_control_data(MHD_ctl) call bcast_sph_monitoring_ctl(MHD_ctl%smonitor_ctl) ! call calypso_mpi_bcast_character & - & (MHD_ctl%fname_psph_ctl, cast_long(kchara), 0) + & (MHD_ctl%fname_psph, cast_long(kchara), 0) +! + call calypso_mpi_bcast_character & + & (MHD_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(MHD_ctl%i_mhd_ctl, 0) ! end subroutine bcast_sph_mhd_control_data @@ -79,6 +82,8 @@ end subroutine bcast_sph_mhd_control_data subroutine bcast_sph_mhd_control(smctl_ctl) ! use t_ctl_data_SPH_MHD_control + use transfer_to_long_integers + use calypso_mpi_char use calypso_mpi_int use bcast_4_time_step_ctl use bcast_ctl_data_mhd_time_rst @@ -90,6 +95,8 @@ subroutine bcast_sph_mhd_control(smctl_ctl) call bcast_time_loop_ctl(smctl_ctl%mevo_ctl) call bcast_ctl_data_4_time_step(smctl_ctl%tctl) ! + call calypso_mpi_bcast_character(smctl_ctl%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(smctl_ctl%i_control, 0) ! end subroutine bcast_sph_mhd_control @@ -99,6 +106,8 @@ end subroutine bcast_sph_mhd_control subroutine bcast_crustal_filtering_ctl(crust_filter_c) ! use t_ctl_data_crust_filter + use transfer_to_long_integers + use calypso_mpi_char use calypso_mpi_int use bcast_control_arrays ! @@ -106,6 +115,9 @@ subroutine bcast_crustal_filtering_ctl(crust_filter_c) ! ! call bcast_ctl_type_i1(crust_filter_c%crust_truncation_ctl) +! + call calypso_mpi_bcast_character(crust_filter_c%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int & & (crust_filter_c%i_crustal_filtering, 0) ! diff --git a/src/Fortran_libraries/MHD_src/IO/bcast_ctl_MHD_model.f90 b/src/Fortran_libraries/MHD_src/IO/bcast_ctl_MHD_model.f90 index d099f43b..50e84588 100644 --- a/src/Fortran_libraries/MHD_src/IO/bcast_ctl_MHD_model.f90 +++ b/src/Fortran_libraries/MHD_src/IO/bcast_ctl_MHD_model.f90 @@ -48,10 +48,12 @@ module bcast_ctl_MHD_model subroutine bcast_ctl_data_mhd_model(model_ctl) ! use t_ctl_data_MHD_model + use calypso_mpi_char use calypso_mpi_int use bcast_4_field_ctl use bcast_ctl_data_mhd_evo use bcast_ctl_data_mhd_forces + use transfer_to_long_integers ! type(mhd_model_control), intent(inout) :: model_ctl ! @@ -73,6 +75,8 @@ subroutine bcast_ctl_data_mhd_model(model_ctl) call bcast_ref_scalar_ctl(model_ctl%reft_ctl) call bcast_ref_scalar_ctl(model_ctl%refc_ctl) ! + call calypso_mpi_bcast_character & + & (model_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(model_ctl%i_model, 0) ! end subroutine bcast_ctl_data_mhd_model @@ -83,12 +87,17 @@ end subroutine bcast_ctl_data_mhd_model subroutine bcast_dimless_ctl(dless_ctl) ! use t_ctl_data_dimless_numbers + use transfer_to_long_integers + use calypso_mpi_char use calypso_mpi_int use bcast_control_arrays ! type(dimless_control), intent(inout) :: dless_ctl ! call bcast_ctl_array_cr(dless_ctl%dimless) +! + call calypso_mpi_bcast_character & + & (dless_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(dless_ctl%i_dimless_ctl, 0) ! end subroutine bcast_dimless_ctl @@ -98,6 +107,8 @@ end subroutine bcast_dimless_ctl subroutine bcast_coef_term_ctl(eqs_ctl) ! use t_ctl_data_mhd_normalize + use transfer_to_long_integers + use calypso_mpi_char use calypso_mpi_int use bcast_control_arrays ! @@ -109,6 +120,8 @@ subroutine bcast_coef_term_ctl(eqs_ctl) call bcast_induction_ctl(eqs_ctl%induct_ctl) call bcast_thermal_ctl(eqs_ctl%comp_ctl) ! + call calypso_mpi_bcast_character & + & (eqs_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(eqs_ctl%i_coef_term_ctl, 0) ! end subroutine bcast_coef_term_ctl @@ -118,6 +131,8 @@ end subroutine bcast_coef_term_ctl subroutine bcast_thermal_ctl(heat_ctl) ! use t_ctl_data_termal_norm + use transfer_to_long_integers + use calypso_mpi_char use calypso_mpi_int use bcast_control_arrays ! @@ -127,6 +142,8 @@ subroutine bcast_thermal_ctl(heat_ctl) call bcast_ctl_array_cr(heat_ctl%coef_4_diffuse) call bcast_ctl_array_cr(heat_ctl%coef_4_source) ! + call calypso_mpi_bcast_character & + & (heat_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(heat_ctl%i_diff_adv, 0) ! end subroutine bcast_thermal_ctl @@ -137,6 +154,8 @@ end subroutine bcast_thermal_ctl subroutine bcast_momentum_ctl(mom_ctl) ! use t_ctl_data_momentum_norm + use transfer_to_long_integers + use calypso_mpi_char use calypso_mpi_int use bcast_control_arrays ! @@ -152,6 +171,8 @@ subroutine bcast_momentum_ctl(mom_ctl) call bcast_ctl_array_cr(mom_ctl%coef_4_Coriolis) call bcast_ctl_array_cr(mom_ctl%coef_4_Lorentz) ! + call calypso_mpi_bcast_character & + & (mom_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(mom_ctl%i_momentum, 0) ! end subroutine bcast_momentum_ctl @@ -161,6 +182,8 @@ end subroutine bcast_momentum_ctl subroutine bcast_induction_ctl(induct_ctl) ! use t_ctl_data_induct_norm + use transfer_to_long_integers + use calypso_mpi_char use calypso_mpi_int use bcast_control_arrays ! @@ -171,6 +194,8 @@ subroutine bcast_induction_ctl(induct_ctl) call bcast_ctl_array_cr(induct_ctl%coef_4_mag_diffuse) call bcast_ctl_array_cr(induct_ctl%coef_4_induction) ! + call calypso_mpi_bcast_character & + & (induct_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(induct_ctl%i_induct_ctl, 0) ! end subroutine bcast_induction_ctl diff --git a/src/Fortran_libraries/MHD_src/IO/bcast_ctl_data_mhd_evo.f90 b/src/Fortran_libraries/MHD_src/IO/bcast_ctl_data_mhd_evo.f90 index 5bfc2bd7..6acb43f2 100644 --- a/src/Fortran_libraries/MHD_src/IO/bcast_ctl_data_mhd_evo.f90 +++ b/src/Fortran_libraries/MHD_src/IO/bcast_ctl_data_mhd_evo.f90 @@ -38,6 +38,8 @@ subroutine bcast_mhd_time_evo_ctl(evo_ctl) ! use t_ctl_data_mhd_evolution use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers use bcast_control_arrays ! type(mhd_evolution_control), intent(inout) :: evo_ctl @@ -45,6 +47,8 @@ subroutine bcast_mhd_time_evo_ctl(evo_ctl) ! call bcast_ctl_array_c1(evo_ctl%t_evo_field_ctl) ! + call calypso_mpi_bcast_character & + & (evo_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(evo_ctl%i_time_evo, 0) ! end subroutine bcast_mhd_time_evo_ctl @@ -55,6 +59,8 @@ subroutine bcast_mhd_layer_ctl(earea_ctl) ! use t_ctl_data_mhd_evo_area use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers use bcast_control_arrays ! type(mhd_evo_area_control), intent(inout) :: earea_ctl @@ -63,6 +69,8 @@ subroutine bcast_mhd_layer_ctl(earea_ctl) call bcast_ctl_array_c1(earea_ctl%evo_fluid_group_ctl) call bcast_ctl_array_c1(earea_ctl%evo_conduct_group_ctl) ! + call calypso_mpi_bcast_character & + & (earea_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(earea_ctl%i_layers_ctl, 0) ! end subroutine bcast_mhd_layer_ctl @@ -74,6 +82,8 @@ subroutine bcast_bc_4_node_ctl(nbc_ctl) ! use t_ctl_data_node_boundary use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers use bcast_control_arrays ! type(node_bc_control), intent(inout) :: nbc_ctl @@ -88,6 +98,8 @@ subroutine bcast_bc_4_node_ctl(nbc_ctl) call bcast_ctl_array_c2r(nbc_ctl%node_bc_A_ctl) call bcast_ctl_array_c2r(nbc_ctl%node_bc_J_ctl) ! + call calypso_mpi_bcast_character & + & (nbc_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(nbc_ctl%i_bc_4_node, 0) ! end subroutine bcast_bc_4_node_ctl @@ -98,6 +110,8 @@ subroutine bcast_bc_4_surf_ctl(sbc_ctl) ! use t_ctl_data_surf_boundary use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers use bcast_control_arrays ! type(surf_bc_control), intent(inout) :: sbc_ctl @@ -113,6 +127,8 @@ subroutine bcast_bc_4_surf_ctl(sbc_ctl) call bcast_ctl_array_c2r(sbc_ctl%surf_bc_CF_ctl) call bcast_ctl_array_c2r(sbc_ctl%surf_bc_INF_ctl) ! + call calypso_mpi_bcast_character & + & (sbc_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(sbc_ctl%i_bc_4_surf, 0) ! end subroutine bcast_bc_4_surf_ctl diff --git a/src/Fortran_libraries/MHD_src/IO/bcast_ctl_data_mhd_forces.f90 b/src/Fortran_libraries/MHD_src/IO/bcast_ctl_data_mhd_forces.f90 index 5b7333b4..2cd8539b 100644 --- a/src/Fortran_libraries/MHD_src/IO/bcast_ctl_data_mhd_forces.f90 +++ b/src/Fortran_libraries/MHD_src/IO/bcast_ctl_data_mhd_forces.f90 @@ -45,12 +45,17 @@ module bcast_ctl_data_mhd_forces subroutine bcast_forces_ctl(frc_ctl) ! use t_ctl_data_mhd_forces + use transfer_to_long_integers use calypso_mpi_int + use calypso_mpi_char use bcast_control_arrays ! type(forces_control), intent(inout) :: frc_ctl ! call bcast_ctl_array_c1(frc_ctl%force_names) +! + call calypso_mpi_bcast_character & + & (frc_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(frc_ctl%i_forces_ctl, 0) ! end subroutine bcast_forces_ctl @@ -61,6 +66,8 @@ subroutine bcast_gravity_ctl(g_ctl) ! use t_ctl_data_gravity use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers use bcast_control_arrays ! type(gravity_control), intent(inout) :: g_ctl @@ -68,6 +75,9 @@ subroutine bcast_gravity_ctl(g_ctl) ! call bcast_ctl_array_cr(g_ctl%gravity_vector) call bcast_ctl_type_c1(g_ctl%gravity) +! + call calypso_mpi_bcast_character & + & (g_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(g_ctl%i_gravity_ctl, 0) ! end subroutine bcast_gravity_ctl @@ -78,11 +88,16 @@ subroutine bcast_coriolis_ctl(cor_ctl) ! use t_ctl_data_coriolis_force use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers use bcast_control_arrays ! type(coriolis_control), intent(inout) :: cor_ctl ! call bcast_ctl_array_cr(cor_ctl%system_rotation) +! + call calypso_mpi_bcast_character & + & (cor_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(cor_ctl%i_coriolis_ctl, 0) ! end subroutine bcast_coriolis_ctl @@ -92,8 +107,10 @@ end subroutine bcast_coriolis_ctl subroutine bcast_magneto_ctl(mcv_ctl) ! use t_ctl_data_mhd_magne - use calypso_mpi_int use bcast_control_arrays + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(magneto_convection_control), intent(inout) :: mcv_ctl ! @@ -102,6 +119,8 @@ subroutine bcast_magneto_ctl(mcv_ctl) call bcast_ctl_type_c1(mcv_ctl%magneto_cv) call bcast_ctl_type_c1(mcv_ctl%filterd_induction_ctl) ! + call calypso_mpi_bcast_character & + & (mcv_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(mcv_ctl%i_magneto_ctl, 0) ! end subroutine bcast_magneto_ctl @@ -111,13 +130,18 @@ end subroutine bcast_magneto_ctl subroutine bcast_magnetic_scale_ctl(bscale_ctl) ! use t_ctl_data_magnetic_scale - use calypso_mpi_int use bcast_control_arrays + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(magnetic_field_scale_control), intent(inout) :: bscale_ctl ! ! call bcast_ctl_array_cr(bscale_ctl%mag_to_kin_energy_ctl) +! + call calypso_mpi_bcast_character & + & (bscale_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(bscale_ctl%i_bscale_ctl, 0) ! end subroutine bcast_magnetic_scale_ctl @@ -128,6 +152,8 @@ subroutine bcast_ref_scalar_ctl(refs_ctl) ! use t_ctl_data_temp_model use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers use bcast_control_arrays ! type(reference_temperature_ctl), intent(inout) :: refs_ctl @@ -142,6 +168,9 @@ subroutine bcast_ref_scalar_ctl(refs_ctl) call bcast_ctl_type_c1(refs_ctl%ref_file_ctl) call bcast_ctl_type_c1(refs_ctl%stratified_ctl) call bcast_ctl_type_r1(refs_ctl%ICB_diffuse_reduction_ctl) +! + call calypso_mpi_bcast_character & + & (refs_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(refs_ctl%i_temp_def, 0) ! end subroutine bcast_ref_scalar_ctl @@ -152,13 +181,18 @@ end subroutine bcast_ref_scalar_ctl subroutine bcast_ref_value_ctl(ref_ctl) ! use t_ctl_data_temp_model - use calypso_mpi_int use bcast_control_arrays + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(reference_point_control), intent(inout) :: ref_ctl ! call bcast_ctl_type_r1(ref_ctl%depth) call bcast_ctl_type_r1(ref_ctl%value) +! + call calypso_mpi_bcast_character & + & (ref_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(ref_ctl%i_referenced, 0) ! end subroutine bcast_ref_value_ctl @@ -168,14 +202,19 @@ end subroutine bcast_ref_value_ctl subroutine bcast_takepiro_ctl(takepiro_ctl) ! use t_ctl_data_stratified_model - use calypso_mpi_int use bcast_control_arrays + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(takepiro_model_control), intent(inout) :: takepiro_ctl ! call bcast_ctl_type_r1(takepiro_ctl%stratified_sigma_ctl) call bcast_ctl_type_r1(takepiro_ctl%stratified_width_ctl) call bcast_ctl_type_r1(takepiro_ctl%stratified_outer_r_ctl) +! + call calypso_mpi_bcast_character & + & (takepiro_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(takepiro_ctl%i_takepiro_t_ctl, 0) ! end subroutine bcast_takepiro_ctl diff --git a/src/Fortran_libraries/MHD_src/IO/bcast_ctl_data_mhd_time_rst.f90 b/src/Fortran_libraries/MHD_src/IO/bcast_ctl_data_mhd_time_rst.f90 index ea8bd169..5a7167ec 100644 --- a/src/Fortran_libraries/MHD_src/IO/bcast_ctl_data_mhd_time_rst.f90 +++ b/src/Fortran_libraries/MHD_src/IO/bcast_ctl_data_mhd_time_rst.f90 @@ -30,6 +30,8 @@ module bcast_ctl_data_mhd_time_rst subroutine bcast_time_loop_ctl(mevo_ctl) ! use t_ctl_data_mhd_evo_scheme + use transfer_to_long_integers + use calypso_mpi_char use calypso_mpi_int use bcast_control_arrays ! @@ -46,6 +48,7 @@ subroutine bcast_time_loop_ctl(mevo_ctl) ! call bcast_ctl_type_r1(mevo_ctl%eps_4_velo_ctl) call bcast_ctl_type_r1(mevo_ctl%eps_4_magne_ctl) + call bcast_ctl_type_r1(mevo_ctl%coef_implicit_ctl) call bcast_ctl_type_r1(mevo_ctl%coef_imp_v_ctl) call bcast_ctl_type_r1(mevo_ctl%coef_imp_t_ctl) call bcast_ctl_type_r1(mevo_ctl%coef_imp_b_ctl) @@ -63,6 +66,8 @@ subroutine bcast_time_loop_ctl(mevo_ctl) call bcast_ctl_type_i1(mevo_ctl%maxiter_ctl) call bcast_ctl_type_i1(mevo_ctl%leg_vector_len) ! + call calypso_mpi_bcast_character(mevo_ctl%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(mevo_ctl%i_time_loop, 0) ! end subroutine bcast_time_loop_ctl @@ -72,6 +77,8 @@ end subroutine bcast_time_loop_ctl subroutine bcast_restart_ctl(mr_ctl) ! use t_ctl_data_mhd_restart + use transfer_to_long_integers + use calypso_mpi_char use calypso_mpi_int use bcast_control_arrays ! @@ -79,6 +86,9 @@ subroutine bcast_restart_ctl(mr_ctl) ! ! call bcast_ctl_type_c1(mr_ctl%restart_flag_ctl) +! + call calypso_mpi_bcast_character(mr_ctl%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(mr_ctl%i_restart_file, 0) ! end subroutine bcast_restart_ctl diff --git a/src/Fortran_libraries/MHD_src/IO/bcast_dynamo_sect_control.f90 b/src/Fortran_libraries/MHD_src/IO/bcast_dynamo_sect_control.f90 index fb17117d..dd30e7bc 100644 --- a/src/Fortran_libraries/MHD_src/IO/bcast_dynamo_sect_control.f90 +++ b/src/Fortran_libraries/MHD_src/IO/bcast_dynamo_sect_control.f90 @@ -34,13 +34,19 @@ module bcast_dynamo_sect_control subroutine s_bcast_dynamo_section_control(zm_sects) ! use t_control_data_dynamo_sects - use calypso_mpi_int use bcast_control_arrays use bcast_section_control_data use bcast_control_sph_MHD + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(sph_dynamo_section_controls), intent(inout) :: zm_sects ! +! + call calypso_mpi_bcast_character(zm_sects%block_name, & + & cast_long(kchara), 0) + call calypso_mpi_bcast_one_int(zm_sects%i_viz_ctl, 0) ! call bcast_crustal_filtering_ctl(zm_sects%crust_filter_ctl) call bcast_files_4_psf_ctl(zm_sects%zm_psf_ctls) diff --git a/src/Fortran_libraries/MHD_src/IO/bcast_monitor_data_ctl.f90 b/src/Fortran_libraries/MHD_src/IO/bcast_monitor_data_ctl.f90 index bdc74739..b57ce1b3 100644 --- a/src/Fortran_libraries/MHD_src/IO/bcast_monitor_data_ctl.f90 +++ b/src/Fortran_libraries/MHD_src/IO/bcast_monitor_data_ctl.f90 @@ -29,6 +29,8 @@ module bcast_monitor_data_ctl ! subroutine bcast_node_monitor_data_ctl(nmtr_ctl) ! + use transfer_to_long_integers + use calypso_mpi_char use calypso_mpi_int use bcast_control_arrays ! @@ -39,6 +41,8 @@ subroutine bcast_node_monitor_data_ctl(nmtr_ctl) call bcast_ctl_array_r3(nmtr_ctl%xx_4_monitor_ctl) call bcast_ctl_array_i2(nmtr_ctl%node_4_monitor_ctl) ! + call calypso_mpi_bcast_character(nmtr_ctl%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(nmtr_ctl%i_monitor_data, 0) ! end subroutine bcast_node_monitor_data_ctl diff --git a/src/Fortran_libraries/MHD_src/IO/ctl_data_MHD_model_IO.f90 b/src/Fortran_libraries/MHD_src/IO/ctl_data_MHD_model_IO.f90 index d2b54c71..791282f5 100644 --- a/src/Fortran_libraries/MHD_src/IO/ctl_data_MHD_model_IO.f90 +++ b/src/Fortran_libraries/MHD_src/IO/ctl_data_MHD_model_IO.f90 @@ -13,13 +13,15 @@ !!@verbatim !! subroutine read_sph_mhd_model & !! & (id_control, hd_block, model_ctl, c_buf) +!! +!! subroutine init_sph_mhd_model_label(hd_block, model_ctl) !! subroutine read_sph_mhd_model_items(id_control, model_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(mhd_model_control), intent(inout) :: model_ctl !! type(buffer_for_control), intent(inout) :: c_buf !! subroutine write_sph_mhd_model & -!! & (id_control, hd_block, model_ctl, level) +!! & (id_control, model_ctl, level) !! subroutine write_sph_mhd_model_items & !! & (id_control, model_ctl, level) !! integer(kind = kint), intent(in) :: id_control @@ -111,10 +113,11 @@ subroutine read_sph_mhd_model & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(model_ctl%i_model .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_sph_mhd_model_items(id_control, model_ctl, c_buf) @@ -126,12 +129,11 @@ end subroutine read_sph_mhd_model ! -------------------------------------------------------------------- ! subroutine write_sph_mhd_model & - & (id_control, hd_block, model_ctl, level) + & (id_control, model_ctl, level) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(mhd_model_control), intent(in) :: model_ctl ! integer(kind = kint), intent(inout) :: level @@ -139,15 +141,53 @@ subroutine write_sph_mhd_model & ! if(model_ctl%i_model .le. 0) return ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) + level = write_begin_flag_for_ctl(id_control, level, & + & model_ctl%block_name) call write_sph_mhd_model_items(id_control, model_ctl, level) - level = write_end_flag_for_ctl(id_control, level, hd_block) + level = write_end_flag_for_ctl(id_control, level, & + & model_ctl%block_name) ! end subroutine write_sph_mhd_model ! ! -------------------------------------------------------------------- ! -------------------------------------------------------------------- +! + subroutine init_sph_mhd_model_label(hd_block, model_ctl) +! + use ctl_data_node_boundary_IO + use ctl_data_surf_boundary_IO + use ctl_data_temp_model_IO + use ctl_data_comp_model_IO +! + character(len=kchara), intent(in) :: hd_block + type(mhd_model_control), intent(inout) :: model_ctl +! + model_ctl%block_name = hd_block + call init_phys_data_ctl_label(hd_phys_values, model_ctl%fld_ctl) + call init_mhd_time_evo_ctl_label(hd_time_evo, model_ctl%evo_ctl) + call init_mhd_layer_ctl_label(hd_layers_ctl, model_ctl%earea_ctl) + + call init_bc_4_node_ctl_label(hd_boundary_condition, & + & model_ctl%nbc_ctl) + call init_bc_4_surf_ctl_label(hd_bc_4_surf, model_ctl%sbc_ctl) + call init_dimless_ctl_label(hd_dimless_ctl, model_ctl%dless_ctl) + call init_coef_term_ctl_label(hd_coef_term_ctl, & + & model_ctl%eqs_ctl) + call init_forces_ctl_label(hd_forces_ctl, model_ctl%frc_ctl) +! + call init_gravity_ctl_label(hd_gravity_ctl, model_ctl%g_ctl) + call init_coriolis_ctl_label(hd_coriolis_ctl, model_ctl%cor_ctl) + call init_magneto_cv_ctl_label(hd_magneto_cv_ctl, & + & model_ctl%mcv_ctl) + call init_magnetic_scale_ctl_label(hd_bscale_ctl, & + & model_ctl%bscale_ctl) + call init_temp_model_ctl_label(hd_temp_def, model_ctl%reft_ctl) + call init_comp_model_ctl_label(hd_comp_def, model_ctl%refc_ctl) +! + end subroutine init_sph_mhd_model_label +! +! -------------------------------------------------------------------- +! ! subroutine read_sph_mhd_model_items(id_control, model_ctl, c_buf) ! @@ -192,9 +232,9 @@ subroutine read_sph_mhd_model_items(id_control, model_ctl, c_buf) & (id_control, hd_magneto_cv_ctl, model_ctl%mcv_ctl, c_buf) call read_magnetic_scale_ctl & & (id_control, hd_bscale_ctl, model_ctl%bscale_ctl, c_buf) - call read_reftemp_ctl & + call read_temp_model_ctl & & (id_control, hd_temp_def, model_ctl%reft_ctl, c_buf) - call read_refcomp_ctl & + call read_comp_model_ctl & & (id_control, hd_comp_def, model_ctl%refc_ctl, c_buf) ! call read_magneto_cv_ctl & @@ -220,7 +260,7 @@ subroutine write_sph_mhd_model_items & ! ! call write_phys_data_control & - & (id_control, hd_phys_values, model_ctl%fld_ctl, level) + & (id_control, model_ctl%fld_ctl, level) ! call write_mhd_time_evo_ctl & & (id_control, hd_time_evo, model_ctl%evo_ctl, level) @@ -232,24 +272,20 @@ subroutine write_sph_mhd_model_items & call write_bc_4_surf_ctl(id_control, hd_bc_4_surf, & & model_ctl%sbc_ctl, level) ! - call write_forces_ctl & - & (id_control, hd_forces_ctl, model_ctl%frc_ctl, level) - call write_dimless_ctl & - & (id_control, hd_dimless_ctl, model_ctl%dless_ctl, level) - call write_coef_term_ctl & - & (id_control, hd_coef_term_ctl, model_ctl%eqs_ctl, level) + call write_forces_ctl(id_control, model_ctl%frc_ctl, level) + call write_dimless_ctl(id_control, model_ctl%dless_ctl, level) + call write_coef_term_ctl(id_control, model_ctl%eqs_ctl, level) ! call write_gravity_ctl & & (id_control, hd_gravity_ctl, model_ctl%g_ctl, level) call write_coriolis_ctl & & (id_control, hd_coriolis_ctl, model_ctl%cor_ctl, level) - call write_magneto_cv_ctl & - & (id_control, hd_magneto_cv_ctl, model_ctl%mcv_ctl, level) + call write_magneto_cv_ctl(id_control, model_ctl%mcv_ctl, level) call write_magnetic_scale_ctl & & (id_control, hd_bscale_ctl, model_ctl%bscale_ctl, level) - call write_reftemp_ctl & + call write_temp_model_ctl & & (id_control, hd_temp_def, model_ctl%reft_ctl, level) - call write_refcomp_ctl & + call write_comp_model_ctl & & (id_control, hd_comp_def, model_ctl%refc_ctl, level) ! end subroutine write_sph_mhd_model_items diff --git a/src/Fortran_libraries/MHD_src/IO/ctl_data_comp_model_IO.f90 b/src/Fortran_libraries/MHD_src/IO/ctl_data_comp_model_IO.f90 index 1ad2ca32..bc8e31d7 100644 --- a/src/Fortran_libraries/MHD_src/IO/ctl_data_comp_model_IO.f90 +++ b/src/Fortran_libraries/MHD_src/IO/ctl_data_comp_model_IO.f90 @@ -9,13 +9,14 @@ !!@n Modified by H. Matsui on Oct., 2007 !! !!@verbatim -!! subroutine read_refcomp_ctl & +!! subroutine init_comp_model_ctl_label(hd_block, refc_ctl) +!! subroutine read_comp_model_ctl & !! & (id_control, hd_block, refc_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(reference_temperature_ctl), intent(inout) :: refc_ctl !! type(buffer_for_control), intent(inout) :: c_buf -!! subroutine write_refcomp_ctl & +!! subroutine write_comp_model_ctl & !! & (id_control, hd_block, refc_ctl, level) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block @@ -104,6 +105,7 @@ module ctl_data_comp_model_IO & :: hd_comp_value = 'composition' ! private :: read_ref_comp_ctl, write_ref_comp_ctl + private :: init_ref_comp_ctl_label ! ! -------------------------------------------------------------------- ! @@ -111,7 +113,7 @@ module ctl_data_comp_model_IO ! ! -------------------------------------------------------------------- ! - subroutine read_refcomp_ctl & + subroutine read_comp_model_ctl & & (id_control, hd_block, refc_ctl, c_buf) ! integer(kind = kint), intent(in) :: id_control @@ -124,7 +126,8 @@ subroutine read_refcomp_ctl & if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(refc_ctl%i_temp_def .gt. 0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_ref_comp_ctl & @@ -148,11 +151,11 @@ subroutine read_refcomp_ctl & end do refc_ctl%i_temp_def = 1 ! - end subroutine read_refcomp_ctl + end subroutine read_comp_model_ctl ! ! -------------------------------------------------------------------- ! - subroutine write_refcomp_ctl & + subroutine write_comp_model_ctl & & (id_control, hd_block, refc_ctl, level) ! use write_control_elements @@ -174,34 +177,57 @@ subroutine write_refcomp_ctl & maxlen = max(maxlen, len_trim(hd_start_ctl)) maxlen = max(maxlen, len_trim(hd_ref_field_file)) ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) -! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_filterd_advection, refc_ctl%filterd_advect_ctl) + & refc_ctl%filterd_advect_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_diffusivity_reduction, & & refc_ctl%ICB_diffuse_reduction_ctl) ! - write(id_control,'(a1)') '!' call write_chara_ctl_type(id_control, level, maxlen, & - & hd_ref_comp, refc_ctl%reference_ctl) + & refc_ctl%reference_ctl) call write_ref_comp_ctl & & (id_control, hd_low_comp, refc_ctl%low_ctl, level) call write_ref_comp_ctl & & (id_control, hd_high_comp, refc_ctl%high_ctl, level) ! - write(id_control,'(a1)') '!' call write_chara_ctl_type(id_control, level, maxlen, & - & hd_start_ctl, refc_ctl%stratified_ctl) + & refc_ctl%stratified_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_ref_field_file, refc_ctl%ref_file_ctl) + & refc_ctl%ref_file_ctl) call write_takepiro_ctl(id_control, hd_takepiro_ctl, & & refc_ctl%takepiro_ctl, level) ! level = write_end_flag_for_ctl(id_control, level, hd_block) ! - end subroutine write_refcomp_ctl + end subroutine write_comp_model_ctl +! +! -------------------------------------------------------------------- +! + subroutine init_comp_model_ctl_label(hd_block, refc_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(reference_temperature_ctl), intent(inout) :: refc_ctl +! +! + refc_ctl%block_name = hd_block + call init_ref_comp_ctl_label(hd_low_comp, refc_ctl%low_ctl) + call init_ref_comp_ctl_label(hd_high_comp, refc_ctl%high_ctl) + call init_takepiro_ctl_label(hd_takepiro_ctl, & + & refc_ctl%takepiro_ctl) +! + call init_chara_ctl_item_label & + & (hd_filterd_advection, refc_ctl%filterd_advect_ctl) + call init_chara_ctl_item_label & + & (hd_ref_comp, refc_ctl%reference_ctl) + call init_chara_ctl_item_label & + & (hd_start_ctl, refc_ctl%stratified_ctl) + call init_chara_ctl_item_label & + & (hd_ref_field_file, refc_ctl%ref_file_ctl) +! + call init_real_ctl_item_label(hd_diffusivity_reduction, & + & refc_ctl%ICB_diffuse_reduction_ctl) +! + end subroutine init_comp_model_ctl_label ! ! -------------------------------------------------------------------- ! -------------------------------------------------------------------- @@ -219,7 +245,8 @@ subroutine read_ref_comp_ctl & if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(ref_ctl%i_referenced .gt. 0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_real_ctl_type(c_buf, hd_position, ref_ctl%depth) @@ -250,17 +277,26 @@ subroutine write_ref_comp_ctl & maxlen = len_trim(hd_position) maxlen = max(maxlen, len_trim(hd_comp_value)) ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) -! call write_real_ctl_type(id_control, level, maxlen, & - & hd_position, ref_ctl%depth) + & ref_ctl%depth) call write_real_ctl_type(id_control, level, maxlen, & - & hd_comp_value, ref_ctl%value) + & ref_ctl%value) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_ref_comp_ctl ! ! -------------------------------------------------------------------- +! + subroutine init_ref_comp_ctl_label(hd_block, ref_ctl) + character(len=kchara), intent(in) :: hd_block + type(reference_point_control), intent(inout) :: ref_ctl +! + ref_ctl%block_name = hd_block + call init_real_ctl_item_label(hd_position, ref_ctl%depth) + call init_real_ctl_item_label(hd_comp_value, ref_ctl%value) + end subroutine init_ref_comp_ctl_label +! +! -------------------------------------------------------------------- ! end module ctl_data_comp_model_IO diff --git a/src/Fortran_libraries/MHD_src/IO/ctl_data_mhd_evo_scheme_IO.f90 b/src/Fortran_libraries/MHD_src/IO/ctl_data_mhd_evo_scheme_IO.f90 index ccee6a6b..f7970ed2 100644 --- a/src/Fortran_libraries/MHD_src/IO/ctl_data_mhd_evo_scheme_IO.f90 +++ b/src/Fortran_libraries/MHD_src/IO/ctl_data_mhd_evo_scheme_IO.f90 @@ -7,6 +7,7 @@ !> @brief Set initial data for spectrum dynamos !! !!@verbatim +!! subroutine init_time_loop_ctl_label(hd_block, mevo_ctl) !! subroutine read_time_loop_ctl & !! & (id_control, hd_block, mevo_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -61,6 +62,7 @@ !! eps_4_magne_ctl 5.0e-1 !! scheme_ctl Crank_Nicolson !! diffuse_correct_ctl On +!! coef_implicit_ctl 5.0e-1 !! coef_imp_v_ctl 5.0e-1 !! coef_imp_t_ctl 5.0e-1 !! coef_imp_b_ctl 5.0e-1 @@ -118,6 +120,8 @@ module ctl_data_mhd_evo_scheme_IO & :: hd_diff_correct = 'diffuse_correct_ctl' ! character(len=kchara), parameter, private & + & :: hd_coef_implicit = 'coef_implicit_ctl' + character(len=kchara), parameter, private & & :: hd_coef_imp_v = 'coef_imp_v_ctl' character(len=kchara), parameter, private & & :: hd_coef_imp_t = 'coef_imp_t_ctl' @@ -162,10 +166,12 @@ subroutine read_time_loop_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(mevo_ctl%i_time_loop .gt. 0) return + mevo_ctl%block_name = hd_block + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_chara_ctl_type & @@ -188,6 +194,8 @@ subroutine read_time_loop_ctl & call read_real_ctl_type & & (c_buf, hd_eps_4_magne, mevo_ctl%eps_4_magne_ctl) call read_real_ctl_type & + & (c_buf, hd_coef_implicit, mevo_ctl%coef_implicit_ctl) + call read_real_ctl_type & & (c_buf, hd_coef_imp_v, mevo_ctl%coef_imp_v_ctl) call read_real_ctl_type & & (c_buf, hd_coef_imp_t, mevo_ctl%coef_imp_t_ctl) @@ -224,15 +232,13 @@ end subroutine read_time_loop_ctl ! ! -------------------------------------------------------------------- ! - subroutine write_time_loop_ctl & - & (id_control, hd_block, mevo_ctl, level) + subroutine write_time_loop_ctl(id_control, mevo_ctl, level) ! use t_read_control_elements use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(mhd_evo_scheme_control), intent(in) :: mevo_ctl ! integer(kind = kint), intent(inout) :: level @@ -253,6 +259,7 @@ subroutine write_time_loop_ctl & maxlen = max(maxlen, len_trim(hd_eps_4_magne)) maxlen = max(maxlen, len_trim(hd_scheme)) maxlen = max(maxlen, len_trim(hd_diff_correct)) + maxlen = max(maxlen, len_trim(hd_coef_implicit)) maxlen = max(maxlen, len_trim(hd_coef_imp_v)) maxlen = max(maxlen, len_trim(hd_coef_imp_t)) maxlen = max(maxlen, len_trim(hd_coef_imp_b)) @@ -266,66 +273,129 @@ subroutine write_time_loop_ctl & maxlen = max(maxlen, len_trim(hd_sph_transform_mode)) maxlen = max(maxlen, len_trim(hd_legendre_vect_len)) ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! + level = write_begin_flag_for_ctl(id_control, level, & + & mevo_ctl%block_name) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_iflag_supg, mevo_ctl%iflag_supg_ctl) + & mevo_ctl%iflag_supg_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_iflag_v_supg, mevo_ctl%iflag_supg_v_ctl) + & mevo_ctl%iflag_supg_v_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_iflag_t_supg, mevo_ctl%iflag_supg_t_ctl) + & mevo_ctl%iflag_supg_t_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_iflag_b_supg, mevo_ctl%iflag_supg_b_ctl) + & mevo_ctl%iflag_supg_b_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_iflag_c_supg, mevo_ctl%iflag_supg_c_ctl) + & mevo_ctl%iflag_supg_c_ctl) ! - write(id_control,'(a1)') '!' call write_integer_ctl_type(id_control, level, maxlen, & - & hd_num_multi_pass, mevo_ctl%num_multi_pass_ctl) + & mevo_ctl%num_multi_pass_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_maxiter, mevo_ctl%maxiter_ctl) + & mevo_ctl%maxiter_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_eps_4_velo, mevo_ctl%eps_4_velo_ctl) + & mevo_ctl%eps_4_velo_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_eps_4_magne, mevo_ctl%eps_4_magne_ctl) + & mevo_ctl%eps_4_magne_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_scheme, mevo_ctl%scheme_ctl) + & mevo_ctl%scheme_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_diff_correct, mevo_ctl%diffuse_correct) + & mevo_ctl%diffuse_correct) ! - write(id_control,'(a1)') '!' call write_real_ctl_type(id_control, level, maxlen, & - & hd_coef_imp_v, mevo_ctl%coef_imp_v_ctl) + & mevo_ctl%coef_implicit_ctl) + call write_real_ctl_type(id_control, level, maxlen, & + & mevo_ctl%coef_imp_v_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_coef_imp_t, mevo_ctl%coef_imp_t_ctl) + & mevo_ctl%coef_imp_t_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_coef_imp_b, mevo_ctl%coef_imp_b_ctl) + & mevo_ctl%coef_imp_b_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_coef_imp_c, mevo_ctl%coef_imp_c_ctl) + & mevo_ctl%coef_imp_c_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_eps_crank, mevo_ctl%eps_crank_ctl) + & mevo_ctl%eps_crank_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_eps_B_crank, mevo_ctl%eps_B_crank_ctl) + & mevo_ctl%eps_B_crank_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_method_4_velo, mevo_ctl%method_4_CN) + & mevo_ctl%method_4_CN) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_precond_4_crank, mevo_ctl%precond_4_CN) + & mevo_ctl%precond_4_CN) ! - write(id_control,'(a1)') '!' call write_chara_ctl_type(id_control, level, maxlen, & - & hd_import_mode, mevo_ctl%import_mode) + & mevo_ctl%import_mode) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_FFT_package, mevo_ctl%FFT_library) + & mevo_ctl%FFT_library) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_sph_transform_mode, mevo_ctl%Legendre_trans_type) + & mevo_ctl%Legendre_trans_type) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_legendre_vect_len, mevo_ctl%leg_vector_len) -! - level = write_end_flag_for_ctl(id_control, level, hd_block) + & mevo_ctl%leg_vector_len) + level = write_end_flag_for_ctl(id_control, level, & + & mevo_ctl%block_name) ! end subroutine write_time_loop_ctl ! ! -------------------------------------------------------------------- +! + subroutine init_time_loop_ctl_label(hd_block, mevo_ctl) +! + character(len=kchara), intent(in) :: hd_block +! + type(mhd_evo_scheme_control), intent(inout) :: mevo_ctl + +! + mevo_ctl%block_name = hd_block +! + call init_chara_ctl_item_label & + & (hd_scheme, mevo_ctl%scheme_ctl) + call init_chara_ctl_item_label(hd_diff_correct, & + & mevo_ctl%diffuse_correct) + call init_chara_ctl_item_label(hd_method_4_velo, & + & mevo_ctl%method_4_CN) + call init_chara_ctl_item_label(hd_precond_4_crank, & + & mevo_ctl%precond_4_CN) + call init_chara_ctl_item_label(hd_sph_transform_mode, & + & mevo_ctl%Legendre_trans_type) + call init_chara_ctl_item_label & + & (hd_FFT_package, mevo_ctl%FFT_library) + call init_chara_ctl_item_label & + & (hd_import_mode, mevo_ctl%import_mode) +! + call init_real_ctl_item_label & + & (hd_eps_4_velo, mevo_ctl%eps_4_velo_ctl) + call init_real_ctl_item_label & + & (hd_eps_4_magne, mevo_ctl%eps_4_magne_ctl) + call init_real_ctl_item_label & + & (hd_coef_implicit, mevo_ctl%coef_implicit_ctl) + call init_real_ctl_item_label & + & (hd_coef_imp_v, mevo_ctl%coef_imp_v_ctl) + call init_real_ctl_item_label & + & (hd_coef_imp_t, mevo_ctl%coef_imp_t_ctl) + call init_real_ctl_item_label & + & (hd_coef_imp_b, mevo_ctl%coef_imp_b_ctl) + call init_real_ctl_item_label & + & (hd_coef_imp_c, mevo_ctl%coef_imp_c_ctl) + call init_real_ctl_item_label & + & (hd_eps_crank, mevo_ctl%eps_crank_ctl) + call init_real_ctl_item_label & + & (hd_eps_B_crank, mevo_ctl%eps_B_crank_ctl) +! + call init_chara_ctl_item_label & + & (hd_iflag_supg, mevo_ctl%iflag_supg_ctl) + call init_chara_ctl_item_label & + & (hd_iflag_v_supg, mevo_ctl%iflag_supg_v_ctl) + call init_chara_ctl_item_label & + & (hd_iflag_t_supg, mevo_ctl%iflag_supg_t_ctl) + call init_chara_ctl_item_label & + & (hd_iflag_b_supg, mevo_ctl%iflag_supg_b_ctl) + call init_chara_ctl_item_label & + & (hd_iflag_c_supg, mevo_ctl%iflag_supg_c_ctl) +! + call init_int_ctl_item_label(hd_num_multi_pass, & + & mevo_ctl%num_multi_pass_ctl) + call init_int_ctl_item_label(hd_maxiter, & + & mevo_ctl%maxiter_ctl) + call init_int_ctl_item_label(hd_legendre_vect_len, & + & mevo_ctl%leg_vector_len) +! + end subroutine init_time_loop_ctl_label +! +! -------------------------------------------------------------------- ! end module ctl_data_mhd_evo_scheme_IO diff --git a/src/Fortran_libraries/MHD_src/IO/ctl_data_node_boundary_IO.f90 b/src/Fortran_libraries/MHD_src/IO/ctl_data_node_boundary_IO.f90 index 879ae602..fbcc40fc 100644 --- a/src/Fortran_libraries/MHD_src/IO/ctl_data_node_boundary_IO.f90 +++ b/src/Fortran_libraries/MHD_src/IO/ctl_data_node_boundary_IO.f90 @@ -8,6 +8,7 @@ !!@n Modified by H. Matsui on Oct., 2007 !! !!@verbatim +!! subroutine init_bc_4_node_ctl_label(hd_block, nbc_ctl) !! subroutine read_bc_4_node_ctl & !! & (id_control, hd_block, nbc_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -165,7 +166,8 @@ subroutine read_bc_4_node_ctl & if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(nbc_ctl%i_bc_4_node .gt. 0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_c2_r(id_control, & @@ -207,29 +209,56 @@ subroutine write_bc_4_node_ctl & ! if(nbc_ctl%i_bc_4_node .le. 0) return ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) -! call write_control_array_c2_r(id_control, level, & - & hd_n_bc_temp, nbc_ctl%node_bc_T_ctl) + & nbc_ctl%node_bc_T_ctl) call write_control_array_c2_r(id_control, level, & - & hd_n_bc_velo, nbc_ctl%node_bc_U_ctl) + & nbc_ctl%node_bc_U_ctl) call write_control_array_c2_r(id_control, level, & - & hd_n_bc_press, nbc_ctl%node_bc_P_ctl) + & nbc_ctl%node_bc_P_ctl) call write_control_array_c2_r(id_control, level, & - & hd_n_bc_composit, nbc_ctl%node_bc_C_ctl) + & nbc_ctl%node_bc_C_ctl) call write_control_array_c2_r(id_control, level, & - & hd_n_bc_magne, nbc_ctl%node_bc_B_ctl) + & nbc_ctl%node_bc_B_ctl) call write_control_array_c2_r(id_control, level, & - & hd_n_bc_mag_p, nbc_ctl%node_bc_MP_ctl) + & nbc_ctl%node_bc_MP_ctl) call write_control_array_c2_r(id_control, level, & - & hd_n_bc_vect_p, nbc_ctl%node_bc_A_ctl) + & nbc_ctl%node_bc_A_ctl) call write_control_array_c2_r(id_control, level, & - & hd_n_bc_currect, nbc_ctl%node_bc_J_ctl) + & nbc_ctl%node_bc_J_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_bc_4_node_ctl ! ! -------------------------------------------------------------------- +! + subroutine init_bc_4_node_ctl_label(hd_block, nbc_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(node_bc_control), intent(inout) :: nbc_ctl +! +! + nbc_ctl%block_name = hd_block +! + call init_c2_r_ctl_array_label & + & (hd_n_bc_temp, nbc_ctl%node_bc_T_ctl) + call init_c2_r_ctl_array_label & + & (hd_n_bc_velo, nbc_ctl%node_bc_U_ctl) + call init_c2_r_ctl_array_label & + & (hd_n_bc_press, nbc_ctl%node_bc_P_ctl) + call init_c2_r_ctl_array_label & + & (hd_n_bc_composit, nbc_ctl%node_bc_C_ctl) + call init_c2_r_ctl_array_label & + & (hd_n_bc_magne, nbc_ctl%node_bc_B_ctl) + call init_c2_r_ctl_array_label & + & (hd_n_bc_mag_p, nbc_ctl%node_bc_MP_ctl) + call init_c2_r_ctl_array_label & + & (hd_n_bc_vect_p, nbc_ctl%node_bc_A_ctl) + call init_c2_r_ctl_array_label & + & (hd_n_bc_currect, nbc_ctl%node_bc_J_ctl) +! + end subroutine init_bc_4_node_ctl_label +! +! -------------------------------------------------------------------- ! end module ctl_data_node_boundary_IO diff --git a/src/Fortran_libraries/MHD_src/IO/ctl_data_surf_boundary_IO.f90 b/src/Fortran_libraries/MHD_src/IO/ctl_data_surf_boundary_IO.f90 index 36f58e76..68e83b8f 100644 --- a/src/Fortran_libraries/MHD_src/IO/ctl_data_surf_boundary_IO.f90 +++ b/src/Fortran_libraries/MHD_src/IO/ctl_data_surf_boundary_IO.f90 @@ -8,6 +8,7 @@ !!@n Modified by H. Matsui on Oct., 2007 !! !!@verbatim +!! subroutine init_bc_4_surf_ctl_label(hd_block, sbc_ctl) !! subroutine read_bc_4_surf_ctl & !! & (id_control, hd_block, sbc_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -160,7 +161,8 @@ subroutine read_bc_4_surf_ctl & if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(sbc_ctl%i_bc_4_surf .gt. 0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_c2_r(id_control, & @@ -204,31 +206,60 @@ subroutine write_bc_4_surf_ctl & ! if(sbc_ctl%i_bc_4_surf .le. 0) return ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) -! call write_control_array_c2_r(id_control, level, & - & hd_n_bc_hf, sbc_ctl%surf_bc_HF_ctl) + & sbc_ctl%surf_bc_HF_ctl) call write_control_array_c2_r(id_control, level, & - & hd_n_bc_mf, sbc_ctl%surf_bc_ST_ctl) + & sbc_ctl%surf_bc_ST_ctl) call write_control_array_c2_r(id_control, level, & - & hd_n_bc_gradp, sbc_ctl%surf_bc_PN_ctl) + & sbc_ctl%surf_bc_PN_ctl) call write_control_array_c2_r(id_control, level, & - & hd_n_bc_gradb, sbc_ctl%surf_bc_BN_ctl) + & sbc_ctl%surf_bc_BN_ctl) call write_control_array_c2_r(id_control, level, & - & hd_n_bc_grada, sbc_ctl%surf_bc_AN_ctl) + & sbc_ctl%surf_bc_AN_ctl) call write_control_array_c2_r(id_control, level, & - & hd_n_bc_gradj, sbc_ctl%surf_bc_JN_ctl) + & sbc_ctl%surf_bc_JN_ctl) call write_control_array_c2_r(id_control, level, & - & hd_n_bc_gradmp, sbc_ctl%surf_bc_MPN_ctl) + & sbc_ctl%surf_bc_MPN_ctl) call write_control_array_c2_r(id_control, level, & - & hd_n_bc_gradc, sbc_ctl%surf_bc_CF_ctl) + & sbc_ctl%surf_bc_CF_ctl) call write_control_array_c2_r(id_control, level, & - & hd_n_bc_infty, sbc_ctl%surf_bc_INF_ctl) + & sbc_ctl%surf_bc_INF_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_bc_4_surf_ctl ! ! -------------------------------------------------------------------- +! + subroutine init_bc_4_surf_ctl_label(hd_block, sbc_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(surf_bc_control), intent(inout) :: sbc_ctl +! +! + sbc_ctl%block_name = hd_block +! + call init_c2_r_ctl_array_label & + & (hd_n_bc_hf, sbc_ctl%surf_bc_HF_ctl) + call init_c2_r_ctl_array_label & + & (hd_n_bc_mf, sbc_ctl%surf_bc_ST_ctl) + call init_c2_r_ctl_array_label & + & (hd_n_bc_gradp, sbc_ctl%surf_bc_PN_ctl) + call init_c2_r_ctl_array_label & + & (hd_n_bc_gradb, sbc_ctl%surf_bc_BN_ctl) + call init_c2_r_ctl_array_label & + & (hd_n_bc_gradj, sbc_ctl%surf_bc_JN_ctl) + call init_c2_r_ctl_array_label & + & (hd_n_bc_grada, sbc_ctl%surf_bc_AN_ctl) + call init_c2_r_ctl_array_label & + & (hd_n_bc_gradmp, sbc_ctl%surf_bc_MPN_ctl) + call init_c2_r_ctl_array_label & + & (hd_n_bc_gradc, sbc_ctl%surf_bc_CF_ctl) + call init_c2_r_ctl_array_label & + & (hd_n_bc_infty, sbc_ctl%surf_bc_INF_ctl) +! + end subroutine init_bc_4_surf_ctl_label +! +! -------------------------------------------------------------------- ! end module ctl_data_surf_boundary_IO diff --git a/src/Fortran_libraries/MHD_src/IO/ctl_data_temp_model_IO.f90 b/src/Fortran_libraries/MHD_src/IO/ctl_data_temp_model_IO.f90 index d14a7c19..953c18e0 100644 --- a/src/Fortran_libraries/MHD_src/IO/ctl_data_temp_model_IO.f90 +++ b/src/Fortran_libraries/MHD_src/IO/ctl_data_temp_model_IO.f90 @@ -1,5 +1,4 @@ -! -!>@file ctl_data_temp_model_IO +!>@file ctl_data_temp_model_IO.f90 !!@brief module ctl_data_temp_model_IO !! !!@author H. Matsui @@ -9,13 +8,14 @@ !!@n Modified by H. Matsui on Oct., 2007 !! !!@verbatim -!! subroutine read_reftemp_ctl & +!! subroutine init_temp_model_ctl_label(hd_block, reft_ctl) +!! subroutine read_temp_model_ctl & !! & (id_control, hd_block, reft_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(reference_temperature_ctl), intent(inout) :: reft_ctl !! type(buffer_for_control), intent(inout) :: c_buf -!! subroutine write_reftemp_ctl & +!! subroutine write_temp_model_ctl & !! & (id_control, hd_block, reft_ctl, level) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block @@ -112,7 +112,7 @@ module ctl_data_temp_model_IO ! ! -------------------------------------------------------------------- ! - subroutine read_reftemp_ctl & + subroutine read_temp_model_ctl & & (id_control, hd_block, reft_ctl, c_buf) ! integer(kind = kint), intent(in) :: id_control @@ -125,7 +125,8 @@ subroutine read_reftemp_ctl & if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(reft_ctl%i_temp_def .gt. 0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_ref_temp_ctl & @@ -150,11 +151,11 @@ subroutine read_reftemp_ctl & end do reft_ctl%i_temp_def = 1 ! - end subroutine read_reftemp_ctl + end subroutine read_temp_model_ctl ! ! -------------------------------------------------------------------- ! - subroutine write_reftemp_ctl & + subroutine write_temp_model_ctl & & (id_control, hd_block, reft_ctl, level) ! use write_control_elements @@ -176,34 +177,58 @@ subroutine write_reftemp_ctl & maxlen = max(maxlen, len_trim(hd_start_ctl)) maxlen = max(maxlen, len_trim(hd_ref_field_file)) ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_filterd_advection, reft_ctl%filterd_advect_ctl) + & reft_ctl%filterd_advect_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_diffusivity_reduction, & & reft_ctl%ICB_diffuse_reduction_ctl) ! - write(id_control,'(a1)') '!' call write_chara_ctl_type(id_control, level, maxlen, & - & hd_ref_temp, reft_ctl%reference_ctl) + & reft_ctl%reference_ctl) call write_ref_temp_ctl & & (id_control, hd_low_temp, reft_ctl%low_ctl, level) call write_ref_temp_ctl & & (id_control, hd_high_temp, reft_ctl%high_ctl, level) ! - write(id_control,'(a1)') '!' call write_chara_ctl_type(id_control, level, maxlen, & - & hd_start_ctl, reft_ctl%stratified_ctl) + & reft_ctl%stratified_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_ref_field_file, reft_ctl%ref_file_ctl) + & reft_ctl%ref_file_ctl) call write_takepiro_ctl(id_control, hd_takepiro_ctl, & & reft_ctl%takepiro_ctl, level) ! level = write_end_flag_for_ctl(id_control, level, hd_block) ! - end subroutine write_reftemp_ctl + end subroutine write_temp_model_ctl +! +! -------------------------------------------------------------------- +! + subroutine init_temp_model_ctl_label(hd_block, reft_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(reference_temperature_ctl), intent(inout) :: reft_ctl +! +! + reft_ctl%block_name = hd_block + call init_ref_temp_ctl_label(hd_low_temp, reft_ctl%low_ctl) + call init_ref_temp_ctl_label(hd_high_temp, reft_ctl%high_ctl) + call init_takepiro_ctl_label(hd_takepiro_ctl, & + & reft_ctl%takepiro_ctl) +! + call init_chara_ctl_item_label & + & (hd_filterd_advection, reft_ctl%filterd_advect_ctl) + call init_chara_ctl_item_label & + & (hd_ref_temp, reft_ctl%reference_ctl) + call init_chara_ctl_item_label & + & (hd_start_ctl, reft_ctl%stratified_ctl) + call init_chara_ctl_item_label & + & (hd_ref_field_file, reft_ctl%ref_file_ctl) +! + call init_real_ctl_item_label(hd_diffusivity_reduction, & + & reft_ctl%ICB_diffuse_reduction_ctl) +! + end subroutine init_temp_model_ctl_label ! ! -------------------------------------------------------------------- ! -------------------------------------------------------------------- @@ -221,7 +246,8 @@ subroutine read_ref_temp_ctl & if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(ref_ctl%i_referenced .gt. 0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_real_ctl_type(c_buf, hd_position, ref_ctl%depth) @@ -252,17 +278,26 @@ subroutine write_ref_temp_ctl & maxlen = len_trim(hd_position) maxlen = max(maxlen, len_trim(hd_temp_value)) ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) -! call write_real_ctl_type(id_control, level, maxlen, & - & hd_position, ref_ctl%depth) + & ref_ctl%depth) call write_real_ctl_type(id_control, level, maxlen, & - & hd_temp_value, ref_ctl%value) + & ref_ctl%value) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_ref_temp_ctl ! ! -------------------------------------------------------------------- +! + subroutine init_ref_temp_ctl_label(hd_block, ref_ctl) + character(len=kchara), intent(in) :: hd_block + type(reference_point_control), intent(inout) :: ref_ctl +! + ref_ctl%block_name = hd_block + call init_real_ctl_item_label(hd_position, ref_ctl%depth) + call init_real_ctl_item_label(hd_temp_value, ref_ctl%value) + end subroutine init_ref_temp_ctl_label +! +! -------------------------------------------------------------------- ! end module ctl_data_temp_model_IO diff --git a/src/Fortran_libraries/MHD_src/IO/m_fem_node_group_types.f90 b/src/Fortran_libraries/MHD_src/IO/m_fem_node_group_types.f90 new file mode 100644 index 00000000..28758def --- /dev/null +++ b/src/Fortran_libraries/MHD_src/IO/m_fem_node_group_types.f90 @@ -0,0 +1,373 @@ +!>@file m_fem_node_group_types.f90 +!!@brief module m_fem_node_group_types +!! +!!@author H. Matsui and H. Okuda +!!@date Programmed by H. Matsui in Sep. 2005 +! +!> @brief set surface boundary condition flags from conterol input +!! +!!@verbatim +!! subroutine set_bc_group_types_each_dir(bc_type_ctl, ibc_type) +!! subroutine set_bc_group_types_sgs_scalar(bc_type_ctl, ibc_type) +!! subroutine set_bc_group_types_sgs_vect(bc_type_ctl, ibc_type) +!! +!! subroutine set_label_thermal_bc(names) +!! subroutine set_label_momentum_bc(array_c) +!! subroutine set_label_induction_bc(array_c) +!! type(ctl_array_chara), intent(inout) :: array_c +!! +!! subroutine set_label_potential_bc(array_c) +!! subroutine set_label_vector_p_bc(array_c) +!! subroutine set_label_current_bc(array_c) +!! type(ctl_array_chara), intent(inout) :: array_c +!!@endverbatim +! + module m_fem_node_group_types +! + use m_precision + use m_boundary_condition_IDs + use m_sph_node_group_types + use skip_comment_f +! + implicit none +! +!> control name for fixed field in SGS model + character(len = kchara), parameter :: fixed_SGS = 'sgs' +! +!> control name for fixed x-componenet by control + character(len = kchara), parameter :: fixed_x = 'fix_x' +!> control name for fixed y-componenet by control + character(len = kchara), parameter :: fixed_y = 'fix_y' +!> control name for fixed z-componenet by control + character(len = kchara), parameter :: fixed_z = 'fix_z' +!> control name for fixed x-componenet by control + character(len = kchara), parameter :: fix_ctl_x = 'fix_ctl_x' +!> control name for fixed y-componenet by control + character(len = kchara), parameter :: fix_ctl_y = 'fix_ctl_y' +!> control name for fixed z-componenet by control + character(len = kchara), parameter :: fix_ctl_z = 'fix_ctl_z' +! +!> control name for fixed x-componenet by external file + character(len = kchara), parameter :: bc_file_x = 'file_x' +!> control name for fixed y-componenet by external file + character(len = kchara), parameter :: bc_file_y = 'file_y' +!> control name for fixed z-componenet by external file + character(len = kchara), parameter :: bc_file_z = 'file_z' +!> control name for fixed x-componenet by external file + character(len = kchara), parameter :: fix_file_x = 'fix_file_x' +!> control name for fixed y-componenet by external file + character(len = kchara), parameter :: fix_file_y = 'fix_file_y' +!> control name for fixed z-componenet by external file + character(len = kchara), parameter :: fix_file_z = 'fix_file_z' +! +!> control name for fixed x-componenet in SGS model + character(len = kchara), parameter :: fix_SGS_x = 'sgs_x' +!> control name for fixed y-componenet in SGS model + character(len = kchara), parameter :: fix_SGS_y = 'sgs_y' +!> control name for fixed z-componenet in SGS model + character(len = kchara), parameter :: fix_SGS_z = 'sgs_z' +! +! +!> control name for equator + character(len = kchara), parameter, private & + & :: equator_bc = 'equator' +! +!> control name for no radial flow + character(len = kchara), parameter, private & + & :: no_radial_comp_bc = 'vr_0' +!> control name for special condition + character(len = kchara), parameter, private & + & :: special_bc = 'special' +! +!> control name for equator + character(len = kchara), parameter, private & + & :: insulate_shell_bc = 'insulate_shell' +! + private :: fixed_x, fix_ctl_x, bc_file_x, fix_file_x + private :: fixed_y, fix_ctl_y, bc_file_y, fix_file_y + private :: fixed_z, fix_ctl_z, bc_file_z, fix_file_z + private :: fixed_SGS, fix_SGS_x, fix_SGS_y, fix_SGS_z +! + private :: add_bc_group_types_equator + private :: add_bc_group_special_velocity + private :: add_bc_group_insulate_shell +! +!----------------------------------------------------------------------- +! + contains +! +!----------------------------------------------------------------------- +! + subroutine set_bc_group_types_each_dir(bc_type_ctl, ibc_type) +! + character (len=kchara), intent(in) :: bc_type_ctl + integer(kind = kint), intent(inout) :: ibc_type +! +! + if (cmp_no_case(bc_type_ctl, fixed_x) & + & .or. cmp_no_case(bc_type_ctl, fix_ctl_x) ) then + ibc_type = iflag_bc_fix_x + else if (cmp_no_case(bc_type_ctl, fixed_y) & + & .or. cmp_no_case(bc_type_ctl, fix_ctl_y) ) then + ibc_type = iflag_bc_fix_y + else if (cmp_no_case(bc_type_ctl, fixed_z) & + & .or. cmp_no_case(bc_type_ctl, fix_ctl_z) ) then + ibc_type = iflag_bc_fix_z + else if (cmp_no_case(bc_type_ctl, bc_file_x) & + & .or. cmp_no_case(bc_type_ctl, fix_file_x)) then + ibc_type = iflag_bc_file_x + else if (cmp_no_case(bc_type_ctl, bc_file_y) & + & .or. cmp_no_case(bc_type_ctl, fix_file_y)) then + ibc_type = iflag_bc_file_y + else if (cmp_no_case(bc_type_ctl, bc_file_z) & + & .or. cmp_no_case(bc_type_ctl, fix_file_z)) then + ibc_type = iflag_bc_file_z + end if +! + end subroutine set_bc_group_types_each_dir +! +!----------------------------------------------------------------------- +! + subroutine set_bc_group_types_sgs_scalar(bc_type_ctl, ibc_type) +! + character (len=kchara), intent(in) :: bc_type_ctl + integer(kind = kint), intent(inout) :: ibc_type +! +! + if(cmp_no_case(bc_type_ctl, fixed_SGS)) then + ibc_type = iflag_bc_sgs_s + end if +! + end subroutine set_bc_group_types_sgs_scalar +! +!----------------------------------------------------------------------- +! + subroutine set_bc_group_types_sgs_vect(bc_type_ctl, ibc_type) +! + character (len=kchara), intent(in) :: bc_type_ctl + integer(kind = kint), intent(inout) :: ibc_type +! +! + if (cmp_no_case(bc_type_ctl, fix_SGS_x)) then + ibc_type = iflag_bc_sgs_x + else if (cmp_no_case(bc_type_ctl, fix_SGS_y)) then + ibc_type = iflag_bc_sgs_y + else if (cmp_no_case(bc_type_ctl, fix_SGS_z)) then + ibc_type = iflag_bc_sgs_z + end if +! + end subroutine set_bc_group_types_sgs_vect +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! + subroutine set_bc_group_types_equator(bc_type_ctl, iflag_4_hemi) + character (len=kchara), intent(in) :: bc_type_ctl + integer(kind = kint), intent(inout) :: iflag_4_hemi +! + if(cmp_no_case(bc_type_ctl, equator_bc)) iflag_4_hemi= 1 + end subroutine set_bc_group_types_equator +! +!----------------------------------------------------------------------- +! + subroutine set_bc_group_special_velocity(bc_type_ctl, ibc_type) +! + character (len=kchara), intent(in) :: bc_type_ctl + integer(kind = kint), intent(inout) :: ibc_type +! +! + if (cmp_no_case(bc_type_ctl, no_radial_comp_bc)) then + ibc_type = iflag_no_vr + else if (cmp_no_case(bc_type_ctl, special_bc)) then + ibc_type = iflag_bc_special + end if +! + end subroutine set_bc_group_special_velocity +! +!----------------------------------------------------------------------- +! + subroutine set_bc_group_insulate_shell(bc_type_ctl, ibc_type) +! + character (len=kchara), intent(in) :: bc_type_ctl + integer(kind = kint), intent(inout) :: ibc_type +! +! + if(cmp_no_case(bc_type_ctl, insulate_shell_bc)) then + ibc_type = iflag_insulator + end if +! + end subroutine set_bc_group_insulate_shell +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! + subroutine set_label_thermal_bc(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 add_bc_group_types_scalar(array_c) + call add_bc_group_types_sph_center(array_c) + call add_bc_group_types_fluxes(array_c) + call add_bc_group_types_sgs_scalar(array_c) +! + end subroutine set_label_thermal_bc +! +!----------------------------------------------------------------------- +! + subroutine set_label_momentum_bc(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 add_bc_group_types_sph_velo(array_c) + call add_bc_group_types_sph_center(array_c) + call add_bc_group_types_vector(array_c) + call add_bc_group_types_each_dir(array_c) + call add_bc_group_types_sgs_vect(array_c) + call add_bc_group_types_rotation(array_c) + call add_bc_group_special_velocity(array_c) + call add_bc_group_types_equator(array_c) +! + end subroutine set_label_momentum_bc +! +!----------------------------------------------------------------------- +! + subroutine set_label_induction_bc(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 add_bc_group_types_sph_magne(array_c) + call add_bc_group_types_sph_center(array_c) + call add_bc_group_types_vector(array_c) + call add_bc_group_types_each_dir(array_c) + call add_bc_group_types_sgs_vect(array_c) +! + end subroutine set_label_induction_bc +! +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! + subroutine set_label_potential_bc(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 add_bc_group_types_scalar(array_c) + call add_bc_group_types_sgs_scalar(array_c) +! + end subroutine set_label_potential_bc +! +! ---------------------------------------------------------------------- +! + subroutine set_label_vector_p_bc(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 add_bc_group_insulate_shell(array_c) + call add_bc_group_types_vector(array_c) + call add_bc_group_types_each_dir(array_c) + call add_bc_group_types_sgs_vect(array_c) +! + end subroutine set_label_vector_p_bc +! +! ---------------------------------------------------------------------- +! + subroutine set_label_current_bc(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 add_bc_group_types_vector(array_c) + call add_bc_group_types_each_dir(array_c) + end subroutine set_label_current_bc +! +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! + subroutine add_bc_group_types_each_dir(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + call append_c_to_ctl_array(fixed_x, array_c) + call append_c_to_ctl_array(fixed_y, array_c) + call append_c_to_ctl_array(fixed_z, array_c) +! + call append_c_to_ctl_array(bc_file_x, array_c) + call append_c_to_ctl_array(bc_file_y, array_c) + call append_c_to_ctl_array(bc_file_z, array_c) +! + end subroutine add_bc_group_types_each_dir +! +! ---------------------------------------------------------------------- +! + subroutine add_bc_group_types_sgs_scalar(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + call append_c_to_ctl_array(fixed_SGS, array_c) + end subroutine add_bc_group_types_sgs_scalar +! +! ---------------------------------------------------------------------- +! + subroutine add_bc_group_types_sgs_vect(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + call append_c_to_ctl_array(fix_SGS_x, array_c) + call append_c_to_ctl_array(fix_SGS_y, array_c) + call append_c_to_ctl_array(fix_SGS_z, array_c) +! + end subroutine add_bc_group_types_sgs_vect +! +! ---------------------------------------------------------------------- +! + subroutine add_bc_group_types_equator(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + call append_c_to_ctl_array(equator_bc, array_c) + end subroutine add_bc_group_types_equator +! +! ---------------------------------------------------------------------- +! + subroutine add_bc_group_special_velocity(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + call append_c_to_ctl_array(no_radial_comp_bc, array_c) + call append_c_to_ctl_array(special_bc, array_c) + end subroutine add_bc_group_special_velocity +! +! ---------------------------------------------------------------------- +! + subroutine add_bc_group_insulate_shell(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + call append_c_to_ctl_array(insulate_shell_bc, array_c) + end subroutine add_bc_group_insulate_shell +! +!----------------------------------------------------------------------- +! + end module m_fem_node_group_types diff --git a/src/Fortran_libraries/MHD_src/IO/m_force_control_labels.f90 b/src/Fortran_libraries/MHD_src/IO/m_force_control_labels.f90 index 9d8e3d1c..50400f4f 100644 --- a/src/Fortran_libraries/MHD_src/IO/m_force_control_labels.f90 +++ b/src/Fortran_libraries/MHD_src/IO/m_force_control_labels.f90 @@ -8,10 +8,10 @@ !> @brief Force labels !! !!@verbatim -!! integer(kind = kint) function num_advection_controls() -!! integer(kind = kint) function num_force_controls() -!! subroutine set_advection_control_labels(n_comps, names, maths) -!! subroutine set_force_control_labels(n_comps, names, maths) +!! subroutine set_force_list_array(array_c) +!! subroutine set_filter_force_list_array(array_c) +!! subroutine set_sph_force_list_array(array_c) +!! type(ctl_array_chara), intent(inout) :: array_c !! !! !!!!! Force names !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! @@ -41,9 +41,6 @@ module m_force_control_labels use t_base_force_labels ! implicit none -! - integer(kind = kint), parameter, private :: nadvect_label = 4 - integer(kind = kint), parameter, private :: nforce_label = 4 ! ! Opthional names of force control labels ! @@ -83,69 +80,85 @@ module m_force_control_labels character(len=kchara), parameter & & :: comp_gravity_e6 = 'Composite_buoyancy' ! -! -------------------------------------------------------------------- ! - contains +!> Filtered thermal buoyancy label + character(len=kchara), parameter & + & :: Filtered_gravity_label = 'Filtered_buoyancy' ! -! -------------------------------------------------------------------- + character(len=kchara), parameter & + & :: Filtered_gravity_e1 = 'Filtered_gravity' ! - integer(kind = kint) function num_advection_controls() - num_advection_controls = nadvect_label - return - end function num_advection_controls +!> Filtered compositional buoyancy label + character(len=kchara), parameter & + & :: Filtered_comp_gravity_label & + & = 'Filtered_compositional_buoyancy' ! -! ---------------------------------------------------------------------- + character(len=kchara), parameter & + & :: Filtered_comp_gravity_e1 & + & = 'Filtered_compositional_gravity' ! - integer(kind = kint) function num_force_controls() - num_force_controls = nforce_label - return - end function num_force_controls + character(len=kchara), parameter & + & :: hd_filtered_inertia = 'filtered_inertia' + character(len=kchara), parameter & + & :: hd_filtered_Lorentz = 'filtered_Lorentz' ! -! ---------------------------------------------------------------------- ! - subroutine set_advection_control_labels(n_comps, names, maths) +! -------------------------------------------------------------------- ! - use m_base_force_labels + contains ! - integer(kind = kint_4b), intent(inout) :: n_comps(nadvect_label) - character(len = kchara), intent(inout) :: names(nadvect_label) - character(len = kchara), intent(inout) :: maths(nadvect_label) +! -------------------------------------------------------------------- ! + subroutine set_force_list_array(array_c) + use m_base_force_labels + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c ! - call set_field_labels(inertia, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(magnetic_induction, & - & n_comps( 2), names( 2), maths( 2)) + call set_sph_force_list_array(array_c) ! - call set_field_labels(heat_advect, & - & n_comps( 3), names( 3), maths( 3)) - call set_field_labels(composition_advect, & - & n_comps( 4), names( 4), maths( 4)) + call append_c_to_ctl_array(Coriolis_force%name, array_c) + call append_c_to_ctl_array(Lorentz_force%name, array_c) + call append_c_to_ctl_array(buoyancy%name, array_c) + call append_c_to_ctl_array(composite_buoyancy%name, array_c) ! - end subroutine set_advection_control_labels + end subroutine set_force_list_array ! ! ---------------------------------------------------------------------- ! - subroutine set_force_control_labels(n_comps, names, maths) + subroutine set_filter_force_list_array(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c ! - use m_base_force_labels + call set_sph_force_list_array(array_c) +! + call append_c_to_ctl_array(Filtered_gravity_label, array_c) + call append_c_to_ctl_array(Filtered_comp_gravity_label, array_c) + call append_c_to_ctl_array(hd_filtered_inertia, array_c) + call append_c_to_ctl_array(hd_filtered_Lorentz, array_c) +! + end subroutine set_filter_force_list_array +! +! ---------------------------------------------------------------------- ! - integer(kind = kint_4b), intent(inout) :: n_comps(nforce_label) - character(len = kchara), intent(inout) :: names(nforce_label) - character(len = kchara), intent(inout) :: maths(nforce_label) + subroutine set_sph_force_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 set_field_labels(Coriolis_force, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(Lorentz_force, & - & n_comps( 2), names( 2), maths( 2)) + call append_c_to_ctl_array(coriolis_e1, array_c) + call append_c_to_ctl_array(lorentz_label, array_c) + call append_c_to_ctl_array(gravity_label, array_c) + call append_c_to_ctl_array(comp_gravity_label, array_c) ! - call set_field_labels(buoyancy, & - & n_comps( 3), names( 3), maths( 3)) - call set_field_labels(composite_buoyancy, & - & n_comps( 4), names( 4), maths( 4)) + call append_c_to_ctl_array(Filtered_gravity_label, array_c) + call append_c_to_ctl_array(Filtered_comp_gravity_label, array_c) + call append_c_to_ctl_array(hd_filtered_inertia, array_c) + call append_c_to_ctl_array(hd_filtered_Lorentz, array_c) ! - end subroutine set_force_control_labels + end subroutine set_sph_force_list_array ! ! ---------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/MHD_src/IO/set_node_group_types.f90 b/src/Fortran_libraries/MHD_src/IO/m_sph_node_group_types.f90 similarity index 51% rename from src/Fortran_libraries/MHD_src/IO/set_node_group_types.f90 rename to src/Fortran_libraries/MHD_src/IO/m_sph_node_group_types.f90 index 12fa8b14..616a863c 100644 --- a/src/Fortran_libraries/MHD_src/IO/set_node_group_types.f90 +++ b/src/Fortran_libraries/MHD_src/IO/m_sph_node_group_types.f90 @@ -1,5 +1,5 @@ -!>@file set_node_group_types.f90 -!!@brief module set_node_group_types +!>@file m_sph_node_group_types.f90 +!!@brief module m_sph_node_group_types !! !!@author H. Matsui and H. Okuda !!@date Programmed by H. Matsui in Sep. 2005 @@ -8,17 +8,30 @@ !! !!@verbatim !! subroutine set_bc_group_types_scalar(bc_type_ctl, ibc_type) -!! subroutine set_bc_group_types_vector(bc_type_ctl, ibc_type) -!! subroutine set_bc_group_types_sgs_scalar(bc_type_ctl, ibc_type) -!! subroutine set_bc_group_types_sgs_vect(bc_type_ctl, ibc_type) !! subroutine set_bc_group_types_rotation(bc_type_ctl, ibc_type) !! subroutine set_bc_group_types_sph_center(bc_type_ctl, ibc_type) !! subroutine set_bc_group_types_sph_velo(bc_type_ctl, ibc_type) !! subroutine set_bc_group_types_sph_magne(bc_type_ctl, ibc_type) !! subroutine set_bc_group_types_fluxes(bc_type_ctl, ibc_type) +!! character (len=kchara), intent(in) :: bc_type_ctl +!! integer(kind = kint), intent(inout) :: ibc_type +!! +!! subroutine set_label_sph_thermal_bc(array_c) +!! subroutine set_label_sph_momentum_bc(array_c) +!! subroutine set_label_sph_induction_bc(array_c) +!! type(ctl_array_chara), intent(inout) :: array_c +!! +!! subroutine add_bc_group_types_scalar(array_c) +!! subroutine add_bc_group_types_vector(array_c) +!! subroutine add_bc_group_types_rotation(array_c) +!! subroutine add_bc_group_types_sph_center(array_c) +!! subroutine add_bc_group_types_sph_velo(array_c) +!! subroutine add_bc_group_types_sph_magne(array_c) +!! subroutine add_bc_group_types_fluxes(array_c) +!! type(ctl_array_chara), intent(inout) :: array_c !!@endverbatim ! - module set_node_group_types + module m_sph_node_group_types ! use m_precision use m_boundary_condition_IDs @@ -27,103 +40,61 @@ module set_node_group_types implicit none ! !> control name for fixed field by control - character(len = kchara), parameter :: fixed_bc = 'fixed' + character(len = kchara), parameter, private & + & :: fixed_bc = 'fixed' !> control name for fixed field by control - character(len = kchara), parameter :: fixed_ctl_bc = 'fixed_ctl' + character(len = kchara), parameter, private & + & :: fixed_ctl_bc = 'fixed_ctl' !> control name for fixed field by external file - character(len = kchara), parameter :: fixed_file = 'file' + character(len = kchara), parameter, private & + & :: fixed_file = 'file' !> control name for fixed field by external file - character(len = kchara), parameter & + character(len = kchara), parameter, private & & :: fixed_file_bc = 'fixed_file' !> control name for evolved field by external file - character(len = kchara), parameter & + character(len = kchara), parameter, private & & :: evo_field_file_bc = 'evolved_field' !> control name for evolved flux by external file - character(len = kchara), parameter & + character(len = kchara), parameter, private & & :: evo_flux_file_bc = 'evolved_flux' -!> control name for fixed field in SGS model - character(len = kchara), parameter :: fixed_SGS = 'sgs' -! -!> control name for fixed x-componenet by control - character(len = kchara), parameter :: fixed_x = 'fix_x' -!> control name for fixed y-componenet by control - character(len = kchara), parameter :: fixed_y = 'fix_y' -!> control name for fixed z-componenet by control - character(len = kchara), parameter :: fixed_z = 'fix_z' -!> control name for fixed x-componenet by control - character(len = kchara), parameter :: fix_ctl_x = 'fix_ctl_x' -!> control name for fixed y-componenet by control - character(len = kchara), parameter :: fix_ctl_y = 'fix_ctl_y' -!> control name for fixed z-componenet by control - character(len = kchara), parameter :: fix_ctl_z = 'fix_ctl_z' -! -!> control name for fixed x-componenet by external file - character(len = kchara), parameter :: bc_file_x = 'file_x' -!> control name for fixed y-componenet by external file - character(len = kchara), parameter :: bc_file_y = 'file_y' -!> control name for fixed z-componenet by external file - character(len = kchara), parameter :: bc_file_z = 'file_z' -!> control name for fixed x-componenet by external file - character(len = kchara), parameter :: fix_file_x = 'fix_file_x' -!> control name for fixed y-componenet by external file - character(len = kchara), parameter :: fix_file_y = 'fix_file_y' -!> control name for fixed z-componenet by external file - character(len = kchara), parameter :: fix_file_z = 'fix_file_z' -! -!> control name for fixed x-componenet in SGS model - character(len = kchara), parameter :: fix_SGS_x = 'sgs_x' -!> control name for fixed y-componenet in SGS model - character(len = kchara), parameter :: fix_SGS_y = 'sgs_y' -!> control name for fixed z-componenet in SGS model - character(len = kchara), parameter :: fix_SGS_z = 'sgs_z' +! !> control name for fixed rotation around x-axis boundary - character(len = kchara), parameter :: fix_rot_x = 'rot_x' + character(len = kchara), parameter, private:: fix_rot_x = 'rot_x' !> control name for fixed rotation around y-axis boundary - character(len = kchara), parameter :: fix_rot_y = 'rot_y' + character(len = kchara), parameter, private:: fix_rot_y = 'rot_y' !> control name for fixed rotation around z-axis boundary - character(len = kchara), parameter :: fix_rot_z = 'rot_z' + character(len = kchara), parameter, private:: fix_rot_z = 'rot_z' ! !> control name for free slip boundary for spherical shell - character(len = kchara), parameter & + character(len = kchara), parameter, private & & :: free_slip_sph = 'free_slip_sph' !> control name for non-slip boundary for spherical shell - character(len = kchara), parameter & + character(len = kchara), parameter, private & & :: non_slip_sph = 'non_slip_sph' !> control name for rotetable inner core for spherical shell - character(len = kchara), parameter & + character(len = kchara), parameter, private & & :: rot_inner_core = 'rot_inner_core' ! !> control name for insulated for spherical shell - character(len = kchara), parameter & + character(len = kchara), parameter, private & & :: insulator_sph = 'insulator' !> control name for psuedo vacuum for spherical shell - character(len = kchara), parameter & + character(len = kchara), parameter, private & & :: pseudo_vacuum_sph = 'pseudo_vacuum' ! !> control name to filling to center - character(len = kchara), parameter & + character(len = kchara), parameter, private & & :: fill_sph_center = 'sph_to_center' !> control name to filling to center - character(len = kchara), parameter & + character(len = kchara), parameter, private & & :: fix_sph_center = 'fix_at_center' ! !> control name for fixed flux by control - character(len = kchara), parameter :: flux_bc = 'fixed_flux' + character(len = kchara), parameter, private & + & :: flux_bc = 'fixed_flux' !> control name for fixed flux by external file - character(len = kchara), parameter & + character(len = kchara), parameter, private & & :: flux_file_bc = 'fixed_flux_file' -! - private :: fixed_bc, fixed_ctl_bc, fixed_file, fixed_file_bc - private :: flux_bc, flux_file_bc - private :: fixed_SGS - private :: fixed_x, fix_ctl_x, bc_file_x, fix_file_x - private :: fixed_y, fix_ctl_y, bc_file_y, fix_file_y - private :: fixed_z, fix_ctl_z, bc_file_z, fix_file_z - private :: fix_SGS_x, fix_rot_x - private :: fix_SGS_y, fix_rot_y - private :: fix_SGS_z, fix_rot_z - private :: fill_sph_center, fix_sph_center - private :: free_slip_sph, non_slip_sph, rot_inner_core ! !----------------------------------------------------------------------- ! @@ -157,26 +128,7 @@ subroutine set_bc_group_types_vector(bc_type_ctl, ibc_type) integer(kind = kint), intent(inout) :: ibc_type ! ! - if (cmp_no_case(bc_type_ctl, fixed_x) & - & .or. cmp_no_case(bc_type_ctl, fix_ctl_x) ) then - ibc_type = iflag_bc_fix_x - else if (cmp_no_case(bc_type_ctl, fixed_y) & - & .or. cmp_no_case(bc_type_ctl, fix_ctl_y) ) then - ibc_type = iflag_bc_fix_y - else if (cmp_no_case(bc_type_ctl, fixed_z) & - & .or. cmp_no_case(bc_type_ctl, fix_ctl_z) ) then - ibc_type = iflag_bc_fix_z - else if (cmp_no_case(bc_type_ctl, bc_file_x) & - & .or. cmp_no_case(bc_type_ctl, fix_file_x)) then - ibc_type = iflag_bc_file_x - else if (cmp_no_case(bc_type_ctl, bc_file_y) & - & .or. cmp_no_case(bc_type_ctl, fix_file_y)) then - ibc_type = iflag_bc_file_y - else if (cmp_no_case(bc_type_ctl, bc_file_z) & - & .or. cmp_no_case(bc_type_ctl, fix_file_z)) then - ibc_type = iflag_bc_file_z -! - else if (cmp_no_case(bc_type_ctl, fixed_file) & + if (cmp_no_case(bc_type_ctl, fixed_file) & & .or. cmp_no_case(bc_type_ctl, fixed_file_bc)) then ibc_type = iflag_bc_file_s else if (cmp_no_case(bc_type_ctl, evo_field_file_bc)) then @@ -186,38 +138,6 @@ subroutine set_bc_group_types_vector(bc_type_ctl, ibc_type) end subroutine set_bc_group_types_vector ! !----------------------------------------------------------------------- -! - subroutine set_bc_group_types_sgs_scalar(bc_type_ctl, ibc_type) -! - character (len=kchara), intent(in) :: bc_type_ctl - integer(kind = kint), intent(inout) :: ibc_type -! -! - if(cmp_no_case(bc_type_ctl, fixed_SGS)) then - ibc_type = iflag_bc_sgs_s - end if -! - end subroutine set_bc_group_types_sgs_scalar -! -!----------------------------------------------------------------------- -! - subroutine set_bc_group_types_sgs_vect(bc_type_ctl, ibc_type) -! - character (len=kchara), intent(in) :: bc_type_ctl - integer(kind = kint), intent(inout) :: ibc_type -! -! - if (cmp_no_case(bc_type_ctl, fix_SGS_x)) then - ibc_type = iflag_bc_sgs_x - else if (cmp_no_case(bc_type_ctl, fix_SGS_y)) then - ibc_type = iflag_bc_sgs_y - else if (cmp_no_case(bc_type_ctl, fix_SGS_z)) then - ibc_type = iflag_bc_sgs_z - end if -! - end subroutine set_bc_group_types_sgs_vect -! -!----------------------------------------------------------------------- ! subroutine set_bc_group_types_rotation(bc_type_ctl, ibc_type) ! @@ -306,5 +226,135 @@ subroutine set_bc_group_types_fluxes(bc_type_ctl, ibc_type) end subroutine set_bc_group_types_fluxes ! !----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! + subroutine set_label_sph_thermal_bc(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 add_bc_group_types_scalar(array_c) + call add_bc_group_types_sph_center(array_c) + call add_bc_group_types_fluxes(array_c) +! + end subroutine set_label_sph_thermal_bc +! +!----------------------------------------------------------------------- +! + subroutine set_label_sph_momentum_bc(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 add_bc_group_types_sph_velo(array_c) + call add_bc_group_types_sph_center(array_c) + call add_bc_group_types_rotation(array_c) +! + end subroutine set_label_sph_momentum_bc +! +!----------------------------------------------------------------------- +! + subroutine set_label_sph_induction_bc(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 add_bc_group_types_sph_magne(array_c) + call add_bc_group_types_sph_center(array_c) +! + end subroutine set_label_sph_induction_bc +! +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! + subroutine add_bc_group_types_scalar(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + call append_c_to_ctl_array(fixed_bc, array_c) + call append_c_to_ctl_array(fixed_file, array_c) + call append_c_to_ctl_array(evo_field_file_bc, array_c) +! + end subroutine add_bc_group_types_scalar +! +! ---------------------------------------------------------------------- +! + subroutine add_bc_group_types_vector(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + call append_c_to_ctl_array(fixed_file, array_c) + call append_c_to_ctl_array(evo_field_file_bc, array_c) +! + end subroutine add_bc_group_types_vector +! +! ---------------------------------------------------------------------- +! + subroutine add_bc_group_types_rotation(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + call append_c_to_ctl_array(fix_rot_x, array_c) + call append_c_to_ctl_array(fix_rot_y, array_c) + call append_c_to_ctl_array(fix_rot_z, array_c) +! + end subroutine add_bc_group_types_rotation +! +! ---------------------------------------------------------------------- +! + subroutine add_bc_group_types_sph_center(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + call append_c_to_ctl_array(fill_sph_center, array_c) + call append_c_to_ctl_array(fix_sph_center, array_c) +! + end subroutine add_bc_group_types_sph_center +! +! ---------------------------------------------------------------------- +! + subroutine add_bc_group_types_sph_velo(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + call append_c_to_ctl_array(non_slip_sph, array_c) + call append_c_to_ctl_array(free_slip_sph, array_c) + call append_c_to_ctl_array(rot_inner_core, array_c) +! + end subroutine add_bc_group_types_sph_velo +! +! ---------------------------------------------------------------------- +! + subroutine add_bc_group_types_sph_magne(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + call append_c_to_ctl_array(insulator_sph, array_c) + call append_c_to_ctl_array(pseudo_vacuum_sph, array_c) +! + end subroutine add_bc_group_types_sph_magne +! +! ---------------------------------------------------------------------- +! + subroutine add_bc_group_types_fluxes(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + call append_c_to_ctl_array(flux_bc, array_c) + call append_c_to_ctl_array(flux_file_bc, array_c) + call append_c_to_ctl_array(evo_flux_file_bc, array_c) +! + end subroutine add_bc_group_types_fluxes +! +! ---------------------------------------------------------------------- ! - end module set_node_group_types + end module m_sph_node_group_types diff --git a/src/Fortran_libraries/MHD_src/IO/set_control_4_composition.f90 b/src/Fortran_libraries/MHD_src/IO/set_control_4_composition.f90 index b242a24e..77121d2b 100644 --- a/src/Fortran_libraries/MHD_src/IO/set_control_4_composition.f90 +++ b/src/Fortran_libraries/MHD_src/IO/set_control_4_composition.f90 @@ -36,10 +36,11 @@ subroutine s_set_control_4_composition & ! use calypso_mpi use m_machine_parameter + use m_sph_node_group_types use t_physical_property use t_control_array_chara2real use t_bc_data_list - use set_node_group_types + use m_fem_node_group_types use set_surface_group_types ! type(scalar_property), intent(in) :: cp_prop diff --git a/src/Fortran_libraries/MHD_src/IO/set_control_4_force.f90 b/src/Fortran_libraries/MHD_src/IO/set_control_4_force.f90 index 31d76bb5..e43873cb 100644 --- a/src/Fortran_libraries/MHD_src/IO/set_control_4_force.f90 +++ b/src/Fortran_libraries/MHD_src/IO/set_control_4_force.f90 @@ -25,22 +25,6 @@ module set_control_4_force use m_force_control_labels ! implicit none -! -!> Filtered thermal buoyancy label - character(len=kchara), parameter & - & :: Filtered_gravity_label = 'Filtered_buoyancy' -! - character(len=kchara), parameter & - & :: Filtered_gravity_e1 = 'Filtered_gravity' -! -!> Filtered compositional buoyancy label - character(len=kchara), parameter & - & :: Filtered_comp_gravity_label & - & = 'Filtered_compositional_buoyancy' -! - character(len=kchara), parameter & - & :: Filtered_comp_gravity_e1 & - & = 'Filtered_compositional_gravity' ! private :: set_control_force_flags, set_control_4_gravity private :: set_control_4_Coriolis_force, set_control_4_induction @@ -148,17 +132,17 @@ subroutine set_control_force_flags(frc_ctl, fl_prop) & .or. cmp_no_case(tmpchara, Filtered_comp_gravity_e1) & & ) fl_prop%iflag_4_filter_comp_buo = .TRUE. ! - if (cmp_no_case(tmpchara, 'Coriolis') & + if (cmp_no_case(tmpchara, coriolis_e1) & & ) fl_prop%iflag_4_coriolis = .TRUE. ! - if(cmp_no_case(tmpchara, 'filtered_inertia')) then + if(cmp_no_case(tmpchara, hd_filtered_inertia)) then fl_prop%iflag_4_filter_inertia = .TRUE. fl_prop%iflag_4_inertia = .FALSE. end if ! if(cmp_no_case(tmpchara, lorentz_label)) then fl_prop%iflag_4_lorentz = .TRUE. - else if(cmp_no_case(tmpchara, 'filtered_Lorentz')) then + else if(cmp_no_case(tmpchara, hd_filtered_Lorentz)) then fl_prop%iflag_4_filter_lorentz = .TRUE. end if ! diff --git a/src/Fortran_libraries/MHD_src/IO/set_control_4_magne.f90 b/src/Fortran_libraries/MHD_src/IO/set_control_4_magne.f90 index 82e57671..3800006e 100644 --- a/src/Fortran_libraries/MHD_src/IO/set_control_4_magne.f90 +++ b/src/Fortran_libraries/MHD_src/IO/set_control_4_magne.f90 @@ -35,11 +35,12 @@ subroutine s_set_control_4_magne & & magne_nod, magne_surf) ! use m_machine_parameter + use m_sph_node_group_types use calypso_mpi use t_physical_property use t_control_array_chara2real use t_bc_data_list - use set_node_group_types + use m_fem_node_group_types use set_surface_group_types ! type(conductive_property), intent(in) :: cd_prop @@ -74,14 +75,16 @@ subroutine s_set_control_4_magne & & = node_bc_B_ctl%vect(1:magne_nod%num_bc) ! do i = 1, magne_nod%num_bc + call set_bc_group_types_each_dir(node_bc_B_ctl%c1_tbl(i), & + & magne_nod%ibc_type(i)) call set_bc_group_types_vector(node_bc_B_ctl%c1_tbl(i), & - & magne_nod%ibc_type(i)) + & magne_nod%ibc_type(i)) call set_bc_group_types_sgs_vect(node_bc_B_ctl%c1_tbl(i), & - & magne_nod%ibc_type(i)) + & magne_nod%ibc_type(i)) call set_bc_group_types_sph_center(node_bc_B_ctl%c1_tbl(i), & - & magne_nod%ibc_type(i)) + & magne_nod%ibc_type(i)) call set_bc_group_types_sph_magne(node_bc_B_ctl%c1_tbl(i), & - & magne_nod%ibc_type(i)) + & magne_nod%ibc_type(i)) ! ! if(cmp_no_case(node_bc_B_ctl%c1_tbl(i),'sph') & ! & ) magne_nod%ibc_type(i) = 999 diff --git a/src/Fortran_libraries/MHD_src/IO/set_control_4_model.f90 b/src/Fortran_libraries/MHD_src/IO/set_control_4_model.f90 index cf2daf0f..296743b1 100644 --- a/src/Fortran_libraries/MHD_src/IO/set_control_4_model.f90 +++ b/src/Fortran_libraries/MHD_src/IO/set_control_4_model.f90 @@ -48,6 +48,7 @@ subroutine s_set_control_4_model(reft_ctl, refc_ctl, & use t_ctl_data_temp_model use t_reference_scalar_param use m_base_field_labels + use set_reference_scalar_param ! type(reference_temperature_ctl), intent(in) :: reft_ctl type(reference_temperature_ctl), intent(in) :: refc_ctl @@ -167,19 +168,33 @@ subroutine s_set_control_4_crank & type(scalar_property), intent(inout) :: ht_prop, cp_prop ! ! + call set_implicit_coefs(mevo_ctl%coef_implicit_ctl, & + & fl_prop%iflag_scheme, fl_prop%coef_imp, fl_prop%coef_exp) call set_implicit_coefs(mevo_ctl%coef_imp_v_ctl, & & fl_prop%iflag_scheme, fl_prop%coef_imp, fl_prop%coef_exp) +! + call set_implicit_coefs(mevo_ctl%coef_implicit_ctl, & + & ht_prop%iflag_scheme, ht_prop%coef_imp, ht_prop%coef_exp) call set_implicit_coefs(mevo_ctl%coef_imp_t_ctl, & & ht_prop%iflag_scheme, ht_prop%coef_imp, ht_prop%coef_exp) +! + call set_implicit_coefs(mevo_ctl%coef_implicit_ctl, & + & cp_prop%iflag_scheme, cp_prop%coef_imp, cp_prop%coef_exp) call set_implicit_coefs(mevo_ctl%coef_imp_c_ctl, & & cp_prop%iflag_scheme, cp_prop%coef_imp, cp_prop%coef_exp) ! if(cd_prop%iflag_Bevo_scheme .ne. id_no_evolution) then call set_implicit_coefs & + & (mevo_ctl%coef_implicit_ctl, cd_prop%iflag_Bevo_scheme, & + & cd_prop%coef_imp, cd_prop%coef_exp) + call set_implicit_coefs & & (mevo_ctl%coef_imp_b_ctl, cd_prop%iflag_Bevo_scheme, & & cd_prop%coef_imp, cd_prop%coef_exp) else if(cd_prop%iflag_Aevo_scheme .ne. id_no_evolution) then call set_implicit_coefs & + & (mevo_ctl%coef_implicit_ctl, cd_prop%iflag_Aevo_scheme, & + & cd_prop%coef_imp, cd_prop%coef_exp) + call set_implicit_coefs & & (mevo_ctl%coef_imp_b_ctl, cd_prop%iflag_Aevo_scheme, & & cd_prop%coef_imp, cd_prop%coef_exp) end if diff --git a/src/Fortran_libraries/MHD_src/IO/set_control_4_press.f90 b/src/Fortran_libraries/MHD_src/IO/set_control_4_press.f90 index 3b27d723..1ef394f2 100644 --- a/src/Fortran_libraries/MHD_src/IO/set_control_4_press.f90 +++ b/src/Fortran_libraries/MHD_src/IO/set_control_4_press.f90 @@ -36,11 +36,12 @@ subroutine s_set_control_4_press & & press_nod, wall_surf) ! use m_machine_parameter + use m_sph_node_group_types use calypso_mpi use t_physical_property use t_control_array_chara2real use t_bc_data_list - use set_node_group_types + use m_fem_node_group_types use set_surface_group_types ! type(fluid_property), intent(in) :: fl_prop diff --git a/src/Fortran_libraries/MHD_src/IO/set_control_4_temp.f90 b/src/Fortran_libraries/MHD_src/IO/set_control_4_temp.f90 index 05625fd6..b08da837 100644 --- a/src/Fortran_libraries/MHD_src/IO/set_control_4_temp.f90 +++ b/src/Fortran_libraries/MHD_src/IO/set_control_4_temp.f90 @@ -36,11 +36,12 @@ subroutine s_set_control_4_temp & & temp_nod, h_flux_surf) ! use m_machine_parameter + use m_sph_node_group_types use calypso_mpi use t_physical_property use t_control_array_chara2real use t_bc_data_list - use set_node_group_types + use m_fem_node_group_types use set_surface_group_types ! type(scalar_property), intent(in) :: ht_prop diff --git a/src/Fortran_libraries/MHD_src/IO/set_control_4_velo.f90 b/src/Fortran_libraries/MHD_src/IO/set_control_4_velo.f90 index 123f09fc..a71abe0e 100644 --- a/src/Fortran_libraries/MHD_src/IO/set_control_4_velo.f90 +++ b/src/Fortran_libraries/MHD_src/IO/set_control_4_velo.f90 @@ -36,11 +36,12 @@ subroutine s_set_control_4_velo & & velo_nod, torque_surf) ! use m_machine_parameter + use m_sph_node_group_types use calypso_mpi use t_physical_property use t_control_array_chara2real use t_bc_data_list - use set_node_group_types + use m_fem_node_group_types use set_surface_group_types use skip_comment_f ! @@ -76,27 +77,25 @@ subroutine s_set_control_4_velo & ! iflag_4_hemi = 0 do i = 1, velo_nod%num_bc - if ( velo_nod%bc_name(i) .eq. 'equator') then - iflag_4_hemi = 1 - end if + call set_bc_group_types_equator(velo_nod%bc_name(i), & + & iflag_4_hemi) end do ! do i = 1, velo_nod%num_bc + call set_bc_group_types_each_dir(node_bc_U_ctl%c1_tbl(i), & + & velo_nod%ibc_type(i)) call set_bc_group_types_vector(node_bc_U_ctl%c1_tbl(i), & - & velo_nod%ibc_type(i)) + & velo_nod%ibc_type(i)) call set_bc_group_types_sgs_vect(node_bc_U_ctl%c1_tbl(i), & - & velo_nod%ibc_type(i)) + & velo_nod%ibc_type(i)) call set_bc_group_types_rotation(node_bc_U_ctl%c1_tbl(i), & - & velo_nod%ibc_type(i)) + & velo_nod%ibc_type(i)) call set_bc_group_types_sph_center(node_bc_U_ctl%c1_tbl(i), & - & velo_nod%ibc_type(i)) + & velo_nod%ibc_type(i)) call set_bc_group_types_sph_velo(node_bc_U_ctl%c1_tbl(i), & - & velo_nod%ibc_type(i)) -! - if(cmp_no_case(node_bc_U_ctl%c1_tbl(i), 'vr_0')) & - & velo_nod%ibc_type(i) = iflag_no_vr - if(cmp_no_case(node_bc_U_ctl%c1_tbl(i), 'special')) & - & velo_nod%ibc_type(i) = iflag_bc_special + & velo_nod%ibc_type(i)) + call set_bc_group_special_velocity(node_bc_U_ctl%c1_tbl(i), & + & velo_nod%ibc_type(i)) end do ! if(iflag_debug .gt. 0) then diff --git a/src/Fortran_libraries/MHD_src/IO/set_surface_group_types.f90 b/src/Fortran_libraries/MHD_src/IO/set_surface_group_types.f90 index 0056211c..cdd2845c 100644 --- a/src/Fortran_libraries/MHD_src/IO/set_surface_group_types.f90 +++ b/src/Fortran_libraries/MHD_src/IO/set_surface_group_types.f90 @@ -13,13 +13,22 @@ !! subroutine set_pseudo_vacuum_group_types(bc_type_ctl, ibc_type) !! subroutine set_surf_wall_group_types(bc_type_ctl, ibc_type) !! subroutine set_surf_infty_group_types(bc_type_ctl, ibc_type) +!! +!! subroutine surf_bc_label_thermal_bc(array_c) +!! subroutine surf_bc_label_momentum_bc(array_c) +!! subroutine surf_bc_label_induction_bc(array_c) +!! subroutine surf_bc_label_infinity_bc(array_c) +!! subroutine surf_bc_label_potential_bc(array_c) +!! subroutine surf_bc_label_vector_p_bc(array_c) +!! subroutine surf_bc_label_current_bc(array_c) +!! type(ctl_array_chara), intent(inout) :: array_c !!@endverbatim ! module set_surface_group_types ! use m_precision use m_boundary_condition_IDs - use set_node_group_types + use m_fem_node_group_types use skip_comment_f ! implicit none @@ -107,6 +116,8 @@ module set_surface_group_types !----------------------------------------------------------------------- ! subroutine set_surf_group_types_scalar(bc_type_ctl, ibc_type) +! + use m_sph_node_group_types ! character (len=kchara), intent(in) :: bc_type_ctl integer(kind = kint), intent(inout) :: ibc_type @@ -136,6 +147,7 @@ subroutine set_surf_group_types_vector(bc_type_ctl, ibc_type) integer(kind = kint), intent(inout) :: ibc_type ! ! + call set_bc_group_types_each_dir(bc_type_ctl, ibc_type) call set_bc_group_types_vector(bc_type_ctl, ibc_type) call set_bc_group_types_sgs_vect(bc_type_ctl, ibc_type) ! @@ -236,5 +248,213 @@ subroutine set_surf_infty_group_types(bc_type_ctl, ibc_type) end subroutine set_surf_infty_group_types ! !----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! + subroutine surf_bc_label_thermal_bc(array_c) + use m_sph_node_group_types + use m_fem_node_group_types + 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 add_bc_group_types_sph_center(array_c) + call add_bc_group_types_scalar(array_c) + call add_bc_group_types_sgs_scalar(array_c) +! + call add_surf_group_types_scalar(array_c) +! + end subroutine surf_bc_label_thermal_bc +! +!----------------------------------------------------------------------- +! + subroutine surf_bc_label_momentum_bc(array_c) + use m_sph_node_group_types + use m_fem_node_group_types + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + array_c%array_name = ' ' + array_c%num = 0 + call set_label_momentum_bc(array_c) +! + call add_bc_group_types_sph_velo(array_c) + call add_bc_group_types_each_dir(array_c) + call add_bc_group_types_vector(array_c) + call add_bc_group_types_sgs_vect(array_c) +! + call add_surf_group_types_vector(array_c) + call add_stress_free_group_types(array_c) +! + end subroutine surf_bc_label_momentum_bc +! +!----------------------------------------------------------------------- +! + subroutine surf_bc_label_induction_bc(array_c) + use m_sph_node_group_types + use m_fem_node_group_types + 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 add_bc_group_types_sph_magne(array_c) + call add_bc_group_types_sph_center(array_c) +! + call add_bc_group_types_each_dir(array_c) + call add_bc_group_types_vector(array_c) + call add_bc_group_types_sgs_vect(array_c) +! + call add_surf_group_types_vector(array_c) +! + end subroutine surf_bc_label_induction_bc +! +! ---------------------------------------------------------------------- +! + subroutine surf_bc_label_potential_bc(array_c) + use m_fem_node_group_types + 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 add_surf_group_types_scalar(array_c) + call add_bc_group_types_scalar(array_c) + call add_bc_group_types_sgs_scalar(array_c) +! + call add_surf_wall_group_types(array_c) +! + end subroutine surf_bc_label_potential_bc +! +! ---------------------------------------------------------------------- +! + subroutine surf_bc_label_vector_p_bc(array_c) + use m_fem_node_group_types + 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 add_bc_group_types_each_dir(array_c) + call add_bc_group_types_vector(array_c) + call add_bc_group_types_sgs_vect(array_c) +! + call add_surf_group_types_vector(array_c) + call add_pseudo_vacuum_group_types(array_c) +! + end subroutine surf_bc_label_vector_p_bc +! +! ---------------------------------------------------------------------- +! + subroutine surf_bc_label_current_bc(array_c) + use m_fem_node_group_types + 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 add_bc_group_types_each_dir(array_c) + call add_bc_group_types_vector(array_c) + call add_bc_group_types_sgs_vect(array_c) +! + call add_surf_group_types_vector(array_c) +! + end subroutine surf_bc_label_current_bc +! +! ---------------------------------------------------------------------- +! + subroutine surf_bc_label_infinity_bc(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(infty_surf, array_c) +! + end subroutine surf_bc_label_infinity_bc +! +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! + subroutine add_surf_group_types_scalar(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + call append_c_to_ctl_array(grad_sf, array_c) + call append_c_to_ctl_array(grad_file, array_c) + call append_c_to_ctl_array(grad_lead, array_c) +! + end subroutine add_surf_group_types_scalar +! +! ---------------------------------------------------------------------- +! + subroutine add_surf_group_types_vector(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + call append_c_to_ctl_array(fixed_norm, array_c) + call append_c_to_ctl_array(norm_file, array_c) +! + call append_c_to_ctl_array(fixed_grad_x, array_c) + call append_c_to_ctl_array(fixed_grad_y, array_c) + call append_c_to_ctl_array(fixed_grad_z, array_c) +! + call append_c_to_ctl_array(grad_file_x, array_c) + call append_c_to_ctl_array(grad_file_y, array_c) + call append_c_to_ctl_array(grad_file_z, array_c) +! + call append_c_to_ctl_array(grad_lead_x, array_c) + call append_c_to_ctl_array(grad_lead_y, array_c) + call append_c_to_ctl_array(grad_lead_z, array_c) +! + end subroutine add_surf_group_types_vector +! +! ---------------------------------------------------------------------- +! + subroutine add_stress_free_group_types(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + call append_c_to_ctl_array(free_sph_in, array_c) + call append_c_to_ctl_array(free_sph_out, array_c) +! + end subroutine add_stress_free_group_types +! +! ---------------------------------------------------------------------- +! + subroutine add_surf_wall_group_types(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + call append_c_to_ctl_array(wall_surf, array_c) + call append_c_to_ctl_array(sphere_in, array_c) + call append_c_to_ctl_array(sphere_out, array_c) +! + end subroutine add_surf_wall_group_types +! +! ---------------------------------------------------------------------- +! + subroutine add_pseudo_vacuum_group_types(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + call append_c_to_ctl_array(pseudo_in, array_c) + call append_c_to_ctl_array(pseudo_out, array_c) +! + end subroutine add_pseudo_vacuum_group_types +! +! ---------------------------------------------------------------------- ! end module set_surface_group_types diff --git a/src/Fortran_libraries/MHD_src/IO/t_control_data_dynamo_sects.f90 b/src/Fortran_libraries/MHD_src/IO/t_control_data_dynamo_sects.f90 index 66e104bc..52bbfdfb 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_control_data_dynamo_sects.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_control_data_dynamo_sects.f90 @@ -7,6 +7,7 @@ !> @brief Control data structure for zonal mean visualization controls !! !!@verbatim +!! subroutine init_dynamo_sects_ctl_label(hd_block, zm_sects) !! subroutine read_dynamo_sects_control & !! & (id_control, hd_block, zm_sects, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -50,6 +51,8 @@ module t_control_data_dynamo_sects ! !> Structures of zonal mean controls type sph_dynamo_section_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 ! @@ -93,10 +96,11 @@ subroutine read_dynamo_sects_control & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(zm_sects%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, c_buf) + 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 ! call read_crustal_filtering_ctl & @@ -129,11 +133,9 @@ subroutine write_dynamo_sects_control & ! if(zm_sects%i_viz_ctl .le. 0) return ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) -! call write_crustal_filtering_ctl(id_control, & - & hd_crustal_filtering, zm_sects%crust_filter_ctl, level) + & zm_sects%crust_filter_ctl, level) ! call write_single_sect_ctl(id_control, hd_zm_section, & & zm_sects%zm_psf_ctls, level) @@ -144,6 +146,23 @@ subroutine write_dynamo_sects_control & end subroutine write_dynamo_sects_control ! ! -------------------------------------------------------------------- +! + subroutine init_dynamo_sects_ctl_label(hd_block, zm_sects) +! + character(len=kchara), intent(in) :: hd_block + type(sph_dynamo_section_controls), intent(inout) :: zm_sects +! +! + zm_sects%block_name = trim(hd_block) + call init_crustal_filtering_ctl(hd_crustal_filtering, & + & zm_sects%crust_filter_ctl) + call init_psf_ctls_labels(hd_zm_section, zm_sects%zm_psf_ctls) + call init_psf_ctls_labels(hd_zRMS_section, & + & zm_sects%zRMS_psf_ctls) +! + end subroutine init_dynamo_sects_ctl_label +! +! -------------------------------------------------------------------- ! subroutine dealloc_dynamo_sects_control(zm_sects) ! @@ -167,6 +186,7 @@ subroutine read_single_sect_ctl & use ctl_data_section_IO use ctl_file_sections_IO use skip_comment_f + use write_control_elements ! integer(kind = kint), intent(in) :: id_control character(len = kchara), intent(in) :: hd_section @@ -180,7 +200,12 @@ subroutine read_single_sect_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) call sel_read_control_4_psf_file(id_control, hd_section, & & psf_ctls%fname_psf_ctl(psf_ctls%num_psf_ctl), & & psf_ctls%psf_ctl_struct(psf_ctls%num_psf_ctl), c_buf) diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_MHD.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_MHD.f90 index eebc12ac..07ec95a3 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_MHD.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_MHD.f90 @@ -12,14 +12,10 @@ !! !!@verbatim !! subroutine read_control_4_sph_MHD_noviz(file_name, MHD_ctl) -!! subroutine read_sph_mhd_ctl_noviz & -!! & (id_control, hd_block, MHD_ctl, c_buf) !! 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(inout) :: MHD_ctl -!! type(surfacing_controls), intent(inout) :: surfacing_ctls -!! type(sph_dynamo_viz_controls), intent(inout) :: zm_ctls !! type(buffer_for_control), intent(inout) :: c_buf !! subroutine write_control_4_sph_MHD_noviz(file_name, MHD_ctl) !! subroutine write_sph_mhd_ctl_noviz & @@ -28,8 +24,6 @@ !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(mhd_simulation_control), intent(in) :: MHD_ctl -!! type(surfacing_controls), intent(in) :: surfacing_ctls -!! type(sph_dynamo_viz_controls), intent(in) :: zm_ctls !! integer(kind = kint), intent(inout) :: level !! !! subroutine dealloc_sph_mhd_ctl_data(MHD_ctl) @@ -54,6 +48,9 @@ module t_ctl_data_MHD integer(kind=kint), parameter, private :: id_control_file = 11 ! type mhd_simulation_control +!> Block name + character(len=kchara) :: block_name = 'MHD_control' +! !> Structure for file settings type(platform_data_control) :: plt !> Control structure for orginal file informations @@ -62,7 +59,7 @@ module t_ctl_data_MHD type(platform_data_control) :: new_plt ! !> file name for parallel spherical shell control - character(len = kchara) :: fname_psph_ctl + character(len = kchara) :: fname_psph = 'NO_FILE' !> Control structure for parallel spherical shell type(parallel_sph_shell_control) :: psph_ctl ! @@ -73,16 +70,15 @@ module t_ctl_data_MHD ! !> Structure for spectr monitoring control type(sph_monitor_control) :: smonitor_ctl -!> Structure for monitoring plave list +!> Structure for monitoring node list type(node_monitor_control) :: nmtr_ctl ! integer (kind=kint) :: i_mhd_ctl = 0 end type mhd_simulation_control ! -! Top level of label ! character(len=kchara), parameter, private & - & :: hd_mhd_ctl = 'MHD_control' + & :: hd_mhd_ctl = 'MHD_control' ! ! 2nd level for MHD ! @@ -102,6 +98,8 @@ module t_ctl_data_MHD & :: hd_pick_sph = 'sph_monitor_ctl' character(len=kchara), parameter, private & & :: hd_monitor_data = 'monitor_data_ctl' +! + private :: read_sph_mhd_ctl_noviz, init_sph_mhd_ctl_noviz_label ! ! ---------------------------------------------------------------------- ! @@ -109,23 +107,29 @@ module t_ctl_data_MHD ! ! ---------------------------------------------------------------------- ! - subroutine read_control_4_sph_MHD_noviz(file_name, MHD_ctl) + subroutine read_control_4_sph_MHD_noviz & + & (file_name, MHD_ctl, c_buf) ! character(len=kchara), intent(in) :: file_name type(mhd_simulation_control), intent(inout) :: MHD_ctl -! - type(buffer_for_control) :: c_buf1 + type(buffer_for_control), intent(inout) :: c_buf ! ! + c_buf%level = c_buf%level + 1 + call init_sph_mhd_ctl_noviz_label(hd_mhd_ctl, MHD_ctl) open(id_control_file, file = file_name, status='old' ) ! do - call load_one_line_from_control(id_control_file, c_buf1) + 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_noviz & - & (id_control_file, hd_mhd_ctl, MHD_ctl, c_buf1) + & (id_control_file, hd_mhd_ctl, MHD_ctl, c_buf) if(MHD_ctl%i_mhd_ctl .gt. 0) exit end do close(id_control_file) + c_buf%level = c_buf%level - 1 ! end subroutine read_control_4_sph_MHD_noviz ! @@ -151,7 +155,7 @@ subroutine write_control_4_sph_MHD_noviz(file_name, MHD_ctl) open(id_control_file, file = file_name) level1 = 0 call write_sph_mhd_ctl_noviz & - & (id_control_file, hd_mhd_ctl, MHD_ctl, level1) + & (id_control_file, MHD_ctl%block_name, MHD_ctl, level1) close(id_control_file) ! end subroutine write_control_4_sph_MHD_noviz @@ -174,10 +178,11 @@ subroutine read_sph_mhd_ctl_noviz & 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, c_buf) + 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 ! ! @@ -187,7 +192,7 @@ subroutine read_sph_mhd_ctl_noviz & & (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) @@ -224,31 +229,53 @@ subroutine write_sph_mhd_ctl_noviz & ! if(MHD_ctl%i_mhd_ctl .le. 0) return ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) -! 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) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_sph_mhd_ctl_noviz ! ! -------------------------------------------------------------------- +! + subroutine init_sph_mhd_ctl_noviz_label(hd_block, MHD_ctl) +! + use ctl_data_platforms_IO + use ctl_data_sph_monitor_IO + use ctl_data_MHD_model_IO + use ctl_file_gen_sph_shell_IO +! + character(len=kchara), intent(in) :: hd_block + type(mhd_simulation_control), intent(inout) :: MHD_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_monitor_data_ctl_label(hd_monitor_data, & + & MHD_ctl%nmtr_ctl) +! + end subroutine init_sph_mhd_ctl_noviz_label +! +! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine dealloc_sph_mhd_ctl_data(MHD_ctl) diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_MHD_model.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_MHD_model.f90 index 0905b2c9..fda56656 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_MHD_model.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_MHD_model.f90 @@ -40,6 +40,9 @@ module t_ctl_data_MHD_model implicit none ! type mhd_model_control +!> Block name + character(len=kchara) :: block_name = 'model' +! !> Structure for field information control type(field_control) :: fld_ctl ! diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_SPH_MHD_control.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_SPH_MHD_control.f90 index adac5203..a6b3824d 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_SPH_MHD_control.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_SPH_MHD_control.f90 @@ -11,14 +11,14 @@ !!@n Modified by H. Matsui on Oct., 2012 !! !!@verbatim +!! subroutine init_sph_mhd_control_label(hd_block, smctl_ctl) !! subroutine read_sph_mhd_control & !! & (id_control, hd_block, smctl_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(sph_mhd_control_control), intent(inout) :: smctl_ctl !! type(buffer_for_control), intent(inout) :: c_buf -!! subroutine write_sph_mhd_control & -!! & (id_control, hd_block, smctl_ctl, level) +!! subroutine write_sph_mhd_control(id_control, smctl_ctl, level) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(sph_mhd_control_control), intent(in) :: smctl_ctl @@ -43,6 +43,8 @@ module t_ctl_data_SPH_MHD_control implicit none ! type sph_mhd_control_control +!> Block name + character(len=kchara) :: block_name = 'control' !> Structure for time stepping control type(time_data_control) :: tctl !> Structure for restart flag @@ -55,7 +57,7 @@ module t_ctl_data_SPH_MHD_control ! ! label for entry of group character(len=kchara), parameter & - & :: hd_time_step = 'time_step_ctl' + & :: hd_time_step = 'time_step_ctl' character(len=kchara), parameter & & :: hd_restart_file = 'restart_file_ctl' character(len=kchara), parameter & @@ -82,12 +84,12 @@ subroutine read_sph_mhd_control & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(smctl_ctl%i_control .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 -! ! call read_control_time_step_data & & (id_control, hd_time_step, smctl_ctl%tctl, c_buf) @@ -103,36 +105,51 @@ end subroutine read_sph_mhd_control ! ! -------------------------------------------------------------------- ! - subroutine write_sph_mhd_control & - & (id_control, hd_block, smctl_ctl, level) + subroutine write_sph_mhd_control(id_control, smctl_ctl, level) ! use ctl_data_mhd_evo_scheme_IO use ctl_data_4_time_steps_IO use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(sph_mhd_control_control), intent(in) :: smctl_ctl ! integer(kind = kint), intent(inout) :: level ! ! if(smctl_ctl%i_control .le. 0) return - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) ! + level = write_begin_flag_for_ctl(id_control, level, & + & smctl_ctl%block_name) call write_control_time_step_data & - & (id_control, hd_time_step, smctl_ctl%tctl, level) - call write_restart_ctl & - & (id_control, hd_restart_file, smctl_ctl%mrst_ctl, level) + & (id_control, smctl_ctl%tctl, level) + call write_restart_ctl(id_control, smctl_ctl%mrst_ctl, level) ! - call write_time_loop_ctl & - & (id_control, hd_time_loop, smctl_ctl%mevo_ctl, level) - level = write_end_flag_for_ctl(id_control, level, hd_block) + call write_time_loop_ctl(id_control, smctl_ctl%mevo_ctl, level) + level = write_end_flag_for_ctl(id_control, level, & + & smctl_ctl%block_name) ! end subroutine write_sph_mhd_control ! ! -------------------------------------------------------------------- +! + subroutine init_sph_mhd_control_label(hd_block, smctl_ctl) +! + use ctl_data_4_time_steps_IO + use ctl_data_mhd_evo_scheme_IO +! + character(len=kchara), intent(in) :: hd_block + type(sph_mhd_control_control), intent(inout) :: smctl_ctl +! +! + smctl_ctl%block_name = hd_block + call init_ctl_time_step_label(hd_time_step, smctl_ctl%tctl) + call init_time_loop_ctl_label(hd_time_loop, smctl_ctl%mevo_ctl) + call init_restart_ctl_label(hd_restart_file, smctl_ctl%mrst_ctl) +! + end subroutine init_sph_mhd_control_label +! +! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine reset_sph_mhd_control(smctl_ctl) diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_coriolis_force.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_coriolis_force.f90 index 5998de6c..cea7bc8f 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_coriolis_force.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_coriolis_force.f90 @@ -8,6 +8,7 @@ !> @brief Control data for magnetic field controls !! !!@verbatim +!! subroutine init_coriolis_ctl_label(hd_block, cor_ctl) !! subroutine read_coriolis_ctl & !! & (id_control, hd_block, cor_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -55,6 +56,8 @@ module t_ctl_data_coriolis_force ! !> Structure for Coriolis force type coriolis_control +!> Block name + character(len=kchara) :: block_name = 'Coriolis_define' !> Coliolis force modeling in FEM !!@n element: Coriolis force in element !!@n node: Coriolis force at node @@ -97,7 +100,8 @@ subroutine read_coriolis_ctl & if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(cor_ctl%i_coriolis_ctl .gt. 0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_chara_ctl_type(c_buf, hd_FEM_Coriolis_model, & @@ -133,21 +137,37 @@ subroutine write_coriolis_ctl & maxlen = len_trim(hd_FEM_Coriolis_model) maxlen = max(maxlen, len_trim(hd_FEM_Coriolis_imp)) ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) -! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_FEM_Coriolis_model, cor_ctl%FEM_coriolis_model) + & cor_ctl%FEM_coriolis_model) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_FEM_Coriolis_imp, cor_ctl%FEM_coriolis_implicit) + & cor_ctl%FEM_coriolis_implicit) ! call write_control_array_c_r(id_control, level, & - & hd_rotation_vec, cor_ctl%system_rotation) + & cor_ctl%system_rotation) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_coriolis_ctl ! ! ----------------------------------------------------------------------- +! + subroutine init_coriolis_ctl_label(hd_block, cor_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(coriolis_control), intent(inout) :: cor_ctl +! +! + cor_ctl%block_name = hd_block + call init_chara_ctl_item_label(hd_FEM_Coriolis_model, & + & cor_ctl%FEM_coriolis_model) + call init_chara_ctl_item_label(hd_FEM_Coriolis_imp, & + & cor_ctl%FEM_coriolis_implicit) +! + call init_c_r_ctl_array_label(hd_rotation_vec, & + & cor_ctl%system_rotation) + end subroutine init_coriolis_ctl_label +! +! ----------------------------------------------------------------------- ! ----------------------------------------------------------------------- ! subroutine dealloc_coriolis_ctl(cor_ctl) diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_crust_filter.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_crust_filter.f90 index 9cf8ceb9..b4c35238 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_crust_filter.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_crust_filter.f90 @@ -7,6 +7,7 @@ !> @brief Control data structure for zonal mean visualization controls !! !!@verbatim +!! subroutine init_crustal_filtering_ctl(hd_block, crust_filter_c) !! subroutine read_crustal_filtering_ctl & !! & (id_control, hd_block, crust_filter_c, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -14,9 +15,8 @@ !! type(clust_filtering_ctl), intent(inout) :: crust_filter_c !! type(buffer_for_control), intent(inout) :: c_buf !! subroutine write_crustal_filtering_ctl & -!! & (id_control, hd_block, crust_filter_c, level) +!! & (id_control, crust_filter_c, level) !! integer(kind = kint), intent(in) :: id_control -!! character(len=kchara), intent(in) :: hd_block !! type(clust_filtering_ctl), intent(in) :: crust_filter_c !! integer(kind = kint), intent(inout) :: level !! subroutine reset_crustal_filtering_ctl(crust_filter_c) @@ -47,6 +47,8 @@ module t_ctl_data_crust_filter ! !> Structure of crustal filtering of mangeitc field type clust_filtering_ctl +!> Block name + character(len=kchara) :: block_name = 'crustal_filtering_ctl' !> Truncation dgree by crustal field type(read_integer_item) :: crust_truncation_ctl ! @@ -78,10 +80,12 @@ subroutine read_crustal_filtering_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(crust_filter_c%i_crustal_filtering .gt. 0) return + crust_filter_c%block_name = hd_block + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_integer_ctl_type(c_buf, hd_crustal_truncation, & @@ -94,14 +98,13 @@ end subroutine read_crustal_filtering_ctl ! --------------------------------------------------------------------- ! subroutine write_crustal_filtering_ctl & - & (id_control, hd_block, crust_filter_c, level) + & (id_control, crust_filter_c, level) ! use t_read_control_elements use write_control_elements use skip_comment_f ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(clust_filtering_ctl), intent(in) :: crust_filter_c ! integer(kind = kint), intent(inout) :: level @@ -113,16 +116,30 @@ subroutine write_crustal_filtering_ctl & ! maxlen = len_trim(hd_crustal_truncation) ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! + level = write_begin_flag_for_ctl(id_control, level, & + & crust_filter_c%block_name) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_crustal_truncation, crust_filter_c%crust_truncation_ctl) - level = write_end_flag_for_ctl(id_control, level, hd_block) + & crust_filter_c%crust_truncation_ctl) + level = write_end_flag_for_ctl(id_control, level, & + & crust_filter_c%block_name) ! end subroutine write_crustal_filtering_ctl ! ! --------------------------------------------------------------------- +! + subroutine init_crustal_filtering_ctl(hd_block, crust_filter_c) +! + character(len=kchara), intent(in) :: hd_block + type(clust_filtering_ctl), intent(inout) :: crust_filter_c +! + crust_filter_c%block_name = hd_block + call init_int_ctl_item_label(hd_crustal_truncation, & + & crust_filter_c%crust_truncation_ctl) +! + end subroutine init_crustal_filtering_ctl +! +! --------------------------------------------------------------------- +! --------------------------------------------------------------------- ! subroutine reset_crustal_filtering_ctl(crust_filter_c) ! diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_gravity.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_gravity.f90 index bd06a7fe..6a65b211 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_gravity.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_gravity.f90 @@ -8,6 +8,7 @@ !> @brief Control data for gravity define !! !!@verbatim +!! subroutine init_gravity_ctl_label(hd_block, g_ctl) !! subroutine read_gravity_ctl(id_control, hd_block, g_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block @@ -20,7 +21,7 @@ !! integer(kind = kint), intent(inout) :: level !! !! subroutine dealloc_gravity_ctl(g_ctl) -!! type(forces_control), intent(inout) :: g_ctl +!! type(gravity_control), intent(inout) :: g_ctl !! !! !!!! gravity_type !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! 0: constant @@ -57,6 +58,8 @@ module t_ctl_data_gravity ! !> Structure for gravity definistion type gravity_control +!> Block name + character(len=kchara) :: block_name = 'gravity_define' !> Coliolis force modeling in FEM !!@n element: Coriolis force in element !!@n node: Coriolis force at node @@ -98,7 +101,8 @@ subroutine read_gravity_ctl(id_control, hd_block, g_ctl, c_buf) if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(g_ctl%i_gravity_ctl .gt. 0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_c_r(id_control, & @@ -133,21 +137,35 @@ subroutine write_gravity_ctl(id_control, hd_block, g_ctl, level) maxlen = len_trim(hd_FEM_gravity_mode) maxlen = max(maxlen, len_trim(hd_gravity_type)) ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) -! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_FEM_gravity_mode, g_ctl%FEM_gravity_model) + & g_ctl%FEM_gravity_model) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_gravity_type, g_ctl%gravity) + & g_ctl%gravity) ! call write_control_array_c_r(id_control, level, & - & hd_gravity_vect, g_ctl%gravity_vector) + & g_ctl%gravity_vector) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_gravity_ctl ! ! ----------------------------------------------------------------------- +! + subroutine init_gravity_ctl_label(hd_block, g_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(gravity_control), intent(inout) :: g_ctl +! + g_ctl%block_name = hd_block + call init_c_r_ctl_array_label & + & (hd_gravity_vect, g_ctl%gravity_vector) + call init_chara_ctl_item_label(hd_gravity_type, g_ctl%gravity) + call init_chara_ctl_item_label(hd_FEM_gravity_mode, & + & g_ctl%FEM_gravity_model) +! + end subroutine init_gravity_ctl_label +! +! -------------------------------------------------------------------- ! ----------------------------------------------------------------------- ! subroutine dealloc_gravity_ctl(g_ctl) diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_induct_norm.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_induct_norm.f90 index 85628919..80b65312 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_induct_norm.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_induct_norm.f90 @@ -8,6 +8,7 @@ !!@n Modified by H. Matsui on Merch, 2006 !! !!@verbatim +!! subroutine init_induction_ctl_label(hd_block, induct_ctl) !! subroutine read_induction_ctl & !! & (id_control, hd_block, induct_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -53,6 +54,8 @@ module t_ctl_data_induct_norm ! !> Structure for coefficients of magnetic induction equation type induction_equation_control +!> Block name + character(len=kchara) :: block_name = 'induction' !> Structure for number and power to construct !! evolution of magnetic field term !!@n coef_4_magne_evo%c_tbl: Name of number @@ -108,10 +111,11 @@ subroutine read_induction_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(induct_ctl%i_induct_ctl .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_c_r(id_control, & @@ -129,15 +133,13 @@ end subroutine read_induction_ctl ! ! -------------------------------------------------------------------- ! - subroutine write_induction_ctl & - & (id_control, hd_block, induct_ctl, level) + subroutine write_induction_ctl(id_control, induct_ctl, level) ! use t_read_control_elements use write_control_elements use skip_comment_f ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(induction_equation_control), intent(in) :: induct_ctl ! integer(kind = kint), intent(inout) :: level @@ -145,22 +147,42 @@ subroutine write_induction_ctl & ! if(induct_ctl%i_induct_ctl .le. 0) return ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! - call write_control_array_c_r(id_control, level, & - & hd_n_magne, induct_ctl%coef_4_magne_evo) - call write_control_array_c_r(id_control, level, & - & hd_n_mag_p, induct_ctl%coef_4_mag_potential) - call write_control_array_c_r(id_control, level, & - & hd_n_m_diff, induct_ctl%coef_4_mag_diffuse) - call write_control_array_c_r(id_control, level, & - & hd_n_induct, induct_ctl%coef_4_induction) - level = write_end_flag_for_ctl(id_control, level, hd_block) + level = write_begin_flag_for_ctl(id_control, level, & + & induct_ctl%block_name) + call write_control_array_c_r(id_control, level, & + & induct_ctl%coef_4_magne_evo) + call write_control_array_c_r(id_control, level, & + & induct_ctl%coef_4_mag_potential) + call write_control_array_c_r(id_control, level, & + & induct_ctl%coef_4_mag_diffuse) + call write_control_array_c_r(id_control, level, & + & induct_ctl%coef_4_induction) + level = write_end_flag_for_ctl(id_control, level, & + & induct_ctl%block_name) ! end subroutine write_induction_ctl ! ! -------------------------------------------------------------------- +! + subroutine init_induction_ctl_label(hd_block, induct_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(induction_equation_control), intent(inout) :: induct_ctl +! + induct_ctl%block_name = trim(hd_block) +! + call init_c_r_ctl_array_label & + & (hd_n_magne, induct_ctl%coef_4_magne_evo) + call init_c_r_ctl_array_label & + & (hd_n_mag_p, induct_ctl%coef_4_mag_potential) + call init_c_r_ctl_array_label & + & (hd_n_m_diff, induct_ctl%coef_4_mag_diffuse) + call init_c_r_ctl_array_label & + & (hd_n_induct, induct_ctl%coef_4_induction) +! + end subroutine init_induction_ctl_label +! +! -------------------------------------------------------------------- ! subroutine dealloc_induction_ctl(induct_ctl) ! diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_magnetic_scale.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_magnetic_scale.f90 index 29c783f9..cff3c7fc 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_magnetic_scale.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_magnetic_scale.f90 @@ -8,6 +8,7 @@ !> @brief Control data for magnetic field controls !! !!@verbatim +!! subroutine init_magnetic_scale_ctl_label(hd_block, bscale_ctl) !! subroutine read_magnetic_scale_ctl & !! & (id_control, hd_block, bscale_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -53,6 +54,9 @@ module t_ctl_data_magnetic_scale ! !> Structure for magnetic field scaling type magnetic_field_scale_control +!> Block name + character(len=kchara) :: block_name & + & = 'magnetic_field_scale_ctl' !> array structure for magnetic energy ratio !!@n mag_to_kin_energy_ctl%c_tbl: name of coefficients !!@n mag_to_kin_energy_ctl%vect: order @@ -84,7 +88,8 @@ subroutine read_magnetic_scale_ctl & if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(bscale_ctl%i_bscale_ctl .gt. 0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_c_r(id_control, hd_mag_to_kin_ratio, & @@ -110,16 +115,26 @@ subroutine write_magnetic_scale_ctl & ! if(bscale_ctl%i_bscale_ctl .le. 0) return ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) -! call write_control_array_c_r(id_control, level, & - & hd_mag_to_kin_ratio, bscale_ctl%mag_to_kin_energy_ctl) + & bscale_ctl%mag_to_kin_energy_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_magnetic_scale_ctl ! ! ----------------------------------------------------------------------- +! + subroutine init_magnetic_scale_ctl_label(hd_block, bscale_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(magnetic_field_scale_control), intent(inout) :: bscale_ctl +! + bscale_ctl%block_name = hd_block + call init_c_r_ctl_array_label(hd_mag_to_kin_ratio, & + & bscale_ctl%mag_to_kin_energy_ctl) + end subroutine init_magnetic_scale_ctl_label +! +! ----------------------------------------------------------------------- ! ----------------------------------------------------------------------- ! subroutine dealloc_magnetic_scale_ctl(bscale_ctl) diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_evo_area.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_evo_area.f90 index bbb88faa..2f6d6ecc 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_evo_area.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_evo_area.f90 @@ -7,6 +7,7 @@ !>@brief Control data of time integration flags !! !!@verbatim +!! subroutine init_mhd_layer_ctl_label(hd_block, earea_ctl) !! subroutine read_mhd_layer_ctl & !! & (id_control, hd_block, earea_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -66,6 +67,8 @@ module t_ctl_data_mhd_evo_area implicit none ! type mhd_evo_area_control +!> Block name + character(len=kchara) :: block_name = 'layers_ctl' !> Structure for list of element group for time evolution in fluid !!@n evo_fluid_group_ctl%num: Number of groups !!@n evo_fluid_group_ctl%c_tbl: Name list of groups @@ -106,7 +109,8 @@ subroutine read_mhd_layer_ctl & if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(earea_ctl%i_layers_ctl .gt. 0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_c1(id_control, & @@ -134,17 +138,29 @@ subroutine write_mhd_layer_ctl & ! if(earea_ctl%i_layers_ctl .le. 0) return ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) call write_control_array_c1(id_control, level, & - & hd_fluid_grp, earea_ctl%evo_fluid_group_ctl) + & earea_ctl%evo_fluid_group_ctl) call write_control_array_c1(id_control, level, & - & hd_conduct_grp, earea_ctl%evo_conduct_group_ctl) + & earea_ctl%evo_conduct_group_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_mhd_layer_ctl ! ! -------------------------------------------------------------------- +! + subroutine init_mhd_layer_ctl_label(hd_block, earea_ctl) + character(len=kchara), intent(in) :: hd_block + type(mhd_evo_area_control), intent(inout) :: earea_ctl +! + earea_ctl%block_name = hd_block + call init_chara_ctl_array_label & + & (hd_fluid_grp, earea_ctl%evo_fluid_group_ctl) + call init_chara_ctl_array_label & + & (hd_conduct_grp, earea_ctl%evo_conduct_group_ctl) + end subroutine init_mhd_layer_ctl_label +! +! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine dealloc_ele_area_grp_ctl(earea_ctl) diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_evo_scheme.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_evo_scheme.f90 index a00b6353..c62d1986 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_evo_scheme.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_evo_scheme.f90 @@ -51,6 +51,7 @@ !! eps_4_magne_ctl 5.0e-1 !! scheme_ctl Crank_Nicolson !! diffuse_correct_ctl On +!! coef_implicit_ctl 5.0e-1 !! coef_imp_v_ctl 5.0e-1 !! coef_imp_t_ctl 5.0e-1 !! coef_imp_b_ctl 5.0e-1 @@ -81,6 +82,10 @@ module t_ctl_data_mhd_evo_scheme implicit none ! type mhd_evo_scheme_control +!> Block name + character(len=kchara) :: block_name = 'time_loop_ctl' +! + type(read_real_item) :: coef_implicit_ctl type(read_real_item) :: coef_imp_v_ctl type(read_real_item) :: coef_imp_t_ctl type(read_real_item) :: coef_imp_b_ctl @@ -138,6 +143,7 @@ subroutine reset_time_loop_ctl(mevo_ctl) ! mevo_ctl%eps_4_velo_ctl%iflag = 0 mevo_ctl%eps_4_magne_ctl%iflag = 0 + mevo_ctl%coef_implicit_ctl%iflag = 0 mevo_ctl%coef_imp_v_ctl%iflag = 0 mevo_ctl%coef_imp_t_ctl%iflag = 0 mevo_ctl%coef_imp_b_ctl%iflag = 0 diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_evolution.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_evolution.f90 index 84dad54c..300e028f 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_evolution.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_evolution.f90 @@ -7,6 +7,7 @@ !>@brief Control data of time integration flags !! !!@verbatim +!! subroutine init_mhd_time_evo_ctl_label(hd_block, evo_ctl) !! subroutine read_mhd_time_evo_ctl & !! & (id_control, hd_block, evo_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -30,7 +31,7 @@ !! vector_potential, composition !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! begin time_evolution_ctl -!! array time_evo_ctl 4 +!! array time_evo_ctl !! time_evo_ctl temperature !! time_evo_ctl velocity !! time_evo_ctl vector_potential @@ -53,6 +54,8 @@ module t_ctl_data_mhd_evolution ! ! type mhd_evolution_control +!> Block name + character(len=kchara) :: block_name = 'time_evolution_ctl' !> Structure for list of field for time evolution !!@n t_evo_field_ctl%icou: Read flag for 'time_evolution_ctl' !!@n t_evo_field_ctl%num: Number of field @@ -95,7 +98,8 @@ subroutine read_mhd_time_evo_ctl & if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(evo_ctl%i_time_evo .gt. 0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_c1(id_control, & @@ -121,15 +125,25 @@ subroutine write_mhd_time_evo_ctl & ! if(evo_ctl%i_time_evo .le. 0) return ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) call write_control_array_c1(id_control, level, & - & hd_t_evo_field, evo_ctl%t_evo_field_ctl) + & evo_ctl%t_evo_field_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_mhd_time_evo_ctl ! ! -------------------------------------------------------------------- +! + subroutine init_mhd_time_evo_ctl_label(hd_block, evo_ctl) + character(len=kchara), intent(in) :: hd_block + type(mhd_evolution_control), intent(inout) :: evo_ctl +! + evo_ctl%block_name = hd_block + call init_chara_ctl_array_label(hd_t_evo_field, & + & evo_ctl%t_evo_field_ctl) + end subroutine init_mhd_time_evo_ctl_label +! +! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine dealloc_t_evo_name_ctl(evo_ctl) diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_forces.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_forces.f90 index 4b1137b7..1eaccfa1 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_forces.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_forces.f90 @@ -8,15 +8,14 @@ !> @brief Control data for magnetic field controls !! !!@verbatim +!! subroutine init_forces_ctl_label(hd_block, frc_ctl) !! subroutine read_forces_ctl(id_control, hd_block, frc_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(forces_control), intent(inout) :: frc_ctl !! type(buffer_for_control), intent(inout) :: c_buf -!! subroutine write_forces_ctl & -!! & (id_control, hd_block, frc_ctl, level) +!! subroutine write_forces_ctl(id_control, frc_ctl, level) !! integer(kind = kint), intent(in) :: id_control -!! character(len=kchara), intent(in) :: hd_block !! type(forces_control), intent(in) :: frc_ctl !! integer(kind = kint), intent(inout) :: level !! @@ -54,6 +53,9 @@ module t_ctl_data_mhd_forces ! !> Structure for force list type forces_control +!> Block name + character(len=kchara) :: block_name = 'forces_define' +! !> Structure for constant force list !!@n force_names%c_tbl: Name of force type(ctl_array_chara) :: force_names @@ -80,10 +82,11 @@ subroutine read_forces_ctl(id_control, hd_block, frc_ctl, c_buf) type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(frc_ctl%i_forces_ctl .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_c1(id_control, hd_num_forces, & @@ -95,31 +98,39 @@ end subroutine read_forces_ctl ! ! -------------------------------------------------------------------- ! - subroutine write_forces_ctl & - & (id_control, hd_block, frc_ctl, level) + subroutine write_forces_ctl(id_control, frc_ctl, level) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(forces_control), intent(in) :: frc_ctl ! integer(kind = kint), intent(inout) :: level ! - integer(kind = kint) :: maxlen = 0 ! if(frc_ctl%i_forces_ctl .le. 0) return - maxlen = len_trim(hd_num_forces) ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) - call write_control_array_c1(id_control, maxlen, & - & hd_num_forces, frc_ctl%force_names) - level = write_end_flag_for_ctl(id_control, level, hd_block) + level = write_begin_flag_for_ctl(id_control, level, & + & frc_ctl%block_name) + call write_control_array_c1(id_control, level, & + & frc_ctl%force_names) + level = write_end_flag_for_ctl(id_control, level, & + & frc_ctl%block_name) ! end subroutine write_forces_ctl ! ! ----------------------------------------------------------------------- +! + subroutine init_forces_ctl_label(hd_block, frc_ctl) + character(len=kchara), intent(in) :: hd_block + type(forces_control), intent(inout) :: frc_ctl +! + frc_ctl%block_name = hd_block + call init_chara_ctl_array_label(hd_num_forces, & + & frc_ctl%force_names) + end subroutine init_forces_ctl_label +! +! -------------------------------------------------------------------- ! ----------------------------------------------------------------------- ! subroutine dealloc_name_force_ctl(frc_ctl) diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_magne.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_magne.f90 index 564e6680..14fb52ff 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_magne.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_magne.f90 @@ -8,14 +8,14 @@ !> @brief Control data for magnetic field controls !! !!@verbatim +!! subroutine init_magneto_cv_ctl_label(hd_block, mcv_ctl) !! subroutine read_magneto_cv_ctl & !! & (id_control, hd_block, mcv_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(magneto_convection_control), intent(inout) :: mcv_ctl !! type(buffer_for_control), intent(inout) :: c_buf -!! subroutine write_magneto_cv_ctl & -!! & (id_control, hd_block, mcv_ctl, level) +!! subroutine write_magneto_cv_ctl(id_control, mcv_ctl, level) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(magneto_convection_control), intent(in) :: mcv_ctl @@ -69,6 +69,8 @@ module t_ctl_data_mhd_magne ! !> Structure for external magnetic field type magneto_convection_control +!> Block name + character(len=kchara) :: block_name = 'Magneto_convection_def' !> Structure for filtered induction flag type(read_character_item) :: filterd_induction_ctl !> Structure for magnetoconvection definition @@ -113,7 +115,8 @@ subroutine read_magneto_cv_ctl & if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(mcv_ctl%i_magneto_ctl .gt. 0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_c_r(id_control, hd_magne_vect, & @@ -130,13 +133,11 @@ end subroutine read_magneto_cv_ctl ! ! ----------------------------------------------------------------------- ! - subroutine write_magneto_cv_ctl & - & (id_control, hd_block, mcv_ctl, level) + subroutine write_magneto_cv_ctl(id_control, mcv_ctl, level) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(magneto_convection_control), intent(in) :: mcv_ctl ! integer(kind = kint), intent(inout) :: level @@ -149,18 +150,37 @@ subroutine write_magneto_cv_ctl & maxlen = len_trim(hd_magneto_cv) maxlen = max(maxlen, len_trim(hd_filetered_induction)) ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! + level = write_begin_flag_for_ctl(id_control, level, & + & mcv_ctl%block_name) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_magneto_cv, mcv_ctl%magneto_cv) + & mcv_ctl%magneto_cv) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_filetered_induction, mcv_ctl%filterd_induction_ctl) - level = write_end_flag_for_ctl(id_control, level, hd_block) + & mcv_ctl%filterd_induction_ctl) +! + call write_control_array_c_r & + & (id_control, level, mcv_ctl%ext_magne) + level = write_end_flag_for_ctl(id_control, level, & + & mcv_ctl%block_name) ! end subroutine write_magneto_cv_ctl ! ! ----------------------------------------------------------------------- +! + subroutine init_magneto_cv_ctl_label(hd_block, mcv_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(magneto_convection_control), intent(inout) :: mcv_ctl +! + mcv_ctl%block_name = hd_block + call init_c_r_ctl_array_label(hd_magne_vect, mcv_ctl%ext_magne) +! + call init_chara_ctl_item_label(hd_magneto_cv, mcv_ctl%magneto_cv) + call init_chara_ctl_item_label(hd_filetered_induction, & + & mcv_ctl%filterd_induction_ctl) +! + end subroutine init_magneto_cv_ctl_label +! +! ----------------------------------------------------------------------- ! ----------------------------------------------------------------------- ! subroutine dealloc_magneto_ctl(mcv_ctl) diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_normalize.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_normalize.f90 index 735fa54e..f2d6e927 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_normalize.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_normalize.f90 @@ -8,10 +8,10 @@ !!@n Modified by H. Matsui on Merch, 2006 !! !!@verbatim +!! subroutine init_coef_term_ctl_label(hd_block, eqs_ctl) !! subroutine read_coef_term_ctl & !! & (id_control, hd_block, eqs_ctl, c_buf) -!! subroutine write_coef_term_ctl & -!! & (id_control, hd_block, eqs_ctl, level) +!! subroutine write_coef_term_ctl(id_control, eqs_ctl, level) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(equations_control), intent(in) :: eqs_ctl @@ -110,6 +110,8 @@ module t_ctl_data_mhd_normalize ! !> Structure for coefficients of governing equations type equations_control +!> Block name + character(len=kchara) :: block_name = 'coefficients_ctl' !> Structure for coefficients of momentum equation type(momentum_equation_control) :: mom_ctl !> Structure for coefficients of magnetic induction equation @@ -149,10 +151,11 @@ subroutine read_coef_term_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(eqs_ctl%i_coef_term_ctl .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_thermal_ctl & @@ -170,13 +173,11 @@ end subroutine read_coef_term_ctl ! ! -------------------------------------------------------------------- ! - subroutine write_coef_term_ctl & - & (id_control, hd_block, eqs_ctl, level) + subroutine write_coef_term_ctl(id_control, eqs_ctl, level) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(equations_control), intent(in) :: eqs_ctl ! integer(kind = kint), intent(inout) :: level @@ -184,22 +185,35 @@ subroutine write_coef_term_ctl & ! if(eqs_ctl%i_coef_term_ctl .le. 0) return ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! - call write_thermal_ctl & - & (id_control, hd_thermal, eqs_ctl%heat_ctl, level) - call write_momentum_ctl & - & (id_control, hd_momentum, eqs_ctl%mom_ctl, level) - call write_induction_ctl & - & (id_control, hd_induction, eqs_ctl%induct_ctl, level) + level = write_begin_flag_for_ctl(id_control, level, & + & eqs_ctl%block_name) + call write_thermal_ctl(id_control, eqs_ctl%heat_ctl, level) + call write_momentum_ctl(id_control, eqs_ctl%mom_ctl, level) + call write_induction_ctl(id_control, eqs_ctl%induct_ctl, level) call write_composition_eq_ctl & - & (id_control, hd_dsc_diff_adv, eqs_ctl%comp_ctl, level) - level = write_end_flag_for_ctl(id_control, level, hd_block) + & (id_control, eqs_ctl%comp_ctl, level) + level = write_end_flag_for_ctl(id_control, level, & + & eqs_ctl%block_name) ! end subroutine write_coef_term_ctl ! ! -------------------------------------------------------------------- +! + subroutine init_coef_term_ctl_label(hd_block, eqs_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(equations_control), intent(inout) :: eqs_ctl +! + eqs_ctl%block_name = trim(hd_block) + call init_momentum_ctl_label(hd_momentum, eqs_ctl%mom_ctl) + call init_induction_ctl_label(hd_induction, eqs_ctl%induct_ctl) + call init_thermal_ctl_label(hd_thermal, eqs_ctl%heat_ctl) + call init_composition_eq_ctl_label(hd_dsc_diff_adv, & + & eqs_ctl%comp_ctl) +! + end subroutine init_coef_term_ctl_label +! +! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine dealloc_coef_term_ctl(eqs_ctl) diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_restart.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_restart.f90 index de072de7..d8ae54e3 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_restart.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_mhd_restart.f90 @@ -7,15 +7,14 @@ !> @brief data structure for restart data control block !! !!@verbatim +!! subroutine init_restart_ctl_label(hd_block, mr_ctl) !! subroutine read_restart_ctl(id_control, hd_block, mr_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(mhd_restart_control), intent(inout) :: mr_ctl !! type(buffer_for_control), intent(inout) :: c_buf -!! subroutine write_restart_ctl(id_control, hd_block, & -!! & mr_ctl, level) +!! subroutine write_restart_ctl(id_control, mr_ctl, level) !! integer(kind = kint), intent(in) :: id_control -!! character(len=kchara), intent(in) :: hd_block !! type(mhd_restart_control), intent(in) :: mr_ctl !! integer(kind = kint), intent(inout) :: level !! @@ -56,6 +55,9 @@ module t_ctl_data_mhd_restart ! !> control flage for restart data type mhd_restart_control +!> Block name + character(len=kchara) :: block_name = 'restart_file_ctl' +!> Initial data type control type(read_character_item) :: restart_flag_ctl ! integer (kind=kint) :: i_restart_file = 0 @@ -84,14 +86,16 @@ subroutine read_restart_ctl(id_control, hd_block, mr_ctl, c_buf) type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(mr_ctl%i_restart_file .gt. 0) return + mr_ctl%block_name = hd_block + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_chara_ctl_type(c_buf, hd_rst_flag, & - & mr_ctl%restart_flag_ctl) + & mr_ctl%restart_flag_ctl) end do mr_ctl%i_restart_file = 1 ! @@ -99,15 +103,13 @@ end subroutine read_restart_ctl ! ! -------------------------------------------------------------------- ! - subroutine write_restart_ctl(id_control, hd_block, & - & mr_ctl, level) + subroutine write_restart_ctl(id_control, mr_ctl, level) ! use t_read_control_elements use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(mhd_restart_control), intent(in) :: mr_ctl ! integer(kind = kint), intent(inout) :: level @@ -118,15 +120,30 @@ subroutine write_restart_ctl(id_control, hd_block, & if(mr_ctl%i_restart_file .le. 0) return maxlen = len_trim(hd_rst_flag) ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) + level = write_begin_flag_for_ctl(id_control, level, & + & mr_ctl%block_name) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_rst_flag, mr_ctl%restart_flag_ctl) - level = write_end_flag_for_ctl(id_control, level, hd_block) + & mr_ctl%restart_flag_ctl) + level = write_end_flag_for_ctl(id_control, level, & + & mr_ctl%block_name) ! end subroutine write_restart_ctl ! ! -------------------------------------------------------------------- +! + subroutine init_restart_ctl_label(hd_block, mr_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(mhd_restart_control), intent(inout) :: mr_ctl +! +! + mr_ctl%block_name = hd_block + call init_chara_ctl_item_label(hd_rst_flag, & + & mr_ctl%restart_flag_ctl) +! + end subroutine init_restart_ctl_label +! +! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine reset_restart_ctl(mr_ctl) diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_momentum_norm.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_momentum_norm.f90 index 22a44bdf..dd8b421a 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_momentum_norm.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_momentum_norm.f90 @@ -8,16 +8,15 @@ !!@n Modified by H. Matsui on Merch, 2006 !! !!@verbatim +!! subroutine init_momentum_ctl_label(hd_block, mom_ctl) !! subroutine read_momentum_ctl & !! & (id_control, hd_block, mom_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(momentum_equation_control), intent(inout) :: mom_ctl !! type(buffer_for_control), intent(inout) :: c_buf -!! subroutine write_momentum_ctl & -!! & (id_control, hd_block, mom_ctl, level) +!! subroutine write_momentum_ctl(id_control, mom_ctl, level) !! integer(kind = kint), intent(in) :: id_control -!! character(len=kchara), intent(in) :: hd_block !! type(momentum_equation_control), intent(in) :: mom_ctl !! integer(kind = kint), intent(inout) :: level !! subroutine dealloc_momentum_ctl(mom_ctl) @@ -70,6 +69,8 @@ module t_ctl_data_momentum_norm ! !> Structure for coefficients of momentum equation type momentum_equation_control +!> Block name + character(len=kchara) :: block_name = 'momentum' !> Structure for number and power to construct viscousity term !!@n coef_4_viscous%c_tbl: Name of number !!@n coef_4_viscous%vect: Power of the number @@ -139,10 +140,11 @@ subroutine read_momentum_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(mom_ctl%i_momentum .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_c_r(id_control, & @@ -167,15 +169,13 @@ end subroutine read_momentum_ctl ! ! -------------------------------------------------------------------- ! - subroutine write_momentum_ctl & - & (id_control, hd_block, mom_ctl, level) + subroutine write_momentum_ctl(id_control, mom_ctl, level) ! use t_read_control_elements use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(momentum_equation_control), intent(in) :: mom_ctl ! integer(kind = kint), intent(inout) :: level @@ -183,29 +183,57 @@ subroutine write_momentum_ctl & ! if(mom_ctl%i_momentum .le. 0) return ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! + level = write_begin_flag_for_ctl(id_control, level, & + & mom_ctl%block_name) call write_control_array_c_r(id_control, level, & - & hd_n_mom, mom_ctl%coef_4_intertia) + & mom_ctl%coef_4_intertia) call write_control_array_c_r(id_control, level, & - & hd_n_press, mom_ctl%coef_4_grad_p) + & mom_ctl%coef_4_grad_p) call write_control_array_c_r(id_control, level, & - & hd_n_v_diff, mom_ctl%coef_4_viscous) + & mom_ctl%coef_4_viscous) ! call write_control_array_c_r(id_control, level, & - & hd_n_buo, mom_ctl%coef_4_termal_buo) + & mom_ctl%coef_4_termal_buo) call write_control_array_c_r(id_control, level, & - & hd_n_c_buo, mom_ctl%coef_4_comp_buo) + & mom_ctl%coef_4_comp_buo) call write_control_array_c_r(id_control, level, & - & hd_n_cor, mom_ctl%coef_4_Coriolis) + & mom_ctl%coef_4_Coriolis) call write_control_array_c_r(id_control, level, & - & hd_n_lor, mom_ctl%coef_4_Lorentz) - level = write_end_flag_for_ctl(id_control, level, hd_block) + & mom_ctl%coef_4_Lorentz) + level = write_end_flag_for_ctl(id_control, level, & + & mom_ctl%block_name) ! end subroutine write_momentum_ctl ! ! -------------------------------------------------------------------- +! + subroutine init_momentum_ctl_label(hd_block, mom_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(momentum_equation_control), intent(inout) :: mom_ctl +! +! + if(mom_ctl%i_momentum .gt. 0) return + mom_ctl%block_name = trim(hd_block) + call init_c_r_ctl_array_label & + & (hd_n_mom, mom_ctl%coef_4_intertia) + call init_c_r_ctl_array_label & + & (hd_n_press, mom_ctl%coef_4_grad_p) + call init_c_r_ctl_array_label & + & (hd_n_v_diff, mom_ctl%coef_4_viscous) +! + call init_c_r_ctl_array_label & + & (hd_n_buo, mom_ctl%coef_4_termal_buo) + call init_c_r_ctl_array_label & + & (hd_n_c_buo, mom_ctl%coef_4_comp_buo) + call init_c_r_ctl_array_label & + & (hd_n_cor, mom_ctl%coef_4_Coriolis) + call init_c_r_ctl_array_label & + & (hd_n_lor, mom_ctl%coef_4_Lorentz) +! + end subroutine init_momentum_ctl_label +! +! -------------------------------------------------------------------- ! subroutine dealloc_momentum_ctl(mom_ctl) ! diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_node_boundary.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_node_boundary.f90 index ccbbde8c..41a83f3d 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_node_boundary.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_node_boundary.f90 @@ -114,6 +114,9 @@ module t_ctl_data_node_boundary implicit none ! type node_bc_control +!> Block name + character(len=kchara) :: block_name = 'boundary_condition' +! !> Structure for nodal boundary conditions for temperature !!@n node_bc_T_ctl%c1_tbl: Type of boundary conditions !!@n node_bc_T_ctl%c2_tbl: Node (radial) group name for boundary diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_node_monitor.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_node_monitor.f90 index 7c7db16d..e5c89126 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_node_monitor.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_node_monitor.f90 @@ -7,14 +7,14 @@ !>@brief Control data of node monitoring !! !!@verbatim +!! subroutine init_monitor_data_ctl_label(hd_block, nmtr_ctl) !! subroutine read_monitor_data_ctl & !! & (id_control, hd_block, nmtr_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(node_monitor_control), intent(inout) :: nmtr_ctl !! type(buffer_for_control), intent(inout) :: c_buf -!! subroutine write_monitor_data_ctl & -!! & (id_control, hd_block, nmtr_ctl, level) +!! subroutine write_monitor_data_ctl(id_control, nmtr_ctl, level) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(node_monitor_control), intent(in) :: nmtr_ctl @@ -56,6 +56,8 @@ module t_ctl_data_node_monitor ! ! type node_monitor_control +!> Block name + character(len=kchara) :: block_name = 'monitor_data_ctl' !> Structure for monitoring plave list !!@n xx_4_monitor_ctl%vec1: X position !!@n xx_4_monitor_ctl%vec2: Y position @@ -100,10 +102,12 @@ subroutine read_monitor_data_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(nmtr_ctl%i_monitor_data .gt. 0) return + nmtr_ctl%block_name = hd_block + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_c1(id_control, & @@ -119,15 +123,13 @@ end subroutine read_monitor_data_ctl ! ! -------------------------------------------------------------------- ! - subroutine write_monitor_data_ctl & - & (id_control, hd_block, nmtr_ctl, level) + subroutine write_monitor_data_ctl(id_control, nmtr_ctl, level) ! use t_read_control_elements use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(node_monitor_control), intent(in) :: nmtr_ctl ! integer(kind = kint), intent(inout) :: level @@ -135,20 +137,37 @@ subroutine write_monitor_data_ctl & ! if(nmtr_ctl%i_monitor_data .le. 0) return ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! - call write_control_array_c1(id_control, level, & - & hd_monitor_grp, nmtr_ctl%group_4_monitor_ctl) - call write_control_array_r3(id_control, level, & - & hd_monitor_position, nmtr_ctl%xx_4_monitor_ctl) - call write_control_array_i2(id_control, level, & - & hd_monitor_node, nmtr_ctl%node_4_monitor_ctl) - level = write_end_flag_for_ctl(id_control, level, hd_block) + level = write_begin_flag_for_ctl(id_control, level, & + & nmtr_ctl%block_name) + call write_control_array_c1(id_control, level, & + & nmtr_ctl%group_4_monitor_ctl) + call write_control_array_r3(id_control, level, & + & nmtr_ctl%xx_4_monitor_ctl) + call write_control_array_i2(id_control, level, & + & nmtr_ctl%node_4_monitor_ctl) + level = write_end_flag_for_ctl(id_control, level, & + & nmtr_ctl%block_name) ! end subroutine write_monitor_data_ctl ! ! -------------------------------------------------------------------- +! + subroutine init_monitor_data_ctl_label(hd_block, nmtr_ctl) + character(len=kchara), intent(in) :: hd_block + type(node_monitor_control), intent(inout) :: nmtr_ctl +! + nmtr_ctl%block_name = hd_block +! + call init_chara_ctl_array_label & + & (hd_monitor_grp, nmtr_ctl%group_4_monitor_ctl) + call init_r3_ctl_array_label & + & (hd_monitor_position, nmtr_ctl%xx_4_monitor_ctl) + call init_int2_ctl_array_label & + & (hd_monitor_node, nmtr_ctl%node_4_monitor_ctl) +! + end subroutine init_monitor_data_ctl_label +! +! -------------------------------------------------------------------- ! subroutine dealloc_monitor_data_ctl(nmtr_ctl) ! diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_sph_MHD_w_psf.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_sph_MHD_w_psf.f90 index b13c91e1..9f1b87ce 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_sph_MHD_w_psf.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_sph_MHD_w_psf.f90 @@ -12,9 +12,7 @@ !! !!@verbatim !! subroutine read_control_4_sph_MHD_w_psf(file_name, MHD_ctl, & -!! & add_SMHD_ctl) -!! subroutine read_sph_mhd_ctl_w_psf(id_control, hd_block, & -!! & MHD_ctl, add_SMHD_ctl, c_buf) +!! & add_SMHD_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_psf(file_name, MHD_ctl, & !! & add_SMHD_ctl) -!! subroutine write_sph_mhd_ctl_w_psf(id_control, hd_block, & +!! subroutine write_sph_mhd_ctl_w_psf(id_control, & !! & MHD_ctl, add_SMHD_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_psf_sph_mhd_ctl), intent(in) :: add_SMHD_ctl !! integer(kind = kint), intent(inout) :: level @@ -65,6 +62,10 @@ module t_ctl_data_sph_MHD_w_psf type(sph_dynamo_section_controls) :: zm_sects end type add_psf_sph_mhd_ctl ! +! + character(len=kchara), parameter, private & + & :: hd_mhd_ctl = 'MHD_control' +! ! 2nd level for MHD ! character(len=kchara), parameter, private & @@ -89,15 +90,11 @@ module t_ctl_data_sph_MHD_w_psf 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' ! - private :: read_sph_mhd_ctl_w_psf, write_sph_mhd_ctl_w_psf + private :: read_sph_mhd_ctl_w_psf, init_sph_mhd_ctl_w_psf_label ! ! ---------------------------------------------------------------------- ! @@ -106,26 +103,32 @@ module t_ctl_data_sph_MHD_w_psf ! ---------------------------------------------------------------------- ! subroutine read_control_4_sph_MHD_w_psf(file_name, MHD_ctl, & - & add_SMHD_ctl) -! - use t_control_data_surfacings + & add_SMHD_ctl, c_buf) ! character(len=kchara), intent(in) :: file_name type(mhd_simulation_control), intent(inout) :: MHD_ctl type(add_psf_sph_mhd_ctl), intent(inout) :: add_SMHD_ctl -! - type(buffer_for_control) :: c_buf1 + type(buffer_for_control), intent(inout) :: c_buf ! ! + c_buf%level = c_buf%level + 1 + call init_sph_mhd_ctl_w_psf_label(hd_mhd_ctl, & + & MHD_ctl, add_SMHD_ctl) open(id_control_file, file = file_name, status='old' ) ! do - call load_one_line_from_control(id_control_file, c_buf1) - call read_sph_mhd_ctl_w_psf(id_control_file, hd_mhd_ctl, & - & MHD_ctl, add_SMHD_ctl, c_buf1) + 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_psf(id_control_file, & + & hd_mhd_ctl, MHD_ctl, add_SMHD_ctl, c_buf) if(MHD_ctl%i_mhd_ctl .gt. 0) exit end do close(id_control_file) +! + c_buf%level = c_buf%level - 1 + if(c_buf%iend .gt. 0) return ! call section_step_ctls_to_time_ctl(add_SMHD_ctl%surfacing_ctls, & & MHD_ctl%smctl_ctl%tctl) @@ -139,7 +142,6 @@ end subroutine read_control_4_sph_MHD_w_psf subroutine write_control_4_sph_MHD_w_psf(file_name, MHD_ctl, & & add_SMHD_ctl) ! - use t_control_data_surfacings use delete_data_files ! character(len=kchara), intent(in) :: file_name @@ -157,8 +159,8 @@ subroutine write_control_4_sph_MHD_w_psf(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_psf(id_control_file, hd_mhd_ctl, & - & MHD_ctl, add_SMHD_ctl, level1) + call write_sph_mhd_ctl_w_psf & + & (id_control_file, MHD_ctl, add_SMHD_ctl, level1) close(id_control_file) ! end subroutine write_control_4_sph_MHD_w_psf @@ -183,10 +185,11 @@ subroutine read_sph_mhd_ctl_w_psf(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, c_buf) + 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 ! ! @@ -196,7 +199,7 @@ subroutine read_sph_mhd_ctl_w_psf(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) @@ -222,7 +225,7 @@ end subroutine read_sph_mhd_ctl_w_psf ! ! -------------------------------------------------------------------- ! - subroutine write_sph_mhd_ctl_w_psf(id_control, hd_block, & + subroutine write_sph_mhd_ctl_w_psf(id_control, & & MHD_ctl, add_SMHD_ctl, level) ! use ctl_data_platforms_IO @@ -234,7 +237,6 @@ subroutine write_sph_mhd_ctl_w_psf(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_psf_sph_mhd_ctl), intent(in) :: add_SMHD_ctl ! @@ -243,37 +245,68 @@ subroutine write_sph_mhd_ctl_w_psf(id_control, hd_block, & ! if(MHD_ctl%i_mhd_ctl .le. 0) return ! - write(id_control,'(a1)') '!' - 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_surfacing_controls & & (id_control, hd_viz_ctl, add_SMHD_ctl%surfacing_ctls, level) ! call write_dynamo_sects_control & & (id_control, hd_dynamo_viz_ctl, add_SMHD_ctl%zm_sects, level) - level = write_end_flag_for_ctl(id_control, level, hd_block) + level = write_end_flag_for_ctl(id_control, level, & + & MHD_ctl%block_name) ! end subroutine write_sph_mhd_ctl_w_psf ! ! -------------------------------------------------------------------- +! + subroutine init_sph_mhd_ctl_w_psf_label(hd_block, & + & MHD_ctl, add_SMHD_ctl) +! + use ctl_data_platforms_IO + use ctl_data_sph_monitor_IO + use ctl_data_MHD_model_IO + use control_data_surfacing_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_psf_sph_mhd_ctl), intent(inout) :: add_SMHD_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_surfacing_ctl_label(hd_viz_ctl, & + & add_SMHD_ctl%surfacing_ctls) + call init_dynamo_sects_ctl_label(hd_dynamo_viz_ctl, & + & add_SMHD_ctl%zm_sects) + call init_monitor_data_ctl_label(hd_monitor_data, & + & MHD_ctl%nmtr_ctl) +! + end subroutine init_sph_mhd_ctl_w_psf_label +! +! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine dealloc_sph_mhd_ctl_w_psf(add_SMHD_ctl) diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_stratified_model.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_stratified_model.f90 index c756f874..15d74faa 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_stratified_model.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_stratified_model.f90 @@ -8,6 +8,7 @@ !!@n Modified by H. Matsui on Oct., 2007 !! !!@verbatim +!! subroutine init_takepiro_ctl_label(hd_block, takepiro_ctl) !! subroutine read_takepiro_ctl & !! & (id_control, hd_block, takepiro_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -54,6 +55,9 @@ module t_ctl_data_stratified_model ! ! type takepiro_model_control +!> Block name + character(len=kchara) :: block_name = 'low_temp_ctl' +! type(read_real_item) :: stratified_sigma_ctl type(read_real_item) :: stratified_width_ctl type(read_real_item) :: stratified_outer_r_ctl @@ -89,7 +93,8 @@ subroutine read_takepiro_ctl & if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(takepiro_ctl%i_takepiro_t_ctl .gt. 0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_real_ctl_type & @@ -125,20 +130,34 @@ subroutine write_takepiro_ctl & maxlen = max(maxlen, len_trim(hd_strat_width)) maxlen = max(maxlen, len_trim(hd_strat_outer)) ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) -! call write_real_ctl_type(id_control, level, maxlen, & - & hd_strat_sigma, takepiro_ctl%stratified_sigma_ctl) + & takepiro_ctl%stratified_sigma_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_strat_width, takepiro_ctl%stratified_width_ctl) + & takepiro_ctl%stratified_width_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_strat_outer, takepiro_ctl%stratified_outer_r_ctl) + & takepiro_ctl%stratified_outer_r_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_takepiro_ctl ! ! -------------------------------------------------------------------- +! + subroutine init_takepiro_ctl_label(hd_block, takepiro_ctl) + character(len=kchara), intent(in) :: hd_block + type(takepiro_model_control), intent(inout) :: takepiro_ctl +! + takepiro_ctl%block_name = hd_block + call init_real_ctl_item_label & + & (hd_strat_sigma, takepiro_ctl%stratified_sigma_ctl) + call init_real_ctl_item_label & + & (hd_strat_width, takepiro_ctl%stratified_width_ctl) + call init_real_ctl_item_label(hd_strat_outer, & + & takepiro_ctl%stratified_outer_r_ctl) +! + end subroutine init_takepiro_ctl_label +! +! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine reset_takepiro_ctl(takepiro_ctl) diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_surf_boundary.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_surf_boundary.f90 index 22ef92ea..0b2c351d 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_surf_boundary.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_surf_boundary.f90 @@ -108,6 +108,8 @@ module t_ctl_data_surf_boundary ! ! type surf_bc_control +!> Block name + character(len=kchara) :: block_name = 'bc_4_surface' !> Structure for surface boundary conditions for heat flux !!@n surf_bc_HF_ctl%c1_tbl: Type of boundary conditions !!@n surf_bc_HF_ctl%c2_tbl: Surface group name for boundary diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_temp_model.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_temp_model.f90 index de5ca96e..7271ebdd 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_temp_model.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_temp_model.f90 @@ -91,6 +91,9 @@ module t_ctl_data_temp_model ! ! type reference_point_control +!> Block name + character(len=kchara) :: block_name = 'low_temp_ctl' + type(read_real_item) :: value type(read_real_item) :: depth ! @@ -98,6 +101,10 @@ module t_ctl_data_temp_model end type reference_point_control ! type reference_temperature_ctl +!> Block name + character(len=kchara) :: block_name & + & = 'temperature_define' + type(read_character_item) :: filterd_advect_ctl type(read_character_item) :: reference_ctl type(read_character_item) :: stratified_ctl diff --git a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_termal_norm.f90 b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_termal_norm.f90 index 80df41e4..597401c0 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_ctl_data_termal_norm.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_ctl_data_termal_norm.f90 @@ -8,6 +8,8 @@ !>@brief Thermal equation parameters to read !! !!@verbatim +!! subroutine init_thermal_ctl_label(hd_block, heat_ctl) +!! subroutine init_composition_eq_ctl_label(hd_block, comp_ctl) !! subroutine read_thermal_ctl & !! & (id_control, hd_block, heat_ctl, c_buf) !! subroutine read_composition_eq_ctl & @@ -18,11 +20,10 @@ !! type(heat_equation_control), intent(inout) :: comp_ctl !! type(buffer_for_control), intent(inout) :: c_buf !! subroutine write_thermal_ctl & -!! & (id_control, hd_block, heat_ctl, level) +!! & (id_control, heat_ctl, level) !! subroutine write_composition_eq_ctl & -!! & (id_control, hd_block, comp_ctl, level) +!! & (id_control, comp_ctl, level) !! integer(kind = kint), intent(in) :: id_control -!! character(len=kchara), intent(in) :: hd_block !! type(heat_equation_control), intent(in) :: heat_ctl !! type(heat_equation_control), intent(in) :: comp_ctl !! integer(kind = kint), intent(inout) :: level @@ -80,6 +81,8 @@ module t_ctl_data_termal_norm ! !> Structure for coefficients of heat and composition equation type heat_equation_control +!> Block name + character(len=kchara) :: block_name = 'scalar' !> Structure for number and power to construct heat flux !!@n coef_4_adv_flux%c_tbl: Name of number !!@n coef_4_adv_flux%vect: Power of the number @@ -135,10 +138,11 @@ subroutine read_thermal_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(heat_ctl%i_diff_adv .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_c_r(id_control, & @@ -167,10 +171,11 @@ subroutine read_composition_eq_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(comp_ctl%i_diff_adv .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_c_r(id_control, & @@ -187,15 +192,13 @@ end subroutine read_composition_eq_ctl ! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! - subroutine write_thermal_ctl & - & (id_control, hd_block, heat_ctl, level) + subroutine write_thermal_ctl(id_control, heat_ctl, level) ! use t_read_control_elements use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(heat_equation_control), intent(in) :: heat_ctl ! integer(kind = kint), intent(inout) :: level @@ -203,30 +206,28 @@ subroutine write_thermal_ctl & ! if(heat_ctl%i_diff_adv .le. 0) return ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! + level = write_begin_flag_for_ctl(id_control, level, & + & heat_ctl%block_name) call write_control_array_c_r(id_control, level, & - & hd_n_thermal, heat_ctl%coef_4_adv_flux) + & heat_ctl%coef_4_adv_flux) call write_control_array_c_r(id_control, level, & - & hd_n_t_diff, heat_ctl%coef_4_diffuse) + & heat_ctl%coef_4_diffuse) call write_control_array_c_r(id_control, level, & - & hd_n_h_src, heat_ctl%coef_4_source) - level = write_end_flag_for_ctl(id_control, level, hd_block) + & heat_ctl%coef_4_source) + level = write_end_flag_for_ctl(id_control, level, & + & heat_ctl%block_name) ! end subroutine write_thermal_ctl ! ! ----------------------------------------------------------------------- ! - subroutine write_composition_eq_ctl & - & (id_control, hd_block, comp_ctl, level) + subroutine write_composition_eq_ctl(id_control, comp_ctl, level) ! use t_read_control_elements use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(heat_equation_control), intent(in) :: comp_ctl ! integer(kind = kint), intent(inout) :: level @@ -234,20 +235,54 @@ subroutine write_composition_eq_ctl & ! if(comp_ctl%i_diff_adv .le. 0) return ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! + level = write_begin_flag_for_ctl(id_control, level, & + & comp_ctl%block_name) call write_control_array_c_r(id_control, level, & - & hd_n_dscalar, comp_ctl%coef_4_adv_flux) + & comp_ctl%coef_4_adv_flux) call write_control_array_c_r(id_control, level, & - & hd_n_dsc_diff, comp_ctl%coef_4_diffuse) + & comp_ctl%coef_4_diffuse) call write_control_array_c_r(id_control, level, & - & hd_n_dsc_src, comp_ctl%coef_4_source) - level = write_end_flag_for_ctl(id_control, level, hd_block) + & comp_ctl%coef_4_source) + level = write_end_flag_for_ctl(id_control, level, & + & comp_ctl%block_name) ! end subroutine write_composition_eq_ctl ! +! -------------------------------------------------------------------- ! ----------------------------------------------------------------------- +! + subroutine init_thermal_ctl_label(hd_block, heat_ctl) + character(len=kchara), intent(in) :: hd_block + type(heat_equation_control), intent(inout) :: heat_ctl +! + heat_ctl%block_name = trim(hd_block) + call init_c_r_ctl_array_label & + & (hd_n_thermal, heat_ctl%coef_4_adv_flux) + call init_c_r_ctl_array_label & + & (hd_n_t_diff, heat_ctl%coef_4_diffuse) + call init_c_r_ctl_array_label & + & (hd_n_h_src, heat_ctl%coef_4_source) +! + end subroutine init_thermal_ctl_label +! +! ----------------------------------------------------------------------- +! + subroutine init_composition_eq_ctl_label(hd_block, comp_ctl) + character(len=kchara), intent(in) :: hd_block + type(heat_equation_control), intent(inout) :: comp_ctl +! + comp_ctl%block_name = trim(hd_block) + call init_c_r_ctl_array_label & + & (hd_n_dscalar, comp_ctl%coef_4_adv_flux) + call init_c_r_ctl_array_label & + & (hd_n_dsc_diff, comp_ctl%coef_4_diffuse) + call init_c_r_ctl_array_label & + & (hd_n_dsc_src, comp_ctl%coef_4_source) +! + end subroutine init_composition_eq_ctl_label +! +! -------------------------------------------------------------------- +! -------------------------------------------------------------------- ! subroutine dealloc_thermal_ctl(heat_ctl) ! diff --git a/src/Fortran_libraries/MHD_src/IO/t_sph_boundary_input_data.f90 b/src/Fortran_libraries/MHD_src/IO/t_sph_boundary_input_data.f90 index ca781c1e..e8b45b16 100644 --- a/src/Fortran_libraries/MHD_src/IO/t_sph_boundary_input_data.f90 +++ b/src/Fortran_libraries/MHD_src/IO/t_sph_boundary_input_data.f90 @@ -11,8 +11,9 @@ !! subroutine bcast_boundary_spectr_file(bc_IO) !! type(boundary_spectra), intent(inout) :: bc_IO !! -!! subroutine read_boundary_spectr_file(bc_IO) +!! subroutine read_boundary_spectr_file(bc_IO, iend) !! type(boundary_spectra), intent(inout) :: bc_IO +!! integer(kind = kint), intent(inout) :: iend !! subroutine write_boundary_spectr_file(bc_IO) !! type(boundary_spectra), intent(in) :: bc_IO !! @@ -123,12 +124,13 @@ end subroutine bcast_boundary_spectr_file ! ----------------------------------------------------------------------- ! ----------------------------------------------------------------------- ! - subroutine read_boundary_spectr_file(bc_IO) + subroutine read_boundary_spectr_file(bc_IO, iend) ! use m_machine_parameter use skip_comment_f ! type(boundary_spectra), intent(inout) :: bc_IO + integer(kind = kint), intent(inout) :: iend ! integer(kind = kint) :: igrp character(len=255) :: tmpchara @@ -138,14 +140,16 @@ subroutine read_boundary_spectr_file(bc_IO) & trim(bc_IO%file_name) open(id_boundary_file, file=bc_IO%file_name) ! - call skip_comment(tmpchara,id_boundary_file) + call skip_comment(id_boundary_file, tmpchara, iend) + if(iend .gt. 0) return read(tmpchara,*) bc_IO%num_bc_fld ! call alloc_sph_bc_item_ctl(bc_IO) ! do igrp = 1, bc_IO%num_bc_fld call read_each_boundary_spectr & - & (id_boundary_file, bc_IO%ctls(igrp)) + & (id_boundary_file, bc_IO%ctls(igrp), iend) + if(iend .gt. 0) return end do close(id_boundary_file) ! diff --git a/src/Fortran_libraries/MHD_src/sph_MHD/Makefile b/src/Fortran_libraries/MHD_src/sph_MHD/Makefile index a16ef8bb..075be9e5 100644 --- a/src/Fortran_libraries/MHD_src/sph_MHD/Makefile +++ b/src/Fortran_libraries/MHD_src/sph_MHD/Makefile @@ -13,7 +13,9 @@ MOD_SPH_MHD = $(addsuffix .o,$(basename $(SOURCES)) ) dir_list: @echo 'MHD_SPH_DIR = $(MHD_SPH_DIR)' >> $(MAKENAME) -lib_archve: +libtarget: + +lib_archve: libtarget @echo ' $$(AR) $$(ARFLUGS) rcsv $$@ $$(MOD_SPH_MHD)' \ >> $(MAKENAME) diff --git a/src/Fortran_libraries/MHD_src/sph_MHD/Makefile.depends b/src/Fortran_libraries/MHD_src/sph_MHD/Makefile.depends index 2f7eb23a..d9e9e188 100644 --- a/src/Fortran_libraries/MHD_src/sph_MHD/Makefile.depends +++ b/src/Fortran_libraries/MHD_src/sph_MHD/Makefile.depends @@ -166,7 +166,7 @@ initial_magne_dbench_qvc.o: $(MHD_SPH_DIR)/initial_magne_dbench_qvc.f90 m_precis $(F90) -c $(F90OPTFLAGS) $< initial_magne_dynamobench.o: $(MHD_SPH_DIR)/initial_magne_dynamobench.f90 m_precision.o m_constants.o t_phys_address.o t_spheric_rj_data.o $(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 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 sph_file_IO_select.o set_control_4_SPH_to_FEM.o parallel_load_data_4_sph.o +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 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) $< @@ -218,7 +218,7 @@ set_bc_sph_mhd.o: $(MHD_SPH_DIR)/set_bc_sph_mhd.f90 m_precision.o m_machine_para $(F90) -c $(F90OPTFLAGS) $< set_bc_sph_scalars.o: $(MHD_SPH_DIR)/set_bc_sph_scalars.f90 m_precision.o calypso_mpi.o m_constants.o m_error_IDs.o m_machine_parameter.o m_boundary_condition_IDs.o t_spheric_rj_data.o t_group_data.o t_boundary_params_sph_MHD.o t_boundary_sph_spectr.o t_sph_boundary_input_data.o t_bc_data_list.o t_field_labels.o m_base_field_labels.o m_base_force_labels.o set_sph_bc_data_by_file.o $(F90) -c $(F90OPTFLAGS) $< -set_control_4_SPH_to_FEM.o: $(MHD_SPH_DIR)/set_control_4_SPH_to_FEM.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_control_parameter.o t_spheric_parameter.o t_phys_data.o t_sph_boundary_input_data.o t_bc_data_list.o check_read_bc_file.o +set_control_4_SPH_to_FEM.o: $(MHD_SPH_DIR)/set_control_4_SPH_to_FEM.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_control_parameter.o t_spheric_parameter.o t_phys_data.o t_sph_boundary_input_data.o t_bc_data_list.o calypso_mpi_int.o check_read_bc_file.o $(F90) -c $(F90OPTFLAGS) $< set_control_sph_data_MHD.o: $(MHD_SPH_DIR)/set_control_sph_data_MHD.f90 m_precision.o calypso_mpi.o m_error_IDs.o m_machine_parameter.o t_control_parameter.o t_control_array_character3.o t_phys_data.o add_nodal_fields_4_MHD.o add_sph_MHD_fields_2_ctl.o set_control_field_data.o m_file_format_switch.o m_FFT_selector.o m_legendre_transform_list.o t_ctl_data_4_platforms.o t_ctl_data_mhd_evo_scheme.o t_field_data_IO.o t_legendre_trans_select.o t_sph_boundary_input_data.o t_work_4_sph_trans.o skip_comment_f.o sph_mhd_rst_IO_control.o sel_spherical_SRs.o $(F90) -c $(F90OPTFLAGS) $< @@ -234,6 +234,8 @@ set_initial_sph_scalars.o: $(MHD_SPH_DIR)/set_initial_sph_scalars.f90 m_precisio $(F90) -c $(F90OPTFLAGS) $< set_radial_mat_sph.o: $(MHD_SPH_DIR)/set_radial_mat_sph.f90 m_precision.o calypso_mpi.o m_constants.o $(F90) -c $(F90OPTFLAGS) $< +set_reference_scalar_param.o: $(MHD_SPH_DIR)/set_reference_scalar_param.f90 m_precision.o m_error_IDs.o m_machine_parameter.o t_reference_scalar_param.o t_ctl_data_temp_model.o t_file_IO_parameter.o calypso_mpi.o t_control_array_character.o m_file_format_switch.o delete_data_files.o t_ctl_data_stratified_model.o + $(F90) -c $(F90OPTFLAGS) $< set_reference_sph_mhd.o: $(MHD_SPH_DIR)/set_reference_sph_mhd.f90 m_precision.o m_constants.o calypso_mpi.o t_phys_address.o t_boundary_params_sph_MHD.o t_boundary_sph_spectr.o $(F90) -c $(F90OPTFLAGS) $< set_scalar_boundary_sph.o: $(MHD_SPH_DIR)/set_scalar_boundary_sph.f90 m_precision.o m_constants.o @@ -346,7 +348,7 @@ t_radial_matrices_sph_MHD.o: $(MHD_SPH_DIR)/t_radial_matrices_sph_MHD.f90 m_prec $(F90) -c $(F90OPTFLAGS) $< t_radial_reference_field.o: $(MHD_SPH_DIR)/t_radial_reference_field.f90 m_precision.o m_constants.o t_spheric_rj_data.o t_phys_data.o t_phys_address.o t_base_field_labels.o t_grad_field_labels.o t_field_component_labels.o t_file_IO_parameter.o t_sph_radial_interpolate.o t_field_data_IO.o m_base_field_labels.o m_grad_field_labels.o m_field_component_labels.o append_phys_data.o interpolate_reference_data.o init_external_magne_sph.o $(F90) -c $(F90OPTFLAGS) $< -t_reference_scalar_param.o: $(MHD_SPH_DIR)/t_reference_scalar_param.f90 m_precision.o m_error_IDs.o m_machine_parameter.o t_ctl_data_temp_model.o t_file_IO_parameter.o calypso_mpi.o t_control_array_character.o m_file_format_switch.o delete_data_files.o t_ctl_data_stratified_model.o +t_reference_scalar_param.o: $(MHD_SPH_DIR)/t_reference_scalar_param.f90 m_precision.o m_error_IDs.o m_machine_parameter.o t_file_IO_parameter.o t_control_array_character.o $(F90) -c $(F90OPTFLAGS) $< t_sph_MHD_w_psf.o: $(MHD_SPH_DIR)/t_sph_MHD_w_psf.f90 m_precision.o t_FEM_mesh_field_data.o t_SPH_MHD_zmean_sections.o t_viz_sections.o t_comm_table.o $(F90) -c $(F90OPTFLAGS) $< @@ -366,7 +368,7 @@ test_legendre_transforms.o: $(MHD_SPH_DIR)/test_legendre_transforms.F90 m_precis $(F90) -c $(F90OPTFLAGS) $(F90CPPFLAGS) $< write_dynamo_benchmark_file.o: $(MHD_SPH_DIR)/write_dynamo_benchmark_file.f90 m_precision.o m_constants.o calypso_mpi.o t_spheric_parameter.o t_spheric_rj_data.o t_boundary_data_sph_MHD.o t_boundary_params_sph_MHD.o t_phys_address.o t_base_field_labels.o t_sph_volume_mean_square.o t_field_4_dynamobench.o t_field_on_circle.o t_read_sph_spectra.o t_time_data.o write_monitors_circle_file.o t_buffer_4_gzip.o set_parallel_file_name.o sph_monitor_data_text.o gz_open_sph_vol_mntr_file.o select_gz_stream_file_IO.o dup_dynamobench_data_to_IO.o dup_detailed_dbench_to_IO.o $(F90) -c $(F90OPTFLAGS) $< -write_monitors_circle_file.o: $(MHD_SPH_DIR)/write_monitors_circle_file.f90 m_precision.o m_constants.o t_spheric_parameter.o t_time_data.o t_phys_data.o t_phys_address.o t_base_field_labels.o t_read_sph_spectra.o t_field_on_circle.o t_circle_transform.o t_sph_circle_parameters.o t_FFT_selector.o t_buffer_4_gzip.o set_parallel_file_name.o sph_monitor_data_text.o gz_open_sph_layer_mntr_file.o gz_layer_mean_monitor_IO.o dup_fields_on_circle_to_IO.o sel_open_sph_fld_on_circle.o gz_volume_spectr_monitor_IO.o +write_monitors_circle_file.o: $(MHD_SPH_DIR)/write_monitors_circle_file.f90 m_precision.o m_constants.o t_spheric_parameter.o t_time_data.o t_phys_data.o t_phys_address.o t_base_field_labels.o t_read_sph_spectra.o t_field_on_circle.o t_circle_transform.o t_sph_circle_parameters.o t_FFT_selector.o t_buffer_4_gzip.o set_parallel_file_name.o sph_monitor_data_text.o gz_open_sph_layer_mntr_file.o gz_layer_mean_monitor_IO.o dup_fields_on_circle_to_IO.o sel_open_sph_fld_on_circle.o skip_comment_f.o gz_volume_spectr_monitor_IO.o $(F90) -c $(F90OPTFLAGS) $< write_typical_scale.o: $(MHD_SPH_DIR)/write_typical_scale.f90 m_precision.o m_constants.o calypso_mpi.o t_sph_typical_scales.o t_field_labels.o t_phys_data.o t_spheric_parameter.o t_spheric_rj_data.o t_boundary_params_sph_MHD.o t_buffer_4_gzip.o t_rms_4_sph_spectr.o t_read_sph_spectra.o t_sph_volume_mean_square.o sph_monitor_data_text.o select_gz_stream_file_IO.o gz_open_sph_vol_mntr_file.o set_parallel_file_name.o check_sph_monitor_header.o compare_sph_monitor_header.o sph_power_spectr_data_text.o sel_gz_input_sph_mtr_head.o $(F90) -c $(F90OPTFLAGS) $< diff --git a/src/Fortran_libraries/MHD_src/sph_MHD/add_prod_field_4_sph_trns.f90 b/src/Fortran_libraries/MHD_src/sph_MHD/add_prod_field_4_sph_trns.f90 index 073f9b31..28b9c7e5 100644 --- a/src/Fortran_libraries/MHD_src/sph_MHD/add_prod_field_4_sph_trns.f90 +++ b/src/Fortran_libraries/MHD_src/sph_MHD/add_prod_field_4_sph_trns.f90 @@ -214,6 +214,12 @@ subroutine add_field_comps_sph_trns_snap & & ipol_cmp%i_velo_s, iphys_cmp%i_velo_s, & & f_trns_cmp%i_velo_s, trns) call add_field_name_4_sph_trns_snap(d_rj, & + & ipol_cmp%i_velo_x, iphys_cmp%i_velo_x, & + & f_trns_cmp%i_velo_x, trns) + call add_field_name_4_sph_trns_snap(d_rj, & + & ipol_cmp%i_velo_y, iphys_cmp%i_velo_y, & + & f_trns_cmp%i_velo_y, trns) + call add_field_name_4_sph_trns_snap(d_rj, & & ipol_cmp%i_velo_z, iphys_cmp%i_velo_z, & & f_trns_cmp%i_velo_z, trns) ! diff --git a/src/Fortran_libraries/MHD_src/sph_MHD/get_components_from_field.f90 b/src/Fortran_libraries/MHD_src/sph_MHD/get_components_from_field.f90 index 0670eedc..d8ad555a 100644 --- a/src/Fortran_libraries/MHD_src/sph_MHD/get_components_from_field.f90 +++ b/src/Fortran_libraries/MHD_src/sph_MHD/get_components_from_field.f90 @@ -86,6 +86,18 @@ subroutine get_components_from_fld & & fld_rtp(1,b_trns_base%i_velo), & & frc_rtp(1,fs_trns_cmp%i_velo_s)) end if +! + if(fs_trns_cmp%i_velo_x .gt. 0) then + call cal_x_comp_sph_smp(sph_rtp, leg, & + & fld_rtp(1,b_trns_base%i_velo), & + & frc_rtp(1,fs_trns_cmp%i_velo_x)) + end if +! + if(fs_trns_cmp%i_velo_y .gt. 0) then + call cal_y_comp_sph_smp(sph_rtp, leg, & + & fld_rtp(1,b_trns_base%i_velo), & + & frc_rtp(1,fs_trns_cmp%i_velo_y)) + end if ! if(fs_trns_cmp%i_velo_z .gt. 0) then call cal_z_comp_sph_smp(sph_rtp, leg, & @@ -117,6 +129,18 @@ subroutine get_components_from_fld & & fld_rtp(1,b_trns_base%i_magne), & & frc_rtp(1,fs_trns_cmp%i_magne_s)) end if +! + if(fs_trns_cmp%i_magne_x .gt. 0) then + call cal_x_comp_sph_smp(sph_rtp, leg, & + & fld_rtp(1,b_trns_base%i_magne), & + & frc_rtp(1,fs_trns_cmp%i_magne_x)) + end if +! + if(fs_trns_cmp%i_magne_y .gt. 0) then + call cal_y_comp_sph_smp(sph_rtp, leg, & + & fld_rtp(1,b_trns_base%i_magne), & + & frc_rtp(1,fs_trns_cmp%i_magne_y)) + end if ! if(fs_trns_cmp%i_magne_z .gt. 0) then call cal_z_comp_sph_smp(sph_rtp, leg, & @@ -157,6 +181,76 @@ subroutine cal_cyl_r_comp_sph_smp(sph_rtp, leg, v_sph, v_s) end subroutine cal_cyl_r_comp_sph_smp ! ! ----------------------------------------------------------------------- +! + subroutine cal_x_comp_sph_smp(sph_rtp, leg, v_sph, v_x) +! + type(sph_rtp_grid), intent(in) :: sph_rtp + type(legendre_4_sph_trans), intent(in) :: leg + real(kind = kreal), intent(in) :: v_sph(sph_rtp%nnod_rtp,3) +! + real(kind = kreal), intent(inout) :: v_x(sph_rtp%nnod_rtp) +! + integer (kind=kint) :: iproc, inod, ist, ied, l, m + real(kind = kreal) :: amphi +! +! + amphi = 8.0d0 * atan(one) / dble(sph_rtp%nidx_rtp(3)) +!$omp do private(l,m,ist,ied,inod) + do iproc = 1, np_smp + ist = sph_rtp%istack_inod_rtp_smp(iproc-1) + 1 + ied = sph_rtp%istack_inod_rtp_smp(iproc) +! +!cdir nodep + do inod = ist, ied + l = sph_rtp%idx_global_rtp(inod,2) + m = sph_rtp%idx_global_rtp(inod,3) + v_x(inod) = v_sph(inod,1) * sin(leg%g_colat_rtm(l)) & + & * cos(dble(m-1) * amphi) & + & + v_sph(inod,2) * cos(leg%g_colat_rtm(l)) & + & * cos(dble(m-1) * amphi) & + & - v_sph(inod,3) * sin(dble(m-1) * amphi) + end do + end do +!$omp end do nowait +! + end subroutine cal_x_comp_sph_smp +! +! ----------------------------------------------------------------------- +! + subroutine cal_y_comp_sph_smp(sph_rtp, leg, v_sph, v_y) +! + type(sph_rtp_grid), intent(in) :: sph_rtp + type(legendre_4_sph_trans), intent(in) :: leg + real(kind = kreal), intent(in) :: v_sph(sph_rtp%nnod_rtp,3) +! + real(kind = kreal), intent(inout) :: v_y(sph_rtp%nnod_rtp) +! + integer (kind=kint) :: iproc, inod, ist, ied, l, m + real(kind = kreal) :: amphi +! +! + amphi = 8.0d0 * atan(one) / dble(sph_rtp%nidx_rtp(3)) +!$omp do private(l,m,ist,ied,inod) + do iproc = 1, np_smp + ist = sph_rtp%istack_inod_rtp_smp(iproc-1) + 1 + ied = sph_rtp%istack_inod_rtp_smp(iproc) +! +!cdir nodep + do inod = ist, ied + l = sph_rtp%idx_global_rtp(inod,2) + m = sph_rtp%idx_global_rtp(inod,3) + v_y(inod) = v_sph(inod,1) * sin(leg%g_colat_rtm(l)) & + & * sin(dble(m-1) * amphi) & + & + v_sph(inod,2) * cos(leg%g_colat_rtm(l)) & + & * sin(dble(m-1) * amphi) & + & + v_sph(inod,3) * cos(dble(m-1) * amphi) + end do + end do +!$omp end do nowait +! + end subroutine cal_y_comp_sph_smp +! +! ----------------------------------------------------------------------- ! subroutine cal_z_comp_sph_smp(sph_rtp, leg, v_sph, v_z) ! diff --git a/src/Fortran_libraries/MHD_src/sph_MHD/input_control_sph_MHD.f90 b/src/Fortran_libraries/MHD_src/sph_MHD/input_control_sph_MHD.f90 index df5c732e..951d4603 100644 --- a/src/Fortran_libraries/MHD_src/sph_MHD/input_control_sph_MHD.f90 +++ b/src/Fortran_libraries/MHD_src/sph_MHD/input_control_sph_MHD.f90 @@ -71,6 +71,7 @@ subroutine load_control_4_sph_MHD_w_psf(file_name, MHD_ctl, & ! use t_ctl_data_MHD use t_ctl_data_sph_MHD_w_psf + use t_read_control_elements use bcast_control_sph_MHD use bcast_ctl_data_surfacings use bcast_dynamo_sect_control @@ -79,10 +80,17 @@ subroutine load_control_4_sph_MHD_w_psf(file_name, MHD_ctl, & type(mhd_simulation_control), intent(inout) :: MHD_ctl type(add_psf_sph_mhd_ctl), intent(inout) :: add_SMHD_ctl ! + type(buffer_for_control) :: c_buf1 ! +! + c_buf1%level = 0 if(my_rank .eq. 0) then call read_control_4_sph_MHD_w_psf(file_name, MHD_ctl, & - & add_SMHD_ctl) + & add_SMHD_ctl, c_buf1) + end if +! + if(c_buf1%iend .gt. 0) then + call calypso_MPI_abort(MHD_ctl%i_mhd_ctl, trim(file_name)) end if ! call bcast_sph_mhd_control_data(MHD_ctl) @@ -101,12 +109,19 @@ subroutine load_control_4_sph_MHD_noviz(file_name, MHD_ctl) character(len=kchara), intent(in) :: file_name type(mhd_simulation_control), intent(inout) :: MHD_ctl ! + type(buffer_for_control) :: c_buf1 ! +! + c_buf1%level = 0 if(my_rank .eq. 0) then - call read_control_4_sph_MHD_noviz(file_name, MHD_ctl) + call read_control_4_sph_MHD_noviz(file_name, MHD_ctl, c_buf1) end if ! call bcast_sph_mhd_control_data(MHD_ctl) +! + if(c_buf1%level .gt. 0) then + call calypso_MPI_abort(MHD_ctl%i_mhd_ctl, trim(file_name)) + end if ! end subroutine load_control_4_sph_MHD_noviz ! diff --git a/src/Fortran_libraries/MHD_src/sph_MHD/radial_reference_field_IO.f90 b/src/Fortran_libraries/MHD_src/sph_MHD/radial_reference_field_IO.f90 index 94eb800d..3d03b4d2 100644 --- a/src/Fortran_libraries/MHD_src/sph_MHD/radial_reference_field_IO.f90 +++ b/src/Fortran_libraries/MHD_src/sph_MHD/radial_reference_field_IO.f90 @@ -124,6 +124,7 @@ subroutine load_sph_reference_fields(refs) type(radial_reference_field), intent(inout) :: refs ! type(time_data) :: time_IO + integer(kind = kint) :: iend integer(kind = kint_gl) :: num64 ! ! @@ -131,7 +132,9 @@ subroutine load_sph_reference_fields(refs) if(refs%ref_input_IO%iflag_IO .eq. 0) return if(my_rank .eq. 0) then call read_and_alloc_step_field(refs%ref_input_IO%file_prefix, & - & my_rank, time_IO, refs%ref_fld_IO) + & my_rank, time_IO, refs%ref_fld_IO, iend) + if(iend .gt. 0) call calypso_mpi_abort(iend, & + & 'Read file failed') ! call interpolate_ref_fields_IO(radius_name, & & refs%iref_radius, refs%ref_fld_IO, & @@ -172,6 +175,7 @@ subroutine load_sph_reference_one_field & type(phys_data), intent(inout) :: ref_field ! type(time_data) :: time_IO + integer(kind = kint) :: iend integer(kind = kint_gl) :: num64 ! ! @@ -179,7 +183,9 @@ subroutine load_sph_reference_one_field & if(ref_file_IO%iflag_IO .eq. 0) return if(my_rank .eq. 0) then call read_and_alloc_step_field(ref_file_IO%file_prefix, & - & my_rank, time_IO, ref_fld_IO) + & my_rank, time_IO, ref_fld_IO, iend) + if(iend .gt. 0) call calypso_mpi_abort(iend, & + & 'Read file failed') ! call interpolate_one_ref_field_IO(radius_name, & & iref_radius, phys_name, iref_in, ncomp, ref_fld_IO, & diff --git a/src/Fortran_libraries/MHD_src/sph_MHD/set_control_4_SPH_to_FEM.f90 b/src/Fortran_libraries/MHD_src/sph_MHD/set_control_4_SPH_to_FEM.f90 index 03db8dd6..539ebbee 100644 --- a/src/Fortran_libraries/MHD_src/sph_MHD/set_control_4_SPH_to_FEM.f90 +++ b/src/Fortran_libraries/MHD_src/sph_MHD/set_control_4_SPH_to_FEM.f90 @@ -37,20 +37,25 @@ module set_control_4_SPH_to_FEM ! subroutine sph_boundary_IO_control(MHD_prop, MHD_BC, bc_IO) ! + use calypso_mpi_int use check_read_bc_file ! type(MHD_evolution_param), intent(in) :: MHD_prop type(MHD_BC_lists), intent(in) :: MHD_BC type(boundary_spectra), intent(inout) :: bc_IO ! - integer(kind = kint) :: iflag + integer(kind = kint) :: iflag, iend ! ! iflag = check_read_boundary_files(MHD_prop, MHD_BC) if (iflag .eq. id_no_boundary_file) return ! - if (iflag_debug.eq.1) write(*,*) 'read_boundary_spectr_file' - if(my_rank .eq. 0) call read_boundary_spectr_file(bc_IO) + if(iflag_debug .gt. 0) write(*,*) 'read_boundary_spectr_file' + if(my_rank .eq. 0) call read_boundary_spectr_file(bc_IO, iend) + call calypso_mpi_bcast_one_int(iend, 0) + if(iend .gt. 0) call calypso_MPI_abort(iend, & + & 'Boundary condition file is broken') +! call bcast_boundary_spectr_file(bc_IO) ! end subroutine sph_boundary_IO_control diff --git a/src/Fortran_libraries/MHD_src/sph_MHD/set_control_sph_mhd.f90 b/src/Fortran_libraries/MHD_src/sph_MHD/set_control_sph_mhd.f90 index 8cf57fff..322bfcb3 100644 --- a/src/Fortran_libraries/MHD_src/sph_MHD/set_control_sph_mhd.f90 +++ b/src/Fortran_libraries/MHD_src/sph_MHD/set_control_sph_mhd.f90 @@ -410,8 +410,7 @@ subroutine set_control_SPH_MHD_monitors(smonitor_ctl, & & (smonitor_ctl%typ_scale_file_prefix_ctl, & & smonitor_ctl%typ_scale_file_format_ctl, rj_fld, monitor%tsl) ! - call set_control_circles_def(smonitor_ctl%circ_ctls, & - & monitor%mul_circle) + call set_control_circles_def(smonitor_ctl, monitor%mul_circle) ! end subroutine set_control_SPH_MHD_monitors ! diff --git a/src/Fortran_libraries/MHD_src/sph_MHD/set_reference_scalar_param.f90 b/src/Fortran_libraries/MHD_src/sph_MHD/set_reference_scalar_param.f90 new file mode 100644 index 00000000..67c4c5d4 --- /dev/null +++ b/src/Fortran_libraries/MHD_src/sph_MHD/set_reference_scalar_param.f90 @@ -0,0 +1,242 @@ +!>@file set_reference_scalar_param.f90 +!!@brief module set_reference_scalar_param +!! +!!@author H. Matsui and H. Okuda +!!@date Programmed by H. Okuda in 2000 +!!@n Mmodified by H. Matsui in 2001 +!!@n Mmodified by H. Matsui in Aug., 2007 +!!@n Mmodified by H. Matsui in Jan, 2017 +! +!> @brief set reference fields for MHD simulation from control data +!! +!!@verbatim +!! subroutine set_reference_scalar_ctl & +!! & (charaflag, ref_ctl, ref_param, takepiro) +!! type(read_character_item), intent(in) :: ref_temp_ctl +!! type(read_character_item), intent(in) :: stratified_ctl +!! type(reference_point_control), intent(in) :: low_temp_ctl +!! type(reference_point_control), intent(in) :: high_temp_ctl +!! type(reference_point_control), intent(in) :: takepiro_ctl +!! type(reference_scalar_param), intent(inout) :: ref_param +!! type(takepiro_model_param), intent(inout) :: takepiro +!!@endverbatim +! + module set_reference_scalar_param +! + use m_precision + use m_error_IDs +! + use m_machine_parameter +! + use t_reference_scalar_param + use t_ctl_data_temp_model + use t_file_IO_parameter +! + implicit none +! + private :: set_linear_ref_scalar_ctl, set_takepiro_scalar_ctl +! +! ----------------------------------------------------------------------- +! + contains +! +! ----------------------------------------------------------------------- +! + subroutine set_reference_scalar_ctl & + & (charaflag, ref_ctl, ref_param, takepiro) +! + use calypso_mpi + use t_ctl_data_temp_model +! + character(len = kchara), intent(in) :: charaflag + type(reference_temperature_ctl), intent(in) :: ref_ctl +! + type(reference_scalar_param), intent(inout) :: ref_param + type(takepiro_model_param), intent(inout) :: takepiro +! +! + if(iflag_debug .ge. iflag_routine_msg) write(*,*) trim(charaflag) +!z + call set_linear_ref_scalar_ctl & + & (ref_ctl%reference_ctl, ref_ctl%ref_file_ctl, & + & ref_ctl%low_ctl, ref_ctl%high_ctl, ref_param) + call set_takepiro_scalar_ctl & + & (ref_ctl%stratified_ctl, ref_ctl%takepiro_ctl, & + & ref_param%iflag_reference, takepiro) +! + end subroutine set_reference_scalar_ctl +! +! ----------------------------------------------------------------------- +! ----------------------------------------------------------------------- +! + subroutine set_linear_ref_scalar_ctl(ref_temp_ctl, ref_file_ctl, & + & low_temp_ctl, high_temp_ctl, ref_param) +! + use calypso_mpi + use t_control_array_character + use m_file_format_switch + use m_error_IDs + use delete_data_files +! + type(read_character_item), intent(in) :: ref_temp_ctl + type(read_character_item), intent(in) :: ref_file_ctl + type(reference_point_control), intent(in) :: low_temp_ctl + type(reference_point_control), intent(in) :: high_temp_ctl +! + type(reference_scalar_param), intent(inout) :: ref_param +! + integer (kind = kint) :: iflag + character(len=kchara) :: tmpchara +! +! set control for temperature +! + if (ref_temp_ctl%iflag .eq. 0) then + ref_param%iflag_reference = id_no_ref_temp + else + tmpchara = ref_temp_ctl%charavalue + if (cmp_no_case(tmpchara, label_sph_shell)) then + ref_param%iflag_reference = id_sphere_ref_temp + else if (cmp_no_case(tmpchara, label_takepiro)) then + ref_param%iflag_reference = id_takepiro_temp + else if (cmp_no_case(tmpchara, label_sph_const_heat)) then + ref_param%iflag_reference = id_linear_r_ref_temp + else if (cmp_no_case(tmpchara, label_linear_x)) then + ref_param%iflag_reference = id_x_ref_temp + else if (cmp_no_case(tmpchara, label_linear_y)) then + ref_param%iflag_reference = id_y_ref_temp + else if (cmp_no_case(tmpchara, label_linear_z)) then + ref_param%iflag_reference = id_z_ref_temp + else if (cmp_no_case(tmpchara, label_get_numerical)) then + ref_param%iflag_reference = id_numerical_solution + else if (cmp_no_case(tmpchara, label_load_file)) then + ref_param%iflag_reference = id_read_file + end if + end if +! + ref_param%flag_ref_field = .FALSE. + if (ref_param%iflag_reference .eq. id_sphere_ref_temp & + & .or. ref_param%iflag_reference .eq. id_takepiro_temp & + & .or. ref_param%iflag_reference .eq. id_numerical_solution & + & .or. ref_param%iflag_reference .eq. id_read_file & + & ) ref_param%flag_ref_field = .TRUE. +! + if(ref_param%iflag_reference .eq. id_read_file) then + ref_param%ref_file_IO%iflag_IO = 0 + ref_param%ref_file_IO%iflag_format = id_ascii_file_fmt + if(ref_file_ctl%iflag .le. 0) then + call calypso_mpi_abort(ierr_file, 'Set reference field file') + else + ref_param%ref_file_IO%file_prefix = ref_file_ctl%charavalue +! + if(check_file_exist(ref_param%ref_file_IO%file_prefix) & + & .eqv. .FALSE.) then + write(e_message,*) 'File ', & + & ref_param%ref_file_IO%file_prefix, ' is missing.' + call calypso_mpi_abort(ierr_file, e_message) + end if + end if + end if +! + iflag = low_temp_ctl%depth%iflag*low_temp_ctl%value%iflag + if (iflag .eq. 0) then + if( ref_param%iflag_reference .eq. id_no_ref_temp & + & .or. ref_param%iflag_reference .eq. id_numerical_solution & + & ) then + ref_param%low_value = 0.0d0 + ref_param%depth_top = 0.0d0 + else + e_message & + & = 'Set lower temperature and its position' + call calypso_MPI_abort(ierr_fld, e_message) + end if + else + ref_param%low_value = low_temp_ctl%value%realvalue + ref_param%depth_top = low_temp_ctl%depth%realvalue + end if +! + iflag = high_temp_ctl%depth%iflag*high_temp_ctl%value%iflag + if (iflag .eq. 0) then + if( ref_param%iflag_reference .eq. id_no_ref_temp & + & .or. ref_param%iflag_reference .eq. id_numerical_solution & + & ) then + ref_param%high_value = 0.0d0 + ref_param%depth_bottom = 0.0d0 + else + e_message & + & = 'Set lower temperature and its position' + call calypso_MPI_abort(ierr_fld, e_message) + end if + else + ref_param%high_value = high_temp_ctl%value%realvalue + ref_param%depth_bottom = high_temp_ctl%depth%realvalue + end if +! + if (iflag_debug .ge. iflag_routine_msg) then + write(*,*) 'iflag_reference ', ref_param%iflag_reference + write(*,*) 'low_value ', ref_param%low_value + write(*,*) 'high_value ', ref_param%high_value + write(*,*) 'depth_top ', ref_param%depth_top + write(*,*) 'depth_bottom ', ref_param%depth_bottom + end if +! + end subroutine set_linear_ref_scalar_ctl +! +! ----------------------------------------------------------------------- +! + subroutine set_takepiro_scalar_ctl & + & (stratified_ctl, takepiro_ctl, iflag_ref, takepiro) +! + use calypso_mpi + use t_ctl_data_temp_model + use t_ctl_data_stratified_model + use t_control_array_character +! + type(read_character_item), intent(in) :: stratified_ctl + type(takepiro_model_control), intent(in) :: takepiro_ctl +! + integer(kind = kint), intent(inout) :: iflag_ref + type(takepiro_model_param), intent(inout) :: takepiro +! + integer (kind = kint) :: iflag +! +! set control for Takepiro model +! + if (stratified_ctl%iflag .gt. id_turn_OFF & + .and. yes_flag(stratified_ctl%charavalue)) then + iflag_ref = id_takepiro_temp + end if +! + if (iflag_ref .eq. id_takepiro_temp) then + iflag = takepiro_ctl%stratified_sigma_ctl%iflag & + & *takepiro_ctl%stratified_width_ctl%iflag & + & *takepiro_ctl%stratified_outer_r_ctl%iflag + if(iflag .eq. 0) then + e_message & + & = 'Set parameteres for stratification' + call calypso_MPI_abort(ierr_fld, e_message) + else + takepiro%stratified_sigma & + & = takepiro_ctl%stratified_sigma_ctl%realvalue + takepiro%stratified_width & + & = takepiro_ctl%stratified_width_ctl%realvalue + takepiro%stratified_outer_r & + & = takepiro_ctl%stratified_outer_r_ctl%realvalue + end if + else + takepiro%stratified_sigma = 0.0d0 + takepiro%stratified_width = 0.0d0 + takepiro%stratified_outer_r = 0.0d0 + end if +! + if (iflag_debug .ge. iflag_routine_msg) then + write(*,*) 'iflag_stratified ', iflag_ref + write(*,*) 'stratified_sigma ', takepiro%stratified_sigma + write(*,*) 'stratified_width ', takepiro%stratified_width + write(*,*) 'stratified_outer_r ', takepiro%stratified_outer_r + end if +! + end subroutine set_takepiro_scalar_ctl +! +! ----------------------------------------------------------------------- +! + end module set_reference_scalar_param diff --git a/src/Fortran_libraries/MHD_src/sph_MHD/t_each_sph_boundary_IO_data.f90 b/src/Fortran_libraries/MHD_src/sph_MHD/t_each_sph_boundary_IO_data.f90 index 4a0ddaf3..1222bc9a 100644 --- a/src/Fortran_libraries/MHD_src/sph_MHD/t_each_sph_boundary_IO_data.f90 +++ b/src/Fortran_libraries/MHD_src/sph_MHD/t_each_sph_boundary_IO_data.f90 @@ -12,8 +12,9 @@ !! subroutine dealloc_each_bc_item_ctl(bc_ctls) !! type(each_boundary_spectr), intent(inout) :: bc_ctls !! -!! subroutine read_each_boundary_spectr(id_file, bc_ctls) +!! subroutine read_each_boundary_spectr(id_file, bc_ctls, iend) !! type(each_boundary_spectr), intent(inout) :: bc_ctls +!! integer(kind = kint), intent(inout) :: iend !! subroutine write_each_boundary_spectr(id_file, bc_ctls) !! type(each_boundary_spectr), intent(in) :: bc_ctls !! @@ -139,7 +140,7 @@ end subroutine bcast_each_bc_item_ctl ! ----------------------------------------------------------------------- ! ----------------------------------------------------------------------- ! - subroutine read_each_boundary_spectr(id_file, bc_ctls) + subroutine read_each_boundary_spectr(id_file, bc_ctls, iend) ! use m_machine_parameter use set_sph_boundary_from_file @@ -147,23 +148,30 @@ subroutine read_each_boundary_spectr(id_file, bc_ctls) ! integer(kind = kint), intent(in) :: id_file type(each_boundary_spectr), intent(inout) :: bc_ctls + integer(kind = kint), intent(inout) :: iend ! integer(kind = kint) :: inum character(len=255) :: tmpchara ! ! - call skip_comment(tmpchara,id_file) + call skip_comment(id_file, tmpchara, iend) + if(iend .gt. 0) return read(tmpchara,*) bc_ctls%bc_field - call skip_comment(tmpchara,id_file) +! + call skip_comment(id_file, tmpchara, iend) + if(iend .gt. 0) return read(tmpchara,*) bc_ctls%bc_group - call skip_comment(tmpchara,id_file) +! + call skip_comment(id_file, tmpchara, iend) + if(iend .gt. 0) return read(tmpchara,*) bc_ctls%num_bc_mode ! bc_ctls%ncomp_bc = num_comp_bc_data(bc_ctls%bc_field) call alloc_each_bc_item_ctl(bc_ctls) ! do inum = 1, bc_ctls%num_bc_mode - call skip_comment(tmpchara,id_file) + call skip_comment(id_file, tmpchara, iend) + if(iend .gt. 0) return read(tmpchara,*) bc_ctls%imode_gl(1:2,inum), & & bc_ctls%bc_input(inum,1:bc_ctls%ncomp_bc) end do diff --git a/src/Fortran_libraries/MHD_src/sph_MHD/t_field_on_circle.f90 b/src/Fortran_libraries/MHD_src/sph_MHD/t_field_on_circle.f90 index 7604e231..c13ecbf6 100644 --- a/src/Fortran_libraries/MHD_src/sph_MHD/t_field_on_circle.f90 +++ b/src/Fortran_libraries/MHD_src/sph_MHD/t_field_on_circle.f90 @@ -11,8 +11,8 @@ !! subroutine dealloc_mul_fields_on_circle(mul_circle) !! integer(kind = kint), intent(in) :: num_circle !! type(mul_fields_on_circle), intent(inout) :: mul_circle -!! subroutine set_control_circles_def(circ_ctls, mul_circle) -!! type(data_on_circles_ctl), intent(in) :: circ_ctls +!! subroutine set_control_circles_def(smonitor_ctl, mul_circle) +!! type(sph_monitor_control), intent(in) :: smonitor_ctl !! type(mul_fields_on_circle), intent(inout) :: mul_circle !! !! subroutine init_circle_point_global(sph, comms_sph, trans_p, & @@ -100,20 +100,20 @@ end subroutine dealloc_mul_fields_on_circle ! ! ---------------------------------------------------------------------- ! - subroutine set_control_circles_def(circ_ctls, mul_circle) + subroutine set_control_circles_def(smonitor_ctl, mul_circle) ! use t_ctl_data_circles ! - type(data_on_circles_ctl), intent(in) :: circ_ctls + type(sph_monitor_control), intent(in) :: smonitor_ctl type(mul_fields_on_circle), intent(inout) :: mul_circle ! integer(kind = kint) :: i ! - call alloc_mul_fields_on_circle(circ_ctls%num_circ_ctl, & + call alloc_mul_fields_on_circle(smonitor_ctl%num_circ_ctl, & & mul_circle) ! do i = 1, mul_circle%num_circles - call set_control_circle_def(circ_ctls%meq_ctl(i), & + call set_control_circle_def(smonitor_ctl%meq_ctl(i), & & mul_circle%cdat(i)%circle) end do ! diff --git a/src/Fortran_libraries/MHD_src/sph_MHD/t_physical_property.f90 b/src/Fortran_libraries/MHD_src/sph_MHD/t_physical_property.f90 index 07ebbb23..16d222ca 100644 --- a/src/Fortran_libraries/MHD_src/sph_MHD/t_physical_property.f90 +++ b/src/Fortran_libraries/MHD_src/sph_MHD/t_physical_property.f90 @@ -11,9 +11,6 @@ !! subroutine alloc_force_list(num, fl_prop) !! subroutine dealloc_force_list(fl_prop) !! type(fluid_property), intent(inout) :: fl_prop -!! subroutine set_reference_scalar_ctl(ref_ctl, scl_prop) -!! type(reference_temperature_ctl), intent(in) :: ref_ctl -!! type(scalar_property), intent(inout) :: scl_prop !!@endverbatim ! module t_physical_property diff --git a/src/Fortran_libraries/MHD_src/sph_MHD/t_reference_scalar_param.f90 b/src/Fortran_libraries/MHD_src/sph_MHD/t_reference_scalar_param.f90 index 256012c4..f9e30e32 100644 --- a/src/Fortran_libraries/MHD_src/sph_MHD/t_reference_scalar_param.f90 +++ b/src/Fortran_libraries/MHD_src/sph_MHD/t_reference_scalar_param.f90 @@ -31,8 +31,6 @@ module t_reference_scalar_param use m_error_IDs ! use m_machine_parameter -! - use t_ctl_data_temp_model use t_file_IO_parameter ! implicit none @@ -58,6 +56,7 @@ module t_reference_scalar_param integer (kind=kint), parameter :: id_takepiro_temp = 1000 ! ! + character(len = kchara), parameter :: label_none = 'none' character(len = kchara), parameter & & :: label_sph_shell = 'spherical_shell' character(len = kchara), parameter & @@ -99,8 +98,6 @@ module t_reference_scalar_param !> Parameter for stratified layer (radius) real (kind=kreal) :: stratified_outer_r end type takepiro_model_param -! - private :: set_linear_ref_scalar_ctl, set_takepiro_scalar_ctl ! ! ----------------------------------------------------------------------- ! @@ -108,200 +105,35 @@ module t_reference_scalar_param ! ! ----------------------------------------------------------------------- ! - subroutine set_reference_scalar_ctl & - & (charaflag, ref_ctl, ref_param, takepiro) -! - use calypso_mpi - use t_ctl_data_temp_model -! - character(len = kchara), intent(in) :: charaflag - type(reference_temperature_ctl), intent(in) :: ref_ctl -! - type(reference_scalar_param), intent(inout) :: ref_param - type(takepiro_model_param), intent(inout) :: takepiro -! -! - if(iflag_debug .ge. iflag_routine_msg) write(*,*) trim(charaflag) -!z - call set_linear_ref_scalar_ctl & - & (ref_ctl%reference_ctl, ref_ctl%ref_file_ctl, & - & ref_ctl%low_ctl, ref_ctl%high_ctl, ref_param) - call set_takepiro_scalar_ctl & - & (ref_ctl%stratified_ctl, ref_ctl%takepiro_ctl, & - & ref_param%iflag_reference, takepiro) -! - end subroutine set_reference_scalar_ctl -! -! ----------------------------------------------------------------------- -! ----------------------------------------------------------------------- -! - subroutine set_linear_ref_scalar_ctl(ref_temp_ctl, ref_file_ctl, & - & low_temp_ctl, high_temp_ctl, ref_param) -! - use calypso_mpi + subroutine set_reftemp_list_array(array_c) use t_control_array_character - use m_file_format_switch - use m_error_IDs - use delete_data_files -! - type(read_character_item), intent(in) :: ref_temp_ctl - type(read_character_item), intent(in) :: ref_file_ctl - type(reference_point_control), intent(in) :: low_temp_ctl - type(reference_point_control), intent(in) :: high_temp_ctl + type(ctl_array_chara), intent(inout) :: array_c ! - type(reference_scalar_param), intent(inout) :: ref_param + call set_sph_reftemp_list_array(array_c) ! - integer (kind = kint) :: iflag - character(len=kchara) :: tmpchara + call append_c_to_ctl_array(label_linear_x, array_c) + call append_c_to_ctl_array(label_linear_y, array_c) + call append_c_to_ctl_array(label_linear_z, array_c) ! -! set control for temperature -! - if (ref_temp_ctl%iflag .eq. 0) then - ref_param%iflag_reference = id_no_ref_temp - else - tmpchara = ref_temp_ctl%charavalue - if (cmp_no_case(tmpchara, label_sph_shell)) then - ref_param%iflag_reference = id_sphere_ref_temp - else if (cmp_no_case(tmpchara, label_takepiro)) then - ref_param%iflag_reference = id_takepiro_temp - else if (cmp_no_case(tmpchara, label_sph_const_heat)) then - ref_param%iflag_reference = id_linear_r_ref_temp - else if (cmp_no_case(tmpchara, label_linear_x)) then - ref_param%iflag_reference = id_x_ref_temp - else if (cmp_no_case(tmpchara, label_linear_y)) then - ref_param%iflag_reference = id_y_ref_temp - else if (cmp_no_case(tmpchara, label_linear_z)) then - ref_param%iflag_reference = id_z_ref_temp - else if (cmp_no_case(tmpchara, label_get_numerical)) then - ref_param%iflag_reference = id_numerical_solution - else if (cmp_no_case(tmpchara, label_load_file)) then - ref_param%iflag_reference = id_read_file - end if - end if -! - ref_param%flag_ref_field = .FALSE. - if (ref_param%iflag_reference .eq. id_sphere_ref_temp & - & .or. ref_param%iflag_reference .eq. id_takepiro_temp & - & .or. ref_param%iflag_reference .eq. id_numerical_solution & - & .or. ref_param%iflag_reference .eq. id_read_file & - & ) ref_param%flag_ref_field = .TRUE. -! - if(ref_param%iflag_reference .eq. id_read_file) then - ref_param%ref_file_IO%iflag_IO = 0 - ref_param%ref_file_IO%iflag_format = id_ascii_file_fmt - if(ref_file_ctl%iflag .le. 0) then - call calypso_mpi_abort(ierr_file, 'Set reference field file') - else - ref_param%ref_file_IO%file_prefix = ref_file_ctl%charavalue -! - if(check_file_exist(ref_param%ref_file_IO%file_prefix) & - & .eqv. .FALSE.) then - write(e_message,*) 'File ', & - & ref_param%ref_file_IO%file_prefix, ' is missing.' - call calypso_mpi_abort(ierr_file, e_message) - end if - end if - end if -! - iflag = low_temp_ctl%depth%iflag*low_temp_ctl%value%iflag - if (iflag .eq. 0) then - if( ref_param%iflag_reference .eq. id_no_ref_temp & - & .or. ref_param%iflag_reference .eq. id_numerical_solution & - & ) then - ref_param%low_value = 0.0d0 - ref_param%depth_top = 0.0d0 - else - e_message & - & = 'Set lower temperature and its position' - call calypso_MPI_abort(ierr_fld, e_message) - end if - else - ref_param%low_value = low_temp_ctl%value%realvalue - ref_param%depth_top = low_temp_ctl%depth%realvalue - end if -! - iflag = high_temp_ctl%depth%iflag*high_temp_ctl%value%iflag - if (iflag .eq. 0) then - if( ref_param%iflag_reference .eq. id_no_ref_temp & - & .or. ref_param%iflag_reference .eq. id_numerical_solution & - & ) then - ref_param%high_value = 0.0d0 - ref_param%depth_bottom = 0.0d0 - else - e_message & - & = 'Set lower temperature and its position' - call calypso_MPI_abort(ierr_fld, e_message) - end if - else - ref_param%high_value = high_temp_ctl%value%realvalue - ref_param%depth_bottom = high_temp_ctl%depth%realvalue - end if -! - if (iflag_debug .ge. iflag_routine_msg) then - write(*,*) 'iflag_reference ', ref_param%iflag_reference - write(*,*) 'low_value ', ref_param%low_value - write(*,*) 'high_value ', ref_param%high_value - write(*,*) 'depth_top ', ref_param%depth_top - write(*,*) 'depth_bottom ', ref_param%depth_bottom - end if -! - end subroutine set_linear_ref_scalar_ctl + end subroutine set_reftemp_list_array ! ! ----------------------------------------------------------------------- ! - subroutine set_takepiro_scalar_ctl & - & (stratified_ctl, takepiro_ctl, iflag_ref, takepiro) -! - use calypso_mpi - use t_ctl_data_temp_model - use t_ctl_data_stratified_model + subroutine set_sph_reftemp_list_array(array_c) use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c ! - type(read_character_item), intent(in) :: stratified_ctl - type(takepiro_model_control), intent(in) :: takepiro_ctl -! - integer(kind = kint), intent(inout) :: iflag_ref - type(takepiro_model_param), intent(inout) :: takepiro -! - integer (kind = kint) :: iflag -! -! set control for Takepiro model -! - if (stratified_ctl%iflag .gt. id_turn_OFF & - .and. yes_flag(stratified_ctl%charavalue)) then - iflag_ref = id_takepiro_temp - end if -! - if (iflag_ref .eq. id_takepiro_temp) then - iflag = takepiro_ctl%stratified_sigma_ctl%iflag & - & *takepiro_ctl%stratified_width_ctl%iflag & - & *takepiro_ctl%stratified_outer_r_ctl%iflag - if(iflag .eq. 0) then - e_message & - & = 'Set parameteres for stratification' - call calypso_MPI_abort(ierr_fld, e_message) - else - takepiro%stratified_sigma & - & = takepiro_ctl%stratified_sigma_ctl%realvalue - takepiro%stratified_width & - & = takepiro_ctl%stratified_width_ctl%realvalue - takepiro%stratified_outer_r & - & = takepiro_ctl%stratified_outer_r_ctl%realvalue - end if - else - takepiro%stratified_sigma = 0.0d0 - takepiro%stratified_width = 0.0d0 - takepiro%stratified_outer_r = 0.0d0 - end if + array_c%array_name = ' ' + array_c%num = 0 + call alloc_control_array_chara(array_c) ! - if (iflag_debug .ge. iflag_routine_msg) then - write(*,*) 'iflag_stratified ', iflag_ref - write(*,*) 'stratified_sigma ', takepiro%stratified_sigma - write(*,*) 'stratified_width ', takepiro%stratified_width - write(*,*) 'stratified_outer_r ', takepiro%stratified_outer_r - end if + call append_c_to_ctl_array(label_none, array_c) + call append_c_to_ctl_array(label_sph_shell, array_c) + call append_c_to_ctl_array(label_get_numerical, array_c) + call append_c_to_ctl_array(label_load_file, array_c) + call append_c_to_ctl_array(label_sph_const_heat, array_c) ! - end subroutine set_takepiro_scalar_ctl + end subroutine set_sph_reftemp_list_array ! ! ----------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/MHD_src/sph_MHD/write_dynamo_benchmark_file.f90 b/src/Fortran_libraries/MHD_src/sph_MHD/write_dynamo_benchmark_file.f90 index d4b5ddae..28daba10 100644 --- a/src/Fortran_libraries/MHD_src/sph_MHD/write_dynamo_benchmark_file.f90 +++ b/src/Fortran_libraries/MHD_src/sph_MHD/write_dynamo_benchmark_file.f90 @@ -186,7 +186,7 @@ subroutine write_detailed_dbench_file & real(kind = kreal), allocatable :: detail_out(:) ! ! - if(bench%detail_bench_file_prefix .eq. 'NO_FILE') return + if(no_file_flag(bench%detail_bench_file_prefix)) return if(my_rank .ne. 0) return ! call dup_detail_dbench_header_to_IO & diff --git a/src/Fortran_libraries/MHD_src/sph_MHD/write_monitors_circle_file.f90 b/src/Fortran_libraries/MHD_src/sph_MHD/write_monitors_circle_file.f90 index 6dcc18bf..4ba0d3a9 100644 --- a/src/Fortran_libraries/MHD_src/sph_MHD/write_monitors_circle_file.f90 +++ b/src/Fortran_libraries/MHD_src/sph_MHD/write_monitors_circle_file.f90 @@ -92,6 +92,7 @@ subroutine write_fields_on_circle_file & use gz_layer_mean_monitor_IO use dup_fields_on_circle_to_IO use sel_open_sph_fld_on_circle + use skip_comment_f ! integer, intent(in) :: my_rank type(sph_shell_parameters), intent(in) :: sph_params @@ -110,7 +111,7 @@ subroutine write_fields_on_circle_file & real(kind = kreal), allocatable :: spectr_IO(:,:) ! ! - if(circle%circle_field_file_prefix .eq. 'NO_FILE') return + if(no_file_flag(circle%circle_field_file_prefix)) return if(my_rank .ne. 0) return ! call dup_field_on_circ_header_to_IO(sph_params, & @@ -148,6 +149,7 @@ subroutine write_spectr_on_circle_file(my_rank, sph_params, & use gz_volume_spectr_monitor_IO use dup_fields_on_circle_to_IO use sel_open_sph_fld_on_circle + use skip_comment_f ! integer, intent(in) :: my_rank type(sph_shell_parameters), intent(in) :: sph_params @@ -164,7 +166,7 @@ subroutine write_spectr_on_circle_file(my_rank, sph_params, & real(kind = kreal), allocatable :: spectr_IO(:,:) ! ! - if(circle%circle_spectr_file_prefix .eq. 'NO_FILE') return + if(no_file_flag(circle%circle_spectr_file_prefix)) return if(my_rank .ne. 0) return ! call dup_spectr_on_circ_header_to_IO(sph_params, & @@ -204,6 +206,7 @@ subroutine write_phase_on_circle_file(my_rank, sph_params, & use gz_volume_spectr_monitor_IO use dup_fields_on_circle_to_IO use sel_open_sph_fld_on_circle + use skip_comment_f ! integer, intent(in) :: my_rank type(sph_shell_parameters), intent(in) :: sph_params @@ -220,7 +223,7 @@ subroutine write_phase_on_circle_file(my_rank, sph_params, & real(kind = kreal), allocatable :: spectr_IO(:,:) ! ! - if(circle%circle_spectr_file_prefix .eq. 'NO_FILE') return + if(no_file_flag(circle%circle_spectr_file_prefix)) return if(my_rank .ne. 0) return ! call dup_spectr_on_circ_header_to_IO(sph_params, & diff --git a/src/Fortran_libraries/PARALLEL_src/COMM_src/Makefile b/src/Fortran_libraries/PARALLEL_src/COMM_src/Makefile index d43a6c2f..97d0e4c8 100644 --- a/src/Fortran_libraries/PARALLEL_src/COMM_src/Makefile +++ b/src/Fortran_libraries/PARALLEL_src/COMM_src/Makefile @@ -13,7 +13,9 @@ MOD_COMM = $(addsuffix .o,$(basename $(SOURCES)) ) dir_list: @echo 'COMMDIR = $(COMMDIR)' >> $(MAKENAME) -lib_archve: +libtarget: + +lib_archve: libtarget @echo ' $$(AR) $$(ARFLUGS) rcsv $$@ $$(MOD_COMM)' >> $(MAKENAME) diff --git a/src/Fortran_libraries/PARALLEL_src/COMM_src/Makefile.depends b/src/Fortran_libraries/PARALLEL_src/COMM_src/Makefile.depends index a1384488..70751427 100644 --- a/src/Fortran_libraries/PARALLEL_src/COMM_src/Makefile.depends +++ b/src/Fortran_libraries/PARALLEL_src/COMM_src/Makefile.depends @@ -1,12 +1,12 @@ -bcast_4_field_ctl.o: $(COMMDIR)/bcast_4_field_ctl.f90 m_precision.o t_ctl_data_4_fields.o calypso_mpi_int.o bcast_control_arrays.o +bcast_4_field_ctl.o: $(COMMDIR)/bcast_4_field_ctl.f90 m_precision.o t_ctl_data_4_fields.o bcast_control_arrays.o calypso_mpi_int.o calypso_mpi_char.o transfer_to_long_integers.o $(F90) -c $(F90OPTFLAGS) $< -bcast_4_platform_ctl.o: $(COMMDIR)/bcast_4_platform_ctl.f90 m_precision.o calypso_mpi.o t_ctl_data_4_platforms.o bcast_control_arrays.o calypso_mpi_int.o t_ctl_data_4_FEM_mesh.o +bcast_4_platform_ctl.o: $(COMMDIR)/bcast_4_platform_ctl.f90 m_precision.o calypso_mpi.o t_ctl_data_4_platforms.o transfer_to_long_integers.o bcast_control_arrays.o calypso_mpi_int.o calypso_mpi_char.o t_ctl_data_4_FEM_mesh.o $(F90) -c $(F90OPTFLAGS) $< -bcast_4_sph_monitor_ctl.o: $(COMMDIR)/bcast_4_sph_monitor_ctl.f90 m_precision.o calypso_mpi.o t_ctl_data_4_sph_monitor.o t_ctl_data_sph_vol_spectr.o t_ctl_data_pick_sph_spectr.o calypso_mpi_int.o bcast_control_arrays.o t_ctl_data_gauss_coefs.o t_ctl_data_sph_layer_spectr.o t_ctl_data_sph_dipolarity.o t_ctl_data_circles.o t_ctl_data_mid_equator.o t_ctl_data_dynamobench.o +bcast_4_sph_monitor_ctl.o: $(COMMDIR)/bcast_4_sph_monitor_ctl.f90 m_precision.o calypso_mpi.o t_ctl_data_4_sph_monitor.o t_ctl_data_sph_vol_spectr.o t_ctl_data_pick_sph_spectr.o transfer_to_long_integers.o calypso_mpi_int.o calypso_mpi_char.o bcast_control_arrays.o t_ctl_data_gauss_coefs.o t_ctl_data_sph_layer_spectr.o t_ctl_data_sph_dipolarity.o t_ctl_data_mid_equator.o t_ctl_data_dynamobench.o $(F90) -c $(F90OPTFLAGS) $< -bcast_4_time_step_ctl.o: $(COMMDIR)/bcast_4_time_step_ctl.f90 m_precision.o calypso_mpi.o calypso_mpi_int.o t_ctl_data_4_time_steps.o bcast_control_arrays.o +bcast_4_time_step_ctl.o: $(COMMDIR)/bcast_4_time_step_ctl.f90 m_precision.o calypso_mpi.o transfer_to_long_integers.o calypso_mpi_char.o calypso_mpi_int.o t_ctl_data_4_time_steps.o bcast_control_arrays.o $(F90) -c $(F90OPTFLAGS) $< -bcast_control_arrays.o: $(COMMDIR)/bcast_control_arrays.f90 m_precision.o m_constants.o calypso_mpi.o t_control_array_real.o calypso_mpi_real.o calypso_mpi_int.o t_control_array_integer.o t_control_array_character.o calypso_mpi_char.o transfer_to_long_integers.o t_control_array_real2.o t_control_array_real3.o t_control_array_integer2.o t_control_array_integer3.o t_control_array_character3.o t_control_array_charaint3.o t_control_array_character2.o t_control_array_charareal.o t_control_array_charaint.o t_control_array_charareal2.o t_control_array_chara2real.o t_control_array_intcharreal.o t_control_array_intreal.o t_control_array_int2real.o t_control_array_int2real2.o +bcast_control_arrays.o: $(COMMDIR)/bcast_control_arrays.f90 m_precision.o m_constants.o calypso_mpi.o t_control_array_real.o calypso_mpi_real.o calypso_mpi_int.o calypso_mpi_char.o transfer_to_long_integers.o t_control_array_integer.o t_control_array_character.o t_control_array_real2.o t_control_array_real3.o t_control_array_integer2.o t_control_array_integer3.o t_control_array_character3.o t_control_array_charaint3.o t_control_array_character2.o t_control_array_charareal.o t_control_array_charaint.o t_control_array_charareal2.o t_control_array_chara2real.o t_control_array_intcharreal.o t_control_array_intreal.o t_control_array_int2real.o t_control_array_int2real2.o $(F90) -c $(F90OPTFLAGS) $< bcast_file_IO_parameter.o: $(COMMDIR)/bcast_file_IO_parameter.f90 m_precision.o m_constants.o t_file_IO_parameter.o calypso_mpi_int.o calypso_mpi_char.o transfer_to_long_integers.o calypso_mpi_logical.o $(F90) -c $(F90OPTFLAGS) $< diff --git a/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_4_field_ctl.f90 b/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_4_field_ctl.f90 index 60f6f51c..2feac92b 100644 --- a/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_4_field_ctl.f90 +++ b/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_4_field_ctl.f90 @@ -69,8 +69,10 @@ module bcast_4_field_ctl ! subroutine bcast_phys_data_ctl(fld_ctl) ! - use calypso_mpi_int use bcast_control_arrays + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(field_control), intent(inout) :: fld_ctl ! @@ -82,6 +84,8 @@ subroutine bcast_phys_data_ctl(fld_ctl) call bcast_ctl_array_ci3(fld_ctl%vector_phys) ! call calypso_mpi_bcast_one_int(fld_ctl%i_phys_values, 0) + call calypso_mpi_bcast_character(fld_ctl%block_name, & + & cast_long(kchara), 0) ! end subroutine bcast_phys_data_ctl ! diff --git a/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_4_platform_ctl.f90 b/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_4_platform_ctl.f90 index 3890a1bb..2f5dc2c5 100644 --- a/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_4_platform_ctl.f90 +++ b/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_4_platform_ctl.f90 @@ -27,8 +27,10 @@ module bcast_4_platform_ctl subroutine bcast_ctl_data_4_platform(plt) ! use t_ctl_data_4_platforms + use transfer_to_long_integers use bcast_control_arrays use calypso_mpi_int + use calypso_mpi_char ! type(platform_data_control), intent(inout) :: plt ! @@ -51,8 +53,8 @@ subroutine bcast_ctl_data_4_platform(plt) call bcast_ctl_type_c1(plt%rayleigh_spectr_dir) call bcast_ctl_type_c1(plt%rayleigh_field_dir) ! - call bcast_ctl_type_c1(plt%interpolate_sph_to_fem_ctl) - call bcast_ctl_type_c1(plt%interpolate_fem_to_sph_ctl) + call bcast_ctl_type_c1(plt%interpolate_sph_to_fem) + call bcast_ctl_type_c1(plt%interpolate_fem_to_sph) ! call bcast_ctl_type_c1(plt%mesh_file_fmt_ctl) call bcast_ctl_type_c1(plt%restart_file_fmt_ctl) @@ -66,6 +68,8 @@ subroutine bcast_ctl_data_4_platform(plt) ! call bcast_ctl_type_c1(plt%del_org_data_ctl) ! + call calypso_mpi_bcast_character & + & (plt%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(plt%i_platform, 0) ! end subroutine bcast_ctl_data_4_platform @@ -77,6 +81,8 @@ subroutine bcast_FEM_mesh_control(Fmesh_ctl) use t_ctl_data_4_FEM_mesh use bcast_control_arrays use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(FEM_mesh_control), intent(inout) :: Fmesh_ctl ! @@ -86,6 +92,8 @@ subroutine bcast_FEM_mesh_control(Fmesh_ctl) call bcast_ctl_type_c1(Fmesh_ctl%FEM_surface_output_switch) call bcast_ctl_type_c1(Fmesh_ctl%FEM_viewer_output_switch) ! + call calypso_mpi_bcast_character & + & (Fmesh_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(Fmesh_ctl%i_FEM_mesh, 0) ! end subroutine bcast_FEM_mesh_control diff --git a/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_4_sph_monitor_ctl.f90 b/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_4_sph_monitor_ctl.f90 index f0aa7630..d37a463e 100644 --- a/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_4_sph_monitor_ctl.f90 +++ b/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_4_sph_monitor_ctl.f90 @@ -25,7 +25,7 @@ module bcast_4_sph_monitor_ctl ! private :: bcast_pickup_spectr_ctl, bcast_gauss_spectr_ctl private :: bcast_each_vol_spectr_ctl, bcast_layerd_spectr_ctl - private :: bcast_data_on_circles_ctl, bcast_mid_eq_monitor_ctl + private :: bcast_mid_eq_monitor_ctl private :: bcast_ctl_data_dynamobench, bcast_sph_dipolarity_ctl ! ! ----------------------------------------------------------------------- @@ -36,12 +36,16 @@ module bcast_4_sph_monitor_ctl ! subroutine bcast_sph_monitoring_ctl(smonitor_ctl) ! + use transfer_to_long_integers use calypso_mpi_int + use calypso_mpi_char use bcast_control_arrays ! type(sph_monitor_control), intent(inout) :: smonitor_ctl ! ! + call calypso_mpi_bcast_character & + & (smonitor_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(smonitor_ctl%i_sph_monitor, 0) ! call bcast_ctl_type_c1(smonitor_ctl%volume_average_prefix) @@ -66,10 +70,11 @@ subroutine bcast_sph_monitoring_ctl(smonitor_ctl) call bcast_layerd_spectr_ctl(smonitor_ctl%lp_ctl) ! call bcast_sph_dipolarity_ctl(smonitor_ctl%fdip_ctl) - call bcast_data_on_circles_ctl(smonitor_ctl%circ_ctls) call bcast_ctl_data_dynamobench(smonitor_ctl%dbench_ctl) ! ! + call calypso_mpi_bcast_character & + & (smonitor_ctl%v_pwr_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(smonitor_ctl%num_vspec_ctl, 0) if(smonitor_ctl%num_vspec_ctl .gt. 0 .and. my_rank .gt. 0) then allocate(smonitor_ctl%v_pwr(smonitor_ctl%num_vspec_ctl)) @@ -78,11 +83,16 @@ subroutine bcast_sph_monitoring_ctl(smonitor_ctl) call bcast_each_vol_spectr_ctl & & (smonitor_ctl%num_vspec_ctl, smonitor_ctl%v_pwr) ! -! do i = 1, smonitor_ctl%num_vspec_ctl -! write(*,*) my_rank, 'bcast_each_vol_spectr_ctl result', i, & -! & smonitor_ctl%v_pwr(i)%inner_radius_ctl%realvalue, & -! & smonitor_ctl%v_pwr(i)%outer_radius_ctl%realvalue -! end do +! + call calypso_mpi_bcast_character & + & (smonitor_ctl%d_circ_name, cast_long(kchara), 0) + call calypso_mpi_bcast_one_int(smonitor_ctl%num_circ_ctl, 0) + if(smonitor_ctl%num_circ_ctl .gt. 0 .and. my_rank .gt. 0) then + allocate(smonitor_ctl%meq_ctl(smonitor_ctl%num_circ_ctl)) + end if +! + call bcast_mid_eq_monitor_ctl(smonitor_ctl%num_circ_ctl, & + & smonitor_ctl%meq_ctl) ! end subroutine bcast_sph_monitoring_ctl ! @@ -91,7 +101,9 @@ end subroutine bcast_sph_monitoring_ctl ! subroutine bcast_pickup_spectr_ctl(pspec_ctl) ! + use transfer_to_long_integers use calypso_mpi_int + use calypso_mpi_char use bcast_control_arrays ! type(pick_spectr_control), intent(inout) :: pspec_ctl @@ -106,6 +118,9 @@ subroutine bcast_pickup_spectr_ctl(pspec_ctl) ! call bcast_ctl_type_c1(pspec_ctl%picked_mode_head_ctl) call bcast_ctl_type_c1(pspec_ctl%picked_mode_fmt_ctl) +! + call calypso_mpi_bcast_character & + & (pspec_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(pspec_ctl%i_pick_sph, 0) ! end subroutine bcast_pickup_spectr_ctl @@ -115,7 +130,9 @@ end subroutine bcast_pickup_spectr_ctl subroutine bcast_gauss_spectr_ctl(g_pwr) ! use t_ctl_data_gauss_coefs + use transfer_to_long_integers use calypso_mpi_int + use calypso_mpi_char use bcast_control_arrays ! type(gauss_spectr_control), intent(inout) :: g_pwr @@ -128,6 +145,9 @@ subroutine bcast_gauss_spectr_ctl(g_pwr) call bcast_ctl_type_r1(g_pwr%gauss_coefs_radius_ctl) call bcast_ctl_type_c1(g_pwr%gauss_coefs_prefix) call bcast_ctl_type_c1(g_pwr%gauss_coefs_format) +! + call calypso_mpi_bcast_character & + & (g_pwr%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(g_pwr%i_gauss_coef_ctl, 0) ! end subroutine bcast_gauss_spectr_ctl @@ -137,6 +157,8 @@ end subroutine bcast_gauss_spectr_ctl ! subroutine bcast_each_vol_spectr_ctl(num_vspec_ctl, v_pwr) ! + use transfer_to_long_integers + use calypso_mpi_char use calypso_mpi_int use bcast_control_arrays use t_ctl_data_sph_vol_spectr @@ -159,6 +181,8 @@ subroutine bcast_each_vol_spectr_ctl(num_vspec_ctl, v_pwr) ! call bcast_ctl_type_r1(v_pwr(i)%inner_radius_ctl) call bcast_ctl_type_r1(v_pwr(i)%outer_radius_ctl) + call calypso_mpi_bcast_character & + & (v_pwr(i)%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(v_pwr(i)%i_vol_spectr_ctl, 0) end do ! @@ -168,7 +192,9 @@ end subroutine bcast_each_vol_spectr_ctl ! subroutine bcast_layerd_spectr_ctl(lp_ctl) ! + use transfer_to_long_integers use calypso_mpi_int + use calypso_mpi_char use bcast_control_arrays use t_ctl_data_sph_layer_spectr ! @@ -185,6 +211,9 @@ subroutine bcast_layerd_spectr_ctl(lp_ctl) call bcast_ctl_type_c1(lp_ctl%order_spectra_switch) call bcast_ctl_type_c1(lp_ctl%diff_lm_spectra_switch) call bcast_ctl_type_c1(lp_ctl%axis_power_switch) +! + call calypso_mpi_bcast_character & + & (lp_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(lp_ctl%i_layer_spectr_ctl, 0) ! end subroutine bcast_layerd_spectr_ctl @@ -193,7 +222,9 @@ end subroutine bcast_layerd_spectr_ctl ! subroutine bcast_sph_dipolarity_ctl(fdip_ctl) ! + use transfer_to_long_integers use calypso_mpi_int + use calypso_mpi_char use bcast_control_arrays use t_ctl_data_sph_dipolarity ! @@ -203,6 +234,9 @@ subroutine bcast_sph_dipolarity_ctl(fdip_ctl) call bcast_ctl_array_i1(fdip_ctl%fdip_truncation_ctl) call bcast_ctl_type_c1(fdip_ctl%fdip_file_prefix_ctl) call bcast_ctl_type_c1(fdip_ctl%fdip_file_format_ctl) +! + call calypso_mpi_bcast_character & + & (fdip_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(fdip_ctl%i_dipolarity_ctl, 0) ! end subroutine bcast_sph_dipolarity_ctl @@ -210,47 +244,35 @@ end subroutine bcast_sph_dipolarity_ctl ! ----------------------------------------------------------------------- ! ----------------------------------------------------------------------- ! - subroutine bcast_data_on_circles_ctl(circ_ctls) + subroutine bcast_mid_eq_monitor_ctl(num_circ_ctl, meq_ctl) ! + use transfer_to_long_integers use calypso_mpi_int + use calypso_mpi_char use bcast_control_arrays - use t_ctl_data_circles + use t_ctl_data_mid_equator ! - type(data_on_circles_ctl), intent(inout) :: circ_ctls + integer(kind = kint), intent(in) :: num_circ_ctl + type(mid_equator_control), intent(inout) :: meq_ctl(num_circ_ctl) integer(kind = kint) :: i ! ! - call calypso_mpi_bcast_one_int(circ_ctls%num_circ_ctl, 0) - if(my_rank .ne. 0) call alloc_data_on_circles_ctl(circ_ctls) + do i = 1, num_circ_ctl + call bcast_ctl_type_r1(meq_ctl(i)%pick_s_ctl) + call bcast_ctl_type_r1(meq_ctl(i)%pick_z_ctl) ! - do i = 1, circ_ctls%num_circ_ctl - call bcast_mid_eq_monitor_ctl(circ_ctls%meq_ctl(i)) - end do + call bcast_ctl_type_i1(meq_ctl(i)%nphi_mid_eq_ctl) ! - end subroutine bcast_data_on_circles_ctl -! -! ----------------------------------------------------------------------- + call bcast_ctl_type_c1(meq_ctl(i)%pick_circle_coord_ctl) ! - subroutine bcast_mid_eq_monitor_ctl(meq_ctl) + call bcast_ctl_type_c1(meq_ctl(i)%circle_field_file_ctl) + call bcast_ctl_type_c1(meq_ctl(i)%circle_spectr_file_ctl) + call bcast_ctl_type_c1(meq_ctl(i)%circle_file_format_ctl) ! - use calypso_mpi_int - use bcast_control_arrays - use t_ctl_data_mid_equator -! - type(mid_equator_control), intent(inout) :: meq_ctl -! -! - call bcast_ctl_type_r1(meq_ctl%pick_s_ctl) - call bcast_ctl_type_r1(meq_ctl%pick_z_ctl) -! - call bcast_ctl_type_i1(meq_ctl%nphi_mid_eq_ctl) -! - call bcast_ctl_type_c1(meq_ctl%pick_circle_coord_ctl) -! - call bcast_ctl_type_c1(meq_ctl%circle_field_file_ctl) - call bcast_ctl_type_c1(meq_ctl%circle_spectr_file_ctl) - call bcast_ctl_type_c1(meq_ctl%circle_file_format_ctl) - call calypso_mpi_bcast_one_int(meq_ctl%i_mid_equator_ctl, 0) + call calypso_mpi_bcast_character & + & (meq_ctl(i)%block_name, cast_long(kchara), 0) + call calypso_mpi_bcast_one_int(meq_ctl(i)%i_mid_equator_ctl, 0) + end do ! end subroutine bcast_mid_eq_monitor_ctl ! @@ -258,7 +280,9 @@ end subroutine bcast_mid_eq_monitor_ctl ! subroutine bcast_ctl_data_dynamobench(dbench_ctl) ! + use transfer_to_long_integers use calypso_mpi_int + use calypso_mpi_char use bcast_control_arrays use t_ctl_data_dynamobench ! @@ -273,6 +297,8 @@ subroutine bcast_ctl_data_dynamobench(dbench_ctl) call bcast_ctl_type_c1(dbench_ctl%dbench_field_file_ctl) call bcast_ctl_type_c1(dbench_ctl%dbench_spectr_file_ctl) ! + call calypso_mpi_bcast_character & + & (dbench_ctl%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(dbench_ctl%i_dynamobench_ctl, 0) ! end subroutine bcast_ctl_data_dynamobench diff --git a/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_4_time_step_ctl.f90 b/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_4_time_step_ctl.f90 index c4e30a4e..7be60ce7 100644 --- a/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_4_time_step_ctl.f90 +++ b/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_4_time_step_ctl.f90 @@ -90,6 +90,8 @@ module bcast_4_time_step_ctl ! subroutine bcast_ctl_data_4_time_step(tctl) ! + use transfer_to_long_integers + use calypso_mpi_char use calypso_mpi_int use t_ctl_data_4_time_steps use bcast_control_arrays @@ -149,6 +151,8 @@ subroutine bcast_ctl_data_4_time_step(tctl) ! call bcast_ctl_type_c1(tctl%flexible_step_ctl) ! + call calypso_mpi_bcast_character(tctl%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(tctl%i_tstep, 0) ! end subroutine bcast_ctl_data_4_time_step diff --git a/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_control_arrays.f90 b/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_control_arrays.f90 index 5f1714df..f93f58a8 100644 --- a/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_control_arrays.f90 +++ b/src/Fortran_libraries/PARALLEL_src/COMM_src/bcast_control_arrays.f90 @@ -102,6 +102,8 @@ subroutine bcast_ctl_type_r1(real_item) use t_control_array_real use calypso_mpi_real use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(read_real_item), intent(inout) :: real_item ! @@ -109,6 +111,8 @@ subroutine bcast_ctl_type_r1(real_item) if(nprocs .eq. 1) return ! call calypso_mpi_bcast_one_int(real_item%iflag, 0) + call calypso_mpi_bcast_character & + & (real_item%item_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_real(real_item%realvalue, 0) ! end subroutine bcast_ctl_type_r1 @@ -119,6 +123,8 @@ subroutine bcast_ctl_type_i1(int_item) ! use t_control_array_integer use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(read_integer_item), intent(inout) :: int_item ! @@ -126,6 +132,8 @@ subroutine bcast_ctl_type_i1(int_item) if(nprocs .eq. 1) return ! call calypso_mpi_bcast_one_int(int_item%iflag, 0) + call calypso_mpi_bcast_character & + & (int_item%item_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int(int_item%intvalue, 0) ! end subroutine bcast_ctl_type_i1 @@ -146,6 +154,8 @@ subroutine bcast_ctl_type_c1(chara_item) ! call calypso_mpi_bcast_one_int(chara_item%iflag, 0) call calypso_mpi_bcast_character & + & (chara_item%item_name, cast_long(kchara), 0) + call calypso_mpi_bcast_character & & (chara_item%charavalue, cast_long(kchara), 0) ! end subroutine bcast_ctl_type_c1 @@ -157,6 +167,7 @@ subroutine bcast_ctl_type_r2(real2_item) use t_control_array_real2 use calypso_mpi_real use calypso_mpi_int + use calypso_mpi_char use transfer_to_long_integers ! type(read_real2_item), intent(inout) :: real2_item @@ -165,6 +176,8 @@ subroutine bcast_ctl_type_r2(real2_item) if(nprocs .eq. 1) return ! call calypso_mpi_bcast_one_int(real2_item%iflag, 0) + call calypso_mpi_bcast_character & + & (real2_item%item_name, cast_long(kchara), 0) call calypso_mpi_bcast_real & & (real2_item%realvalue, cast_long(2), 0) ! @@ -177,6 +190,7 @@ subroutine bcast_ctl_type_r3(real3_item) use t_control_array_real3 use calypso_mpi_real use calypso_mpi_int + use calypso_mpi_char use transfer_to_long_integers ! type(read_real3_item), intent(inout) :: real3_item @@ -185,6 +199,8 @@ subroutine bcast_ctl_type_r3(real3_item) if(nprocs .eq. 1) return ! call calypso_mpi_bcast_one_int(real3_item%iflag, 0) + call calypso_mpi_bcast_character & + & (real3_item%item_name, cast_long(kchara), 0) call calypso_mpi_bcast_real & & (real3_item%realvalue, cast_long(3), 0) ! @@ -196,6 +212,7 @@ subroutine bcast_ctl_type_i2(int2_item) ! use t_control_array_integer2 use calypso_mpi_int + use calypso_mpi_char use transfer_to_long_integers ! type(read_int2_item), intent(inout) :: int2_item @@ -204,6 +221,8 @@ subroutine bcast_ctl_type_i2(int2_item) if(nprocs .eq. 1) return ! call calypso_mpi_bcast_one_int(int2_item%iflag, 0) + call calypso_mpi_bcast_character & + & (int2_item%item_name, cast_long(kchara), 0) call calypso_mpi_bcast_int & & (int2_item%intvalue, cast_long(2), 0) ! @@ -215,6 +234,7 @@ subroutine bcast_ctl_type_i3(int3_item) ! use t_control_array_integer3 use calypso_mpi_int + use calypso_mpi_char use transfer_to_long_integers ! type(read_int3_item), intent(inout) :: int3_item @@ -223,6 +243,8 @@ subroutine bcast_ctl_type_i3(int3_item) if(nprocs .eq. 1) return ! call calypso_mpi_bcast_one_int(int3_item%iflag, 0) + call calypso_mpi_bcast_character & + & (int3_item%item_name, cast_long(kchara), 0) call calypso_mpi_bcast_int & & (int3_item%intvalue, cast_long(3), 0) ! @@ -244,6 +266,8 @@ subroutine bcast_ctl_type_c3(chara3_item) ! call calypso_mpi_bcast_one_int(chara3_item%iflag, 0) call calypso_mpi_bcast_character & + & (chara3_item%item_name, cast_long(kchara), 0) + call calypso_mpi_bcast_character & & (chara3_item%charavalue, cast_long(3*kchara), 0) ! end subroutine bcast_ctl_type_c3 @@ -264,6 +288,8 @@ subroutine bcast_ctl_type_c_i3(ci3_item) ! call calypso_mpi_bcast_one_int(ci3_item%iflag, 0) call calypso_mpi_bcast_character & + & (ci3_item%item_name, cast_long(kchara), 0) + call calypso_mpi_bcast_character & & (ci3_item%charavalue, cast_long(kchara), 0) call calypso_mpi_bcast_int & & (ci3_item%intvalue, cast_long(3), 0) @@ -279,6 +305,7 @@ subroutine bcast_ctl_array_r1(array_real) use transfer_to_long_integers use calypso_mpi_real use calypso_mpi_int + use calypso_mpi_char ! type(ctl_array_real), intent(inout) :: array_real ! @@ -287,6 +314,8 @@ subroutine bcast_ctl_array_r1(array_real) ! call calypso_mpi_bcast_one_int(array_real%num, 0) call calypso_mpi_bcast_one_int(array_real%icou, 0) + call calypso_mpi_bcast_character & + & (array_real%array_name, cast_long(kchara), 0) ! if(my_rank .ne. 0) call alloc_control_array_real(array_real) ! @@ -303,6 +332,7 @@ subroutine bcast_ctl_array_r2(array_r2) use transfer_to_long_integers use calypso_mpi_real use calypso_mpi_int + use calypso_mpi_char ! type(ctl_array_r2), intent(inout) :: array_r2 ! @@ -311,6 +341,8 @@ subroutine bcast_ctl_array_r2(array_r2) ! call calypso_mpi_bcast_one_int(array_r2%num, 0) call calypso_mpi_bcast_one_int(array_r2%icou, 0) + call calypso_mpi_bcast_character & + & (array_r2%array_name, cast_long(kchara), 0) ! if(my_rank .ne. 0) call alloc_control_array_r2(array_r2) ! @@ -329,6 +361,7 @@ subroutine bcast_ctl_array_r3(array_r3) use transfer_to_long_integers use calypso_mpi_real use calypso_mpi_int + use calypso_mpi_char ! type(ctl_array_r3), intent(inout) :: array_r3 ! @@ -337,6 +370,8 @@ subroutine bcast_ctl_array_r3(array_r3) ! call calypso_mpi_bcast_one_int(array_r3%num, 0) call calypso_mpi_bcast_one_int(array_r3%icou, 0) + call calypso_mpi_bcast_character & + & (array_r3%array_name, cast_long(kchara), 0) ! if(my_rank .ne. 0) call alloc_control_array_r3(array_r3) ! @@ -354,6 +389,7 @@ end subroutine bcast_ctl_array_r3 subroutine bcast_ctl_array_i1(array_int) ! use calypso_mpi_int + use calypso_mpi_char use t_control_array_integer use transfer_to_long_integers ! @@ -364,6 +400,8 @@ subroutine bcast_ctl_array_i1(array_int) ! call calypso_mpi_bcast_one_int(array_int%num, 0) call calypso_mpi_bcast_one_int(array_int%icou, 0) + call calypso_mpi_bcast_character & + & (array_int%array_name, cast_long(kchara), 0) ! if(my_rank .ne. 0) call alloc_control_array_int(array_int) ! @@ -377,6 +415,7 @@ end subroutine bcast_ctl_array_i1 subroutine bcast_ctl_array_i2(array_i2) ! use calypso_mpi_int + use calypso_mpi_char use t_control_array_integer2 use transfer_to_long_integers ! @@ -387,6 +426,8 @@ subroutine bcast_ctl_array_i2(array_i2) ! call calypso_mpi_bcast_one_int(array_i2%num, 0) call calypso_mpi_bcast_one_int(array_i2%icou, 0) + call calypso_mpi_bcast_character & + & (array_i2%array_name, cast_long(kchara), 0) ! if(my_rank .ne. 0) call alloc_control_array_i2(array_i2) ! @@ -402,6 +443,7 @@ end subroutine bcast_ctl_array_i2 subroutine bcast_ctl_array_i3(array_i3) ! use calypso_mpi_int + use calypso_mpi_char use t_control_array_integer3 use transfer_to_long_integers ! @@ -412,6 +454,8 @@ subroutine bcast_ctl_array_i3(array_i3) ! call calypso_mpi_bcast_one_int(array_i3%num, 0) call calypso_mpi_bcast_one_int(array_i3%icou, 0) + call calypso_mpi_bcast_character & + & (array_i3%array_name, cast_long(kchara), 0) ! if(my_rank .ne. 0) call alloc_control_array_i3(array_i3) ! @@ -440,6 +484,8 @@ subroutine bcast_ctl_array_c1(array_chara) ! call calypso_mpi_bcast_one_int(array_chara%num, 0) call calypso_mpi_bcast_one_int(array_chara%icou, 0) + call calypso_mpi_bcast_character & + & (array_chara%array_name, cast_long(kchara), 0) ! if(my_rank .ne. 0) call alloc_control_array_chara(array_chara) ! @@ -464,6 +510,8 @@ subroutine bcast_ctl_array_c2(array_c2) ! call calypso_mpi_bcast_one_int(array_c2%num, 0) call calypso_mpi_bcast_one_int(array_c2%icou, 0) + call calypso_mpi_bcast_character & + & (array_c2%array_name, cast_long(kchara), 0) ! if(my_rank .ne. 0) call alloc_control_array_c2(array_c2) ! @@ -490,6 +538,8 @@ subroutine bcast_ctl_array_c3(array_c3) ! call calypso_mpi_bcast_one_int(array_c3%num, 0) call calypso_mpi_bcast_one_int(array_c3%icou, 0) + call calypso_mpi_bcast_character & + & (array_c3%array_name, cast_long(kchara), 0) ! if(my_rank .ne. 0) call alloc_control_array_c3(array_c3) ! @@ -519,6 +569,8 @@ subroutine bcast_ctl_array_cr(array_cr) ! call calypso_mpi_bcast_one_int(array_cr%num, 0) call calypso_mpi_bcast_one_int(array_cr%icou, 0) + call calypso_mpi_bcast_character & + & (array_cr%array_name, cast_long(kchara), 0) ! if(my_rank .ne. 0) call alloc_control_array_c_r(array_cr) ! @@ -545,6 +597,8 @@ subroutine bcast_ctl_array_ci(array_ci) ! call calypso_mpi_bcast_one_int(array_ci%num, 0) call calypso_mpi_bcast_one_int(array_ci%icou, 0) + call calypso_mpi_bcast_character & + & (array_ci%array_name, cast_long(kchara), 0) ! if(my_rank .ne. 0) call alloc_control_array_c_i(array_ci) ! @@ -572,6 +626,8 @@ subroutine bcast_ctl_array_cr2(array_cr2) ! call calypso_mpi_bcast_one_int(array_cr2%num, 0) call calypso_mpi_bcast_one_int(array_cr2%icou, 0) + call calypso_mpi_bcast_character & + & (array_cr2%array_name, cast_long(kchara), 0) ! if(my_rank .ne. 0) call alloc_control_array_c_r2(array_cr2) ! @@ -601,6 +657,8 @@ subroutine bcast_ctl_array_c2r(array_c2r) ! call calypso_mpi_bcast_one_int(array_c2r%num, 0) call calypso_mpi_bcast_one_int(array_c2r%icou, 0) + call calypso_mpi_bcast_character & + & (array_c2r%array_name, cast_long(kchara), 0) ! if(my_rank .ne. 0) call alloc_control_array_c2_r(array_c2r) ! @@ -630,6 +688,8 @@ subroutine bcast_ctl_array_icr(array_icr) ! call calypso_mpi_bcast_one_int(array_icr%num, 0) call calypso_mpi_bcast_one_int(array_icr%icou, 0) + call calypso_mpi_bcast_character & + & (array_icr%array_name, cast_long(kchara), 0) ! if(my_rank .ne. 0) call alloc_control_array_i_c_r(array_icr) ! @@ -648,6 +708,7 @@ subroutine bcast_ctl_array_ir(array_ir) ! use calypso_mpi_real use calypso_mpi_int + use calypso_mpi_char use t_control_array_intreal use transfer_to_long_integers ! @@ -658,6 +719,8 @@ subroutine bcast_ctl_array_ir(array_ir) ! call calypso_mpi_bcast_one_int(array_ir%num, 0) call calypso_mpi_bcast_one_int(array_ir%icou, 0) + call calypso_mpi_bcast_character & + & (array_ir%array_name, cast_long(kchara), 0) ! if(my_rank .ne. 0) call alloc_control_array_i_r(array_ir) ! @@ -674,6 +737,7 @@ subroutine bcast_ctl_array_i2r(array_i2r) ! use calypso_mpi_real use calypso_mpi_int + use calypso_mpi_char use t_control_array_int2real use transfer_to_long_integers ! @@ -684,6 +748,8 @@ subroutine bcast_ctl_array_i2r(array_i2r) ! call calypso_mpi_bcast_one_int(array_i2r%num, 0) call calypso_mpi_bcast_one_int(array_i2r%icou, 0) + call calypso_mpi_bcast_character & + & (array_i2r%array_name, cast_long(kchara), 0) ! if(my_rank .ne. 0) call alloc_control_array_i2_r(array_i2r) ! @@ -702,6 +768,7 @@ subroutine bcast_ctl_array_i2r2(array_i2r2) ! use calypso_mpi_real use calypso_mpi_int + use calypso_mpi_char use t_control_array_int2real2 use transfer_to_long_integers ! @@ -712,6 +779,8 @@ subroutine bcast_ctl_array_i2r2(array_i2r2) ! call calypso_mpi_bcast_one_int(array_i2r2%num, 0) call calypso_mpi_bcast_one_int(array_i2r2%icou, 0) + call calypso_mpi_bcast_character & + & (array_i2r2%array_name, cast_long(kchara), 0) ! if(my_rank .ne. 0) call alloc_control_array_i2_r2(array_i2r2) ! @@ -742,6 +811,8 @@ subroutine bcast_ctl_array_ci3(array_ci3) ! call calypso_mpi_bcast_one_int(array_ci3%num, 0) call calypso_mpi_bcast_one_int(array_ci3%icou, 0) + call calypso_mpi_bcast_character & + & (array_ci3%array_name, cast_long(kchara), 0) ! if(my_rank .ne. 0) call alloc_control_array_c_i3(array_ci3) ! diff --git a/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/Makefile b/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/Makefile index 8a3bbb01..3f97d439 100644 --- a/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/Makefile +++ b/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/Makefile @@ -15,11 +15,11 @@ dir_list: lib_name: -lib_tasks: libtarget lib_archve +lib_tasks: lib_archve libtarget: -lib_archve: +lib_archve: libtarget @echo ' $$(AR) $$(ARFLUGS) rcsv $$@ $$(MOD_SPH_GRID)' \ >> $(MAKENAME) diff --git a/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/Makefile.depends b/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/Makefile.depends index 900dc677..6f63c28a 100644 --- a/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/Makefile.depends +++ b/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/Makefile.depends @@ -1,4 +1,4 @@ -bcast_4_sphere_ctl.o: $(SPH_GRID_SRCDIR)/bcast_4_sphere_ctl.f90 m_precision.o m_constants.o calypso_mpi.o t_ctl_data_gen_sph_shell.o calypso_mpi_int.o bcast_4_platform_ctl.o t_ctl_data_4_sphere_model.o bcast_control_arrays.o t_ctl_data_4_divide_sphere.o +bcast_4_sphere_ctl.o: $(SPH_GRID_SRCDIR)/bcast_4_sphere_ctl.f90 m_precision.o m_constants.o calypso_mpi.o t_ctl_data_gen_sph_shell.o transfer_to_long_integers.o calypso_mpi_char.o calypso_mpi_int.o bcast_4_platform_ctl.o t_ctl_data_4_sphere_model.o bcast_control_arrays.o t_ctl_data_4_divide_sphere.o $(F90) -c $(F90OPTFLAGS) $< bcast_comm_stacks_sph.o: $(SPH_GRID_SRCDIR)/bcast_comm_stacks_sph.f90 m_precision.o m_constants.o m_machine_parameter.o calypso_mpi.o t_sph_trans_comm_tbl.o calypso_mpi_int.o transfer_to_long_integers.o $(F90) -c $(F90OPTFLAGS) $< diff --git a/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/bcast_4_sphere_ctl.f90 b/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/bcast_4_sphere_ctl.f90 index 97b7df9e..5835f7a2 100644 --- a/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/bcast_4_sphere_ctl.f90 +++ b/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/bcast_4_sphere_ctl.f90 @@ -35,14 +35,17 @@ module bcast_4_sphere_ctl subroutine bcast_parallel_shell_ctl(psph_ctl) ! use t_ctl_data_gen_sph_shell + use transfer_to_long_integers + use calypso_mpi_char use calypso_mpi_int use bcast_4_platform_ctl ! type(parallel_sph_shell_control), intent(inout) :: psph_ctl ! ! + call calypso_mpi_bcast_character(psph_ctl%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(psph_ctl%iflag_sph_shell, 0) - call calypso_mpi_bcast_one_int(psph_ctl%ifile_sph_shell, 0) ! if(psph_ctl%iflag_sph_shell .eq. 0) return ! @@ -58,6 +61,8 @@ end subroutine bcast_parallel_shell_ctl subroutine bcast_ctl_4_shell_define(spctl) ! use t_ctl_data_4_sphere_model + use transfer_to_long_integers + use calypso_mpi_char use calypso_mpi_int use bcast_control_arrays ! @@ -96,6 +101,8 @@ subroutine bcast_ctl_4_shell_define(spctl) call bcast_ctl_array_i2(spctl%radial_layer_list_ctl) call bcast_ctl_array_i2(spctl%med_layer_list_ctl) ! + call calypso_mpi_bcast_character(spctl%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(spctl%i_shell_def, 0) ! end subroutine bcast_ctl_4_shell_define @@ -105,6 +112,8 @@ end subroutine bcast_ctl_4_shell_define subroutine bcast_ctl_ndomain_4_shell(sdctl) ! use t_ctl_data_4_divide_sphere + use transfer_to_long_integers + use calypso_mpi_char use calypso_mpi_int use bcast_control_arrays ! @@ -130,6 +139,8 @@ subroutine bcast_ctl_ndomain_4_shell(sdctl) call bcast_ctl_array_ci(sdctl%ndomain_legendre_ctl) call bcast_ctl_array_ci(sdctl%ndomain_spectr_ctl) ! + call calypso_mpi_bcast_character(sdctl%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(sdctl%i_domains_sph, 0) ! end subroutine bcast_ctl_ndomain_4_shell diff --git a/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/ctl_file_gen_sph_shell_IO.f90 b/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/ctl_file_gen_sph_shell_IO.f90 index bb960942..4a85a6b5 100644 --- a/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/ctl_file_gen_sph_shell_IO.f90 +++ b/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/ctl_file_gen_sph_shell_IO.f90 @@ -10,7 +10,7 @@ !! subroutine sel_read_ctl_gen_shell_grids & !! & (id_control, hd_block, file_name, psph_ctl, c_buf) !! subroutine read_ctl_file_gen_shell_grids(id_control, file_name, & -!! & hd_block, psph_ctl) +!! & hd_block, psph_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! character(len = kchara), intent(inout) :: file_name @@ -18,12 +18,11 @@ !! type(buffer_for_control), intent(inout) :: c_buf !! !! subroutine sel_write_ctl_gen_shell_grids & -!! & (id_control, hd_block, file_name, psph_ctl, level) +!! & (id_control, file_name, psph_ctl, level) !! subroutine write_ctl_file_gen_shell_grids(id_control, file_name,& -!! & hd_block, psph_ctl) +!! & psph_ctl) !! integer(kind = kint), intent(in) :: id_control !! character(len = kchara), intent(in) :: file_name -!! character(len = kchara), intent(in) :: hd_block !! type(parallel_sph_shell_control), intent(in) :: psph_ctl !! integer(kind = kint), intent(inout) :: level !! ======================================================= @@ -82,6 +81,8 @@ module ctl_file_gen_sph_shell_IO ! subroutine sel_read_ctl_gen_shell_grids & & (id_control, hd_block, file_name, psph_ctl, c_buf) +! + use write_control_elements ! integer(kind = kint), intent(in) :: id_control character(len=kchara), intent(in) :: hd_block @@ -91,16 +92,18 @@ subroutine sel_read_ctl_gen_shell_grids & type(buffer_for_control), intent(inout) :: c_buf ! ! - if((psph_ctl%iflag_sph_shell + psph_ctl%ifile_sph_shell) & - & .gt. 0) return + if(psph_ctl%iflag_sph_shell .gt. 0) return if(check_file_flag(c_buf, hd_block)) then file_name = third_word(c_buf) - psph_ctl%ifile_sph_shell = 1 +! + call write_one_ctl_file_message & + & (hd_block, c_buf%level, file_name) call read_ctl_file_gen_shell_grids(id_control+2, file_name, & - & hd_block, psph_ctl) + & hd_block, psph_ctl, c_buf) else if(check_begin_flag(c_buf, hd_block)) then file_name = 'NO_FILE' - write(*,*) 'resolution data is included' +! + call write_included_message(hd_block, c_buf%level) call read_parallel_shell_ctl & & (id_control, hd_block, psph_ctl, c_buf) end if @@ -110,33 +113,33 @@ end subroutine sel_read_ctl_gen_shell_grids ! -------------------------------------------------------------------- ! subroutine read_ctl_file_gen_shell_grids(id_control, file_name, & - & hd_block, psph_ctl) + & hd_block, psph_ctl, c_buf) ! integer(kind = kint), intent(in) :: id_control character(len = kchara), intent(in) :: file_name character(len=kchara), intent(in) :: hd_block type(parallel_sph_shell_control), intent(inout) :: psph_ctl -! - type(buffer_for_control) :: c_buf1 + type(buffer_for_control), intent(inout) :: c_buf ! ! - write(*,*) 'Spherical shell resolution file: ', & - & trim(file_name) + c_buf%level = c_buf%level + 1 open(id_control, file = file_name) ! do if(psph_ctl%iflag_sph_shell .gt. 0) exit - call load_one_line_from_control(id_control, c_buf1) - if(check_end_flag(c_buf1, hd_block)) exit + 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 ! call read_parallel_shell_ctl(id_control, hd_block, & - & psph_ctl, c_buf1) + & psph_ctl, c_buf) call read_parallel_shell_ctl(id_control, hd_sph_shell, & - & psph_ctl, c_buf1) + & psph_ctl, c_buf) + if(psph_ctl%iflag_sph_shell .gt. 0) exit end do ! close(id_control) - write(*,*) 'Spherical shell resolution file end' + c_buf%level = c_buf%level - 1 ! end subroutine read_ctl_file_gen_shell_grids ! @@ -144,27 +147,30 @@ end subroutine read_ctl_file_gen_shell_grids ! -------------------------------------------------------------------- ! subroutine sel_write_ctl_gen_shell_grids & - & (id_control, hd_block, file_name, psph_ctl, level) + & (id_control, file_name, psph_ctl, level) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_control character(len = kchara), intent(in) :: file_name - character(len = kchara), intent(in) :: hd_block type(parallel_sph_shell_control), intent(in) :: psph_ctl ! integer(kind = kint), intent(inout) :: level ! ! - if(cmp_no_case(file_name, 'NO_FILE')) then - call write_parallel_shell_ctl(id_control, hd_block, & - & psph_ctl, level) + if(no_file_flag(file_name)) then + call write_parallel_shell_ctl(id_control, psph_ctl, level) + else if(id_control .eq. id_monitor) then + write(*,'(4a)') '! ', trim(psph_ctl%block_name), & + & ' should be written to file ... ', trim(file_name) + call write_parallel_shell_ctl(id_control, psph_ctl, level) else - write(*,'(a)', ADVANCE='NO') ' is write file to ... ' + write(*,'(3a)') trim(psph_ctl%block_name), & + & ' is written to file ... ', trim(file_name) call write_file_name_for_ctl_line(id_control, level, & - & hd_block, file_name) + & psph_ctl%block_name, file_name) call write_ctl_file_gen_shell_grids((id_control+2), file_name, & - & hd_block, psph_ctl) + & psph_ctl) end if ! end subroutine sel_write_ctl_gen_shell_grids @@ -172,13 +178,12 @@ end subroutine sel_write_ctl_gen_shell_grids ! -------------------------------------------------------------------- ! subroutine write_ctl_file_gen_shell_grids(id_control, file_name, & - & hd_block, psph_ctl) + & psph_ctl) ! use delete_data_files ! integer(kind = kint), intent(in) :: id_control character(len = kchara), intent(in) :: file_name - character(len=kchara), intent(in) :: hd_block type(parallel_sph_shell_control), intent(in) :: psph_ctl ! integer(kind = kint) :: level @@ -189,11 +194,9 @@ subroutine write_ctl_file_gen_shell_grids(id_control, file_name, & read(*,*) end if ! - write(*,*) 'Spherical shell resolution file: ', trim(file_name) level = 0 open(id_control, file = file_name) - call write_parallel_shell_ctl(id_control, hd_block, & - & psph_ctl, level) + call write_parallel_shell_ctl(id_control, psph_ctl, level) close(id_control) ! end subroutine write_ctl_file_gen_shell_grids diff --git a/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/set_ctl_4_shell_grids.f90 b/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/set_ctl_4_shell_grids.f90 index 6a7b6ff7..bfcc6e70 100644 --- a/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/set_ctl_4_shell_grids.f90 +++ b/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/set_ctl_4_shell_grids.f90 @@ -9,7 +9,7 @@ !!@verbatim !! subroutine set_control_4_shell_grids(nprocs_check, & !! & spctl, sdctl, sph, gen_sph, ierr) -!! type(sphere_data_control), intent(inout) :: spctl +!! type(sphere_data_control), intent(in) :: spctl !! type(sphere_domain_control), intent(in) :: sdctl !! type(sph_grids), intent(inout) :: sph !! type(construct_spherical_grid), intent(inout) :: gen_sph diff --git a/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/t_ctl_data_const_sph_mesh.f90 b/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/t_ctl_data_const_sph_mesh.f90 index 9efd7ae5..0e1ca7f4 100644 --- a/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/t_ctl_data_const_sph_mesh.f90 +++ b/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/t_ctl_data_const_sph_mesh.f90 @@ -11,7 +11,8 @@ !!@n Modified by H. Matsui on Oct., 2012 !! !!@verbatim -!! subroutine read_control_4_const_shell(file_name, gen_SPH_ctl) +!! subroutine read_control_4_const_shell(file_name, & +!! & gen_SPH_ctl, c_buf) !! character(len=kchara), intent(in) :: file_name !! type(sph_mesh_generation_ctl), intent(inout) :: gen_SPH_ctl !! subroutine write_control_4_const_shell(file_name, gen_SPH_ctl) @@ -36,23 +37,20 @@ module t_ctl_data_const_sph_mesh integer(kind=kint), parameter, private :: control_file_code = 11 ! type sph_mesh_generation_ctl +!> Block name + character(len=kchara) :: hd_mesh_generation = 'MHD_control' +! !> Structure for file settings type(platform_data_control) :: plt ! !> file name for parallel spherical shell control - character(len = kchara) :: fname_psph_ctl + character(len = kchara) :: fname_psph = 'NO_FILE' !> Control structure for parallel spherical shell type(parallel_sph_shell_control) :: psph_ctl ! integer(kind=kint) :: i_sph_mesh_ctl = 0 end type sph_mesh_generation_ctl ! -! -! Top level of label -! - character(len=kchara), parameter, private & - & :: hd_mhd_ctl = 'MHD_control' -! ! 2nd level for MHD ! character(len=kchara), parameter, private & @@ -69,24 +67,31 @@ module t_ctl_data_const_sph_mesh ! ! ---------------------------------------------------------------------- ! - subroutine read_control_4_const_shell(file_name, gen_SPH_ctl) + subroutine read_control_4_const_shell(file_name, & + & gen_SPH_ctl, c_buf) ! character(len=kchara), intent(in) :: file_name type(sph_mesh_generation_ctl), intent(inout) :: gen_SPH_ctl -! - type(buffer_for_control) :: c_buf1 + type(buffer_for_control), intent(inout) :: c_buf ! ! + c_buf%level = c_buf%level + 1 open(control_file_code, file = file_name, status='old') ! do - call load_one_line_from_control(control_file_code, c_buf1) - call read_sph_shell_define_ctl & - & (control_file_code, hd_mhd_ctl, gen_SPH_ctl, c_buf1) + call load_one_line_from_control & + & (control_file_code, gen_SPH_ctl%hd_mesh_generation, c_buf) + if(c_buf%iend .gt. 0) exit +! + call read_sph_shell_define_ctl & + & (control_file_code, gen_SPH_ctl%hd_mesh_generation, & + & gen_SPH_ctl, c_buf) if(gen_SPH_ctl%i_sph_mesh_ctl .gt. 0) exit end do ! close(control_file_code) +! + c_buf%level = c_buf%level - 1 ! end subroutine read_control_4_const_shell ! @@ -110,7 +115,8 @@ subroutine write_control_4_const_shell(file_name, gen_SPH_ctl) write(*,*) 'Write control file: ', trim(file_name) open(control_file_code, file = file_name, status='old' ) call write_sph_shell_define_ctl & - & (control_file_code, hd_mhd_ctl, gen_SPH_ctl, level1) + & (control_file_code, gen_SPH_ctl%hd_mesh_generation, & + & gen_SPH_ctl, level1) close(control_file_code) ! end subroutine write_control_4_const_shell @@ -131,16 +137,20 @@ subroutine read_sph_shell_define_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(gen_SPH_ctl%i_sph_mesh_ctl .gt. 0) return + call init_platforms_labels(hd_platform, gen_SPH_ctl%plt) + call init_parallel_shell_ctl_label(hd_sph_shell, & + & gen_SPH_ctl%psph_ctl) + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_platforms & & (id_control, hd_platform, gen_SPH_ctl%plt, c_buf) call sel_read_ctl_gen_shell_grids(id_control, hd_sph_shell, & - & gen_SPH_ctl%fname_psph_ctl, gen_SPH_ctl%psph_ctl, c_buf) + & gen_SPH_ctl%fname_psph, gen_SPH_ctl%psph_ctl, c_buf) end do gen_SPH_ctl%i_sph_mesh_ctl = 1 ! @@ -163,13 +173,11 @@ subroutine write_sph_shell_define_ctl & ! if(gen_SPH_ctl%i_sph_mesh_ctl .le. 0) return ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) -! call write_control_platforms & & (id_control, hd_platform, gen_SPH_ctl%plt, level) - call sel_write_ctl_gen_shell_grids(id_control, hd_sph_shell, & - & gen_SPH_ctl%fname_psph_ctl, gen_SPH_ctl%psph_ctl, level) + call sel_write_ctl_gen_shell_grids(id_control, & + & gen_SPH_ctl%fname_psph, gen_SPH_ctl%psph_ctl, level) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_sph_shell_define_ctl diff --git a/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/t_ctl_data_gen_sph_shell.f90 b/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/t_ctl_data_gen_sph_shell.f90 index d1f6c0cc..ff61f0ef 100644 --- a/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/t_ctl_data_gen_sph_shell.f90 +++ b/src/Fortran_libraries/PARALLEL_src/CONST_SPH_GRID/t_ctl_data_gen_sph_shell.f90 @@ -7,6 +7,7 @@ !>@brief control data for resolutions of spherical shell !! !!@verbatim +!! subroutine init_parallel_shell_ctl_label(hd_block, psph_ctl) !! subroutine read_parallel_shell_ctl & !! & (id_control, hd_block, psph_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -15,11 +16,9 @@ !! type(parallel_sph_shell_control), intent(inout) :: psph_ctl !! type(buffer_for_control), intent(inout) :: c_buf !! -!! subroutine write_parallel_shell_ctl & -!! & (id_control, hd_block, psph_ctl, level) +!! subroutine write_parallel_shell_ctl(id_control, psph_ctl, level) !! integer(kind = kint), intent(in) :: id_control !! character(len = kchara), intent(in) :: file_name -!! character(len = kchara), intent(in) :: hd_block !! type(parallel_sph_shell_control), intent(inout) :: psph_ctl !! integer(kind = kint), intent(inout) :: level !! @@ -70,6 +69,8 @@ module t_ctl_data_gen_sph_shell ! !> structure of parallel spherical shell data type parallel_sph_shell_control +!> Block name + character(len=kchara) :: block_name = 'spherical_shell_ctl' !> Structure of mesh IO controls and sleeve informations type(FEM_mesh_control) :: Fmesh_ctl !> Structure of spherical shell configuration @@ -79,8 +80,6 @@ module t_ctl_data_gen_sph_shell ! !> Integer flag to defined spherical shell integer (kind=kint) :: iflag_sph_shell = 0 -!> Integer flag to read spherical shell control file - integer (kind=kint) :: ifile_sph_shell = 0 end type parallel_sph_shell_control ! ! Labels @@ -114,10 +113,11 @@ subroutine read_parallel_shell_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(psph_ctl%iflag_sph_shell .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_FEM_mesh_control & @@ -136,14 +136,12 @@ end subroutine read_parallel_shell_ctl ! ! -------------------------------------------------------------------- ! - subroutine write_parallel_shell_ctl & - & (id_control, hd_block, psph_ctl, level) + subroutine write_parallel_shell_ctl(id_control, psph_ctl, level) ! use ctl_data_sphere_model_IO use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(parallel_sph_shell_control), intent(in) :: psph_ctl ! integer(kind = kint), intent(inout) :: level @@ -151,20 +149,34 @@ subroutine write_parallel_shell_ctl & ! if(psph_ctl%iflag_sph_shell .le. 0) return ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! + level = write_begin_flag_for_ctl(id_control, level, & + & psph_ctl%block_name) call write_FEM_mesh_control & - & (id_control, hd_FEM_mesh, psph_ctl%Fmesh_ctl, level) + & (id_control, psph_ctl%Fmesh_ctl, level) + call write_control_shell_domain & + & (id_control, psph_ctl%sdctl, level) call write_control_shell_define & - & (id_control, hd_sph_def, psph_ctl%spctl, level) + & (id_control, psph_ctl%spctl, level) + level = write_end_flag_for_ctl(id_control, level, & + & psph_ctl%block_name) ! - call write_control_shell_domain & - & (id_control, hd_domains_sph, psph_ctl%sdctl, level) + end subroutine write_parallel_shell_ctl +! +! -------------------------------------------------------------------- ! - level = write_end_flag_for_ctl(id_control, level, hd_block) + subroutine init_parallel_shell_ctl_label(hd_block, psph_ctl) ! - end subroutine write_parallel_shell_ctl + use ctl_data_sphere_model_IO +! + character(len=kchara), intent(in) :: hd_block + type(parallel_sph_shell_control), intent(inout) :: psph_ctl +! + psph_ctl%block_name = trim(hd_block) + call init_ctl_shell_define_label(hd_sph_def, psph_ctl%spctl) + call init_ctl_shell_domain_label(hd_domains_sph, psph_ctl%sdctl) + call init_FEM_mesh_ctl_label(hd_FEM_mesh, psph_ctl%Fmesh_ctl) +! + end subroutine init_parallel_shell_ctl_label ! ! -------------------------------------------------------------------- ! -------------------------------------------------------------------- @@ -175,7 +187,6 @@ subroutine dealloc_parallel_shell_ctl(psph_ctl) ! ! psph_ctl%iflag_sph_shell = 0 - psph_ctl%ifile_sph_shell = 0 ! call reset_FEM_mesh_control(psph_ctl%Fmesh_ctl) call dealloc_control_shell_define(psph_ctl%spctl) diff --git a/src/Fortran_libraries/PARALLEL_src/MPI_IO/Makefile b/src/Fortran_libraries/PARALLEL_src/MPI_IO/Makefile index 90306e4c..102f0647 100644 --- a/src/Fortran_libraries/PARALLEL_src/MPI_IO/Makefile +++ b/src/Fortran_libraries/PARALLEL_src/MPI_IO/Makefile @@ -13,7 +13,9 @@ MOD_MPI_IO = $(addsuffix .o,$(basename $(SOURCES)) ) dir_list: @echo 'MPI_IO_DIR = $(MPI_IO_DIR)' >> $(MAKENAME) -lib_archve: +libtarget: + +lib_archve: libtarget @echo ' $$(AR) $$(ARFLUGS) rcsv $$@ $$(MOD_MPI_IO)' >> $(MAKENAME) diff --git a/src/Fortran_libraries/PARALLEL_src/MPI_IO/field_IO_select.F90 b/src/Fortran_libraries/PARALLEL_src/MPI_IO/field_IO_select.F90 index 3962e185..7591b69b 100644 --- a/src/Fortran_libraries/PARALLEL_src/MPI_IO/field_IO_select.F90 +++ b/src/Fortran_libraries/PARALLEL_src/MPI_IO/field_IO_select.F90 @@ -405,7 +405,8 @@ subroutine sel_read_step_field_file & #endif ! else - call read_step_field_file(file_name, id_rank, t_IO, fld_IO) + call read_step_field_file(file_name, id_rank, t_IO, & + & fld_IO, ierr) end if ! if(ierr .gt. 0) call calypso_mpi_abort(ierr, & @@ -462,7 +463,7 @@ subroutine sel_read_alloc_step_field_file & ! else call read_and_alloc_step_field & - & (file_name, id_rank, t_IO, fld_IO) + & (file_name, id_rank, t_IO, fld_IO, ierr) end if ! if(ierr .gt. 0) call calypso_mpi_abort(ierr, & @@ -519,7 +520,7 @@ subroutine sel_read_alloc_field_head & ! else call read_and_allocate_step_head & - & (file_name, id_rank, t_IO, fld_IO) + & (file_name, id_rank, t_IO, fld_IO, ierr) end if ! if(ierr .gt. 0) call calypso_mpi_abort(ierr, & diff --git a/src/Fortran_libraries/PARALLEL_src/MPI_ZLIB_IO/Makefile b/src/Fortran_libraries/PARALLEL_src/MPI_ZLIB_IO/Makefile index ce50b159..ac0caa99 100644 --- a/src/Fortran_libraries/PARALLEL_src/MPI_ZLIB_IO/Makefile +++ b/src/Fortran_libraries/PARALLEL_src/MPI_ZLIB_IO/Makefile @@ -13,7 +13,9 @@ MOD_MPI_ZLIB_IO = $(addsuffix .o,$(basename $(SOURCES)) ) dir_list: @echo 'MPI_ZLIB_IO_DIR = $(MPI_ZLIB_IO_DIR)' >> $(MAKENAME) -lib_archve: +libtarget: + +lib_archve: libtarget @echo ' $$(AR) $$(ARFLUGS) rcsv $$@ $$(MOD_MPI_ZLIB_IO)' >> $(MAKENAME) diff --git a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/Makefile b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/Makefile index af9cc09a..34554e84 100644 --- a/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/Makefile +++ b/src/Fortran_libraries/PARALLEL_src/SPH_SHELL_src/Makefile @@ -13,7 +13,9 @@ MOD_COMM_SPH = $(addsuffix .o,$(basename $(SOURCES)) ) dir_list: @echo 'SPH_COMMDIR = $(SPH_COMMDIR)' >> $(MAKENAME) -lib_archve: +libtarget: + +lib_archve: libtarget @echo ' $$(AR) $$(ARFLUGS) rcsv $$@ $$(MOD_COMM_SPH)' >> $(MAKENAME) diff --git a/src/Fortran_libraries/SERIAL_src/BASE/Makefile b/src/Fortran_libraries/SERIAL_src/BASE/Makefile index a33a8bd8..393187b3 100644 --- a/src/Fortran_libraries/SERIAL_src/BASE/Makefile +++ b/src/Fortran_libraries/SERIAL_src/BASE/Makefile @@ -13,7 +13,9 @@ MOD_BASE = $(addsuffix .o,$(basename $(SOURCES)) ) dir_list: @echo 'BASEDIR = $(BASEDIR)' >> $(MAKENAME) -lib_archve: +libtarget: + +lib_archve: libtarget @echo ' $$(AR) $$(ARFLUGS) rcsv $$@ $$(MOD_BASE)' >> $(MAKENAME) diff --git a/src/Fortran_libraries/SERIAL_src/FFT_wrapper/Makefile b/src/Fortran_libraries/SERIAL_src/FFT_wrapper/Makefile index 5b88dd37..3fedc9f0 100644 --- a/src/Fortran_libraries/SERIAL_src/FFT_wrapper/Makefile +++ b/src/Fortran_libraries/SERIAL_src/FFT_wrapper/Makefile @@ -17,7 +17,7 @@ lib_name: libtarget: -lib_archve: +lib_archve: libtarget @echo ' $$(AR) $$(ARFLUGS) rcsv $$@ $$(MOD_FFT_WRAP)' >> $(MAKENAME) mod_list: diff --git a/src/Fortran_libraries/SERIAL_src/Fields/Makefile b/src/Fortran_libraries/SERIAL_src/Fields/Makefile index 677d6f76..1f9a17ea 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/Makefile +++ b/src/Fortran_libraries/SERIAL_src/Fields/Makefile @@ -13,7 +13,9 @@ MOD_FIELDS = $(addsuffix .o,$(basename $(SOURCES)) ) dir_list: @echo 'FIELDIR = $(FIELDIR)' >> $(MAKENAME) -lib_archve: +libtarget: + +lib_archve: libtarget @echo ' $$(AR) $$(ARFLUGS) rcsv $$@ $$(MOD_FIELDS)' >> $(MAKENAME) diff --git a/src/Fortran_libraries/SERIAL_src/Fields/Makefile.depends b/src/Fortran_libraries/SERIAL_src/Fields/Makefile.depends index 02bb31f2..1a09f6c3 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/Makefile.depends +++ b/src/Fortran_libraries/SERIAL_src/Fields/Makefile.depends @@ -8,33 +8,33 @@ check_workarea_4_explicit.o: $(FIELDIR)/check_workarea_4_explicit.f90 m_precisio $(F90) -c $(F90OPTFLAGS) $< decomp_w_sym_rj_base_field.o: $(FIELDIR)/decomp_w_sym_rj_base_field.f90 m_precision.o t_spheric_rj_data.o t_phys_data.o t_base_field_labels.o $(F90) -c $(F90OPTFLAGS) $< -m_base_field_labels.o: $(FIELDIR)/m_base_field_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o +m_base_field_labels.o: $(FIELDIR)/m_base_field_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o t_control_array_chara2int.o t_control_array_character.o $(F90) -c $(F90OPTFLAGS) $< -m_base_force_labels.o: $(FIELDIR)/m_base_force_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o +m_base_force_labels.o: $(FIELDIR)/m_base_force_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o t_control_array_chara2int.o $(F90) -c $(F90OPTFLAGS) $< -m_diff_vector_labels.o: $(FIELDIR)/m_diff_vector_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o +m_diff_vector_labels.o: $(FIELDIR)/m_diff_vector_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o t_control_array_chara2int.o $(F90) -c $(F90OPTFLAGS) $< -m_diffusion_term_labels.o: $(FIELDIR)/m_diffusion_term_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o +m_diffusion_term_labels.o: $(FIELDIR)/m_diffusion_term_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o t_control_array_chara2int.o $(F90) -c $(F90OPTFLAGS) $< -m_div_force_labels.o: $(FIELDIR)/m_div_force_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o +m_div_force_labels.o: $(FIELDIR)/m_div_force_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o t_control_array_chara2int.o $(F90) -c $(F90OPTFLAGS) $< -m_energy_flux_labels.o: $(FIELDIR)/m_energy_flux_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o +m_energy_flux_labels.o: $(FIELDIR)/m_energy_flux_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o t_control_array_chara2int.o $(F90) -c $(F90OPTFLAGS) $< -m_explicit_term_labels.o: $(FIELDIR)/m_explicit_term_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o +m_explicit_term_labels.o: $(FIELDIR)/m_explicit_term_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o t_control_array_chara2int.o $(F90) -c $(F90OPTFLAGS) $< -m_field_component_labels.o: $(FIELDIR)/m_field_component_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o +m_field_component_labels.o: $(FIELDIR)/m_field_component_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o t_control_array_chara2int.o $(F90) -c $(F90OPTFLAGS) $< -m_field_product_labels.o: $(FIELDIR)/m_field_product_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o +m_field_product_labels.o: $(FIELDIR)/m_field_product_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o t_control_array_chara2int.o $(F90) -c $(F90OPTFLAGS) $< -m_field_w_symmetry_labels.o: $(FIELDIR)/m_field_w_symmetry_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o +m_field_w_symmetry_labels.o: $(FIELDIR)/m_field_w_symmetry_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o t_control_array_chara2int.o $(F90) -c $(F90OPTFLAGS) $< -m_force_w_sym_labels.o: $(FIELDIR)/m_force_w_sym_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o +m_force_w_sym_labels.o: $(FIELDIR)/m_force_w_sym_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o t_control_array_chara2int.o $(F90) -c $(F90OPTFLAGS) $< -m_grad_field_labels.o: $(FIELDIR)/m_grad_field_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o +m_grad_field_labels.o: $(FIELDIR)/m_grad_field_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o t_control_array_chara2int.o $(F90) -c $(F90OPTFLAGS) $< -m_rot_force_labels.o: $(FIELDIR)/m_rot_force_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o +m_rot_force_labels.o: $(FIELDIR)/m_rot_force_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o t_control_array_chara2int.o $(F90) -c $(F90OPTFLAGS) $< -m_sym_ene_flux_labels.o: $(FIELDIR)/m_sym_ene_flux_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o +m_sym_ene_flux_labels.o: $(FIELDIR)/m_sym_ene_flux_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o t_control_array_chara2int.o $(F90) -c $(F90OPTFLAGS) $< m_time_labels.o: $(FIELDIR)/m_time_labels.f90 m_precision.o $(F90) -c $(F90OPTFLAGS) $< @@ -66,7 +66,7 @@ t_explicit_term_labels.o: $(FIELDIR)/t_explicit_term_labels.f90 m_precision.o m_ $(F90) -c $(F90OPTFLAGS) $< t_field_component_labels.o: $(FIELDIR)/t_field_component_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o m_field_component_labels.o $(F90) -c $(F90OPTFLAGS) $< -t_field_labels.o: $(FIELDIR)/t_field_labels.f90 m_precision.o m_constants.o m_phys_constants.o skip_comment_f.o +t_field_labels.o: $(FIELDIR)/t_field_labels.f90 m_precision.o m_constants.o m_phys_constants.o t_control_array_chara2int.o skip_comment_f.o $(F90) -c $(F90OPTFLAGS) $< t_field_product_labels.o: $(FIELDIR)/t_field_product_labels.f90 m_precision.o m_phys_constants.o t_field_labels.o m_field_product_labels.o $(F90) -c $(F90OPTFLAGS) $< diff --git a/src/Fortran_libraries/SERIAL_src/Fields/check_base_field.f90 b/src/Fortran_libraries/SERIAL_src/Fields/check_base_field.f90 index 9ffd6b69..dc0e5792 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/check_base_field.f90 +++ b/src/Fortran_libraries/SERIAL_src/Fields/check_base_field.f90 @@ -182,8 +182,11 @@ subroutine add_field_ctl_4_field_comps(field_ctl) & .or. check_field_list_ctl(theta_velocity, field_ctl) & & .or. check_field_list_ctl(phi_velocity, field_ctl) & & .or. check_field_list_ctl(cyl_r_velocity, field_ctl) & + & .or. check_field_list_ctl(x_velocity, field_ctl) & + & .or. check_field_list_ctl(y_velocity, field_ctl) & & .or. check_field_list_ctl(z_velocity, field_ctl)) & & call add_phys_name_ctl(velocity, field_ctl) +! if( check_field_list_ctl(r_magnetic_f, field_ctl) & & .or. check_field_list_ctl(theta_magnetic_f, field_ctl) & & .or. check_field_list_ctl(phi_magnetic_f, field_ctl) & diff --git a/src/Fortran_libraries/SERIAL_src/Fields/m_base_field_labels.f90 b/src/Fortran_libraries/SERIAL_src/Fields/m_base_field_labels.f90 index 10f59672..eaf5bdfc 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/m_base_field_labels.f90 +++ b/src/Fortran_libraries/SERIAL_src/Fields/m_base_field_labels.f90 @@ -11,9 +11,10 @@ !! logical function check_base_vector(field_name) !! logical function check_base_scalar(field_name) !! -!! integer(kind = kint) function num_base_fields() -!! subroutine set_base_field_names(n_comps, names, maths) -!! +!! subroutine set_base_field_names(array_c2i) +!! type(ctl_array_c2i), intent(inout) :: array_c2i +!! subroutine time_evolution_list_array(array_c) +!! type(ctl_array_chara), intent(inout) :: array_c !! !!!!! Base field names !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! !! field names @@ -56,9 +57,6 @@ module m_base_field_labels ! implicit none ! -! - integer(kind = kint), parameter, private :: nfld_base = 21 -! !> Field label for velocity !! @f$ u_{i} @f$ type(field_def), parameter :: velocity & @@ -248,69 +246,55 @@ end function check_base_scalar ! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- ! - integer(kind = kint) function num_base_fields() - num_base_fields = nfld_base - return - end function num_base_fields + subroutine set_base_field_names(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i +! + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) +! + call set_field_label_to_ctl(velocity, array_c2i) + call set_field_label_to_ctl(vorticity, array_c2i) + call set_field_label_to_ctl(pressure, array_c2i) + call set_field_label_to_ctl(system_Rotation, array_c2i) + call set_field_label_to_ctl(magnetic_field, array_c2i) + call set_field_label_to_ctl(vector_potential, array_c2i) + call set_field_label_to_ctl(current_density, array_c2i) + call set_field_label_to_ctl(background_B, array_c2i) + call set_field_label_to_ctl(magnetic_potential, array_c2i) + call set_field_label_to_ctl(scalar_potential, array_c2i) + call set_field_label_to_ctl(temperature, array_c2i) + call set_field_label_to_ctl(perturbation_temp, array_c2i) + call set_field_label_to_ctl(heat_source, array_c2i) + call set_field_label_to_ctl(composition, array_c2i) + call set_field_label_to_ctl(perturbation_composition, array_c2i) + call set_field_label_to_ctl(composition_source, array_c2i) + call set_field_label_to_ctl(entropy, array_c2i) + call set_field_label_to_ctl(perturbation_entropy, array_c2i) + call set_field_label_to_ctl(entropy_source, array_c2i) + call set_field_label_to_ctl(density, array_c2i) + call set_field_label_to_ctl(perturbation_density, array_c2i) +! + end subroutine set_base_field_names ! ! ---------------------------------------------------------------------- ! - subroutine set_base_field_names(n_comps, names, maths) -! - integer(kind = kint_4b), intent(inout) :: n_comps(nfld_base) - character(len = kchara), intent(inout) :: names(nfld_base) - character(len = kchara), intent(inout) :: maths(nfld_base) -! -! - call set_field_labels(velocity, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(vorticity, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(pressure, & - & n_comps( 3), names( 3), maths( 3)) - call set_field_labels(system_Rotation, & - & n_comps( 4), names( 4), maths( 4)) -! - call set_field_labels(magnetic_field, & - & n_comps( 5), names( 5), maths( 5)) - call set_field_labels(vector_potential, & - & n_comps( 6), names( 6), maths( 6)) - call set_field_labels(current_density, & - & n_comps( 7), names( 7), maths( 7)) - call set_field_labels(background_B, & - & n_comps( 8), names( 8), maths( 8)) - call set_field_labels(magnetic_potential, & - & n_comps( 9), names( 9), maths( 9)) - call set_field_labels(scalar_potential, & - & n_comps(10), names(10), maths(10)) -! - call set_field_labels(temperature, & - & n_comps(11), names(11), maths(11)) - call set_field_labels(perturbation_temp, & - & n_comps(12), names(12), maths(12)) - call set_field_labels(heat_source, & - & n_comps(13), names(13), maths(13)) -! - call set_field_labels(composition, & - & n_comps(14), names(14), maths(14)) - call set_field_labels(perturbation_composition, & - & n_comps(15), names(15), maths(15)) - call set_field_labels(composition_source, & - & n_comps(16), names(16), maths(16)) -! - call set_field_labels(entropy, & - & n_comps(17), names(17), maths(17)) - call set_field_labels(perturbation_entropy, & - & n_comps(18), names(18), maths(18)) - call set_field_labels(entropy_source, & - & n_comps(19), names(19), maths(19)) -! - call set_field_labels(density, & - & n_comps(20), names(20), maths(20)) - call set_field_labels(perturbation_density, & - & n_comps(21), names(21), maths(21)) + subroutine time_evolution_list_array(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c ! - end subroutine set_base_field_names + array_c%array_name = ' ' + array_c%num = 0 + call alloc_control_array_chara(array_c) +! + call append_c_to_ctl_array(velocity%name, array_c) + call append_c_to_ctl_array(magnetic_field%name, array_c) + call append_c_to_ctl_array(temperature%name, array_c) + call append_c_to_ctl_array(composition%name, array_c) + call append_c_to_ctl_array(vector_potential%name, array_c) +! + end subroutine time_evolution_list_array ! ! ---------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/SERIAL_src/Fields/m_base_force_labels.f90 b/src/Fortran_libraries/SERIAL_src/Fields/m_base_force_labels.f90 index 2778ab11..f7003c1c 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/m_base_force_labels.f90 +++ b/src/Fortran_libraries/SERIAL_src/Fields/m_base_force_labels.f90 @@ -12,8 +12,8 @@ !! logical function check_flux_tensors(field_name) !! logical function check_asym_flux_tensors(field_name) !! -!! integer(kind = kint) function num_base_forces() -!! subroutine set_base_force_labels(n_comps, names, maths) +!! subroutine set_base_force_names_to_ctl(array_c2i) +!! type(ctl_array_c2i), intent(inout) :: array_c2i !! !! !!!!! Base force names !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! @@ -66,8 +66,6 @@ module m_base_force_labels ! implicit none ! - integer(kind = kint), parameter, private :: nforce_base = 21 -! !> Field label for pressure gradient !! @f$ \partial_{i} p @f$ type(field_def), parameter :: pressure_gradient & @@ -276,70 +274,37 @@ end function check_asym_flux_tensors ! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- ! - integer(kind = kint) function num_base_forces() - num_base_forces = nforce_base - return - end function num_base_forces -! -! ---------------------------------------------------------------------- -! - subroutine set_base_force_labels(n_comps, names, maths) -! - integer(kind = kint_4b), intent(inout) :: n_comps(nforce_base) - character(len = kchara), intent(inout) :: names(nforce_base) - character(len = kchara), intent(inout) :: maths(nforce_base) -! -! - call set_field_labels(pressure_gradient, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(inertia, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(Coriolis_force, & - & n_comps( 3), names( 3), maths( 3)) -! - call set_field_labels(Lorentz_force, & - & n_comps( 4), names( 4), maths( 4)) - call set_field_labels(magnetic_tension, & - & n_comps( 5), names( 5), maths( 5)) -! - call set_field_labels(buoyancy, & - & n_comps( 6), names( 6), maths( 6)) - call set_field_labels(composite_buoyancy, & - & n_comps( 7), names( 7), maths( 7)) -! - call set_field_labels(magnetic_induction, & - & n_comps( 8), names( 8), maths( 8)) - call set_field_labels(vecp_induction, & - & n_comps( 9), names( 9), maths( 9)) - call set_field_labels(magnetic_stretch, & - & n_comps(10), names(10), maths(10)) -! - call set_field_labels(heat_advect, & - & n_comps(11), names(11), maths(11)) - call set_field_labels(pert_heat_advect, & - & n_comps(12), names(12), maths(12)) - call set_field_labels(composition_advect, & - & n_comps(13), names(13), maths(13)) - call set_field_labels(pert_comp_advect, & - & n_comps(14), names(14), maths(14)) -! - call set_field_labels(momentum_flux, & - & n_comps(15), names(15), maths(15)) - call set_field_labels(maxwell_tensor, & - & n_comps(16), names(16), maths(16)) - call set_field_labels(induction_tensor, & - & n_comps(17), names(17), maths(17)) -! - call set_field_labels(heat_flux, & - & n_comps(18), names(18), maths(18)) - call set_field_labels(pert_heat_flux, & - & n_comps(19), names(19), maths(19)) - call set_field_labels(composite_flux, & - & n_comps(20), names(20), maths(20)) - call set_field_labels(pert_comp_flux, & - & n_comps(21), names(21), maths(21)) -! - end subroutine set_base_force_labels + subroutine set_base_force_names_to_ctl(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i +! + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) +! + call set_field_label_to_ctl(pressure_gradient, array_c2i) + call set_field_label_to_ctl(inertia, array_c2i) + call set_field_label_to_ctl(Coriolis_force, array_c2i) + call set_field_label_to_ctl(Lorentz_force, array_c2i) + call set_field_label_to_ctl(magnetic_tension, array_c2i) + call set_field_label_to_ctl(buoyancy, array_c2i) + call set_field_label_to_ctl(composite_buoyancy, array_c2i) + call set_field_label_to_ctl(magnetic_induction, array_c2i) + call set_field_label_to_ctl(vecp_induction, array_c2i) + call set_field_label_to_ctl(magnetic_stretch, array_c2i) + call set_field_label_to_ctl(heat_advect, array_c2i) + call set_field_label_to_ctl(pert_heat_advect, array_c2i) + call set_field_label_to_ctl(composition_advect, array_c2i) + call set_field_label_to_ctl(pert_comp_advect, array_c2i) + call set_field_label_to_ctl(momentum_flux, array_c2i) + call set_field_label_to_ctl(maxwell_tensor, array_c2i) + call set_field_label_to_ctl(induction_tensor, array_c2i) + call set_field_label_to_ctl(heat_flux, array_c2i) + call set_field_label_to_ctl(pert_heat_flux, array_c2i) + call set_field_label_to_ctl(composite_flux, array_c2i) + call set_field_label_to_ctl(pert_comp_flux, array_c2i) +! + end subroutine set_base_force_names_to_ctl ! ! ---------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/SERIAL_src/Fields/m_diff_vector_labels.f90 b/src/Fortran_libraries/SERIAL_src/Fields/m_diff_vector_labels.f90 index 710f0a70..a4c8ef27 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/m_diff_vector_labels.f90 +++ b/src/Fortran_libraries/SERIAL_src/Fields/m_diff_vector_labels.f90 @@ -9,8 +9,8 @@ !!@verbatim !! logical function check_difference_vectors(field_name) !! -!! integer(kind = kint) function num_difference_vector() -!! subroutine set_differnce_vector_labels(n_comps, names, maths) +!! subroutine set_differnce_vector_names(array_c2i) +!! type(ctl_array_c2i), intent(inout) :: array_c2i !! !! !!!!! diffrence of vector fields !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! @@ -37,9 +37,6 @@ module m_diff_vector_labels use t_field_labels ! implicit none -! - integer(kind = kint), parameter, private :: ngrad_vector = 15 -! ! ! difference of field !> Field label for gradient of velocity @@ -173,57 +170,32 @@ end function check_difference_vectors ! ! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_difference_vector() - num_difference_vector = ngrad_vector - return - end function num_difference_vector -! -! ---------------------------------------------------------------------- ! - subroutine set_differnce_vector_labels(n_comps, names, maths) -! - integer(kind = kint_4b), intent(inout) :: n_comps(ngrad_vector) - character(len = kchara), intent(inout) :: names(ngrad_vector) - character(len = kchara), intent(inout) :: maths(ngrad_vector) -! -! - call set_field_labels(grad_v_1, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(grad_v_2, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(grad_v_3, & - & n_comps( 3), names( 3), maths( 3)) -! - call set_field_labels(grad_w_1, & - & n_comps( 4), names( 4), maths( 4)) - call set_field_labels(grad_w_2, & - & n_comps( 5), names( 5), maths( 5)) - call set_field_labels(grad_w_3, & - & n_comps( 6), names( 6), maths( 6)) -! - call set_field_labels(grad_b_1, & - & n_comps( 7), names( 7), maths( 7)) - call set_field_labels(grad_b_2, & - & n_comps( 8), names( 8), maths( 8)) - call set_field_labels(grad_b_3, & - & n_comps( 9), names( 9), maths( 9)) -! - call set_field_labels(grad_a_1, & - & n_comps(10), names(10), maths(10)) - call set_field_labels(grad_a_2, & - & n_comps(11), names(11), maths(11)) - call set_field_labels(grad_a_3, & - & n_comps(12), names(12), maths(12)) -! - call set_field_labels(grad_j_1, & - & n_comps(13), names(13), maths(13)) - call set_field_labels(grad_j_2, & - & n_comps(14), names(14), maths(14)) - call set_field_labels(grad_j_3, & - & n_comps(15), names(15), maths(15)) -! - end subroutine set_differnce_vector_labels + subroutine set_differnce_vector_names(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i +! + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) +! + call set_field_label_to_ctl(grad_v_1, array_c2i) + call set_field_label_to_ctl(grad_v_2, array_c2i) + call set_field_label_to_ctl(grad_v_3, array_c2i) + call set_field_label_to_ctl(grad_w_1, array_c2i) + call set_field_label_to_ctl(grad_w_2, array_c2i) + call set_field_label_to_ctl(grad_w_3, array_c2i) + call set_field_label_to_ctl(grad_b_1, array_c2i) + call set_field_label_to_ctl(grad_b_2, array_c2i) + call set_field_label_to_ctl(grad_b_3, array_c2i) + call set_field_label_to_ctl(grad_a_1, array_c2i) + call set_field_label_to_ctl(grad_a_2, array_c2i) + call set_field_label_to_ctl(grad_a_3, array_c2i) + call set_field_label_to_ctl(grad_j_1, array_c2i) + call set_field_label_to_ctl(grad_j_2, array_c2i) + call set_field_label_to_ctl(grad_j_3, array_c2i) +! + end subroutine set_differnce_vector_names ! ! ---------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/SERIAL_src/Fields/m_diffusion_term_labels.f90 b/src/Fortran_libraries/SERIAL_src/Fields/m_diffusion_term_labels.f90 index 4224de23..024cc6b5 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/m_diffusion_term_labels.f90 +++ b/src/Fortran_libraries/SERIAL_src/Fields/m_diffusion_term_labels.f90 @@ -12,10 +12,9 @@ !! logical function check_scalar_diffusion(field_name) !! logical function check_diffusivity(field_name) !! -!! integer(kind = kint) function num_base_diffusions() -!! integer(kind = kint) function num_base_diffusivities() -!! subroutine set_base_diffusion_labels(n_comps, names, maths) -!! subroutine set_base_diffusivity_labels(n_comps, names, maths) +!! subroutine set_base_diffusion_names(array_c2i) +!! subroutine set_base_diffusivity_names(array_c2i) +!! type(ctl_array_c2i), intent(inout) :: array_c2i !! !! !!!!! SGS model coefficients names !!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! @@ -50,12 +49,6 @@ module m_diffusion_term_labels ! implicit none ! -!> Numbder of diffusion terms - integer(kind = kint), parameter, private :: ndiffusion = 7 -!> Numbder of diffusivities - integer(kind = kint), parameter, private :: ndiffusivities = 7 -! -! !> Field label for viscous diffusion !! @f$ \nu \partial_{j}\partial_{j} u_{i} @f$ type(field_def), parameter :: viscous_diffusion & @@ -201,72 +194,44 @@ end function check_diffusivity ! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- ! - integer(kind = kint) function num_base_diffusions() - num_base_diffusions = ndiffusion - return - end function num_base_diffusions -! -! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_base_diffusivities() - num_base_diffusivities = ndiffusivities - return - end function num_base_diffusivities -! -! ---------------------------------------------------------------------- + subroutine set_base_diffusion_names(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i ! - subroutine set_base_diffusion_labels(n_comps, names, maths) + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) ! - integer(kind = kint_4b), intent(inout) :: n_comps(ndiffusion) - character(len = kchara), intent(inout) :: names(ndiffusion) - character(len = kchara), intent(inout) :: maths(ndiffusion) + call set_field_label_to_ctl(viscous_diffusion, array_c2i) + call set_field_label_to_ctl(vorticity_diffusion, array_c2i) + call set_field_label_to_ctl(vector_potential_diffusion, & + & array_c2i) + call set_field_label_to_ctl(magnetic_diffusion, array_c2i) + call set_field_label_to_ctl(thermal_diffusion, array_c2i) + call set_field_label_to_ctl(composition_diffusion, array_c2i) + call set_field_label_to_ctl(div_viscousity, array_c2i) ! -! - call set_field_labels(viscous_diffusion, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(vorticity_diffusion, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(vector_potential_diffusion, & - & n_comps( 3), names( 3), maths( 3)) - call set_field_labels(magnetic_diffusion, & - & n_comps( 4), names( 4), maths( 4)) - call set_field_labels(thermal_diffusion, & - & n_comps( 5), names( 5), maths( 5)) -! - call set_field_labels(composition_diffusion, & - & n_comps( 6), names( 6), maths( 6)) -! - call set_field_labels(div_viscousity, & - & n_comps( 7), names( 7), maths( 7)) -! - end subroutine set_base_diffusion_labels + end subroutine set_base_diffusion_names ! ! ---------------------------------------------------------------------- ! - subroutine set_base_diffusivity_labels(n_comps, names, maths) -! - integer(kind = kint_4b), intent(inout) :: n_comps(ndiffusivities) - character(len = kchara), intent(inout) :: names(ndiffusivities) - character(len = kchara), intent(inout) :: maths(ndiffusivities) -! + subroutine set_base_diffusivity_names(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i ! - call set_field_labels(kinetic_viscosity, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(magnetic_diffusivity, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(thermal_diffusivity, & - & n_comps( 3), names( 3), maths( 3)) - call set_field_labels(chemical_diffusivity, & - & n_comps( 4), names( 4), maths( 4)) + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) ! - call set_field_labels(viscosity, & - & n_comps( 5), names( 5), maths( 5)) - call set_field_labels(thermal_conductivity, & - & n_comps( 6), names( 6), maths( 6)) - call set_field_labels(chemical_conductivity, & - & n_comps( 7), names( 7), maths( 7)) + call set_field_label_to_ctl(kinetic_viscosity, array_c2i) + call set_field_label_to_ctl(magnetic_diffusivity, array_c2i) + call set_field_label_to_ctl(thermal_diffusivity, array_c2i) + call set_field_label_to_ctl(chemical_diffusivity, array_c2i) + call set_field_label_to_ctl(viscosity, array_c2i) + call set_field_label_to_ctl(thermal_conductivity, array_c2i) + call set_field_label_to_ctl(chemical_conductivity, array_c2i) ! - end subroutine set_base_diffusivity_labels + end subroutine set_base_diffusivity_names ! ! ---------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/SERIAL_src/Fields/m_div_force_labels.f90 b/src/Fortran_libraries/SERIAL_src/Fields/m_div_force_labels.f90 index b0a282bd..33cac777 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/m_div_force_labels.f90 +++ b/src/Fortran_libraries/SERIAL_src/Fields/m_div_force_labels.f90 @@ -11,8 +11,8 @@ !! logical function check_div_flux_tensor(field_name) !! logical function check_div_scalar_flux(field_name) !! -!! integer(kind = kint) function num_div_forces() -!! subroutine set_div_force_labels(n_comps, names, maths) +!! subroutine set_div_force_names(array_c2i) +!! type(ctl_array_c2i), intent(inout) :: array_c2i !! !! !!!!! divergence of forces by filtered field !!!!!!!!!!!!!!!!!! !! @@ -42,9 +42,6 @@ module m_div_force_labels use m_phys_constants use t_field_labels ! -!> Number of field labels - integer(kind = kint), parameter, private :: ndiv_force = 12 -! ! divergence of momentum equations !> Field label for divergence of advection !! @f$ - \partial_{i} @@ -181,49 +178,29 @@ end function check_div_scalar_flux ! ! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_div_forces() - num_div_forces = ndiv_force - return - end function num_div_forces -! -! ---------------------------------------------------------------------- ! - subroutine set_div_force_labels(n_comps, names, maths) -! - integer(kind = kint_4b), intent(inout) :: n_comps(ndiv_force) - character(len = kchara), intent(inout) :: names(ndiv_force) - character(len = kchara), intent(inout) :: maths(ndiv_force) -! -! - call set_field_labels(div_inertia, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(div_Coriolis_force, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(div_Lorentz_force, & - & n_comps( 3), names( 3), maths( 3)) - call set_field_labels(div_buoyancy, & - & n_comps( 4), names( 4), maths( 4)) - call set_field_labels(div_composite_buoyancy, & - & n_comps( 5), names( 5), maths( 5)) -! - call set_field_labels(div_momentum_flux, & - & n_comps( 6), names( 6), maths( 6)) - call set_field_labels(div_maxwell_tensor, & - & n_comps( 7), names( 7), maths( 7)) - call set_field_labels(div_induction_tensor, & - & n_comps( 8), names( 8), maths( 8)) -! - call set_field_labels(div_heat_flux, & - & n_comps( 9), names( 9), maths( 9)) - call set_field_labels(div_pert_heat_flux, & - & n_comps(10), names(10), maths(10)) - call set_field_labels(div_composition_flux, & - & n_comps(11), names(11), maths(11)) - call set_field_labels(div_pert_composition_flux, & - & n_comps(12), names(12), maths(12)) -! - end subroutine set_div_force_labels + subroutine set_div_force_names(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i +! + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) +! + call set_field_label_to_ctl(div_inertia, array_c2i) + call set_field_label_to_ctl(div_Coriolis_force, array_c2i) + call set_field_label_to_ctl(div_Lorentz_force, array_c2i) + call set_field_label_to_ctl(div_buoyancy, array_c2i) + call set_field_label_to_ctl(div_composite_buoyancy, array_c2i) + call set_field_label_to_ctl(div_momentum_flux, array_c2i) + call set_field_label_to_ctl(div_maxwell_tensor, array_c2i) + call set_field_label_to_ctl(div_induction_tensor, array_c2i) + call set_field_label_to_ctl(div_heat_flux, array_c2i) + call set_field_label_to_ctl(div_pert_heat_flux, array_c2i) + call set_field_label_to_ctl(div_composition_flux, array_c2i) + call set_field_label_to_ctl(div_pert_composition_flux, array_c2i) +! + end subroutine set_div_force_names ! ! ---------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/SERIAL_src/Fields/m_energy_flux_labels.f90 b/src/Fortran_libraries/SERIAL_src/Fields/m_energy_flux_labels.f90 index 1b8b2f3a..228c8e3d 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/m_energy_flux_labels.f90 +++ b/src/Fortran_libraries/SERIAL_src/Fields/m_energy_flux_labels.f90 @@ -10,8 +10,8 @@ !!@verbatim !! logical function check_enegy_fluxes(field_name) !! -!! integer(kind = kint) function num_energy_fluxes() -!! subroutine set_energy_flux_names(n_comps, names, maths) +!! subroutine set_energy_flux_names(array_c2i) +!! type(ctl_array_c2i), intent(inout) :: array_c2i !! !!!!! energy flux names !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! !! field names [address] @@ -62,9 +62,6 @@ module m_energy_flux_labels ! implicit none ! -! - integer(kind = kint), parameter, private :: nene_flux = 14 -! !> Field label of work of inertia !! @f$ -u_{i} (e_{ijk} \omega_{j} u_{k}) @f$ type(field_def), parameter :: inertia_work & @@ -200,51 +197,28 @@ end function check_enegy_fluxes ! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- ! - integer(kind = kint) function num_energy_fluxes() - num_energy_fluxes = nene_flux - return - end function num_energy_fluxes -! -! ---------------------------------------------------------------------- -! - subroutine set_energy_flux_names(n_comps, names, maths) -! - integer(kind = kint_4b), intent(inout) :: n_comps(nene_flux) - character(len = kchara), intent(inout) :: names(nene_flux) - character(len = kchara), intent(inout) :: maths(nene_flux) -! -! - call set_field_labels(inertia_work, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(work_against_Lorentz, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(Lorentz_work, & - & n_comps( 3), names( 3), maths( 3)) - call set_field_labels(mag_tension_work, & - & n_comps( 4), names( 4), maths( 4)) - call set_field_labels(buoyancy_flux, & - & n_comps( 5), names( 5), maths( 5)) - call set_field_labels(composite_buoyancy_flux, & - & n_comps( 6), names( 6), maths( 6)) -! - call set_field_labels(magnetic_ene_generation, & - & n_comps( 7), names( 7), maths( 7)) - call set_field_labels(magnetic_stretch_flux, & - & n_comps( 8), names( 8), maths( 8)) -! - call set_field_labels(temp_generation, & - & n_comps( 9), names( 9), maths( 9)) - call set_field_labels(pert_temp_generation, & - & n_comps(10), names(10), maths(10)) - call set_field_labels(comp_generation, & - & n_comps(11), names(11), maths(11)) - call set_field_labels(pert_comp_generation, & - & n_comps(12), names(12), maths(12)) -! - call set_field_labels(viscous_ene_diffusion, & - & n_comps(13), names(13), maths(13)) - call set_field_labels(magnetic_ene_diffusion, & - & n_comps(14), names(14), maths(14)) + subroutine set_energy_flux_names(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i +! + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) +! + call set_field_label_to_ctl(inertia_work, array_c2i) + call set_field_label_to_ctl(work_against_Lorentz, array_c2i) + call set_field_label_to_ctl(Lorentz_work, array_c2i) + call set_field_label_to_ctl(mag_tension_work, array_c2i) + call set_field_label_to_ctl(buoyancy_flux, array_c2i) + call set_field_label_to_ctl(composite_buoyancy_flux, array_c2i) + call set_field_label_to_ctl(magnetic_ene_generation, array_c2i) + call set_field_label_to_ctl(magnetic_stretch_flux, array_c2i) + call set_field_label_to_ctl(temp_generation, array_c2i) + call set_field_label_to_ctl(pert_temp_generation, array_c2i) + call set_field_label_to_ctl(comp_generation, array_c2i) + call set_field_label_to_ctl(pert_comp_generation, array_c2i) + call set_field_label_to_ctl(viscous_ene_diffusion, array_c2i) + call set_field_label_to_ctl(magnetic_ene_diffusion, array_c2i) ! end subroutine set_energy_flux_names ! diff --git a/src/Fortran_libraries/SERIAL_src/Fields/m_explicit_term_labels.f90 b/src/Fortran_libraries/SERIAL_src/Fields/m_explicit_term_labels.f90 index f70658aa..35d1a649 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/m_explicit_term_labels.f90 +++ b/src/Fortran_libraries/SERIAL_src/Fields/m_explicit_term_labels.f90 @@ -14,10 +14,9 @@ !! logical function check_vector_check_field(field_name) !! logical function check_scalar_check_field(field_name) !! -!! integer(kind = kint) function num_work_4_explicit() -!! integer(kind = kint) function num_check_fields() -!! subroutine set_work_4_explicit_labels(n_comps, names, maths) -!! subroutine set_check_fields_labels(n_comps, names, maths) +!! subroutine set_explicit_work_names(array_c2i) +!! subroutine set_check_fields_names(array_c2i) +!! type(ctl_array_c2i), intent(inout) :: array_c2i !! !! !!!!! force include SGS terms names !!!!!!!!!!!!!!!!!!!!!!!!!!! !! @@ -66,9 +65,6 @@ module m_explicit_term_labels use t_field_labels ! implicit none -! - integer(kind = kint), parameter, private :: nexp_work = 11 - integer(kind = kint), parameter, private :: ncheck_fld = 12 ! ! arrays for current forces ! @@ -295,95 +291,52 @@ end function check_scalar_check_field ! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- ! - integer(kind = kint) function num_work_4_explicit() - num_work_4_explicit = nexp_work - return - end function num_work_4_explicit -! -! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_check_fields() - num_check_fields = ncheck_fld - return - end function num_check_fields -! -! ---------------------------------------------------------------------- -! - subroutine set_work_4_explicit_labels(n_comps, names, maths) -! - integer(kind = kint_4b), intent(inout) :: n_comps(nexp_work) - character(len = kchara), intent(inout) :: names(nexp_work) - character(len = kchara), intent(inout) :: maths(nexp_work) -! -! - call set_field_labels(sum_forces, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(rot_sum_forces, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(div_sum_forces, & - & n_comps( 3), names( 3), maths( 3)) + subroutine set_explicit_work_names(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i ! - call set_field_labels(previous_momentum, & - & n_comps( 4), names( 4), maths( 4)) - call set_field_labels(previous_induction, & - & n_comps( 5), names( 5), maths( 5)) - call set_field_labels(previous_heat, & - & n_comps( 6), names( 6), maths( 6)) - call set_field_labels(previous_composition, & - & n_comps( 7), names( 7), maths( 7)) + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) ! - call set_field_labels(previous_pressure, & - & n_comps( 8), names( 8), maths( 8)) - call set_field_labels(previous_potential, & - & n_comps( 9), names( 9), maths( 9)) + call set_field_label_to_ctl(sum_forces, array_c2i) + call set_field_label_to_ctl(rot_sum_forces, array_c2i) + call set_field_label_to_ctl(div_sum_forces, array_c2i) + call set_field_label_to_ctl(previous_momentum, array_c2i) + call set_field_label_to_ctl(previous_induction, array_c2i) + call set_field_label_to_ctl(previous_heat, array_c2i) + call set_field_label_to_ctl(previous_composition, array_c2i) + call set_field_label_to_ctl(previous_pressure, array_c2i) + call set_field_label_to_ctl(previous_potential, array_c2i) + call set_field_label_to_ctl(pressure_work, array_c2i) + call set_field_label_to_ctl(m_potential_work, array_c2i) ! - call set_field_labels(pressure_work, & - & n_comps(10), names(10), maths(10)) - call set_field_labels(m_potential_work, & - & n_comps(11), names(11), maths(11)) -! - end subroutine set_work_4_explicit_labels + end subroutine set_explicit_work_names ! ! ---------------------------------------------------------------------- ! - subroutine set_check_fields_labels(n_comps, names, maths) -! - integer(kind = kint_4b), intent(inout) :: n_comps(ncheck_fld) - character(len = kchara), intent(inout) :: names(ncheck_fld) - character(len = kchara), intent(inout) :: maths(ncheck_fld) -! -! - call set_field_labels(check_momentum, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(check_induction, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(check_heat, & - & n_comps( 3), names( 3), maths( 3)) -! - call set_field_labels(check_composition, & - & n_comps( 4), names( 4), maths( 4)) -! - call set_field_labels(check_pressure, & - & n_comps( 5), names( 5), maths( 5)) - call set_field_labels(check_potential, & - & n_comps( 6), names( 6), maths( 6)) -! - call set_field_labels(check_momentum_2, & - & n_comps( 7), names( 7), maths( 7)) -! - call set_field_labels(check_induction_2, & - & n_comps( 8), names( 8), maths( 8)) - call set_field_labels(check_heat_2, & - & n_comps( 9), names( 9), maths( 9)) -! - call set_field_labels(check_composition_2, & - & n_comps(10), names(10), maths(10)) - call set_field_labels(check_pressure_2, & - & n_comps(11), names(11), maths(11)) - call set_field_labels(check_potential_2, & - & n_comps(12), names(12), maths(12)) -! - end subroutine set_check_fields_labels + subroutine set_check_fields_names(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i +! + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) +! + call set_field_label_to_ctl(check_momentum, array_c2i) + call set_field_label_to_ctl(check_induction, array_c2i) + call set_field_label_to_ctl(check_heat, array_c2i) + call set_field_label_to_ctl(check_composition, array_c2i) + call set_field_label_to_ctl(check_pressure, array_c2i) + call set_field_label_to_ctl(check_potential, array_c2i) + call set_field_label_to_ctl(check_momentum_2, array_c2i) + call set_field_label_to_ctl(check_induction_2, array_c2i) + call set_field_label_to_ctl(check_heat_2, array_c2i) + call set_field_label_to_ctl(check_composition_2, array_c2i) + call set_field_label_to_ctl(check_pressure_2, array_c2i) + call set_field_label_to_ctl(check_potential_2, array_c2i) +! + end subroutine set_check_fields_names ! ! ---------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/SERIAL_src/Fields/m_field_component_labels.f90 b/src/Fortran_libraries/SERIAL_src/Fields/m_field_component_labels.f90 index e745db26..b21c4575 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/m_field_component_labels.f90 +++ b/src/Fortran_libraries/SERIAL_src/Fields/m_field_component_labels.f90 @@ -11,8 +11,8 @@ !!@verbatim !! logical function check_field_comp_list(field_name) !! -!! integer(kind = kint) function num_field_comp_list() -!! subroutine set_field_component_labels(n_comps, names, maths) +!! subroutine set_field_component_names(array_c2i) +!! type(ctl_array_c2i), intent(inout) :: array_c2i !! !! !!!!! product of field component names !!!!!!!!!!!!!!!!!!!!!!!!!!! !! @@ -22,6 +22,8 @@ !! theta_velocity [i_velo_t]: !! phi_velocity [i_velo_p]: !! cyl_r_velocity [i_velo_s]: +!! x_velocity [i_velo_x]: +!! y_velocity [i_velo_y]: !! z_velocity [i_velo_z]: !! !! r_magnetic_f [i_magne_r]: @@ -43,9 +45,6 @@ module m_field_component_labels ! implicit none ! - integer(kind = kint), parameter, private :: nfid_comps = 12 -! -! !> Field label for radial velocity @f$ u_{r} @f$ type(field_def), parameter :: r_velocity & & = field_def(n_comp = n_scalar, & @@ -66,6 +65,16 @@ module m_field_component_labels & = field_def(n_comp = n_scalar, & & name = 'cyl_r_velocity', & & math = '$ u_{s} $') +!> Field label for z-componennt of velocity @f$ u_{x} @f$ + type(field_def), parameter :: x_velocity & + & = field_def(n_comp = n_scalar, & + & name = 'x_velocity', & + & math = '$ u_{x} $') +!> Field label for z-componennt of velocity @f$ u_{y} @f$ + type(field_def), parameter :: y_velocity & + & = field_def(n_comp = n_scalar, & + & name = 'y_velocity', & + & math = '$ u_{y} $') !> Field label for z-componennt of velocity @f$ u_{z} @f$ type(field_def), parameter :: z_velocity & & = field_def(n_comp = n_scalar, & @@ -131,6 +140,8 @@ logical function check_field_comp_list(field_name) & .or. (field_name .eq. theta_velocity%name) & & .or. (field_name .eq. phi_velocity%name) & & .or. (field_name .eq. cyl_r_velocity%name) & + & .or. (field_name .eq. x_velocity%name) & + & .or. (field_name .eq. y_velocity%name) & & .or. (field_name .eq. z_velocity%name) & ! & .or. (field_name .eq. r_magnetic_f%name) & @@ -146,48 +157,32 @@ end function check_field_comp_list ! ! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_field_comp_list() - num_field_comp_list = nfid_comps - return - end function num_field_comp_list -! -! ---------------------------------------------------------------------- ! - subroutine set_field_component_labels(n_comps, names, maths) -! - integer(kind = kint_4b), intent(inout) :: n_comps(nfid_comps) - character(len = kchara), intent(inout) :: names(nfid_comps) - character(len = kchara), intent(inout) :: maths(nfid_comps) -! -! - call set_field_labels(r_velocity, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(theta_velocity, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(phi_velocity, & - & n_comps( 3), names( 3), maths( 3)) - call set_field_labels(cyl_r_velocity, & - & n_comps( 4), names( 4), maths( 4)) - call set_field_labels(z_velocity, & - & n_comps( 5), names( 5), maths( 5)) -! - call set_field_labels(r_magnetic_f, & - & n_comps( 6), names( 6), maths( 6)) - call set_field_labels(theta_magnetic_f, & - & n_comps( 7), names( 7), maths( 7)) - call set_field_labels(phi_magnetic_f, & - & n_comps( 8), names( 8), maths( 8)) - call set_field_labels(cyl_r_magnetic_f, & - & n_comps( 9), names( 9), maths( 9)) - call set_field_labels(x_magnetic_f, & - & n_comps(10), names(10), maths(10)) - call set_field_labels(y_magnetic_f, & - & n_comps(11), names(11), maths(11)) - call set_field_labels(z_magnetic_f, & - & n_comps(12), names(12), maths(12)) -! - end subroutine set_field_component_labels + subroutine set_field_component_names(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i +! + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) +! + call set_field_label_to_ctl(r_velocity, array_c2i) + call set_field_label_to_ctl(theta_velocity, array_c2i) + call set_field_label_to_ctl(phi_velocity, array_c2i) + call set_field_label_to_ctl(cyl_r_velocity, array_c2i) + call set_field_label_to_ctl(x_velocity, array_c2i) + call set_field_label_to_ctl(y_velocity, array_c2i) + call set_field_label_to_ctl(z_velocity, array_c2i) +! + call set_field_label_to_ctl(r_magnetic_f, array_c2i) + call set_field_label_to_ctl(theta_magnetic_f, array_c2i) + call set_field_label_to_ctl(phi_magnetic_f, array_c2i) + call set_field_label_to_ctl(cyl_r_magnetic_f, array_c2i) + call set_field_label_to_ctl(x_magnetic_f, array_c2i) + call set_field_label_to_ctl(y_magnetic_f, array_c2i) + call set_field_label_to_ctl(z_magnetic_f, array_c2i) +! + end subroutine set_field_component_names ! ! ---------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/SERIAL_src/Fields/m_field_product_labels.f90 b/src/Fortran_libraries/SERIAL_src/Fields/m_field_product_labels.f90 index 2ca9d5a6..e7fdbc98 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/m_field_product_labels.f90 +++ b/src/Fortran_libraries/SERIAL_src/Fields/m_field_product_labels.f90 @@ -13,8 +13,8 @@ !! logical function check_field_product_vectors(field_name) !! logical function check_field_product_scalars(field_name) !! -!! integer(kind = kint) function num_field_products() -!! subroutine set_field_product_labels(n_comps, names, maths) +!! subroutine set_field_product_names(array_c2i) +!! type(ctl_array_c2i), intent(inout) :: array_c2i !! !! !!!!! product of fields names !!!!!!!!!!!!!!!!!!!!!!!!!!! !! @@ -63,9 +63,6 @@ module m_field_product_labels ! implicit none ! - integer(kind = kint), parameter, private :: nfid_product = 26 -! -! !> Field label for ageostrophic balance !! @f$ -2 e_{ijk} \Omega_{j} u_{k} - \partial_{i} p @f$ type(field_def), parameter :: rest_of_geostrophic & @@ -291,80 +288,43 @@ end function check_field_product_scalars ! ! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_field_products() - num_field_products = nfid_product - return - end function num_field_products -! -! ---------------------------------------------------------------------- ! - subroutine set_field_product_labels(n_comps, names, maths) -! - integer(kind = kint_4b), intent(inout) :: n_comps(nfid_product) - character(len = kchara), intent(inout) :: names(nfid_product) - character(len = kchara), intent(inout) :: maths(nfid_product) -! -! - call set_field_labels(rest_of_geostrophic, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(truncated_magnetic_field, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(electric_field, & - & n_comps( 3), names( 3), maths( 3)) - call set_field_labels(poynting_flux, & - & n_comps( 4), names( 4), maths( 4)) -! - call set_field_labels(kinetic_helicity, & - & n_comps( 5), names( 5), maths( 5)) - call set_field_labels(magnetic_helicity, & - & n_comps( 6), names( 6), maths( 6)) - call set_field_labels(current_helicity, & - & n_comps( 7), names( 7), maths( 7)) - call set_field_labels(cross_helicity, & - & n_comps( 8), names( 8), maths( 8)) -! - call set_field_labels(square_velocity, & - & n_comps( 9), names( 9), maths( 9)) - call set_field_labels(square_vorticity, & - & n_comps(10), names(10), maths(10)) - call set_field_labels(square_magne, & - & n_comps(11), names(11), maths(11)) - call set_field_labels(square_vector_potential, & - & n_comps(12), names(12), maths(12)) - call set_field_labels(square_current, & - & n_comps(13), names(13), maths(13)) - call set_field_labels(square_temperature, & - & n_comps(14), names(14), maths(14)) - call set_field_labels(square_composition, & - & n_comps(15), names(15), maths(15)) -! - call set_field_labels(velocity_scale, & - & n_comps(16), names(16), maths(16)) - call set_field_labels(magnetic_scale, & - & n_comps(17), names(17), maths(17)) - call set_field_labels(temperature_scale, & - & n_comps(18), names(18), maths(18)) - call set_field_labels(composition_scale, & - & n_comps(19), names(19), maths(19)) -! - call set_field_labels(stream_pol_velocity, & - & n_comps(20), names(20), maths(20)) - call set_field_labels(stream_pol_magne, & - & n_comps(21), names(21), maths(21)) -! - call set_field_labels(magnetic_intensity, & - & n_comps(22), names(22), maths(22)) - call set_field_labels(declination, & - & n_comps(23), names(23), maths(23)) - call set_field_labels(inclination, & - & n_comps(24), names(24), maths(24)) - call set_field_labels(vgp_latitude, & - & n_comps(25), names(25), maths(25)) - call set_field_labels(vgp_longigude, & - & n_comps(26), names(26), maths(26)) -! - end subroutine set_field_product_labels + subroutine set_field_product_names(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i +! + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) +! + call set_field_label_to_ctl(rest_of_geostrophic, array_c2i) + call set_field_label_to_ctl(truncated_magnetic_field, array_c2i) + call set_field_label_to_ctl(electric_field, array_c2i) + call set_field_label_to_ctl(poynting_flux, array_c2i) + call set_field_label_to_ctl(kinetic_helicity, array_c2i) + call set_field_label_to_ctl(magnetic_helicity, array_c2i) + call set_field_label_to_ctl(current_helicity, array_c2i) + call set_field_label_to_ctl(cross_helicity, array_c2i) + call set_field_label_to_ctl(square_velocity, array_c2i) + call set_field_label_to_ctl(square_vorticity, array_c2i) + call set_field_label_to_ctl(square_magne, array_c2i) + call set_field_label_to_ctl(square_vector_potential, array_c2i) + call set_field_label_to_ctl(square_current, array_c2i) + call set_field_label_to_ctl(square_temperature, array_c2i) + call set_field_label_to_ctl(square_composition, array_c2i) + call set_field_label_to_ctl(velocity_scale, array_c2i) + call set_field_label_to_ctl(magnetic_scale, array_c2i) + call set_field_label_to_ctl(temperature_scale, array_c2i) + call set_field_label_to_ctl(composition_scale, array_c2i) + call set_field_label_to_ctl(stream_pol_velocity, array_c2i) + call set_field_label_to_ctl(stream_pol_magne, array_c2i) + call set_field_label_to_ctl(magnetic_intensity, array_c2i) + call set_field_label_to_ctl(declination, array_c2i) + call set_field_label_to_ctl(inclination, array_c2i) + call set_field_label_to_ctl(vgp_latitude, array_c2i) + call set_field_label_to_ctl(vgp_longigude, array_c2i) +! + end subroutine set_field_product_names ! ! ---------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/SERIAL_src/Fields/m_field_w_symmetry_labels.f90 b/src/Fortran_libraries/SERIAL_src/Fields/m_field_w_symmetry_labels.f90 index 761a45d7..c786ec53 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/m_field_w_symmetry_labels.f90 +++ b/src/Fortran_libraries/SERIAL_src/Fields/m_field_w_symmetry_labels.f90 @@ -11,8 +11,8 @@ !! logical function check_base_vector_symmetry(field_name) !! logical function check_base_scalar_w_symmetry(field_name) !! -!! integer(kind = kint) function num_fields_w_symmetry() -!! subroutine set_field_w_symmetry_labels(n_comps, names, maths) +!! subroutine set_field_w_symmetry_names(array_c2i) +!! type(ctl_array_c2i), intent(inout) :: array_c2i !! !! !!!!! Base field names !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! @@ -41,9 +41,6 @@ module m_field_w_symmetry_labels ! implicit none ! -! - integer(kind = kint), parameter, private :: nfld_w_sym = 2 * 16 -! !> Field label for symmetric velocity @f$ u_{sym} @f$ type(field_def), parameter :: sym_velocity & & = field_def(n_comp = n_vector, & @@ -300,91 +297,51 @@ end function check_base_scalar_w_symmetry ! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- ! - integer(kind = kint) function num_fields_w_symmetry() - num_fields_w_symmetry = nfld_w_sym - return - end function num_fields_w_symmetry -! -! ---------------------------------------------------------------------- -! - subroutine set_field_w_symmetry_labels(n_comps, names, maths) -! - integer(kind = kint_4b), intent(inout) :: n_comps(nfld_w_sym) - character(len = kchara), intent(inout) :: names(nfld_w_sym) - character(len = kchara), intent(inout) :: maths(nfld_w_sym) -! -! - call set_field_labels(sym_velocity, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(asym_velocity, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(sym_vorticity, & - & n_comps( 3), names( 3), maths( 3)) - call set_field_labels(asym_vorticity, & - & n_comps( 4), names( 4), maths( 4)) - call set_field_labels(sym_pressure, & - & n_comps( 5), names( 5), maths( 5)) - call set_field_labels(asym_pressure, & - & n_comps( 6), names( 6), maths( 6)) -! - call set_field_labels(sym_magnetic_field, & - & n_comps( 7), names( 7), maths( 7)) - call set_field_labels(asym_magnetic_field, & - & n_comps( 8), names( 8), maths( 8)) -! - call set_field_labels(sym_vector_potential, & - & n_comps( 9), names( 9), maths( 9)) - call set_field_labels(asym_vector_potential, & - & n_comps(10), names(10), maths(10)) - call set_field_labels(sym_current_density, & - & n_comps(11), names(11), maths(11)) - call set_field_labels(asym_current_density, & - & n_comps(12), names(12), maths(12)) -! - call set_field_labels(sym_magnetic_potential, & - & n_comps(13), names(13), maths(13)) - call set_field_labels(asym_magnetic_potential, & - & n_comps(14), names(14), maths(14)) - call set_field_labels(sym_scalar_potential, & - & n_comps(15), names(15), maths(15)) - call set_field_labels(asym_scalar_potential, & - & n_comps(16), names(16), maths(16)) -! - call set_field_labels(sym_density, & - & n_comps(17), names(17), maths(17)) - call set_field_labels(asym_density, & - & n_comps(18), names(18), maths(18)) - call set_field_labels(sym_temperature, & - & n_comps(19), names(19), maths(19)) - call set_field_labels(asym_temperature, & - & n_comps(20), names(20), maths(20)) - call set_field_labels(sym_composition, & - & n_comps(21), names(21), maths(21)) - call set_field_labels(asym_composition, & - & n_comps(22), names(22), maths(22)) - call set_field_labels(sym_entropy, & - & n_comps(23), names(23), maths(23)) - call set_field_labels(asym_entropy, & - & n_comps(24), names(24), maths(24)) -! - call set_field_labels(sym_perturbation_density, & - & n_comps(25), names(25), maths(25)) - call set_field_labels(asym_perturbation_density, & - & n_comps(26), names(26), maths(26)) - call set_field_labels(sym_perturbation_temp, & - & n_comps(27), names(27), maths(27)) - call set_field_labels(asym_perturbation_temp, & - & n_comps(28), names(28), maths(28)) - call set_field_labels(sym_perturbation_composition, & - & n_comps(29), names(29), maths(29)) - call set_field_labels(asym_perturbation_composition, & - & n_comps(30), names(30), maths(30)) - call set_field_labels(sym_perturbation_entropy, & - & n_comps(31), names(31), maths(31)) - call set_field_labels(asym_perturbation_entropy, & - & n_comps(32), names(32), maths(32)) -! - end subroutine set_field_w_symmetry_labels + subroutine set_field_w_symmetry_names(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i +! + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) +! + call set_field_label_to_ctl(sym_velocity, array_c2i) + call set_field_label_to_ctl(asym_velocity, array_c2i) + call set_field_label_to_ctl(sym_vorticity, array_c2i) + call set_field_label_to_ctl(asym_vorticity, array_c2i) + call set_field_label_to_ctl(sym_pressure, array_c2i) + call set_field_label_to_ctl(asym_pressure, array_c2i) + call set_field_label_to_ctl(sym_magnetic_field, array_c2i) + call set_field_label_to_ctl(asym_magnetic_field, array_c2i) + call set_field_label_to_ctl(sym_vector_potential, array_c2i) + call set_field_label_to_ctl(asym_vector_potential, array_c2i) + call set_field_label_to_ctl(sym_current_density, array_c2i) + call set_field_label_to_ctl(asym_current_density, array_c2i) + call set_field_label_to_ctl(sym_magnetic_potential, array_c2i) + call set_field_label_to_ctl(asym_magnetic_potential, array_c2i) + call set_field_label_to_ctl(sym_scalar_potential, array_c2i) + call set_field_label_to_ctl(asym_scalar_potential, array_c2i) + call set_field_label_to_ctl(sym_density, array_c2i) + call set_field_label_to_ctl(asym_density, array_c2i) + call set_field_label_to_ctl(sym_temperature, array_c2i) + call set_field_label_to_ctl(asym_temperature, array_c2i) + call set_field_label_to_ctl(sym_composition, array_c2i) + call set_field_label_to_ctl(asym_composition, array_c2i) + call set_field_label_to_ctl(sym_entropy, array_c2i) + call set_field_label_to_ctl(asym_entropy, array_c2i) + call set_field_label_to_ctl(sym_perturbation_density, array_c2i) + call set_field_label_to_ctl(asym_perturbation_density, array_c2i) + call set_field_label_to_ctl(sym_perturbation_temp, array_c2i) + call set_field_label_to_ctl(asym_perturbation_temp, & + & array_c2i) + call set_field_label_to_ctl(sym_perturbation_composition, & + & array_c2i) + call set_field_label_to_ctl(asym_perturbation_composition, & + & array_c2i) + call set_field_label_to_ctl(sym_perturbation_entropy, array_c2i) + call set_field_label_to_ctl(asym_perturbation_entropy, array_c2i) +! + end subroutine set_field_w_symmetry_names ! ! ---------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/SERIAL_src/Fields/m_force_w_sym_labels.f90 b/src/Fortran_libraries/SERIAL_src/Fields/m_force_w_sym_labels.f90 index 1808944b..fa7bb42a 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/m_force_w_sym_labels.f90 +++ b/src/Fortran_libraries/SERIAL_src/Fields/m_force_w_sym_labels.f90 @@ -13,8 +13,8 @@ !! logical function check_flux_tensors_w_sym(field_name) !! logical function check_flux_asym_tensors_w_sym(field_name) !! -!! integer(kind = kint) function num_forces_w_symmetry() -!! subroutine set_force_w_symmetry_names(n_comps, names, maths) +!! subroutine set_force_w_symmetry_names(array_c2i) +!! type(ctl_array_c2i), intent(inout) :: array_c2i !! !! !!!!! Base field names !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! @@ -84,8 +84,6 @@ module m_force_w_sym_labels use t_field_labels ! implicit none -! - integer(kind = kint), parameter, private :: nforce_w_sym = 70 ! !> Field label of advection of momentum !! @f$ u_{symj} \partial_{j} u_{symi} @f$ @@ -675,179 +673,100 @@ end function check_flux_asym_tensors_w_sym ! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- ! - integer(kind = kint) function num_forces_w_symmetry() - num_forces_w_symmetry = nforce_w_sym - return - end function num_forces_w_symmetry -! -! ---------------------------------------------------------------------- -! - subroutine set_force_w_symmetry_names(n_comps, names, maths) -! - integer(kind = kint_4b), intent(inout) :: n_comps(nforce_w_sym) - character(len = kchara), intent(inout) :: names(nforce_w_sym) - character(len = kchara), intent(inout) :: maths(nforce_w_sym) -! -! -! - call set_field_labels(wsym_x_usym, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(wasym_x_uasym, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(wsym_x_uasym, & - & n_comps( 3), names( 3), maths( 3)) - call set_field_labels(wasym_x_usym, & - & n_comps( 4), names( 4), maths( 4)) -! - call set_field_labels(Jsym_x_Bsym, & - & n_comps( 5), names( 5), maths( 5)) - call set_field_labels(Jasym_x_Basym, & - & n_comps( 6), names( 6), maths( 6)) - call set_field_labels(Jsym_x_Basym, & - & n_comps( 7), names( 7), maths( 7)) - call set_field_labels(Jasym_x_Bsym, & - & n_comps( 8), names( 8), maths( 8)) -! - call set_field_labels(Bsym_nabla_Bsym, & - & n_comps( 9), names( 9), maths( 9)) - call set_field_labels(Basym_nabla_Basym, & - & n_comps(10), names(10), maths(10)) - call set_field_labels(Bsym_nabla_Basym, & - & n_comps(11), names(11), maths(11)) - call set_field_labels(Basym_nabla_Bsym, & - & n_comps(12), names(12), maths(12)) -! - call set_field_labels(sym_thermal_buoyancy, & - & n_comps(13), names(13), maths(13)) - call set_field_labels(asym_thermal_buoyancy, & - & n_comps(14), names(14), maths(14)) -! - call set_field_labels(sym_composite_buoyancy, & - & n_comps(15), names(15), maths(15)) - call set_field_labels(asym_composite_buoyancy, & - & n_comps(16), names(16), maths(16)) -! - call set_field_labels(usym_x_Bsym, & - & n_comps(17), names(17), maths(17)) - call set_field_labels(uasym_x_Basym, & - & n_comps(18), names(18), maths(18)) - call set_field_labels(usym_x_Basym, & - & n_comps(19), names(19), maths(19)) - call set_field_labels(uasym_x_Bsym, & - & n_comps(20), names(20), maths(20)) -! - call set_field_labels(rot_usym_x_Bsym, & - & n_comps(21), names(21), maths(21)) - call set_field_labels(rot_uasym_x_Basym, & - & n_comps(22), names(22), maths(22)) - call set_field_labels(rot_usym_x_Basym, & - & n_comps(23), names(23), maths(23)) - call set_field_labels(rot_uasym_x_Bsym, & - & n_comps(24), names(24), maths(24)) -! - call set_field_labels(Bsym_nabla_usym, & - & n_comps(25), names(25), maths(25)) - call set_field_labels(Basym_nabla_uasym, & - & n_comps(26), names(26), maths(26)) - call set_field_labels(Bsym_nabla_uasym, & - & n_comps(27), names(27), maths(27)) - call set_field_labels(Basym_nabla_usym, & - & n_comps(28), names(28), maths(28)) -! - call set_field_labels(usym_nabla_Tsym, & - & n_comps(29), names(29), maths(29)) - call set_field_labels(uasym_nabla_Tasym, & - & n_comps(30), names(30), maths(30)) - call set_field_labels(usym_nabla_Tasym, & - & n_comps(31), names(31), maths(31)) - call set_field_labels(uasym_nabla_Tsym, & - & n_comps(32), names(32), maths(32)) -! - call set_field_labels(usym_nabla_pTsym, & - & n_comps(33), names(33), maths(33)) - call set_field_labels(uasym_nabla_pTasym, & - & n_comps(34), names(34), maths(34)) - call set_field_labels(usym_nabla_pTasym, & - & n_comps(35), names(35), maths(35)) - call set_field_labels(uasym_nabla_pTsym, & - & n_comps(36), names(36), maths(36)) -! - call set_field_labels(usym_nabla_Csym, & - & n_comps(37), names(37), maths(37)) - call set_field_labels(uasym_nabla_Casym, & - & n_comps(38), names(38), maths(38)) - call set_field_labels(usym_nabla_Casym, & - & n_comps(39), names(39), maths(39)) - call set_field_labels(uasym_nabla_Csym, & - & n_comps(40), names(40), maths(40)) -! - call set_field_labels(usym_nabla_pCsym, & - & n_comps(41), names(41), maths(41)) - call set_field_labels(uasym_nabla_pCasym, & - & n_comps(42), names(42), maths(42)) - call set_field_labels(usym_nabla_pCasym, & - & n_comps(43), names(43), maths(43)) - call set_field_labels(uasym_nabla_pCsym, & - & n_comps(44), names(44), maths(44)) -! - call set_field_labels(heat_flux_sym_sym, & - & n_comps(45), names(45), maths(45)) - call set_field_labels(heat_flux_asym_asym, & - & n_comps(46), names(46), maths(46)) - call set_field_labels(heat_flux_sym_asym, & - & n_comps(47), names(47), maths(47)) - call set_field_labels(heat_flux_asym_sym, & - & n_comps(48), names(48), maths(48)) -! - call set_field_labels(pert_h_flux_sym_sym, & - & n_comps(49), names(49), maths(49)) - call set_field_labels(pert_h_flux_asym_asym, & - & n_comps(50), names(50), maths(50)) - call set_field_labels(pert_h_flux_sym_asym, & - & n_comps(51), names(51), maths(51)) - call set_field_labels(pert_h_flux_asym_sym, & - & n_comps(52), names(52), maths(52)) -! - call set_field_labels(composite_flux_sym_sym, & - & n_comps(53), names(53), maths(53)) - call set_field_labels(composite_flux_asym_asym, & - & n_comps(54), names(54), maths(54)) - call set_field_labels(composite_flux_sym_asym, & - & n_comps(55), names(55), maths(55)) - call set_field_labels(composite_flux_asym_sym, & - & n_comps(56), names(56), maths(56)) -! - call set_field_labels(pert_c_flux_sym_sym, & - & n_comps(57), names(57), maths(57)) - call set_field_labels(pert_c_flux_asym_asym, & - & n_comps(58), names(58), maths(58)) - call set_field_labels(pert_c_flux_sym_asym, & - & n_comps(59), names(59), maths(59)) - call set_field_labels(pert_c_flux_asym_sym, & - & n_comps(60), names(60), maths(60)) -! - call set_field_labels(m_flux_sym_sym, & - & n_comps(61), names(61), maths(61)) - call set_field_labels(m_flux_asym_asym, & - & n_comps(62), names(62), maths(62)) - call set_field_labels(m_flux_sym_asym, & - & n_comps(63), names(63), maths(63)) -! - call set_field_labels(maxwell_tensor_sym_sym, & - & n_comps(64), names(64), maths(64)) - call set_field_labels(maxwell_tensor_asym_asym, & - & n_comps(65), names(65), maths(65)) - call set_field_labels(maxwell_tensor_sym_asym, & - & n_comps(66), names(66), maths(66)) -! - call set_field_labels(usym_Bsym, & - & n_comps(67), names(67), maths(67)) - call set_field_labels(uasym_Basym, & - & n_comps(68), names(68), maths(68)) - call set_field_labels(usym_Basym, & - & n_comps(69), names(69), maths(69)) - call set_field_labels(uasym_Bsym, & - & n_comps(70), names(70), maths(70)) + subroutine set_force_w_symmetry_names(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i +! + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) +! + call set_field_label_to_ctl(wsym_x_usym, array_c2i) + call set_field_label_to_ctl(wasym_x_uasym, array_c2i) + call set_field_label_to_ctl(wsym_x_uasym, array_c2i) + call set_field_label_to_ctl(wasym_x_usym, array_c2i) +! + call set_field_label_to_ctl(Jsym_x_Bsym, array_c2i) + call set_field_label_to_ctl(Jasym_x_Basym, array_c2i) + call set_field_label_to_ctl(Jsym_x_Basym, array_c2i) + call set_field_label_to_ctl(Jasym_x_Bsym, array_c2i) +! + call set_field_label_to_ctl(Bsym_nabla_Bsym, array_c2i) + call set_field_label_to_ctl(Basym_nabla_Basym, array_c2i) + call set_field_label_to_ctl(Bsym_nabla_Basym, array_c2i) + call set_field_label_to_ctl(Basym_nabla_Bsym, array_c2i) +! + call set_field_label_to_ctl(sym_thermal_buoyancy, array_c2i) + call set_field_label_to_ctl(asym_thermal_buoyancy, array_c2i) + call set_field_label_to_ctl(sym_composite_buoyancy, array_c2i) + call set_field_label_to_ctl(asym_composite_buoyancy, array_c2i) +! + call set_field_label_to_ctl(usym_x_Bsym, array_c2i) + call set_field_label_to_ctl(uasym_x_Basym, array_c2i) + call set_field_label_to_ctl(usym_x_Basym, array_c2i) + call set_field_label_to_ctl(uasym_x_Bsym, array_c2i) + + call set_field_label_to_ctl(rot_usym_x_Bsym, array_c2i) + call set_field_label_to_ctl(rot_uasym_x_Basym, array_c2i) + call set_field_label_to_ctl(rot_usym_x_Basym, array_c2i) + call set_field_label_to_ctl(rot_uasym_x_Bsym, array_c2i) +! + call set_field_label_to_ctl(Bsym_nabla_usym, array_c2i) + call set_field_label_to_ctl(Basym_nabla_uasym, array_c2i) + call set_field_label_to_ctl(Bsym_nabla_uasym, array_c2i) + call set_field_label_to_ctl(Basym_nabla_usym, array_c2i) +! + call set_field_label_to_ctl(usym_nabla_Tsym, array_c2i) + call set_field_label_to_ctl(uasym_nabla_Tasym, array_c2i) + call set_field_label_to_ctl(usym_nabla_Tasym, array_c2i) + call set_field_label_to_ctl(uasym_nabla_Tsym, array_c2i) +! + call set_field_label_to_ctl(usym_nabla_pTsym, array_c2i) + call set_field_label_to_ctl(uasym_nabla_pTasym, array_c2i) + call set_field_label_to_ctl(usym_nabla_pTasym, array_c2i) + call set_field_label_to_ctl(uasym_nabla_pTsym, array_c2i) +! + call set_field_label_to_ctl(usym_nabla_Csym, array_c2i) + call set_field_label_to_ctl(uasym_nabla_Casym, array_c2i) + call set_field_label_to_ctl(usym_nabla_Casym, array_c2i) +! + call set_field_label_to_ctl(usym_nabla_pCsym, array_c2i) + call set_field_label_to_ctl(uasym_nabla_pCasym, array_c2i) + call set_field_label_to_ctl(usym_nabla_pCasym, array_c2i) + call set_field_label_to_ctl(uasym_nabla_pCsym, array_c2i) +! + call set_field_label_to_ctl(heat_flux_sym_sym, array_c2i) + call set_field_label_to_ctl(heat_flux_asym_asym, array_c2i) + call set_field_label_to_ctl(heat_flux_sym_asym, array_c2i) + call set_field_label_to_ctl(heat_flux_asym_sym, array_c2i) +! + call set_field_label_to_ctl(pert_h_flux_sym_sym, array_c2i) + call set_field_label_to_ctl(pert_h_flux_asym_asym, array_c2i) + call set_field_label_to_ctl(pert_h_flux_sym_asym, array_c2i) + call set_field_label_to_ctl(pert_h_flux_asym_sym, array_c2i) +! + call set_field_label_to_ctl(composite_flux_sym_sym, array_c2i) + call set_field_label_to_ctl(composite_flux_asym_asym, array_c2i) + call set_field_label_to_ctl(composite_flux_sym_asym, array_c2i) + call set_field_label_to_ctl(composite_flux_asym_sym, array_c2i) +! + call set_field_label_to_ctl(pert_c_flux_sym_sym, array_c2i) + call set_field_label_to_ctl(pert_c_flux_asym_asym, array_c2i) + call set_field_label_to_ctl(pert_c_flux_sym_asym, array_c2i) + call set_field_label_to_ctl(pert_c_flux_asym_sym, array_c2i) +! + call set_field_label_to_ctl(m_flux_sym_sym, array_c2i) + call set_field_label_to_ctl(m_flux_asym_asym, array_c2i) + call set_field_label_to_ctl(m_flux_sym_asym, array_c2i) +! + call set_field_label_to_ctl(maxwell_tensor_sym_sym, array_c2i) + call set_field_label_to_ctl(maxwell_tensor_asym_asym, array_c2i) + call set_field_label_to_ctl(maxwell_tensor_sym_asym, array_c2i) +! + call set_field_label_to_ctl(usym_Bsym, array_c2i) + call set_field_label_to_ctl(uasym_Basym, array_c2i) + call set_field_label_to_ctl(usym_Basym, array_c2i) + call set_field_label_to_ctl(uasym_Bsym, array_c2i) ! end subroutine set_force_w_symmetry_names ! diff --git a/src/Fortran_libraries/SERIAL_src/Fields/m_grad_field_labels.f90 b/src/Fortran_libraries/SERIAL_src/Fields/m_grad_field_labels.f90 index 8a9f11c6..14803bc5 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/m_grad_field_labels.f90 +++ b/src/Fortran_libraries/SERIAL_src/Fields/m_grad_field_labels.f90 @@ -10,10 +10,9 @@ !! logical function check_divergence_field(field_name) !! logical function check_gradient_field(field_name) !! -!! integer(kind = kint) function num_divergence_fields() -!! integer(kind = kint) function num_gradient_fields() -!! subroutine set_divergence_field_labels(n_comps, names, maths) -!! subroutine set_gradient_field_labels(n_comps, names, maths) +!! subroutine set_divergence_field_names(array_c2i) +!! subroutine set_gradient_field_names(array_c2i) +!! type(ctl_array_c2i), intent(inout) :: array_c2i !! !!!!! physical values!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! !! field names @@ -49,9 +48,6 @@ module m_grad_field_labels use t_field_labels ! implicit none -! - integer(kind = kint), parameter, private :: ndiv_vector = 3 - integer(kind = kint), parameter, private :: ngrad_scalar = 8 ! !> Divergence of velocity !! @f$ \partial_{i} u_{i} @f$ @@ -166,67 +162,41 @@ end function check_gradient_field ! ! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_divergence_fields() - num_divergence_fields = ndiv_vector - return - end function num_divergence_fields -! -! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_gradient_fields() - num_gradient_fields = ngrad_scalar - return - end function num_gradient_fields -! -! ---------------------------------------------------------------------- ! - subroutine set_divergence_field_labels(n_comps, names, maths) + subroutine set_divergence_field_names(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i ! - integer(kind = kint_4b), intent(inout) :: n_comps(ndiv_vector) - character(len = kchara), intent(inout) :: names(ndiv_vector) - character(len = kchara), intent(inout) :: maths(ndiv_vector) + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) ! + call set_field_label_to_ctl(div_velocity, array_c2i) + call set_field_label_to_ctl(div_magnetic, array_c2i) + call set_field_label_to_ctl(div_vector_potential, array_c2i) ! - call set_field_labels(div_velocity, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(div_magnetic, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(div_vector_potential, & - & n_comps( 3), names( 3), maths( 3)) -! - end subroutine set_divergence_field_labels + end subroutine set_divergence_field_names ! ! ---------------------------------------------------------------------- ! - subroutine set_gradient_field_labels(n_comps, names, maths) -! - integer(kind = kint_4b), intent(inout) :: n_comps(ngrad_scalar) - character(len = kchara), intent(inout) :: names(ngrad_scalar) - character(len = kchara), intent(inout) :: maths(ngrad_scalar) -! -! - call set_field_labels(grad_temp, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(grad_pert_temp, & - & n_comps( 2), names( 2), maths( 2)) -! - call set_field_labels(grad_composition, & - & n_comps( 3), names( 3), maths( 3)) - call set_field_labels(grad_pert_composition, & - & n_comps( 4), names( 4), maths( 4)) + subroutine set_gradient_field_names(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i ! - call set_field_labels(grad_density, & - & n_comps( 5), names( 5), maths( 5)) - call set_field_labels(grad_pert_density, & - & n_comps( 6), names( 6), maths( 6)) + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) ! - call set_field_labels(grad_entropy, & - & n_comps( 7), names( 7), maths( 7)) - call set_field_labels(grad_pert_entropy, & - & n_comps( 8), names( 8), maths( 8)) + call set_field_label_to_ctl(grad_temp, array_c2i) + call set_field_label_to_ctl(grad_pert_temp, array_c2i) + call set_field_label_to_ctl(grad_composition, array_c2i) + call set_field_label_to_ctl(grad_pert_composition, array_c2i) + call set_field_label_to_ctl(grad_density, array_c2i) + call set_field_label_to_ctl(grad_pert_density, array_c2i) + call set_field_label_to_ctl(grad_entropy, array_c2i) + call set_field_label_to_ctl(grad_pert_entropy, array_c2i) ! - end subroutine set_gradient_field_labels + end subroutine set_gradient_field_names ! ! ---------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/SERIAL_src/Fields/m_rot_force_labels.f90 b/src/Fortran_libraries/SERIAL_src/Fields/m_rot_force_labels.f90 index b443e7d9..445c4b76 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/m_rot_force_labels.f90 +++ b/src/Fortran_libraries/SERIAL_src/Fields/m_rot_force_labels.f90 @@ -9,9 +9,8 @@ !!@verbatim !! logical function check_rot_force(field_name) !! -!! integer(kind = kint) function num_rot_forces() -!! subroutine set_rot_force_labels(n_comps, names, maths) -!! +!! subroutine set_rot_force_names(array_c2i) +!! type(ctl_array_c2i), intent(inout) :: array_c2i !! !!!!! difference of forces by filtered field !!!!!!!!!!!!!!!!!! !! !! Field name [Address] @@ -31,9 +30,6 @@ module m_rot_force_labels use m_phys_constants use t_field_labels ! -!> Number of field labels - integer(kind = kint), parameter, private :: nrot_force = 5 -! ! rotation of momentum equations !> Field label for curl of advection !! @f$-e_{ijk} \partial_{j} @@ -97,32 +93,21 @@ end function check_rot_force ! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- ! - integer(kind = kint) function num_rot_forces() - num_rot_forces = nrot_force - return - end function num_rot_forces -! -! ---------------------------------------------------------------------- -! - subroutine set_rot_force_labels(n_comps, names, maths) -! - integer(kind = kint_4b), intent(inout) :: n_comps(nrot_force) - character(len = kchara), intent(inout) :: names(nrot_force) - character(len = kchara), intent(inout) :: maths(nrot_force) + subroutine set_rot_force_names(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i ! + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) ! - call set_field_labels(rot_inertia, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(rot_Coriolis_force, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(rot_Lorentz_force, & - & n_comps( 3), names( 3), maths( 3)) - call set_field_labels(rot_buoyancy, & - & n_comps( 4), names( 4), maths( 4)) - call set_field_labels(rot_composite_buoyancy, & - & n_comps( 5), names( 5), maths( 5)) + call set_field_label_to_ctl(rot_inertia, array_c2i) + call set_field_label_to_ctl(rot_Coriolis_force, array_c2i) + call set_field_label_to_ctl(rot_Lorentz_force, array_c2i) + call set_field_label_to_ctl(rot_buoyancy, array_c2i) + call set_field_label_to_ctl(rot_composite_buoyancy, array_c2i) ! - end subroutine set_rot_force_labels + end subroutine set_rot_force_names ! ! ---------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/SERIAL_src/Fields/m_sym_ene_flux_labels.f90 b/src/Fortran_libraries/SERIAL_src/Fields/m_sym_ene_flux_labels.f90 index 6d352968..502adffc 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/m_sym_ene_flux_labels.f90 +++ b/src/Fortran_libraries/SERIAL_src/Fields/m_sym_ene_flux_labels.f90 @@ -10,8 +10,8 @@ !!@verbatim !! logical function check_filter_enegy_fluxes(field_name) !! -!! integer(kind = kint) function num_sym_ene_fluxes() -!! subroutine set_sym_ene_flax_labels(n_comps, names, maths) +!! subroutine set_sym_ene_flux_names(array_c2i) +!! type(ctl_array_c2i), intent(inout) :: array_c2i !! !! !!!!! List of energy flux by SGS terms !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! @@ -44,8 +44,6 @@ module m_sym_ene_flux_labels use t_field_labels ! implicit none -! - integer(kind = kint), parameter, private :: neflux_w_sym = 10 ! !> Field label of work of inertia !! @f$ u_{i} (\tilde{u}_{j} \partial_{j} \tilde{u}_{i}) @f$, @@ -129,62 +127,45 @@ logical function check_enegy_fluxes_w_sym(field_name) character(len = kchara), intent(in) :: field_name ! ! - check_enegy_fluxes_w_sym & - & = (field_name .eq. mns_us_d_ws_x_ua%name) & - & .or. (field_name .eq. mns_us_d_wa_x_us%name) & - & .or. (field_name .eq. mns_ua_d_ws_x_us%name) & - & .or. (field_name .eq. mns_ua_d_wa_x_ua%name) & - & .or. (field_name .eq. us_d_js_x_ba%name) & - & .or. (field_name .eq. us_d_ja_x_bs%name) & - & .or. (field_name .eq. ua_d_js_x_bs%name) & - & .or. (field_name .eq. ua_d_ja_x_ba%name) & - & .or. (field_name .eq. sym_buoyancy_flux%name) & - & .or. (field_name .eq. asym_buoyancy_flux%name) + check_enegy_fluxes_w_sym & + & = (field_name .eq. mns_us_d_ws_x_ua%name) & + & .or. (field_name .eq. mns_us_d_wa_x_us%name) & + & .or. (field_name .eq. mns_ua_d_ws_x_us%name) & + & .or. (field_name .eq. mns_ua_d_wa_x_ua%name) & + & .or. (field_name .eq. us_d_js_x_ba%name) & + & .or. (field_name .eq. us_d_ja_x_bs%name) & + & .or. (field_name .eq. ua_d_js_x_bs%name) & + & .or. (field_name .eq. ua_d_ja_x_ba%name) & + & .or. (field_name .eq. sym_buoyancy_flux%name) & + & .or. (field_name .eq. asym_buoyancy_flux%name) ! end function check_enegy_fluxes_w_sym ! ! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_sym_ene_fluxes() - num_sym_ene_fluxes = neflux_w_sym - return - end function num_sym_ene_fluxes ! -! ---------------------------------------------------------------------- + subroutine set_sym_ene_flux_names(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i ! - subroutine set_sym_ene_flax_labels(n_comps, names, maths) -! - integer(kind = kint_4b), intent(inout) & - & :: n_comps(neflux_w_sym) - character(len = kchara), intent(inout) :: names(neflux_w_sym) - character(len = kchara), intent(inout) :: maths(neflux_w_sym) -! -! - call set_field_labels(us_d_js_x_ba, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(us_d_ja_x_bs, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(ua_d_js_x_bs, & - & n_comps( 3), names( 3), maths( 3)) - call set_field_labels(ua_d_ja_x_ba, & - & n_comps( 4), names( 4), maths( 4)) -! - call set_field_labels(sym_buoyancy_flux, & - & n_comps( 5), names( 5), maths( 5)) - call set_field_labels(asym_buoyancy_flux, & - & n_comps( 6), names( 6), maths( 6)) -! - call set_field_labels(mns_us_d_ws_x_ua, & - & n_comps( 7), names( 7), maths( 7)) - call set_field_labels(mns_us_d_wa_x_us, & - & n_comps( 8), names( 8), maths( 8)) - call set_field_labels(mns_ua_d_ws_x_us, & - & n_comps( 9), names( 9), maths( 9)) - call set_field_labels(mns_ua_d_wa_x_ua, & - & n_comps( 10), names( 10), maths( 10)) -! - end subroutine set_sym_ene_flax_labels + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) +! + call set_field_label_to_ctl(us_d_js_x_ba, array_c2i) + call set_field_label_to_ctl(us_d_ja_x_bs, array_c2i) + call set_field_label_to_ctl(ua_d_js_x_bs, array_c2i) + call set_field_label_to_ctl(ua_d_ja_x_ba, array_c2i) +! + call set_field_label_to_ctl(sym_buoyancy_flux, array_c2i) + call set_field_label_to_ctl(asym_buoyancy_flux, array_c2i) +! + call set_field_label_to_ctl(mns_us_d_ws_x_ua, array_c2i) + call set_field_label_to_ctl(mns_us_d_wa_x_us, array_c2i) + call set_field_label_to_ctl(mns_ua_d_ws_x_us, array_c2i) + call set_field_label_to_ctl(mns_ua_d_wa_x_ua, array_c2i) +! + end subroutine set_sym_ene_flux_names ! ! ---------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/SERIAL_src/Fields/t_field_component_labels.f90 b/src/Fortran_libraries/SERIAL_src/Fields/t_field_component_labels.f90 index 0499d987..884a3af6 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/t_field_component_labels.f90 +++ b/src/Fortran_libraries/SERIAL_src/Fields/t_field_component_labels.f90 @@ -20,6 +20,8 @@ !! theta_velocity [i_velo_t]: !! phi_velocity [i_velo_p]: !! cyl_r_velocity [i_velo_s]: +!! x_velocity [i_velo_x]: +!! y_velocity [i_velo_y]: !! z_velocity [i_velo_z]: !! !! r_magnetic_f [i_magne_r]: @@ -53,6 +55,10 @@ module t_field_component_labels integer (kind=kint) :: i_velo_p = izero !> Start address for cylindrical radial velocity @f$ u_{s} @f$ integer (kind=kint) :: i_velo_s = izero +!> Start address for x-componennt of velocity @f$ u_{z} @f$ + integer (kind=kint) :: i_velo_x = izero +!> Start address for y-componennt of velocity @f$ u_{z} @f$ + integer (kind=kint) :: i_velo_y = izero !> Start address for z-componennt of velocity @f$ u_{z} @f$ integer (kind=kint) :: i_velo_z = izero ! @@ -106,15 +112,19 @@ subroutine set_field_component_addresses & fld_cmp%i_velo_p = i_phys else if (field_name .eq. cyl_r_velocity%name) then fld_cmp%i_velo_s = i_phys + else if (field_name .eq. x_velocity%name) then + fld_cmp%i_velo_x = i_phys + else if (field_name .eq. y_velocity%name) then + fld_cmp%i_velo_y = i_phys else if (field_name .eq. z_velocity%name) then fld_cmp%i_velo_z = i_phys ! else if (field_name .eq. r_magnetic_f%name) then - fld_cmp%i_magne_r = i_phys + fld_cmp%i_magne_r = i_phys else if (field_name .eq. theta_magnetic_f%name) then - fld_cmp%i_magne_t = i_phys + fld_cmp%i_magne_t = i_phys else if (field_name .eq. phi_magnetic_f%name) then - fld_cmp%i_magne_p = i_phys + fld_cmp%i_magne_p = i_phys else if (field_name .eq. cyl_r_magnetic_f%name) then fld_cmp%i_magne_s = i_phys else if (field_name .eq. x_magnetic_f%name) then diff --git a/src/Fortran_libraries/SERIAL_src/Fields/t_field_labels.f90 b/src/Fortran_libraries/SERIAL_src/Fields/t_field_labels.f90 index 1e4c2a65..080828ad 100644 --- a/src/Fortran_libraries/SERIAL_src/Fields/t_field_labels.f90 +++ b/src/Fortran_libraries/SERIAL_src/Fields/t_field_labels.f90 @@ -17,8 +17,10 @@ !! & math = '$u_{i}$', & !! & n_comp = n_vector) !! -!! subroutine set_field_labels(field, n_comps, field_names, maths) -!! logical function cmp_field_no_case(cmp_chara, field) +!! subroutine set_field_label_to_ctl(field, array_c2i) +!! type(field_def), intent(in) :: field +!! type(ctl_array_c2i), intent(inout) :: array_c2i +!! logical function cmp_field_no_case(cmp_chara, field) !! type(field_def), intent(in) :: field !!@endverbatim ! @@ -46,16 +48,16 @@ module t_field_labels ! ! ---------------------------------------------------------------------- ! - subroutine set_field_labels(field, n_comps, field_names, maths) + subroutine set_field_label_to_ctl(field, array_c2i) +! + use t_control_array_chara2int ! type(field_def), intent(in) :: field - integer(kind = kint_4b), intent(inout) :: n_comps - character(len = kchara), intent(inout) :: field_names - character(len = kchara), intent(inout) :: maths + type(ctl_array_c2i), intent(inout) :: array_c2i ! + character(len = kchara) :: maths, field_names integer(kind = kint) :: i, icou ! - n_comps = int(field%n_comp,KIND(n_comps)) write(field_names, '(a,a1)') trim(field%name) // char(0) ! icou = 0 @@ -65,8 +67,10 @@ subroutine set_field_labels(field, n_comps, field_names, maths) if(icou .ge. 2) exit end do maths(i+1:i+1) = char(0) + call append_c2i_to_ctl_array(field_names, maths, field%n_comp, & + & array_c2i) ! - end subroutine set_field_labels + end subroutine set_field_label_to_ctl ! ! ---------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/SERIAL_src/Fortran2003/Makefile b/src/Fortran_libraries/SERIAL_src/Fortran2003/Makefile index ace255fe..f6eacec6 100644 --- a/src/Fortran_libraries/SERIAL_src/Fortran2003/Makefile +++ b/src/Fortran_libraries/SERIAL_src/Fortran2003/Makefile @@ -13,7 +13,9 @@ MOD_F2003 = $(addsuffix .o,$(basename $(SOURCES)) ) dir_list: @echo 'F2003DIR = $(F2003DIR)' >> $(MAKENAME) -lib_archve: +libtarget: + +lib_archve: libtarget @echo ' $$(AR) $$(ARFLUGS) rcsv $$@ $$(MOD_F2003)' >> $(MAKENAME) diff --git a/src/Fortran_libraries/SERIAL_src/IO/Makefile b/src/Fortran_libraries/SERIAL_src/IO/Makefile index f6dc3565..eb9a1953 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/Makefile +++ b/src/Fortran_libraries/SERIAL_src/IO/Makefile @@ -13,7 +13,9 @@ MOD_IO = $(addsuffix .o,$(basename $(SOURCES)) ) dir_list: @echo 'IO_DIR = $(IO_DIR)' >> $(MAKENAME) -lib_archve: +libtarget: + +lib_archve: libtarget @echo ' $$(AR) $$(ARFLUGS) rcsv $$@ $$(MOD_IO)' >> $(MAKENAME) mod_list: diff --git a/src/Fortran_libraries/SERIAL_src/IO/Makefile.depends b/src/Fortran_libraries/SERIAL_src/IO/Makefile.depends index 07b47080..0806f2dc 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/Makefile.depends +++ b/src/Fortran_libraries/SERIAL_src/IO/Makefile.depends @@ -1,6 +1,6 @@ add_direction_labels.o: $(IO_DIR)/add_direction_labels.f90 m_precision.o $(F90) -c $(F90OPTFLAGS) $< -add_nodal_fields_ctl.o: $(IO_DIR)/add_nodal_fields_ctl.f90 m_precision.o m_machine_parameter.o t_field_labels.o t_control_array_character3.o skip_comment_f.o t_read_control_elements.o +add_nodal_fields_ctl.o: $(IO_DIR)/add_nodal_fields_ctl.f90 m_precision.o m_machine_parameter.o t_field_labels.o t_control_array_character3.o skip_comment_f.o t_control_array_character.o $(F90) -c $(F90OPTFLAGS) $< binary_IO.o: $(IO_DIR)/binary_IO.F90 m_precision.o m_constants.o m_machine_parameter.o m_error_IDs.o t_binary_IO_buffer.o set_parallel_file_name.o transfer_to_long_integers.o byte_swap_f.o $(F90) -c $(F90OPTFLAGS) $(F90CPPFLAGS) $< @@ -20,10 +20,12 @@ ctl_data_4_time_steps_IO.o: $(IO_DIR)/ctl_data_4_time_steps_IO.f90 m_precision.o $(F90) -c $(F90OPTFLAGS) $< ctl_data_platforms_IO.o: $(IO_DIR)/ctl_data_platforms_IO.f90 m_precision.o m_machine_parameter.o t_control_array_character.o t_control_array_integer.o t_ctl_data_4_platforms.o t_read_control_elements.o skip_comment_f.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< -ctl_data_sph_monitor_IO.o: $(IO_DIR)/ctl_data_sph_monitor_IO.f90 m_precision.o t_read_control_elements.o t_control_array_character.o t_ctl_data_sph_vol_spectr.o t_ctl_data_sph_layer_spectr.o t_ctl_data_pick_sph_spectr.o t_ctl_data_gauss_coefs.o t_ctl_data_mid_equator.o t_ctl_data_sph_dipolarity.o t_ctl_data_4_sph_monitor.o skip_comment_f.o write_control_elements.o +ctl_data_sph_monitor_IO.o: $(IO_DIR)/ctl_data_sph_monitor_IO.f90 m_precision.o t_read_control_elements.o t_control_array_character.o t_ctl_data_sph_vol_spectr.o t_ctl_data_sph_layer_spectr.o t_ctl_data_pick_sph_spectr.o t_ctl_data_gauss_coefs.o t_ctl_data_mid_equator.o t_ctl_data_sph_dipolarity.o t_ctl_data_4_sph_monitor.o skip_comment_f.o ctl_data_volume_spectr_IO.o t_ctl_data_circles.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< ctl_data_sphere_model_IO.o: $(IO_DIR)/ctl_data_sphere_model_IO.f90 m_precision.o t_control_array_character.o t_control_array_real.o t_control_array_integer.o t_control_array_charaint.o t_control_array_integer2.o t_control_array_intreal.o t_ctl_data_4_sphere_model.o m_machine_parameter.o t_read_control_elements.o skip_comment_f.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< +ctl_data_volume_spectr_IO.o: $(IO_DIR)/ctl_data_volume_spectr_IO.f90 m_precision.o t_read_control_elements.o t_ctl_data_sph_vol_spectr.o t_ctl_data_4_sph_monitor.o skip_comment_f.o write_control_elements.o + $(F90) -c $(F90OPTFLAGS) $< data_IO_to_textline.o: $(IO_DIR)/data_IO_to_textline.f90 m_precision.o m_constants.o $(F90) -c $(F90OPTFLAGS) $< delete_data_files.o: $(IO_DIR)/delete_data_files.F90 m_precision.o m_file_format_switch.o set_parallel_file_name.o @@ -66,7 +68,7 @@ gz_field_data_IO_b.o: $(IO_DIR)/gz_field_data_IO_b.f90 m_precision.o m_constants $(F90) -c $(F90OPTFLAGS) $< gz_field_file_IO_b.o: $(IO_DIR)/gz_field_file_IO_b.f90 m_precision.o m_constants.o m_machine_parameter.o t_time_data.o t_field_data_IO.o t_buffer_4_gzip.o gz_field_data_IO_b.o gz_binary_IO.o binary_IO.o transfer_to_long_integers.o gzip_file_access.o $(F90) -c $(F90OPTFLAGS) $< -m_component_flags.o: $(IO_DIR)/m_component_flags.f90 m_precision.o m_phys_constants.o t_field_labels.o +m_component_flags.o: $(IO_DIR)/m_component_flags.f90 m_precision.o m_phys_constants.o t_field_labels.o t_control_array_chara2int.o $(F90) -c $(F90OPTFLAGS) $< m_default_file_prefix.o: $(IO_DIR)/m_default_file_prefix.f90 m_precision.o $(F90) -c $(F90OPTFLAGS) $< @@ -78,7 +80,7 @@ m_field_file_format.o: $(IO_DIR)/m_field_file_format.f90 m_precision.o m_file_fo $(F90) -c $(F90OPTFLAGS) $< m_field_file_format_labels.o: $(IO_DIR)/m_field_file_format_labels.f90 m_precision.o m_constants.o m_file_format_labels.o t_multi_flag_labels.o $(F90) -c $(F90OPTFLAGS) $< -m_file_format_labels.o: $(IO_DIR)/m_file_format_labels.f90 m_precision.o m_constants.o t_multi_flag_labels.o t_read_control_elements.o skip_comment_f.o +m_file_format_labels.o: $(IO_DIR)/m_file_format_labels.f90 m_precision.o m_constants.o t_multi_flag_labels.o t_control_array_character.o skip_comment_f.o $(F90) -c $(F90OPTFLAGS) $< m_file_format_switch.o: $(IO_DIR)/m_file_format_switch.f90 m_precision.o m_constants.o m_file_format_labels.o t_multi_flag_labels.o t_control_array_character.o skip_comment_f.o $(F90) -c $(F90OPTFLAGS) $< @@ -192,6 +194,8 @@ surface_data_IO_b.o: $(IO_DIR)/surface_data_IO_b.f90 m_precision.o t_comm_table. $(F90) -c $(F90OPTFLAGS) $< t_IO_step_parameter.o: $(IO_DIR)/t_IO_step_parameter.f90 m_precision.o m_constants.o t_control_array_integer.o t_control_array_real.o t_time_data.o $(F90) -c $(F90OPTFLAGS) $< +t_control_array_chara2int.o: $(IO_DIR)/t_control_array_chara2int.f90 m_precision.o m_machine_parameter.o t_read_control_elements.o write_control_elements.o skip_comment_f.o + $(F90) -c $(F90OPTFLAGS) $< t_control_array_chara2real.o: $(IO_DIR)/t_control_array_chara2real.f90 m_precision.o m_machine_parameter.o t_read_control_elements.o write_control_elements.o skip_comment_f.o $(F90) -c $(F90OPTFLAGS) $< t_control_array_character.o: $(IO_DIR)/t_control_array_character.f90 m_precision.o m_machine_parameter.o t_read_control_elements.o write_control_elements.o skip_comment_f.o @@ -204,7 +208,7 @@ t_control_array_charaint.o: $(IO_DIR)/t_control_array_charaint.f90 m_precision.o $(F90) -c $(F90OPTFLAGS) $< t_control_array_charaint3.o: $(IO_DIR)/t_control_array_charaint3.f90 m_precision.o m_machine_parameter.o t_read_control_elements.o write_control_elements.o skip_comment_f.o $(F90) -c $(F90OPTFLAGS) $< -t_control_array_charareal.o: $(IO_DIR)/t_control_array_charareal.f90 m_precision.o m_machine_parameter.o t_read_control_elements.o write_control_elements.o skip_comment_f.o +t_control_array_charareal.o: $(IO_DIR)/t_control_array_charareal.f90 m_precision.o m_machine_parameter.o t_read_control_elements.o write_control_elements.o skip_comment_f.o write_control_items.o $(F90) -c $(F90OPTFLAGS) $< t_control_array_charareal2.o: $(IO_DIR)/t_control_array_charareal2.f90 m_precision.o m_machine_parameter.o t_read_control_elements.o write_control_elements.o skip_comment_f.o $(F90) -c $(F90OPTFLAGS) $< @@ -236,7 +240,7 @@ t_ctl_data_4_fields.o: $(IO_DIR)/t_ctl_data_4_fields.f90 m_precision.o m_machine $(F90) -c $(F90OPTFLAGS) $< t_ctl_data_4_platforms.o: $(IO_DIR)/t_ctl_data_4_platforms.f90 m_precision.o m_machine_parameter.o t_control_array_character.o t_control_array_integer.o $(F90) -c $(F90OPTFLAGS) $< -t_ctl_data_4_sph_monitor.o: $(IO_DIR)/t_ctl_data_4_sph_monitor.f90 m_precision.o t_read_control_elements.o t_control_array_character.o t_ctl_data_sph_vol_spectr.o t_ctl_data_sph_layer_spectr.o t_ctl_data_pick_sph_spectr.o t_ctl_data_gauss_coefs.o t_ctl_data_circles.o t_ctl_data_dynamobench.o t_ctl_data_sph_dipolarity.o skip_comment_f.o +t_ctl_data_4_sph_monitor.o: $(IO_DIR)/t_ctl_data_4_sph_monitor.f90 m_precision.o t_read_control_elements.o t_control_array_character.o t_ctl_data_sph_vol_spectr.o t_ctl_data_sph_layer_spectr.o t_ctl_data_pick_sph_spectr.o t_ctl_data_gauss_coefs.o t_ctl_data_mid_equator.o t_ctl_data_dynamobench.o t_ctl_data_sph_dipolarity.o skip_comment_f.o $(F90) -c $(F90OPTFLAGS) $< t_ctl_data_4_sphere_model.o: $(IO_DIR)/t_ctl_data_4_sphere_model.f90 m_precision.o t_control_array_character.o t_control_array_real.o t_control_array_integer.o t_control_array_charaint.o t_control_array_integer2.o t_control_array_intreal.o $(F90) -c $(F90OPTFLAGS) $< @@ -244,7 +248,7 @@ t_ctl_data_4_time_steps.o: $(IO_DIR)/t_ctl_data_4_time_steps.f90 m_precision.o m $(F90) -c $(F90OPTFLAGS) $< t_ctl_data_FEM_sleeve_size.o: $(IO_DIR)/t_ctl_data_FEM_sleeve_size.f90 m_precision.o t_control_array_character.o t_control_array_integer.o t_control_array_real.o m_machine_parameter.o t_read_control_elements.o skip_comment_f.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< -t_ctl_data_circles.o: $(IO_DIR)/t_ctl_data_circles.f90 m_precision.o t_read_control_elements.o t_ctl_data_mid_equator.o skip_comment_f.o write_control_elements.o +t_ctl_data_circles.o: $(IO_DIR)/t_ctl_data_circles.f90 m_precision.o t_read_control_elements.o t_ctl_data_4_sph_monitor.o t_ctl_data_mid_equator.o skip_comment_f.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< t_ctl_data_dimless_numbers.o: $(IO_DIR)/t_ctl_data_dimless_numbers.f90 m_precision.o m_machine_parameter.o skip_comment_f.o t_read_control_elements.o t_control_array_charareal.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< diff --git a/src/Fortran_libraries/SERIAL_src/IO/add_nodal_fields_ctl.f90 b/src/Fortran_libraries/SERIAL_src/IO/add_nodal_fields_ctl.f90 index 7f86ee2d..183257a9 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/add_nodal_fields_ctl.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/add_nodal_fields_ctl.f90 @@ -20,10 +20,9 @@ !! character(len = kchara) function set_monitor_control_flag & !! & (iflag_fld_monitor) !! -!! integer(kind = kint) function num_ctl_flag_visualize_field() -!! integer(kind = kint) function num_ctl_flag_monitored_field() -!! subroutine set_ctl_flag_visualize_field(names) -!! subroutine set_ctl_flag_monitored_field(names) +!! subroutine field_viz_flag_array(array_c) +!! subroutine field_monitor_flag_array(array_c) +!! type(ctl_array_chara), intent(inout) :: array_c !!@endverbatim ! module add_nodal_fields_ctl @@ -35,7 +34,6 @@ module add_nodal_fields_ctl ! implicit none ! - integer(kind = kint), parameter :: n_label_viz_flag = 2 character(len = kchara), parameter :: cflag_viz_on = 'Viz_On' character(len = kchara), parameter :: cflag_viz_off = 'Viz_Off' ! @@ -190,47 +188,35 @@ character(len = kchara) function set_monitor_control_flag & end function set_monitor_control_flag ! ! ----------------------------------------------------------------------- -! --------------------------------------------------------------------- -! - integer(kind = kint) function num_ctl_flag_visualize_field() - num_ctl_flag_visualize_field = n_label_viz_flag - return - end function num_ctl_flag_visualize_field -! -! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_ctl_flag_monitored_field() - num_ctl_flag_monitored_field = n_label_viz_flag - return - end function num_ctl_flag_monitored_field -! ! ---------------------------------------------------------------------- ! - subroutine set_ctl_flag_visualize_field(names) + subroutine field_viz_flag_array(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c ! - use t_read_control_elements + array_c%array_name = ' ' + array_c%num = 0 + call alloc_control_array_chara(array_c) ! - character(len = kchara), intent(inout) :: names(n_label_viz_flag) + call append_c_to_ctl_array(cflag_viz_on, array_c) + call append_c_to_ctl_array(cflag_viz_off, array_c) ! -! - call set_control_labels(cflag_viz_on, names( 1)) - call set_control_labels(cflag_viz_off, names( 2)) -! - end subroutine set_ctl_flag_visualize_field + end subroutine field_viz_flag_array ! ! ---------------------------------------------------------------------- ! - subroutine set_ctl_flag_monitored_field(names) -! - use t_read_control_elements -! - character(len = kchara), intent(inout) :: names(n_label_viz_flag) + subroutine field_monitor_flag_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 set_control_labels(cflag_monitor_on, names( 1)) - call set_control_labels(cflag_monitor_off, names( 2)) + call append_c_to_ctl_array(cflag_monitor_on, array_c) + call append_c_to_ctl_array(cflag_monitor_off, array_c) ! - end subroutine set_ctl_flag_monitored_field + end subroutine field_monitor_flag_array ! ! ---------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/check_sph_monitor_header.f90 b/src/Fortran_libraries/SERIAL_src/IO/check_sph_monitor_header.f90 index b7e67bab..04551aab 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/check_sph_monitor_header.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/check_sph_monitor_header.f90 @@ -82,30 +82,47 @@ logical function error_sph_vol_monitor_head(id_file, mode_label, & ! character(len=255) :: character_4_read character(len=kchara) :: label(2) + integer(kind = kint) :: iend = 0 ! ! - call skip_comment(character_4_read, id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) then + error_sph_vol_monitor_head = .TRUE. + return + end if read(character_4_read, *) label(1:2) error_sph_vol_monitor_head & & = error_sph_moniter_two_int(id_file, label, nri_sph, ltr_sph) if(error_sph_vol_monitor_head) return ! ! - call skip_comment(character_4_read, id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) then + error_sph_vol_monitor_head = .TRUE. + return + end if read(character_4_read, *) label(1:2) error_sph_vol_monitor_head & & = error_sph_moniter_two_int(id_file, label, & & nlayer_ICB, nlayer_CMB) if(error_sph_vol_monitor_head) return ! - call skip_comment(character_4_read, id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) then + error_sph_vol_monitor_head = .TRUE. + return + end if read(character_4_read, *) label(1:2) error_sph_vol_monitor_head & & = error_sph_moniter_int_real(id_file, label, & & kr_inside, r_inside) if(error_sph_vol_monitor_head) return ! - call skip_comment(character_4_read, id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) then + error_sph_vol_monitor_head = .TRUE. + return + end if read(character_4_read, *) label(1:2) error_sph_vol_monitor_head & & = error_sph_moniter_int_real(id_file, label, & @@ -113,7 +130,11 @@ logical function error_sph_vol_monitor_head(id_file, mode_label, & if(error_sph_vol_monitor_head) return ! ! - call skip_comment(character_4_read, id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) then + error_sph_vol_monitor_head = .TRUE. + return + end if label(1) = 'Number_of_field' label(2) = 'Number_of_component' error_sph_vol_monitor_head & diff --git a/src/Fortran_libraries/SERIAL_src/IO/comm_table_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/comm_table_IO.f90 index 366c7c2a..da3356c3 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/comm_table_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/comm_table_IO.f90 @@ -74,13 +74,14 @@ subroutine read_comm_table(id_file, id_rank, comm_IO, ierr) ! write(id_file,'(a)') '! 2.1 element ID for import ' ! write(id_file,'(a)') '!' ! - call read_import_data(id_file, comm_IO) + call read_import_data(id_file, comm_IO, ierr) + if(ierr .ne. 0) return ! ! write(id_file,'(a)') '!' ! write(id_file,'(a)') '! 2.2 element ID for export ' ! write(id_file,'(a)') '! ' ! - call read_export_data(id_file, comm_IO) + call read_export_data(id_file, comm_IO, ierr) ! end subroutine read_comm_table ! @@ -125,11 +126,12 @@ subroutine read_calypso_comm_tbl & ! call read_domain_info(id_file, id_rank, import_IO, ierr) if(ierr .ne. 0) return - call read_import_data(id_file, import_IO) + call read_import_data(id_file, import_IO, ierr) + if(ierr .ne. 0) return ! call read_domain_info(id_file, id_rank, export_IO, ierr) if(ierr .ne. 0) return - call read_export_data(id_file, export_IO) + call read_export_data(id_file, export_IO, ierr) ! end subroutine read_calypso_comm_tbl ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/comm_table_data_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/comm_table_data_IO.f90 index 9f1b057d..a807d998 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/comm_table_data_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/comm_table_data_IO.f90 @@ -7,13 +7,13 @@ !>@brief Routines for communcation table IO !! !!@verbatim -!! subroutine read_send_recv_item(id_file, ntot_sr, inod_sr) +!! subroutine read_send_recv_item(id_file, ntot_sr, inod_sr, iend) !! subroutine read_send_recv_work(id_file, ntot_sr, nwork, & -!! & inod_sr, idx_work) +!! & inod_sr, idx_work, iend) !! subroutine write_send_recv_data(id_file, num_sr, ntot_sr, & -!! & istack_sr, inod_sr) +!! & istack_sr, inod_sr) !! subroutine write_send_recv_work(id_file, num_sr, ntot_sr, nwork,& -!! & istack_sr, inod_sr, idx_work) +!! & istack_sr, inod_sr, idx_work) !!@endverbatim ! module comm_table_data_IO @@ -31,17 +31,19 @@ module comm_table_data_IO ! ! ----------------------------------------------------------------------- ! - subroutine read_send_recv_item(id_file, ntot_sr, inod_sr) + subroutine read_send_recv_item(id_file, ntot_sr, inod_sr, iend) ! use skip_comment_f ! integer(kind = kint), intent(in) :: id_file integer(kind = kint), intent(in) :: ntot_sr integer(kind = kint), intent(inout) :: inod_sr(ntot_sr) + integer (kind=kint), intent(inout) :: iend ! integer(kind = kint) :: i ! - call skip_comment(character_4_read, id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) inod_sr(1) do i = 2, ntot_sr read(id_file,*) inod_sr(i) @@ -52,7 +54,7 @@ end subroutine read_send_recv_item ! ----------------------------------------------------------------------- ! subroutine read_send_recv_work(id_file, ntot_sr, nwork, & - & inod_sr, idx_work) + & inod_sr, idx_work, iend) ! use skip_comment_f ! @@ -60,11 +62,13 @@ subroutine read_send_recv_work(id_file, ntot_sr, nwork, & integer(kind = kint), intent(in) :: ntot_sr, nwork integer(kind = kint), intent(inout) :: inod_sr(ntot_sr) integer(kind = kint), intent(inout) :: idx_work(ntot_sr,nwork) + integer (kind=kint), intent(inout) :: iend ! integer(kind = kint) :: i ! ! - call skip_comment(character_4_read, id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) inod_sr(1), idx_work(1,1:nwork) do i = 2, ntot_sr read(id_file,*) inod_sr(i), idx_work(i,1:nwork) @@ -76,7 +80,7 @@ end subroutine read_send_recv_work ! ----------------------------------------------------------------------- ! subroutine write_send_recv_data(id_file, num_sr, ntot_sr, & - & istack_sr, inod_sr) + & istack_sr, inod_sr) ! integer(kind = kint), intent(in) :: id_file integer(kind = kint), intent(in) :: num_sr, ntot_sr @@ -103,7 +107,7 @@ end subroutine write_send_recv_data ! ----------------------------------------------------------------------- ! subroutine write_send_recv_work(id_file, num_sr, ntot_sr, nwork, & - & istack_sr, inod_sr, idx_work) + & istack_sr, inod_sr, idx_work) ! integer(kind = kint), intent(in) :: id_file integer(kind = kint), intent(in) :: num_sr, ntot_sr, nwork diff --git a/src/Fortran_libraries/SERIAL_src/IO/ctl_data_4_time_steps_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/ctl_data_4_time_steps_IO.f90 index 20258147..cce0d44f 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/ctl_data_4_time_steps_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/ctl_data_4_time_steps_IO.f90 @@ -8,17 +8,12 @@ !> @brief Control input routine for time step parameters !! !!@verbatim -!! +!! subroutine init_ctl_time_step_label(hd_block, tctl) !! subroutine read_control_time_step_data & !! & (id_control, hd_block, tctl, c_buf) !! type(time_data_control), intent(inout) :: tctl -!! subroutine write_control_time_step_data & -!! & (id_control, hd_block, tctl, level) +!! subroutine write_control_time_step_data(id_control, tctl, level) !! type(time_data_control), intent(in) :: tctl -!! -!! integer(kind = kint) function num_label_time_step_ctl() -!! integer(kind = kint) function num_label_time_step_ctl_w_dep() -!! subroutine set_label_time_step_ctl(names) !! ------------------------------------------------------------------ !! Example of control parameters for flexible time step !! @@ -194,11 +189,6 @@ module ctl_data_4_time_steps_IO & :: hd_i_step_psf = 'i_step_psf_ctl' character(len=kchara), parameter, private & & :: hd_i_step_iso = 'i_step_iso_ctl' -! - integer(kind = kint), parameter, private & - & :: n_label_time_step_ctl = 39 - integer(kind = kint), parameter, private & - & :: n_label_time_step_ctl_w_dep = 41 ! ! ----------------------------------------------------------------------- ! @@ -219,10 +209,12 @@ subroutine read_control_time_step_data & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(tctl%i_tstep .gt. 0) return + tctl%block_name = hd_block + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! ! @@ -333,14 +325,12 @@ end subroutine read_control_time_step_data ! ! -------------------------------------------------------------------- ! - subroutine write_control_time_step_data & - & (id_control, hd_block, tctl, level) + subroutine write_control_time_step_data(id_control, tctl, level) ! use t_read_control_elements use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(time_data_control), intent(in) :: tctl ! integer(kind = kint), intent(inout) :: level @@ -392,192 +382,218 @@ subroutine write_control_time_step_data & maxlen = max(maxlen, len_trim(hd_end_rst_step)) maxlen = max(maxlen, len_trim(hd_flexible_step)) ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! -! + level = write_begin_flag_for_ctl(id_control, level, & + & tctl%block_name) call write_real_ctl_type(id_control, level, maxlen, & - & hd_elapsed_time, tctl%elapsed_time_ctl) + & tctl%elapsed_time_ctl) ! - write(id_control,'(a1)') '!' call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_init, tctl%i_step_init_ctl) + & tctl%i_step_init_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_finish_number, tctl%i_step_number_ctl) + & tctl%i_step_number_ctl) ! - write(id_control,'(a1)') '!' call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_check, tctl%i_step_check_ctl) + & tctl%i_step_check_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_rst, tctl%i_step_rst_ctl) + & tctl%i_step_rst_ctl) ! call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_section, tctl%i_step_psf_ctl) + & tctl%i_step_psf_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_isosurf, tctl%i_step_iso_ctl) + & tctl%i_step_iso_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_map_projection, tctl%i_step_map_ctl) + & tctl%i_step_map_ctl) ! call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_pvr, tctl%i_step_pvr_ctl) + & tctl%i_step_pvr_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_fline, tctl%i_step_fline_ctl) + & tctl%i_step_fline_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_lic, tctl%i_step_lic_ctl) + & tctl%i_step_lic_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_ucd, tctl%i_step_ucd_ctl) + & tctl%i_step_ucd_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_monitor, tctl%i_step_monitor_ctl) + & tctl%i_step_monitor_ctl) ! - write(id_control,'(a1)') '!' call write_real_ctl_type(id_control, level, maxlen, & - & hd_dt, tctl%dt_ctl) + & tctl%dt_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_time_init, tctl%time_init_ctl) + & tctl%time_init_ctl) ! - write(id_control,'(a1)') '!' call write_real_ctl_type(id_control, level, maxlen, & - & hd_min_delta_t, tctl%min_delta_t_ctl) + & tctl%min_delta_t_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_max_delta_t, tctl%max_delta_t_ctl) + & tctl%max_delta_t_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_max_eps_to_shrink, tctl%max_eps_to_shrink_ctl) + & tctl%max_eps_to_shrink_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_min_eps_to_expand, tctl%min_eps_to_expand_ctl) + & tctl%min_eps_to_expand_ctl) ! - write(id_control,'(a1)') '!' call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_check, tctl%delta_t_check_ctl) + & tctl%delta_t_check_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_rst, tctl%delta_t_rst_ctl) + & tctl%delta_t_rst_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_section, tctl%delta_t_psf_ctl) + & tctl%delta_t_psf_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_isosurf, tctl%delta_t_iso_ctl) + & tctl%delta_t_iso_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_map_projection, tctl%delta_t_map_ctl) + & tctl%delta_t_map_ctl) ! call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_pvr, tctl%delta_t_pvr_ctl) + & tctl%delta_t_pvr_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_fline, tctl%delta_t_fline_ctl) + & tctl%delta_t_fline_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_lic, tctl%delta_t_lic_ctl) + & tctl%delta_t_lic_ctl) ! ! - write(id_control,'(a1)') '!' call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_ucd, tctl%delta_t_field_ctl) + & tctl%delta_t_field_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_monitor, tctl%delta_t_monitor_ctl) + & tctl%delta_t_monitor_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_sgs_coefs, tctl%delta_t_sgs_coefs_ctl) + & tctl%delta_t_sgs_coefs_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_boundary, tctl%delta_t_boundary_ctl) + & tctl%delta_t_boundary_ctl) ! call write_real_ctl_type(id_control, level, maxlen, & - & hd_ratio_to_cfl, tctl%ratio_to_cfl_ctl) + & tctl%ratio_to_cfl_ctl) ! call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_sgs_coefs, tctl%i_step_sgs_coefs_ctl) + & tctl%i_step_sgs_coefs_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_boundary, tctl%i_step_boundary_ctl) + & tctl%i_step_boundary_ctl) ! call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_diff_steps, tctl%i_diff_steps_ctl) + & tctl%i_diff_steps_ctl) ! call write_integer_ctl_type(id_control, level, maxlen, & - & hd_start_rst_step, tctl%start_rst_step_ctl) + & tctl%start_rst_step_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_end_rst_step, tctl%end_rst_step_ctl) + & tctl%end_rst_step_ctl) ! - write(id_control,'(a1)') '!' call write_chara_ctl_type(id_control, level, maxlen, & - & hd_flexible_step, tctl%flexible_step_ctl) + & tctl%flexible_step_ctl) ! - level = write_end_flag_for_ctl(id_control, level, hd_block) + level = write_end_flag_for_ctl(id_control, level, & + & tctl%block_name) ! end subroutine write_control_time_step_data ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- ! - integer(kind = kint) function num_label_time_step_ctl() - num_label_time_step_ctl = n_label_time_step_ctl - return - end function num_label_time_step_ctl + subroutine init_ctl_time_step_label(hd_block, tctl) +! + character(len=kchara), intent(in) :: hd_block + type(time_data_control), intent(inout) :: tctl +! +! + tctl%block_name = hd_block ! -! ---------------------------------------------------------------------- + call init_real_ctl_item_label & + & (hd_elapsed_time, tctl%elapsed_time_ctl) ! - integer(kind = kint) function num_label_time_step_ctl_w_dep() - num_label_time_step_ctl_w_dep = n_label_time_step_ctl_w_dep - return - end function num_label_time_step_ctl_w_dep + call init_real_ctl_item_label(hd_dt, tctl%dt_ctl) + call init_real_ctl_item_label & + & (hd_time_init, tctl%time_init_ctl) ! -! ---------------------------------------------------------------------- + call init_real_ctl_item_label(hd_min_delta_t, & + & tctl%min_delta_t_ctl) + call init_real_ctl_item_label(hd_max_delta_t, & + & tctl%max_delta_t_ctl) + call init_real_ctl_item_label(hd_max_eps_to_shrink, & + & tctl%max_eps_to_shrink_ctl) + call init_real_ctl_item_label(hd_min_eps_to_expand, & + & tctl%min_eps_to_expand_ctl) +! + call init_real_ctl_item_label(hd_delta_t_check, & + & tctl%delta_t_check_ctl) + call init_real_ctl_item_label(hd_delta_t_rst, & + & tctl%delta_t_rst_ctl) ! - subroutine set_label_time_step_ctl(names) + call init_real_ctl_item_label(hd_delta_t_section, & + & tctl%delta_t_psf_ctl) + call init_real_ctl_item_label(hd_delta_t_isosurf, & + & tctl%delta_t_iso_ctl) + call init_real_ctl_item_label(hd_delta_t_map_projection, & + & tctl%delta_t_map_ctl) +! + call init_real_ctl_item_label(hd_delta_t_pvr, & + & tctl%delta_t_pvr_ctl) + call init_real_ctl_item_label(hd_delta_t_fline, & + & tctl%delta_t_fline_ctl) + call init_real_ctl_item_label(hd_delta_t_lic, & + & tctl%delta_t_lic_ctl) ! - character(len = kchara), intent(inout) & - & :: names(n_label_time_step_ctl_w_dep) + call init_real_ctl_item_label(hd_delta_t_ucd, & + & tctl%delta_t_field_ctl) + call init_real_ctl_item_label(hd_delta_t_monitor, & + & tctl%delta_t_monitor_ctl) + call init_real_ctl_item_label(hd_delta_t_sgs_coefs, & + & tctl%delta_t_sgs_coefs_ctl) + call init_real_ctl_item_label(hd_delta_t_boundary, & + & tctl%delta_t_boundary_ctl) ! + call init_real_ctl_item_label(hd_ratio_to_cfl, & + & tctl%ratio_to_cfl_ctl) ! - call set_control_labels(hd_elapsed_time, names( 1)) - call set_control_labels(hd_time_init, names( 2)) - call set_control_labels(hd_dt, names( 3)) + call init_int_ctl_item_label(hd_i_step_init, & + & tctl%i_step_init_ctl) + call init_int_ctl_item_label(hd_i_step_number, & + & tctl%i_step_number_ctl) + call init_int_ctl_item_label(hd_i_finish_number, & + & tctl%i_step_number_ctl) ! - call set_control_labels(hd_i_step_init, names( 4)) - call set_control_labels(hd_i_finish_number, names( 5)) - call set_control_labels(hd_i_step_check, names( 6)) - call set_control_labels(hd_i_step_rst, names( 7)) + call init_int_ctl_item_label(hd_i_step_check, & + & tctl%i_step_check_ctl) + call init_int_ctl_item_label(hd_i_step_rst, & + & tctl%i_step_rst_ctl) ! - call set_control_labels(hd_i_step_section, names( 8)) - call set_control_labels(hd_i_step_isosurf, names( 9)) - call set_control_labels(hd_i_step_isosurf, names(10)) - call set_control_labels(hd_i_step_pvr, names(11)) - call set_control_labels(hd_i_step_fline, names(12)) - call set_control_labels(hd_i_step_lic, names(13)) + call init_int_ctl_item_label(hd_i_step_section, & + & tctl%i_step_psf_ctl) + call init_int_ctl_item_label(hd_i_step_psf, & + & tctl%i_step_psf_ctl) ! - call set_control_labels(hd_i_step_ucd, names(14)) - call set_control_labels(hd_i_step_monitor, names(15)) - call set_control_labels(hd_i_step_sgs_coefs, names(16)) - call set_control_labels(hd_i_step_boundary, names(17)) - call set_control_labels(hd_i_diff_steps, names(18)) + call init_int_ctl_item_label(hd_i_step_isosurf, & + & tctl%i_step_iso_ctl) + call init_int_ctl_item_label(hd_i_step_iso, & + & tctl%i_step_iso_ctl) ! + call init_int_ctl_item_label(hd_i_step_map_projection, & + & tctl%i_step_map_ctl) ! - call set_control_labels(hd_flexible_step, names(19)) - call set_control_labels(hd_min_delta_t, names(20)) - call set_control_labels(hd_max_delta_t, names(21)) - call set_control_labels(hd_max_eps_to_shrink, names(22)) - call set_control_labels(hd_min_eps_to_expand, names(23)) + call init_int_ctl_item_label(hd_i_step_pvr, & + & tctl%i_step_pvr_ctl) + call init_int_ctl_item_label(hd_i_step_lic, & + & tctl%i_step_lic_ctl) + call init_int_ctl_item_label(hd_i_step_fline, & + & tctl%i_step_fline_ctl) ! - call set_control_labels(hd_ratio_to_cfl, names(24)) - - call set_control_labels(hd_start_rst_step, names(25)) - call set_control_labels(hd_end_rst_step, names(26)) + call init_int_ctl_item_label(hd_i_step_ucd, & + & tctl%i_step_ucd_ctl) + call init_int_ctl_item_label(hd_i_step_monitor, & + & tctl%i_step_monitor_ctl) ! - call set_control_labels(hd_delta_t_check, names(27)) - call set_control_labels(hd_delta_t_rst, names(28)) + call init_int_ctl_item_label(hd_i_step_sgs_coefs, & + & tctl%i_step_sgs_coefs_ctl) + call init_int_ctl_item_label(hd_i_step_boundary, & + & tctl%i_step_boundary_ctl) ! - call set_control_labels(hd_delta_t_section, names(29)) - call set_control_labels(hd_delta_t_isosurf, names(30)) - call set_control_labels(hd_delta_t_map_projection, names(31)) - call set_control_labels(hd_delta_t_pvr, names(32)) - call set_control_labels(hd_delta_t_fline, names(33)) - call set_control_labels(hd_delta_t_lic, names(34)) + call init_int_ctl_item_label(hd_i_diff_steps, & + & tctl%i_diff_steps_ctl) ! - call set_control_labels(hd_delta_t_ucd, names(35)) - call set_control_labels(hd_delta_t_monitor, names(36)) - call set_control_labels(hd_delta_t_sgs_coefs, names(37)) - call set_control_labels(hd_delta_t_boundary, names(38)) + call init_int_ctl_item_label(hd_start_rst_step, & + & tctl%start_rst_step_ctl) + call init_int_ctl_item_label(hd_end_rst_step, & + & tctl%end_rst_step_ctl) ! ! - call set_control_labels(hd_i_step_number, names(39)) - call set_control_labels(hd_i_step_psf, names(40)) - call set_control_labels(hd_i_step_iso, names(41)) + call init_chara_ctl_item_label(hd_flexible_step, & + & tctl%flexible_step_ctl) ! - end subroutine set_label_time_step_ctl + end subroutine init_ctl_time_step_label ! -! --------------------------------------------------------------------- +! -------------------------------------------------------------------- ! end module ctl_data_4_time_steps_IO diff --git a/src/Fortran_libraries/SERIAL_src/IO/ctl_data_platforms_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/ctl_data_platforms_IO.f90 index 2243ee2f..f5817111 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/ctl_data_platforms_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/ctl_data_platforms_IO.f90 @@ -7,6 +7,7 @@ !> @brief Control input routine for data file headers !! !!@verbatim +!! subroutine init_platforms_labels(hd_block, plt) !! subroutine read_control_platforms & !! & (id_control, hd_block, plt, c_buf) !! type(platform_data_control), intent(inout) :: plt @@ -141,10 +142,13 @@ subroutine read_control_platforms & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(plt%i_platform .gt. 0) return + call init_platforms_labels(hd_block, plt) +! + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! ! @@ -174,9 +178,9 @@ subroutine read_control_platforms & & plt%radial_data_file_name_ctl) ! call read_chara_ctl_type(c_buf, hd_itp_sph_to_fem, & - & plt%interpolate_sph_to_fem_ctl) + & plt%interpolate_sph_to_fem) call read_chara_ctl_type(c_buf, hd_itp_fem_to_sph, & - & plt%interpolate_fem_to_sph_ctl) + & plt%interpolate_fem_to_sph) ! call read_chara_ctl_type(c_buf, hd_rayleigh_spectr_dir, & & plt%rayleigh_spectr_dir) @@ -249,75 +253,137 @@ subroutine write_control_platforms & maxlen = max(maxlen, len_trim(hd_coriolis_file_fmt)) maxlen = max(maxlen, len_trim(hd_del_org_data)) ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! + level = write_begin_flag_for_ctl(id_control, level, & + & hd_block) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_debug_flag_ctl, plt%debug_flag_ctl) + & plt%debug_flag_ctl) ! - write(id_control,'(a1)') '!' call write_integer_ctl_type(id_control, level, maxlen, & - & hd_num_subdomain, plt%ndomain_ctl) + & plt%ndomain_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_num_smp, plt%num_smp_ctl) + & plt%num_smp_ctl) ! - write(id_control,'(a1)') '!' call write_chara_ctl_type(id_control, level, maxlen, & - & hd_mesh_header, plt%mesh_file_prefix) + & plt%mesh_file_prefix) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_sph_files_header, plt%sph_file_prefix) + & plt%sph_file_prefix) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_rst_header, plt%restart_file_prefix) + & plt%restart_file_prefix) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_udt_header, plt%field_file_prefix) + & plt%field_file_prefix) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_spectr_header, plt%spectr_field_file_prefix) + & plt%spectr_field_file_prefix) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_mesh_file_fmt, plt%mesh_file_fmt_ctl) + & plt%mesh_file_fmt_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_sph_files_fmt, plt%sph_file_fmt_ctl) + & plt%sph_file_fmt_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_rst_files_fmt, plt%restart_file_fmt_ctl) + & plt%restart_file_fmt_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_udt_files_fmt, plt%field_file_fmt_ctl) + & plt%field_file_fmt_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_spect_field_fmt, plt%spectr_field_fmt_ctl) + & plt%spectr_field_fmt_ctl) ! - write(id_control,'(a)') '!' call write_chara_ctl_type(id_control, level, maxlen, & - & hd_bc_data_file_name, plt%bc_data_file_name_ctl) + & plt%bc_data_file_name_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_radial_data_file_name, plt%radial_data_file_name_ctl) + & plt%radial_data_file_name_ctl) ! - write(id_control,'(a)') '!' call write_chara_ctl_type(id_control, level, maxlen, & - & hd_rayleigh_spectr_dir, plt%rayleigh_spectr_dir) + & plt%rayleigh_spectr_dir) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_rayleigh_field_dir, plt%rayleigh_field_dir) + & plt%rayleigh_field_dir) ! ! - write(id_control,'(a)') '!' call write_chara_ctl_type(id_control, level, maxlen, & - & hd_coriolis_tri_int_name, plt%coriolis_int_file_name) + & plt%coriolis_int_file_name) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_itp_sph_to_fem, plt%interpolate_sph_to_fem_ctl) + & plt%interpolate_sph_to_fem) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_itp_fem_to_sph, plt%interpolate_fem_to_sph_ctl) + & plt%interpolate_fem_to_sph) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_coriolis_file_fmt, plt%coriolis_file_fmt_ctl) + & plt%coriolis_file_fmt_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_itp_files_fmt, plt%itp_file_fmt_ctl) + & plt%itp_file_fmt_ctl) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_del_org_data, plt%del_org_data_ctl) + & plt%del_org_data_ctl) ! - level = write_end_flag_for_ctl(id_control, level, hd_block) + level = write_end_flag_for_ctl(id_control, level, & + & hd_block) ! end subroutine write_control_platforms ! ! --------------------------------------------------------------------- +! + subroutine init_platforms_labels(hd_block, plt) +! + character(len=kchara), intent(in) :: hd_block + type(platform_data_control), intent(inout) :: plt +! +! + plt%block_name = trim(hd_block) + call init_int_ctl_item_label & + & (hd_num_subdomain, plt%ndomain_ctl) + call init_int_ctl_item_label(hd_num_smp, plt%num_smp_ctl) +! +! + call init_chara_ctl_item_label & + & (hd_mesh_header, plt%mesh_file_prefix) +! + call init_chara_ctl_item_label(hd_udt_header, & + & plt%field_file_prefix) + call init_chara_ctl_item_label(hd_rst_header, & + & plt%restart_file_prefix) + call init_chara_ctl_item_label(hd_spectr_header, & + & plt%spectr_field_file_prefix) +! + call init_chara_ctl_item_label(hd_sph_files_header, & + & plt%sph_file_prefix) +! + call init_chara_ctl_item_label(hd_coriolis_tri_int_name, & + & plt%coriolis_int_file_name) + call init_chara_ctl_item_label(hd_bc_data_file_name, & + & plt%bc_data_file_name_ctl) + call init_chara_ctl_item_label(hd_radial_data_file_name, & + & plt%radial_data_file_name_ctl) +! + call init_chara_ctl_item_label(hd_itp_sph_to_fem, & + & plt%interpolate_sph_to_fem) + call init_chara_ctl_item_label(hd_itp_fem_to_sph, & + & plt%interpolate_fem_to_sph) +! + call init_chara_ctl_item_label(hd_rayleigh_spectr_dir, & + & plt%rayleigh_spectr_dir) + call init_chara_ctl_item_label(hd_rayleigh_field_dir, & + & plt%rayleigh_field_dir) +! + call init_chara_ctl_item_label(hd_mesh_file_fmt, & + & plt%mesh_file_fmt_ctl) + call init_chara_ctl_item_label(hd_rst_files_fmt, & + & plt%restart_file_fmt_ctl) + call init_chara_ctl_item_label(hd_udt_files_fmt, & + & plt%field_file_fmt_ctl) + call init_chara_ctl_item_label(hd_sph_files_fmt, & + & plt%sph_file_fmt_ctl) + call init_chara_ctl_item_label(hd_itp_files_fmt, & + & plt%itp_file_fmt_ctl) + call init_chara_ctl_item_label(hd_spect_field_fmt, & + & plt%spectr_field_fmt_ctl) + call init_chara_ctl_item_label(hd_coriolis_file_fmt, & + & plt%coriolis_file_fmt_ctl) +! + call init_chara_ctl_item_label & + & (hd_debug_flag_ctl, plt%debug_flag_ctl) +! + call init_chara_ctl_item_label & + & (hd_del_org_data, plt%del_org_data_ctl) +! + end subroutine init_platforms_labels +! +! --------------------------------------------------------------------- ! end module ctl_data_platforms_IO diff --git a/src/Fortran_libraries/SERIAL_src/IO/ctl_data_sph_monitor_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/ctl_data_sph_monitor_IO.f90 index 5429a79e..68e3f2a9 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/ctl_data_sph_monitor_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/ctl_data_sph_monitor_IO.f90 @@ -8,6 +8,7 @@ !> @brief Monitoring section IO for Control data !! !!@verbatim +!! subroutine init_sph_monitoring_labels(hd_block, smonitor_ctl) !! subroutine read_sph_monitoring_ctl & !! & (id_control, hd_block, smonitor_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -15,9 +16,8 @@ !! type(sph_monitor_control), intent(inout) :: smonitor_ctl !! type(buffer_for_control), intent(inout) :: c_buf !! subroutine write_sph_monitoring_ctl & -!! & (id_control, hd_block, smonitor_ctl, level) +!! & (id_control, smonitor_ctl, level) !! integer(kind = kint), intent(in) :: id_control -!! character(len=kchara), intent(in) :: hd_block !! type(sph_monitor_control), intent(in) :: smonitor_ctl !! integer(kind = kint), intent(inout) :: level !! subroutine dealloc_sph_monitoring_ctl(smonitor_ctl) @@ -150,10 +150,8 @@ module ctl_data_sph_monitor_IO & :: hd_comp_Nusselt_file_fmt = 'comp_Nusselt_number_format' ! ! Deprecated labels - character(len=kchara), parameter, private & + character(len=kchara), parameter, private & & :: hd_mid_eq_monitor_ctl = 'mid_equator_monitor_ctl' -! - private :: read_volume_spectr_ctl, write_volume_spectr_ctl ! ! ----------------------------------------------------------------------- ! @@ -163,6 +161,9 @@ module ctl_data_sph_monitor_IO ! subroutine read_sph_monitoring_ctl & & (id_control, hd_block, smonitor_ctl, c_buf) +! + use ctl_data_volume_spectr_IO + use t_ctl_data_circles ! integer(kind = kint), intent(in) :: id_control character(len=kchara), intent(in) :: hd_block @@ -170,11 +171,14 @@ subroutine read_sph_monitoring_ctl & type(sph_monitor_control), intent(inout) :: smonitor_ctl type(buffer_for_control), intent(inout) :: c_buf ! +! + if(smonitor_ctl%i_sph_monitor .gt. 0) return + call init_sph_monitoring_labels(hd_block, smonitor_ctl) ! if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return - if(smonitor_ctl%i_sph_monitor .gt. 0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_gauss_spectr_ctl(id_control, hd_gauss_spec_block, & @@ -189,9 +193,9 @@ subroutine read_sph_monitoring_ctl & & hd_dynamobench_ctl, smonitor_ctl%dbench_ctl, c_buf) ! call read_data_on_circles_ctl(id_control, & - & hd_field_on_circle_ctl, smonitor_ctl%circ_ctls, c_buf) + & hd_field_on_circle_ctl, smonitor_ctl, c_buf) call read_data_on_circles_ctl(id_control, & - & hd_mid_eq_monitor_ctl, smonitor_ctl%circ_ctls, c_buf) + & hd_mid_eq_monitor_ctl, smonitor_ctl, c_buf) ! call read_volume_spectr_ctl & & (id_control, hd_vol_spec_block, smonitor_ctl, c_buf) @@ -235,48 +239,16 @@ subroutine read_sph_monitoring_ctl & end subroutine read_sph_monitoring_ctl ! ! ----------------------------------------------------------------------- -! - subroutine read_volume_spectr_ctl & - & (id_control, hd_block, smonitor_ctl, c_buf) -! - integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block - type(sph_monitor_control), intent(inout) :: smonitor_ctl - type(buffer_for_control), intent(inout) :: c_buf -! - type(volume_spectr_control) :: read_vpwr -! -! - if(check_array_flag(c_buf, hd_block) .eqv. .FALSE.) return - if(smonitor_ctl%num_vspec_ctl .gt. 0) return - read_vpwr%i_vol_spectr_ctl = 0 - smonitor_ctl%num_vspec_ctl = 0 - call alloc_volume_spectr_control(smonitor_ctl) -! - do - call load_one_line_from_control(id_control, c_buf) - if(check_end_array_flag(c_buf, hd_block)) exit -! - call read_each_vol_spectr_ctl(id_control, hd_block, & - & read_vpwr, c_buf) - if(read_vpwr%i_vol_spectr_ctl .gt. 0) then - call append_volume_spectr_ctls(read_vpwr, smonitor_ctl) - read_vpwr%i_vol_spectr_ctl = 0 - end if - end do -! - end subroutine read_volume_spectr_ctl -! -! --------------------------------------------------------------------- ! --------------------------------------------------------------------- ! subroutine write_sph_monitoring_ctl & - & (id_control, hd_block, smonitor_ctl, level) + & (id_control, smonitor_ctl, level) ! use write_control_elements + use t_ctl_data_circles + use ctl_data_volume_spectr_IO ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(sph_monitor_control), intent(in) :: smonitor_ctl ! integer(kind = kint), intent(inout) :: level @@ -301,107 +273,88 @@ subroutine write_sph_monitoring_ctl & maxlen = max(maxlen, len_trim(hd_diff_lm_spectr_switch)) maxlen = max(maxlen, len_trim(hd_axis_spectr_switch)) ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! + level = write_begin_flag_for_ctl(id_control, level, & + & smonitor_ctl%block_name) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_voume_ave_head, smonitor_ctl%volume_average_prefix) + & smonitor_ctl%volume_average_prefix) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_voume_rms_head, smonitor_ctl%volume_pwr_spectr_prefix) + & smonitor_ctl%volume_pwr_spectr_prefix) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_diff_lm_spectr_switch, & & smonitor_ctl%volume_pwr_spectr_format) ! - write(id_control,'(a1)') '!' call write_chara_ctl_type(id_control, level, maxlen, & - & hd_degree_spectr_switch, smonitor_ctl%degree_v_spectra_switch) + & smonitor_ctl%degree_v_spectra_switch) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_order_spectr_switch, smonitor_ctl%order_v_spectra_switch) + & smonitor_ctl%order_v_spectra_switch) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_diff_lm_spectr_switch, & & smonitor_ctl%diff_v_lm_spectra_switch) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_axis_spectr_switch, smonitor_ctl%axis_v_power_switch) + & smonitor_ctl%axis_v_power_switch) ! - call write_volume_spectr_ctl(id_control, hd_vol_spec_block, & - & smonitor_ctl, level) - write(id_control,'(a1)') '!' - call write_layerd_spectr_ctl(id_control, hd_layer_spec_block, & + call write_volume_spectr_ctl(id_control, smonitor_ctl, level) + call write_layerd_spectr_ctl(id_control, & & smonitor_ctl%lp_ctl, level) ! - write(id_control,'(a1)') '!' - call write_pickup_spectr_ctl(id_control, hd_pick_sph_ctl, & + call write_pickup_spectr_ctl(id_control, & & smonitor_ctl%pspec_ctl, level) - write(id_control,'(a1)') '!' - call write_gauss_spectr_ctl(id_control, hd_gauss_spec_block, & + call write_gauss_spectr_ctl(id_control, & & smonitor_ctl%g_pwr, level) ! - write(id_control,'(a1)') '!' call write_sph_dipolarity_ctl(id_control, & - & hd_sph_dipolarity_ctl, smonitor_ctl%fdip_ctl, level) + & smonitor_ctl%fdip_ctl, level) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_Nusselt_file_head, smonitor_ctl%heat_Nusselt_file_prefix) + & smonitor_ctl%heat_Nusselt_file_prefix) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_Nusselt_file_fmt, smonitor_ctl%heat_Nusselt_file_format) + & smonitor_ctl%heat_Nusselt_file_format) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_heat_Nusselt_file_head, & & smonitor_ctl%heat_Nusselt_file_prefix) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_heat_Nusselt_file_fmt, & & smonitor_ctl%heat_Nusselt_file_format) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_comp_Nusselt_file_head, & & smonitor_ctl%comp_Nusselt_file_prefix) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_comp_Nusselt_file_fmt, & & smonitor_ctl%comp_Nusselt_file_format) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_typ_scale_file_head, & & smonitor_ctl%typ_scale_file_prefix_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_typ_scale_file_format, & & smonitor_ctl%typ_scale_file_format_ctl) ! call write_ctl_data_dynamobench(id_control, & - & hd_dynamobench_ctl, smonitor_ctl%dbench_ctl, level) - call write_data_on_circles_ctl(id_control, & - & hd_field_on_circle_ctl, smonitor_ctl%circ_ctls, level) + & smonitor_ctl%dbench_ctl, level) + call write_data_on_circles_ctl(id_control, smonitor_ctl, level) ! - level = write_end_flag_for_ctl(id_control, level, hd_block) + level = write_end_flag_for_ctl(id_control, level, & + & smonitor_ctl%block_name) ! end subroutine write_sph_monitoring_ctl ! ! ----------------------------------------------------------------------- ! - subroutine write_volume_spectr_ctl & - & (id_control, hd_block, smonitor_ctl, level) -! - use write_control_elements + subroutine init_sph_monitoring_labels(hd_block, smonitor_ctl) ! - integer(kind = kint), intent(in) :: id_control character(len=kchara), intent(in) :: hd_block - type(sph_monitor_control), intent(in) :: smonitor_ctl -! - integer(kind = kint), intent(inout) :: level ! - integer(kind = kint) :: i -! -! - if(smonitor_ctl%num_vspec_ctl .le. 0) return + type(sph_monitor_control), intent(inout) :: smonitor_ctl ! - write(id_control,'(a1)') '!' - level = write_array_flag_for_ctl(id_control, level, hd_block) - do i = 1, smonitor_ctl%num_vspec_ctl - write(id_control,'(a1)') '!' - call write_each_vol_spectr_ctl(id_control, hd_block, & - & smonitor_ctl%v_pwr(i), level) - end do - level = write_end_array_flag_for_ctl(id_control, level, hd_block) ! - end subroutine write_volume_spectr_ctl + smonitor_ctl%block_name = trim(hd_block) + smonitor_ctl%v_pwr_name = hd_vol_spec_block + smonitor_ctl%d_circ_name = hd_field_on_circle_ctl + call init_gauss_spectr_ctl_labels(hd_gauss_spec_block, & + & smonitor_ctl%g_pwr) + call init_pickup_spectr_ctl_labels(hd_pick_sph_ctl, & + & smonitor_ctl%pspec_ctl) + call init_layerd_spectr_ctl_labels(hd_layer_spec_block, & + & smonitor_ctl%lp_ctl) + call init_sph_dipolarity_ctl_label(hd_sph_dipolarity_ctl, & + & smonitor_ctl%fdip_ctl) + call init_ctl_data_dynamobench_label(hd_dynamobench_ctl, & + & smonitor_ctl%dbench_ctl) +! + end subroutine init_sph_monitoring_labels ! ! --------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/ctl_data_sphere_model_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/ctl_data_sphere_model_IO.f90 index 6fe90207..ca98c1b8 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/ctl_data_sphere_model_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/ctl_data_sphere_model_IO.f90 @@ -7,16 +7,15 @@ !>@brief control data for resolutions of spherical shell !! !!@verbatim +!! subroutine init_ctl_shell_define_label(hd_block, spctl) !! subroutine read_control_shell_define & !! & (id_control, hd_block, spctl, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(sphere_data_control), intent(inout) :: spctl !! type(buffer_for_control), intent(inout) :: c_buf -!! subroutine write_control_shell_define & -!! & (id_control, hd_block, spctl, level) +!! subroutine write_control_shell_define(id_control, spctl, level) !! integer(kind = kint), intent(in) :: id_control -!! character(len=kchara), intent(in) :: hd_block !! type(sphere_data_control), intent(in) :: spctl !! integer(kind = kint), intent(inout) :: level !! @@ -25,7 +24,7 @@ !! !! begin num_grid_sph !!! ---------------------------------------------------------------- -!!! sph_coef_type_ctl: grid type for spherical harmonics data +!!! sph_center_coef_ctl: grid type for spherical harmonics data !!! no_pole: Coefficients on spherical shell only !!! with_center: Add center !!! sph_grid_type_ctl: grid type for mesh data @@ -34,8 +33,8 @@ !!! with_center: Add center !!! ---------------------------------------------------------------- !! -!! sph_coef_type_ctl no_pole -!! sph_grid_type_ctl no_pole +!! sph_center_coef_ctl no_pole +!! sph_grid_type_ctl no_pole !! truncation_level_ctl 4 !! longitude_symmetry_ctl 2 !! ngrid_meridonal_ctl 12 @@ -121,7 +120,7 @@ module ctl_data_sphere_model_IO character(len=kchara), parameter, private & & :: hd_phi_symmetry = 'longitude_symmetry_ctl' character(len=kchara), parameter, private & - & :: hd_sph_c_type = 'sph_coef_type_ctl' + & :: hd_sph_c_type = 'sph_center_coef_ctl' character(len=kchara), parameter, private & & :: hd_sph_g_type = 'sph_grid_type_ctl' ! @@ -159,6 +158,13 @@ module ctl_data_sphere_model_IO character(len=kchara), parameter, private & & :: hd_list_med_grp = 'meridional_layering_ctl' ! +!! Deprecated flags +! + character(len=kchara), parameter, private & + & :: hd_sph_ctl_type = 'sph_coef_type_ctl' +! +! +! ! --------------------------------------------------------------------- ! contains @@ -179,10 +185,12 @@ subroutine read_control_shell_define & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(spctl%i_shell_def .gt. 0) return + spctl%block_name = hd_block + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! ! @@ -197,6 +205,9 @@ subroutine read_control_shell_define & call read_chara_ctl_type & & (c_buf, hd_sph_c_type, spctl%sph_coef_type_ctl) call read_chara_ctl_type & + & (c_buf, hd_sph_ctl_type, spctl%sph_coef_type_ctl) +! + call read_chara_ctl_type & & (c_buf, hd_sph_g_type, spctl%sph_grid_type_ctl) call read_chara_ctl_type & & (c_buf, hd_r_grid_type, spctl%radial_grid_type_ctl) @@ -246,8 +257,7 @@ end subroutine read_control_shell_define ! ! -------------------------------------------------------------------- ! - subroutine write_control_shell_define & - & (id_control, hd_block, spctl, level) + subroutine write_control_shell_define(id_control, spctl, level) ! use m_machine_parameter use t_read_control_elements @@ -255,7 +265,6 @@ subroutine write_control_shell_define & use skip_comment_f ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(sphere_data_control), intent(in) :: spctl ! integer(kind = kint), intent(inout) :: level @@ -289,68 +298,131 @@ subroutine write_control_shell_define & maxlen = max(maxlen, len_trim(hd_num_radial_grp)) maxlen = max(maxlen, len_trim(hd_num_med_grp)) ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! + level = write_begin_flag_for_ctl(id_control, level, & + & spctl%block_name) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_sph_c_type, spctl%sph_coef_type_ctl) + & spctl%sph_coef_type_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_sph_g_type, spctl%sph_grid_type_ctl) + & spctl%sph_grid_type_ctl) ! - write(id_control,'(a1)') '!' call write_integer_ctl_type(id_control, level, maxlen, & - & hd_sph_truncate, spctl%ltr_ctl) + & spctl%ltr_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_phi_symmetry, spctl%phi_symmetry_ctl) + & spctl%phi_symmetry_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_ntheta_shell, spctl%ngrid_elevation_ctl) + & spctl%ngrid_elevation_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_nphi_shell, spctl%ngrid_azimuth_ctl) + & spctl%ngrid_azimuth_ctl) ! - write(id_control,'(a1)') '!' call write_chara_ctl_type(id_control, level, maxlen, & - & hd_r_grid_type, spctl%radial_grid_type_ctl) + & spctl%radial_grid_type_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_n_fluid_grid, spctl%num_fluid_grid_ctl) + & spctl%num_fluid_grid_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_cheby_increment, spctl%increment_cheby_ctl) + & spctl%increment_cheby_ctl) ! - write(id_control,'(a1)') '!' call write_real_ctl_type(id_control, level, maxlen, & - & hd_shell_size, spctl%fluid_core_size_ctl) + & spctl%fluid_core_size_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_shell_ratio, spctl%ICB_to_CMB_ratio_ctl) + & spctl%ICB_to_CMB_ratio_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_Min_radius, spctl%Min_radius_ctl) + & spctl%Min_radius_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_ICB_radius, spctl%ICB_radius_ctl) + & spctl%ICB_radius_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_CMB_radius, spctl%CMB_radius_ctl) + & spctl%CMB_radius_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_Max_radius, spctl%Max_radius_ctl) + & spctl%Max_radius_ctl) ! call write_control_array_i_r(id_control, level, & - & hd_numlayer_shell, spctl%radius_ctl) + & spctl%radius_ctl) call write_control_array_r1(id_control, level, & - & hd_add_external_layer, spctl%add_ext_layer_ctl) + & spctl%add_ext_layer_ctl) ! - write(id_control,'(a1)') '!' call write_control_array_c_i(id_control, level, & - & hd_bc_sph, spctl%radial_grp_ctl) + & spctl%radial_grp_ctl) ! call write_integer_ctl_type(id_control, level, maxlen, & - & hd_num_radial_grp, spctl%num_radial_layer_ctl) + & spctl%num_radial_layer_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_num_med_grp, spctl%num_med_layer_ctl) + & spctl%num_med_layer_ctl) ! call write_control_array_i2(id_control, level, & - & hd_list_radial_grp, spctl%radial_layer_list_ctl) + & spctl%radial_layer_list_ctl) call write_control_array_i2(id_control, level, & - & hd_list_med_grp, spctl%med_layer_list_ctl) - level = write_end_flag_for_ctl(id_control, level, hd_block) + & spctl%med_layer_list_ctl) + level = write_end_flag_for_ctl(id_control, level, & + & spctl%block_name) ! end subroutine write_control_shell_define ! ! -------------------------------------------------------------------- +! + subroutine init_ctl_shell_define_label(hd_block, spctl) +! + character(len=kchara), intent(in) :: hd_block +! + type(sphere_data_control), intent(inout) :: spctl +! +! + spctl%block_name = hd_block +! + call init_i_r_array_label & + & (hd_numlayer_shell, spctl%radius_ctl) + call init_c_i_array_label & + & (hd_bc_sph, spctl%radial_grp_ctl) + call init_real_ctl_array_label & + & (hd_add_external_layer, spctl%add_ext_layer_ctl) +! +! + call init_chara_ctl_item_label & + & (hd_sph_c_type, spctl%sph_coef_type_ctl) + call init_chara_ctl_item_label & + & (hd_sph_g_type, spctl%sph_grid_type_ctl) + call init_chara_ctl_item_label & + & (hd_r_grid_type, spctl%radial_grid_type_ctl) +! + call init_int_ctl_item_label & + & (hd_phi_symmetry, spctl%phi_symmetry_ctl) + call init_int_ctl_item_label & + & (hd_sph_truncate, spctl%ltr_ctl) + call init_int_ctl_item_label & + & (hd_ntheta_shell, spctl%ngrid_elevation_ctl) + call init_int_ctl_item_label & + & (hd_nphi_shell, spctl%ngrid_azimuth_ctl) +! + call init_int_ctl_item_label & + & (hd_n_fluid_grid, spctl%num_fluid_grid_ctl) + call init_int_ctl_item_label & + & (hd_cheby_increment, spctl%increment_cheby_ctl) +! +! + call init_real_ctl_item_label & + & (hd_Min_radius, spctl%Min_radius_ctl) + call init_real_ctl_item_label & + & (hd_ICB_radius, spctl%ICB_radius_ctl) + call init_real_ctl_item_label & + & (hd_CMB_radius, spctl%CMB_radius_ctl) + call init_real_ctl_item_label & + & (hd_Max_radius, spctl%Max_radius_ctl) +! + call init_real_ctl_item_label & + & (hd_shell_size, spctl%fluid_core_size_ctl) + call init_real_ctl_item_label & + & (hd_shell_ratio, spctl%ICB_to_CMB_ratio_ctl) +! + call init_int_ctl_item_label & + & (hd_num_radial_grp, spctl%num_radial_layer_ctl) + call init_int_ctl_item_label & + & (hd_num_med_grp, spctl%num_med_layer_ctl) +! + call init_int2_ctl_array_label & + & (hd_list_radial_grp, spctl%radial_layer_list_ctl) + call init_int2_ctl_array_label & + & (hd_list_med_grp, spctl%med_layer_list_ctl) +! + end subroutine init_ctl_shell_define_label +! +! -------------------------------------------------------------------- ! end module ctl_data_sphere_model_IO diff --git a/src/Fortran_libraries/SERIAL_src/IO/ctl_data_volume_spectr_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/ctl_data_volume_spectr_IO.f90 new file mode 100644 index 00000000..3878dbb9 --- /dev/null +++ b/src/Fortran_libraries/SERIAL_src/IO/ctl_data_volume_spectr_IO.f90 @@ -0,0 +1,196 @@ +!>@file ctl_data_volume_spectr_IO.f90 +!! module ctl_data_volume_spectr_IO +!! +!! @author H. Matsui +!! @date Programmed in 2012 +!! +!! +!> @brief Monitoring section IO for Control data +!! +!!@verbatim +!! subroutine read_volume_spectr_ctl & +!! & (id_control, hd_block, smonitor_ctl, c_buf) +!! subroutine write_volume_spectr_ctl & +!! & (id_control, smonitor_ctl, level) +!! integer(kind = kint), intent(in) :: id_control +!! character(len=kchara), intent(in) :: hd_block +!! type(sph_monitor_control), intent(inout) :: smonitor_ctl +!! type(buffer_for_control), intent(inout) :: c_buf +!! +!! subroutine append_volume_spectr_ctls(idx_in, hd_block, & +!! & smonitor_ctl) +!! subroutine delete_volume_spectr_ctls(idx_in, smonitor_ctl) +!! integer(kind = kint), intent(in) :: idx_in +!! character(len=kchara), intent(in) :: hd_block +!! type(sph_monitor_control), intent(inout) :: smonitor_ctl +!! +!! ----------------------------------------------------------------- +!! +!! control block for pickup spherical harmonics +!! +!! array volume_spectrum_ctl +!! ... +!! end array volume_spectrum_ctl +!! +!! ----------------------------------------------------------------- +!!@endverbatim +! + module ctl_data_volume_spectr_IO +! + use m_precision +! + use t_read_control_elements + use t_ctl_data_sph_vol_spectr + use t_ctl_data_4_sph_monitor + use skip_comment_f +! + implicit none +! +! ----------------------------------------------------------------------- +! + contains +! +! ----------------------------------------------------------------------- +! + subroutine read_volume_spectr_ctl & + & (id_control, hd_block, smonitor_ctl, c_buf) +! + integer(kind = kint), intent(in) :: id_control + character(len=kchara), intent(in) :: hd_block + type(sph_monitor_control), intent(inout) :: smonitor_ctl + type(buffer_for_control), intent(inout) :: c_buf +! + integer(kind = kint) :: n_append +! +! + if(smonitor_ctl%num_vspec_ctl .gt. 0) return + if(check_array_flag(c_buf, hd_block) .eqv. .FALSE.) return + smonitor_ctl%num_vspec_ctl = 0 + call alloc_volume_spectr_control(smonitor_ctl) +! + do + call load_one_line_from_control(id_control, hd_block, c_buf) + if(c_buf%iend .gt. 0) exit + if(check_end_array_flag(c_buf, hd_block)) exit +! + if(check_begin_flag(c_buf, hd_block)) then + n_append = smonitor_ctl%num_vspec_ctl + call append_volume_spectr_ctls(n_append, hd_block, & + & smonitor_ctl) + call read_each_vol_spectr_ctl(id_control, hd_block, & + & smonitor_ctl%v_pwr(smonitor_ctl%num_vspec_ctl), c_buf) + end if + end do +! + end subroutine read_volume_spectr_ctl +! +! --------------------------------------------------------------------- +! ----------------------------------------------------------------------- +! + subroutine write_volume_spectr_ctl & + & (id_control, smonitor_ctl, level) +! + use write_control_elements +! + integer(kind = kint), intent(in) :: id_control + type(sph_monitor_control), intent(in) :: smonitor_ctl +! + integer(kind = kint), intent(inout) :: level +! + integer(kind = kint) :: i +! +! + if(smonitor_ctl%num_vspec_ctl .le. 0) return +! + level = write_array_flag_for_ctl(id_control, level, & + & smonitor_ctl%v_pwr_name) + do i = 1, smonitor_ctl%num_vspec_ctl + call write_each_vol_spectr_ctl & + & (id_control, smonitor_ctl%v_pwr(i), level) + end do + level = write_end_array_flag_for_ctl(id_control, level, & + & smonitor_ctl%v_pwr_name) +! + end subroutine write_volume_spectr_ctl +! +! --------------------------------------------------------------------- +! --------------------------------------------------------------------- +! + subroutine append_volume_spectr_ctls(idx_in, hd_block, & + & smonitor_ctl) +! + integer(kind = kint), intent(in) :: idx_in + character(len=kchara), intent(in) :: hd_block + type(sph_monitor_control), intent(inout) :: smonitor_ctl +! + type(volume_spectr_control), allocatable :: tmp_vpwr(:) + integer(kind = kint) :: i, num_tmp +! +! + if(idx_in.lt.0 .or. idx_in.gt.smonitor_ctl%num_vspec_ctl) return +! + num_tmp = smonitor_ctl%num_vspec_ctl + allocate(tmp_vpwr(num_tmp)) + do i = 1, num_tmp + call copy_volume_spectr_control(smonitor_ctl%v_pwr(i), & + & tmp_vpwr(i)) + end do +! + call dealloc_volume_spectr_control(smonitor_ctl) + smonitor_ctl%num_vspec_ctl = num_tmp + 1 + call alloc_volume_spectr_control(smonitor_ctl) +! + do i = 1, idx_in + call copy_volume_spectr_control(tmp_vpwr(i), & + & smonitor_ctl%v_pwr(i)) + end do + call init_each_vol_spectr_labels(hd_block, & + & smonitor_ctl%v_pwr(idx_in+1)) + do i = idx_in+1, num_tmp + call copy_volume_spectr_control(tmp_vpwr(i), & + & smonitor_ctl%v_pwr(i+1)) + end do + deallocate(tmp_vpwr) +! + end subroutine append_volume_spectr_ctls +! +! ----------------------------------------------------------------------- +! + subroutine delete_volume_spectr_ctls(idx_in, smonitor_ctl) +! + integer(kind = kint), intent(in) :: idx_in + type(sph_monitor_control), intent(inout) :: smonitor_ctl +! + integer(kind = kint) :: num_tmp + type(volume_spectr_control), allocatable :: tmp_vpwr(:) + integer(kind = kint) :: i +! +! + if(idx_in.le.0 .or. idx_in.gt.smonitor_ctl%num_vspec_ctl) return + + num_tmp = smonitor_ctl%num_vspec_ctl + allocate(tmp_vpwr(num_tmp)) + do i = 1, num_tmp + call copy_volume_spectr_control(smonitor_ctl%v_pwr(i), & + & tmp_vpwr(i)) + end do +! + call dealloc_volume_spectr_control(smonitor_ctl) + smonitor_ctl%num_vspec_ctl = num_tmp - 1 + call alloc_volume_spectr_control(smonitor_ctl) +! + do i = 1, idx_in-1 + call copy_volume_spectr_control(tmp_vpwr(i), & + & smonitor_ctl%v_pwr(i)) + end do + do i = idx_in, smonitor_ctl%num_vspec_ctl + call copy_volume_spectr_control(tmp_vpwr(i+1), & + & smonitor_ctl%v_pwr(i)) + end do + deallocate(tmp_vpwr) +! + end subroutine delete_volume_spectr_ctls +! +! ----------------------------------------------------------------------- +! + end module ctl_data_volume_spectr_IO diff --git a/src/Fortran_libraries/SERIAL_src/IO/domain_data_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/domain_data_IO.f90 index adb1780a..35b81c86 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/domain_data_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/domain_data_IO.f90 @@ -8,9 +8,11 @@ !! !!@verbatim !! subroutine read_domain_info(id_file, id_rank, comm_IO, ierr) -!! subroutine read_import_data(id_file, comm_IO) -!! subroutine read_export_data(id_file, comm_IO) +!! subroutine read_import_data(id_file, comm_IO, ierr) +!! subroutine read_export_data(id_file, comm_IO, ierr) +!! integer(kind = kint), intent(in) :: id_file !! type(communication_table), intent(inout) :: comm_IO +!! integer(kind = kint), intent(inout) :: ierr !! !! subroutine write_domain_info(id_file, id_rank, comm_IO) !! subroutine write_import_data(id_file, comm_IO) @@ -51,7 +53,8 @@ subroutine read_domain_info(id_file, id_rank, comm_IO, ierr) character(len=255) :: character_4_read = '' ! ! - call skip_comment(character_4_read,id_file) + call skip_comment(id_file, character_4_read, ierr) + if(ierr .gt. 0) return read(character_4_read,*) irank_read ! ierr = 0 @@ -73,22 +76,23 @@ end subroutine read_domain_info ! ----------------------------------------------------------------------- ! ----------------------------------------------------------------------- ! - subroutine read_import_data(id_file, comm_IO) + subroutine read_import_data(id_file, comm_IO, ierr) ! integer(kind = kint), intent(in) :: id_file type(communication_table), intent(inout) :: comm_IO + integer(kind = kint), intent(inout) :: ierr ! ! call alloc_import_num(comm_IO) ! if (comm_IO%num_neib .gt. 0) then -! call read_arrays_for_stacks(id_file, comm_IO%num_neib, & - & izero, comm_IO%ntot_import, comm_IO%istack_import) + & izero, comm_IO%ntot_import, comm_IO%istack_import, ierr) + if(ierr .ne. 0) return ! call alloc_import_item(comm_IO) call read_send_recv_item(id_file, comm_IO%ntot_import, & - & comm_IO%item_import) + & comm_IO%item_import, ierr) else comm_IO%ntot_import = 0 call alloc_import_item(comm_IO) @@ -98,21 +102,23 @@ end subroutine read_import_data ! ! ----------------------------------------------------------------------- ! - subroutine read_export_data(id_file, comm_IO) + subroutine read_export_data(id_file, comm_IO, ierr) ! integer(kind = kint), intent(in) :: id_file type(communication_table), intent(inout) :: comm_IO + integer(kind = kint), intent(inout) :: ierr ! ! call alloc_export_num(comm_IO) ! if (comm_IO%num_neib .gt. 0) then -! call read_arrays_for_stacks(id_file, comm_IO%num_neib, & - & izero, comm_IO%ntot_export, comm_IO%istack_export) + & izero, comm_IO%ntot_export, comm_IO%istack_export, ierr) + if(ierr .ne. 0) return +! call alloc_export_item(comm_IO) call read_send_recv_item(id_file, comm_IO%ntot_export, & - & comm_IO%item_export) + & comm_IO%item_export, ierr) else comm_IO%ntot_export = 0 call alloc_export_item(comm_IO) diff --git a/src/Fortran_libraries/SERIAL_src/IO/edge_data_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/edge_data_IO.f90 index 276cd126..cbf1ef9d 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/edge_data_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/edge_data_IO.f90 @@ -18,11 +18,12 @@ !! type(element_data), intent(in) :: ele_IO !! type(surf_edge_IO_data), intent(in) :: sfed_IO !! -!! subroutine read_edge_geometry(id_file, nod_IO, sfed_IO) +!! subroutine read_edge_geometry(id_file, nod_IO, sfed_IO, iend) !! type(communication_table), intent(inout) :: comm_IO !! type(node_data), intent(inout) :: nod_IO !! type(element_data), intent(inout) :: ele_IO !! type(surf_edge_IO_data), intent(inout) :: sfed_IO +!! integer(kind = kint), intent(inout) :: iend !! subroutine write_edge_geometry(id_file, nod_IO, sfed_IO) !! subroutine write_edge_geometry_sph(id_file, nod_IO, sfed_IO) !! subroutine write_edge_geometry_cyl(id_file, nod_IO, sfed_IO) @@ -72,6 +73,7 @@ subroutine read_edge_connection & ! write(id_file,'(a)', advance='NO') hd_fem_para() ! call read_domain_info(id_file, id_rank, comm_IO, ierr) + if(ierr .ne. 0) return ! ! write(id_file,'(a)') '!' ! write(id_file,'(a)') '! 2 edge connectivity' @@ -79,7 +81,8 @@ subroutine read_edge_connection & ! write(id_file,'(a)') '! (type and connection) ' ! write(id_file,'(a)') '!' ! - call read_number_of_element(id_file, ele_IO) + call read_number_of_element(id_file, ele_IO, ierr) + if(ierr .ne. 0) return call read_element_info(id_file, ele_IO) ! ! write(id_file,'(a)') '!' @@ -101,13 +104,14 @@ subroutine read_edge_connection & ! write(id_file,'(a)') '! 3.1 edge ID for import ' ! write(id_file,'(a)') '!' ! - call read_import_data(id_file, comm_IO) + call read_import_data(id_file, comm_IO, ierr) + if(ierr .ne. 0) return ! ! write(id_file,'(a)') '!' ! write(id_file,'(a)') '! 3.2 edge ID for export ' ! write(id_file,'(a)') '!' ! - call read_export_data(id_file, comm_IO) + call read_export_data(id_file, comm_IO, ierr) ! end subroutine read_edge_connection ! @@ -152,34 +156,36 @@ end subroutine write_edge_connection !------------------------------------------------------------------ !------------------------------------------------------------------ ! - subroutine read_edge_geometry(id_file, nod_IO, sfed_IO) + subroutine read_edge_geometry(id_file, nod_IO, sfed_IO, iend) ! use node_geometry_IO ! integer (kind = kint), intent(in) :: id_file type(node_data), intent(inout) :: nod_IO type(surf_edge_IO_data), intent(inout) :: sfed_IO -! + integer(kind = kint), intent(inout) :: iend ! ! write(id_file,'(a)') '!' ! write(id_file,'(a)') '! 4. geometry of edge' ! write(id_file,'(a)') '! 4.1. center of edge' ! write(id_file,'(a)') '!' ! - call read_number_of_node(id_file, nod_IO) + call read_number_of_node(id_file, nod_IO, iend) + if(iend .ne. 0) return call read_geometry_info(id_file, nod_IO) ! ! write(id_file,'(a)') '!' ! write(id_file,'(a)') '! 4.2 direction of edge' ! write(id_file,'(a)') '!' ! - call read_vector_in_element(id_file, nod_IO, sfed_IO) + call read_vector_in_element(id_file, nod_IO, sfed_IO, iend) + if(iend .ne. 0) return ! ! write(id_file,'(a)') '!' ! write(id_file,'(a)') '! 4.3 length of edge' ! write(id_file,'(a)') '!' ! - call read_scalar_in_element(id_file, nod_IO, sfed_IO) + call read_scalar_in_element(id_file, nod_IO, sfed_IO, iend) ! end subroutine read_edge_geometry ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/element_connect_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/element_connect_IO.f90 index 9a6fbdf5..77fc9488 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/element_connect_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/element_connect_IO.f90 @@ -13,7 +13,10 @@ !! subroutine write_edge_4_element(id_file, sfed_IO) !! type(surf_edge_IO_data), intent(in) :: sfed_IO !! -!! subroutine read_number_of_element(id_file, ele_IO) +!! subroutine read_number_of_element(id_file, ele_IO, iend) +!! integer (kind = kint), intent(in) :: id_file +!! type(element_data), intent(inout) :: ele_IO +!! integer (kind=kint), intent(inout) :: iend !! subroutine read_element_info(id_file, ele_IO) !! type(element_data), intent(inout) :: ele_IO !! type(surf_edge_IO_data), intent(inout) :: sfed_IO @@ -100,15 +103,17 @@ end subroutine write_edge_4_element !------------------------------------------------------------------ !------------------------------------------------------------------ ! - subroutine read_number_of_element(id_file, ele_IO) + subroutine read_number_of_element(id_file, ele_IO, iend) ! use skip_comment_f ! integer (kind = kint), intent(in) :: id_file type(element_data), intent(inout) :: ele_IO + integer (kind=kint), intent(inout) :: iend ! ! - call skip_comment(character_4_read,id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return ! read(character_4_read,*) ele_IO%numele ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/element_data_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/element_data_IO.f90 index a9d2393c..1b901818 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/element_data_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/element_data_IO.f90 @@ -7,7 +7,7 @@ !>@brief Data IO routines for element data !! !!@verbatim -!! subroutine read_element_geometry(id_file, nod_IO, sfed_IO) +!! subroutine read_element_geometry(id_file, nod_IO, sfed_IO, iend) !! type(node_data), intent(inout) :: nod_IO !! type(surf_edge_IO_data), intent(inout) :: sfed_IO !! subroutine write_element_geometry(id_file, nod_IO, sfed_IO) @@ -35,14 +35,14 @@ module element_data_IO ! !------------------------------------------------------------------ ! - subroutine read_element_geometry(id_file, nod_IO, sfed_IO) + subroutine read_element_geometry(id_file, nod_IO, sfed_IO, iend) ! use node_geometry_IO ! integer (kind = kint), intent(in) :: id_file type(node_data), intent(inout) :: nod_IO type(surf_edge_IO_data), intent(inout) :: sfed_IO -! + integer(kind = kint), intent(inout) :: iend ! ! write(id_file,'(a)') '!' ! write(id_file,'(a)') '! 3.element information' @@ -50,14 +50,15 @@ subroutine read_element_geometry(id_file, nod_IO, sfed_IO) ! write(id_file,'(a)') '! 3.1 center of element (position) ' ! write(id_file,'(a)') '!' ! - call read_number_of_node(id_file, nod_IO) + call read_number_of_node(id_file, nod_IO, iend) + if(iend .ne. 0) return call read_geometry_info(id_file, nod_IO) ! ! write(id_file,'(a)') '!' ! write(id_file,'(a)') '! 3.2 Volume of element ' ! write(id_file,'(a)') '!' ! - call read_scalar_in_element(id_file, nod_IO, sfed_IO) + call read_scalar_in_element(id_file, nod_IO, sfed_IO, iend) ! end subroutine read_element_geometry ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/element_file_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/element_file_IO.f90 index 24bd94d6..9c68153d 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/element_file_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/element_file_IO.f90 @@ -70,7 +70,7 @@ subroutine input_element_file & call read_comm_table(input_file_code, id_rank, & & ele_mesh_IO%comm, ierr) ! call read_element_geometry(input_file_code, & -! & ele_mesh_IO%node, ele_mesh_IO%sfed) +! & ele_mesh_IO%node, ele_mesh_IO%sfed, ierr) close(input_file_code) ! end subroutine input_element_file @@ -96,7 +96,7 @@ subroutine input_surface_file & & (input_file_code, id_rank, surf_mesh_IO%comm, & & surf_mesh_IO%ele, surf_mesh_IO%sfed, ierr) ! call read_surface_geometry(input_file_code, & -! & surf_mesh_IO%node, surf_mesh_IO%sfed) +! & surf_mesh_IO%node, surf_mesh_IO%sfed, ierr) close (input_file_code) ! end subroutine input_surface_file @@ -122,7 +122,7 @@ subroutine input_edge_file & & (input_file_code, id_rank, edge_mesh_IO%comm, & & edge_mesh_IO%ele, edge_mesh_IO%sfed, ierr) ! call read_edge_geometry(input_file_code, & -! & edge_mesh_IO%node, edge_mesh_IO%sfed) +! & edge_mesh_IO%node, edge_mesh_IO%sfed, ierr) close (input_file_code) ! end subroutine input_edge_file diff --git a/src/Fortran_libraries/SERIAL_src/IO/field_data_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/field_data_IO.f90 index f11bb6aa..aff6f292 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/field_data_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/field_data_IO.f90 @@ -14,8 +14,8 @@ !! function field_comp_buffer(num_field, ncomp_field) !! function each_field_name_buffer(field_name) !! -!! subroutine read_arrays_for_stacks(file_id, num, istack_begin, & -!! & ntot, istack) +!! subroutine read_arrays_for_stacks(id_file, num, istack_begin, & +!! & ntot, istack, iend) !! subroutine read_field_num_buffer(textbuf, nnod, num_field) !! subroutine read_buffer_istack_nod_buffer & !! & (textbuf, num_pe, istack_nod) @@ -24,16 +24,15 @@ !! subroutine read_each_field_name_buffer & !! & (textbuf, field_name, len_text) !! -!! subroutine write_arrays_for_stacks(file_id, num, istack) +!! subroutine write_arrays_for_stacks(id_file, num, istack) !! subroutine write_field_data & !! & (id_file, nnod64, num_field, ntot_comp, & !! & ncomp_field, field_name, field_data) !! subroutine read_field_data & !! & (id_file, nnod64, num_field, ntot_comp, & -!! & ncomp_field, field_name, field_data) -!! subroutine read_field_name & -!! & (id_file, nnod64, num_field, ntot_comp, & -!! & ncomp_field, field_name) +!! & ncomp_field, field_name, field_data, iend) +!! subroutine read_field_name(id_file, nnod64, num_field, & +!! & ncomp_field, field_name, iend) !!@endverbatim ! module field_data_IO @@ -137,15 +136,16 @@ end function each_field_name_buffer ! ------------------------------------------------------------------- ! ------------------------------------------------------------------- ! - subroutine read_arrays_for_stacks(file_id, num, istack_begin, & - & ntot, istack) + subroutine read_arrays_for_stacks(id_file, num, istack_begin, & + & ntot, istack, iend) ! use skip_comment_f ! - integer (kind = kint), intent(in) :: file_id + integer (kind = kint), intent(in) :: id_file integer (kind = kint), intent(in) :: num, istack_begin integer (kind = kint), intent(inout) :: ntot integer (kind = kint), intent(inout) :: istack(0:num) + integer (kind=kint), intent(inout) :: iend ! integer (kind = kint) :: i, ii character(len=255) :: character_4_read = '' @@ -155,7 +155,8 @@ subroutine read_arrays_for_stacks(file_id, num, istack_begin, & ! if(num .gt. 0) then character_4_read = '' - call skip_comment(character_4_read,file_id) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*,end=41) istack 41 continue ! @@ -170,7 +171,7 @@ subroutine read_arrays_for_stacks(file_id, num, istack_begin, & istack(0) = istack_begin ! if ( ii .le. num ) then - read(file_id,*) (istack(i),i=ii,num) + read(id_file,*) (istack(i),i=ii,num) end if end if ! @@ -267,14 +268,14 @@ end subroutine read_each_field_name_buffer ! ------------------------------------------------------------------- ! ------------------------------------------------------------------- ! - subroutine write_arrays_for_stacks(file_id, num, istack) + subroutine write_arrays_for_stacks(id_file, num, istack) ! - integer (kind = kint), intent(in) :: file_id + integer (kind = kint), intent(in) :: id_file integer (kind = kint), intent(in) :: num integer (kind = kint), intent(in) :: istack(0:num) ! ! - if(num .gt. 0) write(file_id,'(8i16)') istack(1:num) + if(num .gt. 0) write(id_file,'(8i16)') istack(1:num) ! end subroutine write_arrays_for_stacks ! @@ -321,7 +322,7 @@ end subroutine write_field_data ! subroutine read_field_data & & (id_file, nnod64, num_field, ntot_comp, & - & ncomp_field, field_name, field_data) + & ncomp_field, field_name, field_data, iend) ! use skip_comment_f ! @@ -335,6 +336,7 @@ subroutine read_field_data & character(len=kchara), intent(inout) :: field_name(num_field) real(kind = kreal), intent(inout) & & :: field_data(nnod64, ntot_comp) + integer(kind = kint), intent(inout) :: iend ! character(len=255) :: character_4_read integer(kind = kint_gl) :: inod @@ -343,7 +345,8 @@ subroutine read_field_data & ! icou = 0 do i_fld = 1, num_field - call skip_comment(character_4_read,id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) field_name(i_fld) ! ist = icou + 1 @@ -357,8 +360,8 @@ end subroutine read_field_data ! ! ------------------------------------------------------------------- ! - subroutine read_field_name & - & (id_file, nnod64, num_field, ncomp_field, field_name) + subroutine read_field_name(id_file, nnod64, num_field, & + & ncomp_field, field_name, iend) ! use skip_comment_f ! @@ -369,6 +372,7 @@ subroutine read_field_name & integer(kind = kint), intent(in) :: ncomp_field(num_field) ! character(len=kchara), intent(inout) :: field_name(num_field) + integer(kind = kint), intent(inout) :: iend ! character(len=255) :: character_4_read integer(kind = kint_gl) :: inod @@ -378,7 +382,8 @@ subroutine read_field_name & ! icou = 0 do i_fld = 1, num_field - call skip_comment(character_4_read,id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) field_name(i_fld) ! ist = icou + 1 diff --git a/src/Fortran_libraries/SERIAL_src/IO/field_file_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/field_file_IO.f90 index eedfa1e1..423819f1 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/field_file_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/field_file_IO.f90 @@ -14,17 +14,17 @@ !! type(field_IO), intent(in) :: fld_IO !! !! subroutine read_and_allocate_field_file & -!! & (file_name, id_rank, fld_IO) +!! & (file_name, id_rank, fld_IO, iend) !! !! subroutine read_step_field_file & -!! & (file_name, id_rank, t_IO, fld_IO) +!! & (file_name, id_rank, t_IO, fld_IO, iend) !! subroutine read_and_alloc_step_field & -!! & (file_name, id_rank, t_IO, fld_IO) +!! & (file_name, id_rank, t_IO, fld_IO, iend) !! type(time_data), intent(inout) :: t_IO !! type(field_IO), intent(inout) :: fld_IO !! !! subroutine read_and_allocate_step_head & -!! & (file_name, id_rank, t_IO, fld_IO) +!! & (file_name, id_rank, t_IO, fld_IO, iend) !! type(time_data), intent(inout) :: t_IO !! type(field_IO), intent(inout) :: fld_IO !!@endverbatim @@ -79,7 +79,7 @@ end subroutine write_step_field_file !------------------------------------------------------------------ ! subroutine read_and_allocate_field_file & - & (file_name, id_rank, fld_IO) + & (file_name, id_rank, fld_IO, iend) ! use skip_comment_f use transfer_to_long_integers @@ -87,6 +87,7 @@ subroutine read_and_allocate_field_file & integer, intent(in) :: id_rank character(len=kchara), intent(in) :: file_name type(field_IO), intent(inout) :: fld_IO + integer(kind = kint), intent(inout) :: iend ! character(len=255) :: character_4_read ! @@ -97,7 +98,8 @@ subroutine read_and_allocate_field_file & ! open(id_phys_file, file = file_name, form = 'formatted') ! - call skip_comment(character_4_read, id_phys_file) + call skip_comment(id_phys_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) fld_IO%nnod_IO, fld_IO%num_field_IO ! call alloc_phys_name_IO(fld_IO) @@ -108,7 +110,8 @@ subroutine read_and_allocate_field_file & ! call read_field_data(id_phys_file, cast_long(fld_IO%nnod_IO), & & fld_IO%num_field_IO, fld_IO%ntot_comp_IO, & - & fld_IO%num_comp_IO, fld_IO%fld_name, fld_IO%d_IO) + & fld_IO%num_comp_IO, fld_IO%fld_name, fld_IO%d_IO, iend) + if(iend .gt. 0) return close (id_phys_file) ! end subroutine read_and_allocate_field_file @@ -117,7 +120,7 @@ end subroutine read_and_allocate_field_file !------------------------------------------------------------------ ! subroutine read_step_field_file & - & (file_name, id_rank, t_IO, fld_IO) + & (file_name, id_rank, t_IO, fld_IO, iend) ! use skip_comment_f use transfer_to_long_integers @@ -127,6 +130,7 @@ subroutine read_step_field_file & ! type(time_data), intent(inout) :: t_IO type(field_IO), intent(inout) :: fld_IO + integer(kind = kint), intent(inout) :: iend ! character(len=255) :: character_4_read ! @@ -137,15 +141,18 @@ subroutine read_step_field_file & ! open(id_phys_file, file = file_name, form = 'formatted') ! - call read_step_data(id_phys_file, t_IO) + call read_step_data(id_phys_file, t_IO, iend) + if(iend .gt. 0) return ! - call skip_comment(character_4_read, id_phys_file) + call skip_comment(id_phys_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) fld_IO%nnod_IO, fld_IO%num_field_IO read(id_phys_file,*) fld_IO%num_comp_IO(1:fld_IO%num_field_IO) ! call read_field_data(id_phys_file, cast_long(fld_IO%nnod_IO), & & fld_IO%num_field_IO, fld_IO%ntot_comp_IO, & - & fld_IO%num_comp_IO, fld_IO%fld_name, fld_IO%d_IO) + & fld_IO%num_comp_IO, fld_IO%fld_name, fld_IO%d_IO, iend) + if(iend .gt. 0) return close (id_phys_file) ! end subroutine read_step_field_file @@ -153,7 +160,7 @@ end subroutine read_step_field_file !------------------------------------------------------------------ ! subroutine read_and_alloc_step_field & - & (file_name, id_rank, t_IO, fld_IO) + & (file_name, id_rank, t_IO, fld_IO, iend) ! use skip_comment_f use transfer_to_long_integers @@ -163,6 +170,7 @@ subroutine read_and_alloc_step_field & ! type(time_data), intent(inout) :: t_IO type(field_IO), intent(inout) :: fld_IO + integer(kind = kint), intent(inout) :: iend ! character(len=255) :: character_4_read ! @@ -173,9 +181,11 @@ subroutine read_and_alloc_step_field & ! open(id_phys_file, file = file_name, form = 'formatted') ! - call read_step_data(id_phys_file, t_IO) + call read_step_data(id_phys_file, t_IO, iend) + if(iend .gt. 0) return ! - call skip_comment(character_4_read, id_phys_file) + call skip_comment(id_phys_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) fld_IO%nnod_IO, fld_IO%num_field_IO ! call alloc_phys_name_IO(fld_IO) @@ -186,7 +196,8 @@ subroutine read_and_alloc_step_field & ! call read_field_data(id_phys_file, cast_long(fld_IO%nnod_IO), & & fld_IO%num_field_IO, fld_IO%ntot_comp_IO, & - & fld_IO%num_comp_IO, fld_IO%fld_name, fld_IO%d_IO) + & fld_IO%num_comp_IO, fld_IO%fld_name, fld_IO%d_IO, iend) + if(iend .gt. 0) return close (id_phys_file) ! end subroutine read_and_alloc_step_field @@ -194,7 +205,7 @@ end subroutine read_and_alloc_step_field !------------------------------------------------------------------ ! subroutine read_and_allocate_step_head & - & (file_name, id_rank, t_IO, fld_IO) + & (file_name, id_rank, t_IO, fld_IO, iend) ! use skip_comment_f use transfer_to_long_integers @@ -204,6 +215,7 @@ subroutine read_and_allocate_step_head & ! type(time_data), intent(inout) :: t_IO type(field_IO), intent(inout) :: fld_IO + integer(kind = kint), intent(inout) :: iend ! character(len=255) :: character_4_read ! @@ -214,9 +226,11 @@ subroutine read_and_allocate_step_head & ! open(id_phys_file, file = file_name, form = 'formatted') ! - call read_step_data(id_phys_file, t_IO) + call read_step_data(id_phys_file, t_IO, iend) + if(iend .gt. 0) return ! - call skip_comment(character_4_read, id_phys_file) + call skip_comment(id_phys_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) fld_IO%nnod_IO, fld_IO%num_field_IO ! call alloc_phys_name_IO(fld_IO) @@ -225,7 +239,9 @@ subroutine read_and_allocate_step_head & call cal_istack_phys_comp_IO(fld_IO) ! call read_field_name(id_phys_file, cast_long(fld_IO%nnod_IO), & - & fld_IO%num_field_IO, fld_IO%num_comp_IO, fld_IO%fld_name) + & fld_IO%num_field_IO, fld_IO%num_comp_IO, & + & fld_IO%fld_name, iend) + if(iend .gt. 0) return close (id_phys_file) ! end subroutine read_and_allocate_step_head diff --git a/src/Fortran_libraries/SERIAL_src/IO/group_data_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/group_data_IO.f90 index cbdf3cd7..fc01688b 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/group_data_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/group_data_IO.f90 @@ -7,11 +7,11 @@ !>@brief Routines for ASCII group data IO !! !!@verbatim -!! subroutine read_group_stack(id_file, ngrp, ntot, istack) +!! subroutine read_group_stack(id_file, ngrp, ntot, istack, iend) !! subroutine read_group_item(id_file, ngrp, ntot, istack, name, & -!! & item) +!! & item, iend) !! subroutine read_surface_group_item(id_file, ngrp, ntot, & -!! & istack, name, item_sf) +!! & istack, name, item_sf, iend) !! !! subroutine write_group_data(id_file, ngrp, ntot, istack, name, & !! & item) @@ -34,7 +34,7 @@ module group_data_IO ! ! ----------------------------------------------------------------------- ! - subroutine read_group_stack(id_file, ngrp, ntot, istack) + subroutine read_group_stack(id_file, ngrp, ntot, istack, iend) ! use field_data_IO ! @@ -42,16 +42,18 @@ subroutine read_group_stack(id_file, ngrp, ntot, istack) integer(kind = kint), intent(in) :: ngrp integer(kind = kint), intent(inout) :: ntot integer(kind = kint), intent(inout) :: istack(0:ngrp) + integer(kind = kint), intent(inout) :: iend ! ! - call read_arrays_for_stacks(id_file, ngrp, izero, ntot, istack) + call read_arrays_for_stacks(id_file, ngrp, izero, & + & ntot, istack, iend) ! end subroutine read_group_stack ! ! ----------------------------------------------------------------------- ! subroutine read_group_item(id_file, ngrp, ntot, istack, name, & - & item) + & item, iend) ! use skip_comment_f ! @@ -61,6 +63,7 @@ subroutine read_group_item(id_file, ngrp, ntot, istack, name, & ! integer(kind = kint), intent(inout) :: item(ntot) character(len = kchara), intent(inout) :: name(ngrp) + integer(kind = kint), intent(inout) :: iend ! integer(kind = kint) :: i, ist, ied ! @@ -70,7 +73,8 @@ subroutine read_group_item(id_file, ngrp, ntot, istack, name, & do i = 1, ngrp ist = istack(i-1)+1 ied = istack(i) - call skip_comment(character_4_read, id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) name(i) read(id_file,*) item(ist:ied) end do @@ -80,7 +84,7 @@ end subroutine read_group_item ! ----------------------------------------------------------------------- ! subroutine read_surface_group_item(id_file, ngrp, ntot, & - & istack, name, item_sf) + & istack, name, item_sf, iend) ! use skip_comment_f ! @@ -90,6 +94,7 @@ subroutine read_surface_group_item(id_file, ngrp, ntot, & ! integer(kind = kint), intent(inout) :: item_sf(2,ntot) character(len = kchara), intent(inout) :: name(ngrp) + integer(kind = kint), intent(inout) :: iend ! integer(kind = kint) :: j, ist, ied ! @@ -99,7 +104,8 @@ subroutine read_surface_group_item(id_file, ngrp, ntot, & do j = 1, ngrp ist = istack(j-1)+1 ied = istack(j) - call skip_comment(character_4_read, id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) name(j) read(id_file,*) item_sf(1,ist:ied) read(id_file,*) item_sf(2,ist:ied) diff --git a/src/Fortran_libraries/SERIAL_src/IO/groups_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/groups_IO.f90 index d01cb364..376f87ce 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/groups_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/groups_IO.f90 @@ -7,10 +7,12 @@ !> @brief Base routines for spectrum group data IO !! !!@verbatim -!! subroutine read_group_datamesh_file_id, grp_IO) -!! subroutine read_surf_grp_data(id_file, surf_grp_IO) +!! subroutine read_group_data(id_file, grp_IO, iend) +!! subroutine read_surf_grp_data(id_file, surf_grp_IO, iend) +!! integer(kind = kint), intent(in) :: id_file !! type(group_data), intent(inout) :: grp_IO !! type(surface_group_data), intent(inout) :: surf_grp_IO +!! integer(kind = kint), intent(inout) :: iend !! !! subroutine write_grp_data(id_file, grp_IO) !! subroutine write_surf_grp_data(id_file, surf_grp_IO) @@ -39,28 +41,30 @@ module groups_IO ! !------------------------------------------------------------------ ! - subroutine read_group_data(id_file, grp_IO) + subroutine read_group_data(id_file, grp_IO, iend) ! use t_group_data ! integer(kind = kint), intent(in) :: id_file type(group_data), intent(inout) :: grp_IO + integer(kind = kint), intent(inout) :: iend ! ! - call skip_comment(character_4_read, id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) grp_IO%num_grp ! call alloc_group_num(grp_IO) ! if (grp_IO%num_grp .gt. 0) then call read_group_stack(id_file, grp_IO%num_grp, & - & grp_IO%num_item, grp_IO%istack_grp) + & grp_IO%num_item, grp_IO%istack_grp, iend) + if(iend .gt. 0) return ! call alloc_group_item(grp_IO) call read_group_item(id_file, grp_IO%num_grp, & & grp_IO%num_item, grp_IO%istack_grp, & - & grp_IO%grp_name, grp_IO%item_grp) -! + & grp_IO%grp_name, grp_IO%item_grp, iend) else grp_IO%num_item = 0 call alloc_group_item(grp_IO) @@ -70,28 +74,30 @@ end subroutine read_group_data ! !------------------------------------------------------------------ ! - subroutine read_surf_grp_data(id_file, surf_grp_IO) + subroutine read_surf_grp_data(id_file, surf_grp_IO, iend) ! use t_group_data ! integer(kind = kint), intent(in) :: id_file type(surface_group_data), intent(inout) :: surf_grp_IO + integer(kind = kint), intent(inout) :: iend ! ! - call skip_comment(character_4_read, id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) surf_grp_IO%num_grp ! call alloc_sf_group_num(surf_grp_IO) ! if (surf_grp_IO%num_grp .gt. 0) then call read_group_stack(id_file, surf_grp_IO%num_grp, & - & surf_grp_IO%num_item, surf_grp_IO%istack_grp) + & surf_grp_IO%num_item, surf_grp_IO%istack_grp, iend) + if(iend .gt. 0) return ! call alloc_sf_group_item(surf_grp_IO) call read_surface_group_item(id_file, surf_grp_IO%num_grp, & & surf_grp_IO%num_item, surf_grp_IO%istack_grp, & - & surf_grp_IO%grp_name, surf_grp_IO%item_sf_grp) -! + & surf_grp_IO%grp_name, surf_grp_IO%item_sf_grp, iend) else call alloc_sf_group_item(surf_grp_IO) end if diff --git a/src/Fortran_libraries/SERIAL_src/IO/m_component_flags.f90 b/src/Fortran_libraries/SERIAL_src/IO/m_component_flags.f90 index 2d777e06..2a10bfdd 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/m_component_flags.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/m_component_flags.f90 @@ -8,15 +8,13 @@ !> @brief flags of components in control !! !!@verbatim -!! integer(kind = kint) function num_flag_scalar_comp() -!! integer(kind = kint) function num_flag_vector_comp() -!! integer(kind = kint) function num_flag_sym_tensor_comp() -!! integer(kind = kint) function num_flag_asym_tensor_comp() -!! -!! subroutine set_flag_scalar_comp(n_comps, names, maths) -!! subroutine set_flag_vector_comp(n_comps, names, maths) -!! subroutine set_flag_sym_tensor_comp(n_comps, names, maths) -!! subroutine set_flag_asym_tensor_comp(n_comps, names, maths) +!! subroutine set_xyz_direction_array(array_c2i) +!! subroutine set_xyzw_direction_array(array_c2i) +!! subroutine set_scalar_direction_array(array_c2i) +!! subroutine set_vector_direction_array(array_c2i) +!! subroutine set_sym_tensor_direction_array(array_c2i) +!! subroutine set_asym_tensor_direction_array(array_c2i) +!! type(ctl_array_c2i), intent(inout) :: array_c2i !! !! !!!!! Base field names !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! @@ -114,11 +112,6 @@ module m_component_flags ! implicit none !! - integer(kind = kint), parameter, private :: ntype_scalar = 1 - integer(kind = kint), parameter, private :: ntype_vector = 11 - integer(kind = kint), parameter, private :: ntype_tensor = 22 - integer(kind = kint), parameter, private :: ntype_as_tsr = 13 -! !> Field label for scalar !! @f$ S @f$ type(field_def), parameter :: scalar & @@ -171,6 +164,13 @@ module m_component_flags & name = 'z', & & math = '$ V_{z} $') ! +!> Field label for w-component +!! @f$ V_{w} @f$ + type(field_def), parameter :: V_w & + & = field_def(n_comp = n_scalar, & + & name = 'w', & + & math = '$ V_{w} $') +! !> Field label for radial component !! @f$ V_{r} @f$ type(field_def), parameter :: V_r & @@ -349,185 +349,146 @@ module m_component_flags ! ! ---------------------------------------------------------------------- ! - integer(kind = kint) function num_flag_scalar_comp() - num_flag_scalar_comp = ntype_scalar - return - end function num_flag_scalar_comp + subroutine set_xyz_direction_array(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i ! -! ---------------------------------------------------------------------- + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) +! + call set_field_label_to_ctl(V_x, array_c2i) + call set_field_label_to_ctl(V_y, array_c2i) + call set_field_label_to_ctl(V_z, array_c2i) ! - integer(kind = kint) function num_flag_vector_comp() - num_flag_vector_comp = ntype_vector - return - end function num_flag_vector_comp + end subroutine set_xyz_direction_array ! ! ---------------------------------------------------------------------- ! - integer(kind = kint) function num_flag_sym_tensor_comp() - num_flag_sym_tensor_comp = ntype_tensor - return - end function num_flag_sym_tensor_comp + subroutine set_xyzw_direction_array(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i ! -! ---------------------------------------------------------------------- + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) +! + call set_field_label_to_ctl(V_x, array_c2i) + call set_field_label_to_ctl(V_y, array_c2i) + call set_field_label_to_ctl(V_z, array_c2i) + call set_field_label_to_ctl(V_w, array_c2i) ! - integer(kind = kint) function num_flag_asym_tensor_comp() - num_flag_asym_tensor_comp = ntype_as_tsr - return - end function num_flag_asym_tensor_comp + end subroutine set_xyzw_direction_array ! ! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- ! - subroutine set_flag_scalar_comp(n_comps, names, maths) + subroutine set_scalar_direction_array(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i +! + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) ! - integer(kind = kint_4b), intent(inout) :: n_comps(ntype_scalar) - character(len = kchara), intent(inout) :: names(ntype_scalar) - character(len = kchara), intent(inout) :: maths(ntype_scalar) + call set_field_label_to_ctl(scalar, array_c2i) ! + end subroutine set_scalar_direction_array +! +! ---------------------------------------------------------------------- ! - call set_field_labels(scalar, & - & n_comps( 1), names( 1), maths( 1)) + subroutine set_vector_direction_array(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i ! - end subroutine set_flag_scalar_comp + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) +! + call set_field_label_to_ctl(vector, array_c2i) + call set_field_label_to_ctl(spherical_vector, array_c2i) + call set_field_label_to_ctl(cylindrical_vector, array_c2i) +! + call set_field_label_to_ctl(magnitude, array_c2i) +! + call set_field_label_to_ctl(V_x, array_c2i) + call set_field_label_to_ctl(V_y, array_c2i) + call set_field_label_to_ctl(V_z, array_c2i) +! + call set_field_label_to_ctl(V_r, array_c2i) + call set_field_label_to_ctl(V_theta, array_c2i) + call set_field_label_to_ctl(V_phi, array_c2i) + call set_field_label_to_ctl(V_s, array_c2i) +! + end subroutine set_vector_direction_array ! ! ---------------------------------------------------------------------- ! - subroutine set_flag_vector_comp(n_comps, names, maths) + subroutine set_sym_tensor_direction_array(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i ! - integer(kind = kint_4b), intent(inout) :: n_comps(ntype_vector) - character(len = kchara), intent(inout) :: names(ntype_vector) - character(len = kchara), intent(inout) :: maths(ntype_vector) + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) ! + call set_field_label_to_ctl(sym_tensor, array_c2i) + call set_field_label_to_ctl(spherical_sym_tensor, array_c2i) + call set_field_label_to_ctl(cylindrical_sym_tensor, array_c2i) ! - call set_field_labels(vector, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(spherical_vector, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(cylindrical_vector, & - & n_comps( 3), names( 3), maths( 3)) + call set_field_label_to_ctl(magnitude, array_c2i) ! - call set_field_labels(magnitude, & - & n_comps( 4), names( 4), maths( 4)) + call set_field_label_to_ctl(T_xx, array_c2i) + call set_field_label_to_ctl(T_xy, array_c2i) + call set_field_label_to_ctl(T_xz, array_c2i) + call set_field_label_to_ctl(T_yy, array_c2i) + call set_field_label_to_ctl(T_yz, array_c2i) + call set_field_label_to_ctl(T_zz, array_c2i) ! - call set_field_labels(V_x, & - & n_comps( 5), names( 5), maths( 5)) - call set_field_labels(V_y, & - & n_comps( 6), names( 6), maths( 6)) - call set_field_labels(V_z, & - & n_comps( 7), names( 7), maths( 7)) + call set_field_label_to_ctl(T_rr, array_c2i) + call set_field_label_to_ctl(T_rt, array_c2i) + call set_field_label_to_ctl(T_rp, array_c2i) + call set_field_label_to_ctl(T_tt, array_c2i) + call set_field_label_to_ctl(T_tp, array_c2i) + call set_field_label_to_ctl(T_pp, array_c2i) ! - call set_field_labels(V_r, & - & n_comps( 8), names( 8), maths( 8)) - call set_field_labels(V_theta, & - & n_comps( 9), names( 9), maths( 9)) - call set_field_labels(V_phi, & - & n_comps(10), names(10), maths(10)) - call set_field_labels(V_s, & - & n_comps(11), names(11), maths(11)) + call set_field_label_to_ctl(T_ss, array_c2i) + call set_field_label_to_ctl(T_sp, array_c2i) + call set_field_label_to_ctl(T_sz, array_c2i) + call set_field_label_to_ctl(T_pp, array_c2i) + call set_field_label_to_ctl(T_pz, array_c2i) + call set_field_label_to_ctl(T_zz, array_c2i) ! - end subroutine set_flag_vector_comp + end subroutine set_sym_tensor_direction_array ! ! ---------------------------------------------------------------------- ! - subroutine set_flag_sym_tensor_comp(n_comps, names, maths) -! - integer(kind = kint_4b), intent(inout) :: n_comps(ntype_tensor) - character(len = kchara), intent(inout) :: names(ntype_tensor) - character(len = kchara), intent(inout) :: maths(ntype_tensor) -! -! - call set_field_labels(sym_tensor, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(spherical_sym_tensor, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(cylindrical_sym_tensor, & - & n_comps( 3), names( 3), maths( 3)) -! - call set_field_labels(magnitude, & - & n_comps( 4), names( 4), maths( 4)) -! - call set_field_labels(T_xx, & - & n_comps( 5), names( 5), maths( 5)) - call set_field_labels(T_xy, & - & n_comps( 6), names( 6), maths( 6)) - call set_field_labels(T_xz, & - & n_comps( 7), names( 7), maths( 7)) - call set_field_labels(T_yy, & - & n_comps( 8), names( 8), maths( 8)) - call set_field_labels(T_yz, & - & n_comps( 9), names( 9), maths( 9)) - call set_field_labels(T_zz, & - & n_comps(10), names(10), maths(10)) -! - call set_field_labels(T_rr, & - & n_comps(11), names(11), maths(11)) - call set_field_labels(T_rt, & - & n_comps(12), names(12), maths(12)) - call set_field_labels(T_rp, & - & n_comps(13), names(13), maths(13)) - call set_field_labels(T_tt, & - & n_comps(14), names(14), maths(14)) - call set_field_labels(T_tp, & - & n_comps(15), names(15), maths(15)) - call set_field_labels(T_pp, & - & n_comps(16), names(16), maths(16)) -! - call set_field_labels(T_ss, & - & n_comps(17), names(17), maths(17)) - call set_field_labels(T_sp, & - & n_comps(18), names(18), maths(18)) - call set_field_labels(T_sz, & - & n_comps(19), names(19), maths(19)) - call set_field_labels(T_pp, & - & n_comps(20), names(20), maths(20)) - call set_field_labels(T_pz, & - & n_comps(21), names(21), maths(21)) - call set_field_labels(T_zz, & - & n_comps(22), names(22), maths(22)) -! - end subroutine set_flag_sym_tensor_comp + subroutine set_asym_tensor_direction_array(array_c2i) + use t_control_array_chara2int + type(ctl_array_c2i), intent(inout) :: array_c2i ! -! ---------------------------------------------------------------------- + array_c2i%array_name = ' ' + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) +! + call set_field_label_to_ctl(asym_tensor, array_c2i) + call set_field_label_to_ctl(spherical_asym_tensor, array_c2i) + call set_field_label_to_ctl(cylindrical_asym_tensor, array_c2i) + call set_field_label_to_ctl(magnitude, array_c2i) +! + call set_field_label_to_ctl(T_xy, array_c2i) + call set_field_label_to_ctl(T_xz, array_c2i) + call set_field_label_to_ctl(T_yz, array_c2i) +! + call set_field_label_to_ctl(T_rt, array_c2i) + call set_field_label_to_ctl(T_rp, array_c2i) + call set_field_label_to_ctl(T_tp, array_c2i) +! + call set_field_label_to_ctl(T_sp, array_c2i) + call set_field_label_to_ctl(T_sz, array_c2i) + call set_field_label_to_ctl(T_pz, array_c2i) ! - subroutine set_flag_asym_tensor_comp(n_comps, names, maths) -! - integer(kind = kint_4b), intent(inout) :: n_comps(ntype_as_tsr) - character(len = kchara), intent(inout) :: names(ntype_as_tsr) - character(len = kchara), intent(inout) :: maths(ntype_as_tsr) -! -! - call set_field_labels(asym_tensor, & - & n_comps( 1), names( 1), maths( 1)) - call set_field_labels(spherical_asym_tensor, & - & n_comps( 2), names( 2), maths( 2)) - call set_field_labels(cylindrical_asym_tensor, & - & n_comps( 3), names( 3), maths( 3)) -! - call set_field_labels(magnitude, & - & n_comps( 4), names( 4), maths( 4)) -! - call set_field_labels(T_xy, & - & n_comps( 5), names( 5), maths( 5)) - call set_field_labels(T_xz, & - & n_comps( 6), names( 6), maths( 6)) - call set_field_labels(T_yz, & - & n_comps( 7), names( 7), maths( 7)) -! - call set_field_labels(T_rt, & - & n_comps( 8), names( 8), maths( 8)) - call set_field_labels(T_rp, & - & n_comps( 9), names( 9), maths( 9)) - call set_field_labels(T_tp, & - & n_comps(10), names(10), maths(10)) -! - call set_field_labels(T_sp, & - & n_comps(11), names(11), maths(11)) - call set_field_labels(T_sz, & - & n_comps(12), names(12), maths(12)) - call set_field_labels(T_pz, & - & n_comps(13), names(13), maths(13)) -! - end subroutine set_flag_asym_tensor_comp + end subroutine set_asym_tensor_direction_array ! ! ---------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/m_file_format_labels.f90 b/src/Fortran_libraries/SERIAL_src/IO/m_file_format_labels.f90 index cd9f8315..9ed449f6 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/m_file_format_labels.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/m_file_format_labels.f90 @@ -20,8 +20,8 @@ !! 'merged_gz': gziopped text (formatted) data in merged file !! 'merged_bin_gz': gziopped binary data in merged file !! -!! integer(kind = kint) function num_label_file_fmt() -!! subroutine set_label_file_fmt(names) +!! subroutine set_label_file_fmt(array_c) +!! type(ctl_array_chara), intent(inout) :: array_c !! subroutine cvt_default_field_format_flag(file_fmt_ctl) !!@endverbatim ! @@ -33,8 +33,6 @@ module m_file_format_labels ! implicit none ! -! - integer(kind = kint), parameter :: n_label_file_fmt = 10 ! !> flag parts for distributed ascii data character(len = kchara), parameter :: hd_ascii = 'ascii' @@ -214,33 +212,26 @@ end subroutine dealloc_file_format_flags ! ----------------------------------------------------------------------- ! --------------------------------------------------------------------- ! - integer(kind = kint) function num_label_file_fmt() - num_label_file_fmt = n_label_file_fmt - return - end function num_label_file_fmt -! -! ---------------------------------------------------------------------- -! - subroutine set_label_file_fmt(names) -! - use t_read_control_elements -! - character(len = kchara), intent(inout) & - & :: names(n_label_file_fmt) -! -! - call set_control_labels(hd_ascii, names( 1)) - call set_control_labels(hd_binary, names( 2)) - call set_control_labels(hd_gzip, names( 3)) - call set_control_labels(hd_bin_gz, names( 4)) -! - call set_control_labels(hd_merged, names( 5)) - call set_control_labels(hd_merged_bin, names( 6)) - call set_control_labels(hd_merged_gz, names( 7)) - call set_control_labels(hd_merged_bin_gz, names( 8)) -! - call set_control_labels(hd_rayleigh, names( 9)) - call set_control_labels(hd_rayleigh99, names(10)) + subroutine set_label_file_fmt(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(hd_ascii, array_c) + call append_c_to_ctl_array(hd_binary, array_c) + call append_c_to_ctl_array(hd_gzip, array_c) + call append_c_to_ctl_array(hd_bin_gz, array_c) + + call append_c_to_ctl_array(hd_merged, array_c) + call append_c_to_ctl_array(hd_merged_bin, array_c) + call append_c_to_ctl_array(hd_merged_gz, array_c) + call append_c_to_ctl_array(hd_merged_bin_gz, array_c) +! + call append_c_to_ctl_array(hd_rayleigh, array_c) + call append_c_to_ctl_array(hd_rayleigh99, array_c) ! end subroutine set_label_file_fmt ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/mesh_data_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/mesh_data_IO.f90 index 6616ba88..c72ad357 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/mesh_data_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/mesh_data_IO.f90 @@ -16,9 +16,11 @@ !! subroutine read_num_node(id_file, id_rank, mesh_IO, ierr) !! subroutine read_num_node_ele(id_file, id_rank, mesh_IO, ierr) !! subroutine read_geometry_data(id_file, id_rank, mesh_IO, ierr) -!! subroutine read_mesh_groups(id_file, mesh_group_IO) +!! subroutine read_mesh_groups(id_file, mesh_group_IO, ierr) +!! integer(kind = kint), intent(in) :: id_file !! type(mesh_geometry), intent(inout) :: mesh_IO !! type(mesh_groups), intent(inout) :: mesh_group_IO +!! integer(kind = kint), intent(inout) :: ierr !! !! subroutine write_filter_geometry & !! & (id_file, id_rank, comm_IO, nod_IO) @@ -125,7 +127,7 @@ subroutine read_num_node(id_file, id_rank, mesh_IO, ierr) & (id_file, id_rank, mesh_IO%nod_comm, ierr) if(ierr .ne. 0) return ! write(*,*) 'read_number_of_node' - call read_number_of_node(id_file, mesh_IO%node) + call read_number_of_node(id_file, mesh_IO%node, ierr) ! end subroutine read_num_node ! @@ -148,7 +150,7 @@ subroutine read_num_node_ele(id_file, id_rank, mesh_IO, ierr) ! ---- read element data ------- ! ! write(*,*) 'read_number_of_element' - call read_number_of_element(id_file, mesh_IO%ele) + call read_number_of_element(id_file, mesh_IO%ele, ierr) ! end subroutine read_num_node_ele ! @@ -175,31 +177,33 @@ subroutine read_geometry_data(id_file, id_rank, mesh_IO, ierr) ! ---- import & export ! ! write(*,*) 'read_import_data' - call read_import_data(id_file, mesh_IO%nod_comm) + call read_import_data(id_file, mesh_IO%nod_comm, ierr) + if(ierr .ne. 0) return ! write(*,*) 'read_export_data' - call read_export_data(id_file, mesh_IO%nod_comm) + call read_export_data(id_file, mesh_IO%nod_comm, ierr) ! end subroutine read_geometry_data ! !------------------------------------------------------------------ ! - subroutine read_mesh_groups(id_file, mesh_group_IO) + subroutine read_mesh_groups(id_file, mesh_group_IO, ierr) ! use groups_IO ! integer(kind = kint), intent(in) :: id_file type(mesh_groups), intent(inout) :: mesh_group_IO + integer(kind = kint), intent(inout) :: ierr ! ! ! read node group ! write(*,*) 'read_group_data node' - call read_group_data(id_file, mesh_group_IO%nod_grp) + call read_group_data(id_file, mesh_group_IO%nod_grp, ierr) ! read element group ! write(*,*) 'read_group_data ele' - call read_group_data(id_file, mesh_group_IO%ele_grp) + call read_group_data(id_file, mesh_group_IO%ele_grp, ierr) ! read surface group ! write(*,*) 'read_surf_grp_data surf' - call read_surf_grp_data(id_file, mesh_group_IO%surf_grp) + call read_surf_grp_data(id_file, mesh_group_IO%surf_grp, ierr) ! end subroutine read_mesh_groups ! @@ -254,15 +258,17 @@ subroutine read_filter_geometry & call read_domain_info(id_file, id_rank, comm_IO, ierr) ! ! write(*,*) 'read_geometry_info' - call read_number_of_node(id_file, nod_IO) + call read_number_of_node(id_file, nod_IO, ierr) + if(ierr .ne. 0) return call read_geometry_info(id_file, nod_IO) ! ! ---- import & export ! ! write(*,*) 'read_import_data' - call read_import_data(id_file, comm_IO) + call read_import_data(id_file, comm_IO, ierr) + if(ierr .ne. 0) return ! write(*,*) 'read_export_data' - call read_export_data(id_file, comm_IO) + call read_export_data(id_file, comm_IO, ierr) ! end subroutine read_filter_geometry ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/mesh_file_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/mesh_file_IO.f90 index d92e7af3..75243f78 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/mesh_file_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/mesh_file_IO.f90 @@ -71,7 +71,9 @@ subroutine read_mesh_file & open(input_file_code, file = file_name, form = 'formatted') ! call read_geometry_data(input_file_code, id_rank, mesh_IO, ierr) - call read_mesh_groups(input_file_code, group_IO) + if(ierr .gt. 0) return + call read_mesh_groups(input_file_code, group_IO, ierr) + if(ierr .gt. 0) return close(input_file_code) ! end subroutine read_mesh_file diff --git a/src/Fortran_libraries/SERIAL_src/IO/node_geometry_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/node_geometry_IO.f90 index 756aca7a..f1b9dc12 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/node_geometry_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/node_geometry_IO.f90 @@ -17,12 +17,15 @@ !! type(node_data), intent(in) :: nod_IO !! type(surf_edge_IO_data), intent(in) :: sfed_IO !! -!! subroutine read_number_of_node(id_file, nod_IO) +!! subroutine read_number_of_node(id_file, nod_IO, iend) !! subroutine read_geometry_info(id_file, nod_IO) -!! subroutine read_scalar_in_element(id_file, nod_IO, sfed_IO) -!! subroutine read_vector_in_element(id_file, nod_IO, sfed_IO) +!! subroutine read_scalar_in_element & +!! & (id_file, nod_IO, sfed_IO, iend) +!! subroutine read_vector_in_element & +!! & (id_file, nod_IO, sfed_IO, iend) !! type(node_data), intent(inout) :: nod_IO !! type(surf_edge_IO_data), intent(inout) :: sfed_IO +!! integer(kind = kint), intent(inout) :: iend !!@endverbatim ! module node_geometry_IO @@ -132,15 +135,17 @@ end subroutine write_vector_in_element !------------------------------------------------------------------ !------------------------------------------------------------------ ! - subroutine read_number_of_node(id_file, nod_IO) + subroutine read_number_of_node(id_file, nod_IO, iend) ! use skip_comment_f ! integer (kind = kint), intent(in) :: id_file type(node_data), intent(inout) :: nod_IO + integer(kind = kint), intent(inout) :: iend ! ! - call skip_comment(character_4_read,id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) nod_IO%numnod, nod_IO%internal_node ! write(*,*) nod_IO%numnod, nod_IO%internal_node ! @@ -166,16 +171,19 @@ end subroutine read_geometry_info ! !------------------------------------------------------------------ ! - subroutine read_scalar_in_element(id_file, nod_IO, sfed_IO) + subroutine read_scalar_in_element & + & (id_file, nod_IO, sfed_IO, iend) ! integer (kind = kint), intent(in) :: id_file type(node_data), intent(inout) :: nod_IO type(surf_edge_IO_data), intent(inout) :: sfed_IO + integer(kind = kint), intent(inout) :: iend ! integer(kind = kint) :: i ! ! - call read_number_of_node(id_file, nod_IO) + call read_number_of_node(id_file, nod_IO, iend) + if(iend .ne. 0) return call alloc_ele_scalar_IO(nod_IO, sfed_IO) ! do i = 1, nod_IO%numnod @@ -187,16 +195,19 @@ end subroutine read_scalar_in_element ! !------------------------------------------------------------------ ! - subroutine read_vector_in_element(id_file, nod_IO, sfed_IO) + subroutine read_vector_in_element & + & (id_file, nod_IO, sfed_IO, iend) ! integer (kind = kint), intent(in) :: id_file type(node_data), intent(inout) :: nod_IO type(surf_edge_IO_data), intent(inout) :: sfed_IO + integer(kind = kint), intent(inout) :: iend ! integer(kind = kint) :: i ! ! - call read_number_of_node(id_file, nod_IO) + call read_number_of_node(id_file, nod_IO, iend) + if(iend .ne. 0) return call alloc_ele_vector_IO(nod_IO, sfed_IO) ! do i = 1, nod_IO%numnod diff --git a/src/Fortran_libraries/SERIAL_src/IO/output_sph_pwr_volume_file.f90 b/src/Fortran_libraries/SERIAL_src/IO/output_sph_pwr_volume_file.f90 index 54f4ce2a..e9277bb8 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/output_sph_pwr_volume_file.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/output_sph_pwr_volume_file.f90 @@ -125,7 +125,7 @@ subroutine write_sph_vol_ms_file & ! do i = 1, pwr%num_vol_spectr if(id_rank .eq. pwr%v_spectr(i)%irank_m) then - if(cmp_no_case(pwr%v_spectr(i)%fhead_rms_v, 'NO_FILE')) cycle + if(no_file_flag(pwr%v_spectr(i)%fhead_rms_v)) cycle ! write(*,*) 'write_sph_volume_pwr_file', id_rank, i write(fname_rms, '(a,a6)') & & trim(pwr%v_spectr(i)%fhead_rms_v), '_s.dat' @@ -166,7 +166,7 @@ subroutine write_sph_vol_ms_spectr_file & if(pwr%v_spectr(i)%flag_skip_v_spec_l) cycle ! if(id_rank .eq. pwr%v_spectr(i)%irank_l) then - if(cmp_no_case(pwr%v_spectr(i)%fhead_rms_v, 'NO_FILE')) cycle + if(no_file_flag(pwr%v_spectr(i)%fhead_rms_v)) cycle ! write(*,*) 'write_sph_vol_ms_spectr_file l', id_rank, i write(fname_rms, '(a,a6)') & & trim(pwr%v_spectr(i)%fhead_rms_v), '_l.dat' @@ -182,7 +182,7 @@ subroutine write_sph_vol_ms_spectr_file & if(pwr%v_spectr(i)%flag_skip_v_spec_lm) cycle ! if(id_rank .eq. pwr%v_spectr(i)%irank_lm) then - if(cmp_no_case(pwr%v_spectr(i)%fhead_rms_v, 'NO_FILE')) cycle + if(no_file_flag(pwr%v_spectr(i)%fhead_rms_v)) cycle ! write(*,*) 'write_sph_vol_ms_spectr_file lm', id_rank, i write(fname_rms, '(a,a7)') & & trim(pwr%v_spectr(i)%fhead_rms_v), '_lm.dat' @@ -198,7 +198,7 @@ subroutine write_sph_vol_ms_spectr_file & if(pwr%v_spectr(i)%flag_skip_v_spec_m) cycle ! if(id_rank .eq. pwr%v_spectr(i)%irank_m) then - if(cmp_no_case(pwr%v_spectr(i)%fhead_rms_v, 'NO_FILE')) cycle + if(no_file_flag(pwr%v_spectr(i)%fhead_rms_v)) cycle ! write(*,*) 'write_sph_vol_ms_spectr_file m', id_rank, i write(fname_rms,'(a,a6)') & & trim(pwr%v_spectr(i)%fhead_rms_v), '_m.dat' @@ -214,7 +214,7 @@ subroutine write_sph_vol_ms_spectr_file & if(pwr%v_spectr(i)%flag_skip_v_spec_m0) cycle ! if(id_rank .eq. pwr%v_spectr(i)%irank_m) then - if(cmp_no_case(pwr%v_spectr(i)%fhead_rms_v, 'NO_FILE')) cycle + if(no_file_flag(pwr%v_spectr(i)%fhead_rms_v)) cycle write(fname_rms, '(a,a7)') & & trim(pwr%v_spectr(i)%fhead_rms_v), '_m0.dat' write(mode_label,'(a)') 'EMPTY' diff --git a/src/Fortran_libraries/SERIAL_src/IO/output_sph_volume_ave_file.f90 b/src/Fortran_libraries/SERIAL_src/IO/output_sph_volume_ave_file.f90 index 7f28c1f2..3dcb4ff0 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/output_sph_volume_ave_file.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/output_sph_volume_ave_file.f90 @@ -66,7 +66,7 @@ subroutine write_sph_vol_ave_file & do i = 1, pwr%num_vol_spectr if(pwr%v_spectr(i)%iflag_volume_ave_sph .eq. 0) cycle ! - if(cmp_no_case(pwr%v_spectr(i)%fhead_ave, 'NO_FILE')) cycle + if(no_file_flag(pwr%v_spectr(i)%fhead_ave)) cycle fname_rms = add_dat_extension(pwr%v_spectr(i)%fhead_ave) write(mode_label,'(a)') 'EMPTY' call write_sph_volume_pwr_file(fname_rms, mode_label, & diff --git a/src/Fortran_libraries/SERIAL_src/IO/rst_data_IO_by_fld.f90 b/src/Fortran_libraries/SERIAL_src/IO/rst_data_IO_by_fld.f90 index ab99b2ee..a7ef8f8b 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/rst_data_IO_by_fld.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/rst_data_IO_by_fld.f90 @@ -7,10 +7,12 @@ !> @brief read restart file !! !!@verbatim -!! subroutine read_rst_file(id_rank, file_name, t_IO, fld_IO) -!! subroutine read_rst_data_comps(id_rank, file_name, t_IO, fld_IO) +!! subroutine read_rst_file(id_rank, file_name, t_IO, fld_IO, iend) +!! subroutine read_rst_data_comps & +!! & (id_rank, file_name, t_IO, fld_IO, iend) !! type(time_data), intent(inout) :: t_IO !! type(field_IO), intent(inout) :: fld_IO +!! integer(kind = kint), intent(inout) :: iend !!@endverbatim ! module rst_data_IO_by_fld @@ -32,7 +34,7 @@ module rst_data_IO_by_fld ! !------------------------------------------------------------------ ! - subroutine read_rst_file(id_rank, file_name, t_IO, fld_IO) + subroutine read_rst_file(id_rank, file_name, t_IO, fld_IO, iend) ! use set_parallel_file_name use field_data_IO @@ -44,6 +46,7 @@ subroutine read_rst_file(id_rank, file_name, t_IO, fld_IO) ! type(time_data), intent(inout) :: t_IO type(field_IO), intent(inout) :: fld_IO + integer(kind = kint), intent(inout) :: iend ! character(len=kchara) :: character_4_read ! @@ -52,21 +55,25 @@ subroutine read_rst_file(id_rank, file_name, t_IO, fld_IO) & 'Read ascii restart file: ', trim(file_name) open (id_phys_file, file = file_name, form='formatted') ! - call read_step_data(id_phys_file, t_IO) + call read_step_data(id_phys_file, t_IO, iend) + if(iend .gt. 0) return ! - call skip_comment(character_4_read,id_phys_file) + call skip_comment(id_phys_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) fld_IO%num_field_IO ! call read_field_data(id_phys_file, cast_long(fld_IO%nnod_IO), & & fld_IO%num_field_IO, fld_IO%ntot_comp_IO, & - & fld_IO%num_comp_IO, fld_IO%fld_name, fld_IO%d_IO) + & fld_IO%num_comp_IO, fld_IO%fld_name, fld_IO%d_IO, iend) + if(iend .gt. 0) return close (id_phys_file) ! end subroutine read_rst_file ! !------------------------------------------------------------------ ! - subroutine read_rst_data_comps(id_rank, file_name, t_IO, fld_IO) + subroutine read_rst_data_comps & + & (id_rank, file_name, t_IO, fld_IO, iend) ! use set_parallel_file_name use field_data_IO @@ -77,6 +84,7 @@ subroutine read_rst_data_comps(id_rank, file_name, t_IO, fld_IO) ! type(time_data), intent(inout) :: t_IO type(field_IO), intent(inout) :: fld_IO + integer(kind = kint), intent(inout) :: iend ! character(len=kchara) :: character_4_read ! @@ -85,14 +93,17 @@ subroutine read_rst_data_comps(id_rank, file_name, t_IO, fld_IO) & 'Read ascii restart file: ', trim(file_name) open (id_phys_file, file = file_name, form='formatted') ! - call read_step_data(id_phys_file, t_IO) + call read_step_data(id_phys_file, t_IO, iend) + if(iend .gt. 0) return ! - call skip_comment(character_4_read,id_phys_file) + call skip_comment(id_phys_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) fld_IO%num_field_IO ! call alloc_phys_name_IO(fld_IO) ! - call read_rst_field_comps(fld_IO) + call read_rst_field_comps(fld_IO, iend) + if(iend .gt. 0) return close (id_phys_file) ! call cal_istack_phys_comp_IO(fld_IO) @@ -102,13 +113,14 @@ end subroutine read_rst_data_comps !------------------------------------------------------------------ !------------------------------------------------------------------ ! - subroutine read_rst_field_comps(fld_IO) + subroutine read_rst_field_comps(fld_IO, iend) ! use skip_comment_f use set_restart_data use skip_comment_f ! type(field_IO), intent(inout) :: fld_IO + integer(kind = kint), intent(inout) :: iend ! character(len=kchara) :: character_4_read integer(kind = kint) :: i, inod @@ -116,7 +128,8 @@ subroutine read_rst_field_comps(fld_IO) ! ! do i = 1, fld_IO%num_field_IO - call skip_comment(character_4_read,id_phys_file) + call skip_comment(id_phys_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) fld_IO%fld_name(i) ! call set_num_comps_4_rst(fld_IO%fld_name(i), & diff --git a/src/Fortran_libraries/SERIAL_src/IO/skip_comment_f.f90 b/src/Fortran_libraries/SERIAL_src/IO/skip_comment_f.f90 index 7a4e9497..ede75aea 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/skip_comment_f.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/skip_comment_f.f90 @@ -8,7 +8,10 @@ !> @brief subroutines to find comment lines in data !! !!@verbatim -!! subroutine skip_comment(character_4_read,id_file) +!! subroutine skip_comment(id_file, character_4_read, iend) +!! integer (kind=kint), intent(in) :: id_file +!! character(len=255), intent(inout) :: character_4_read +!! integer (kind=kint), intent(inout) :: iend !! !! subroutine read_one_line_from_stream(id_file, & !! & lenghbuf, num_word, nchara_read, tbuf) @@ -22,7 +25,10 @@ !! subroutine count_field_by_comma(id_file, charabuf, & !! & ncomp, field_name) !! subroutine read_stack_array(character_4_read, id_file, num, & -!! & istack_array) +!! & istack_array, iend) +!! integer (kind=kint), intent(in) :: id_file, num +!! integer (kind=kint), intent(inout) :: istack_array(0:num) +!! integer (kind=kint), intent(inout) :: iend !! !! subroutine change_2_upper_case(string) !! subroutine change_2_lower_case(string) @@ -38,6 +44,8 @@ !! returns 1, othewwise returns 0 !! logical function yes_flag(control) !! logical function no_flag(control) +!! logical function no_file_flag(control) +!! character(len=kchara), intent(in) :: control !!@endverbatim ! module skip_comment_f @@ -52,18 +60,26 @@ module skip_comment_f ! !----------------------------------------------------------------------- ! - subroutine skip_comment(character_4_read,id_file) + subroutine skip_comment(id_file, character_4_read, iend) ! - integer (kind=kint), intent(in) :: id_file - character(len=255), intent(inout) :: character_4_read - character(len=1) :: detect_comment + integer (kind=kint), intent(in) :: id_file + character(len=255), intent(inout) :: character_4_read + integer (kind=kint), intent(inout) :: iend + character(len=1) :: detect_comment ! - 10 continue - read(id_file,'(a)') character_4_read - read(character_4_read,*,end=10) detect_comment - if ( detect_comment.eq.'!' .or. detect_comment.eq.'#') go to 10 + iend = 0 + 10 continue + read(id_file,'(a)',end=99) character_4_read + read(character_4_read,*,end=10) detect_comment + if(detect_comment.eq.'!' .or. detect_comment.eq.'#') go to 10 ! return +! + 99 continue + write(*,*) 'File is probably incorrect.' + iend = 99 + return +! end subroutine skip_comment ! !----------------------------------------------------------------------- @@ -169,41 +185,43 @@ end subroutine count_field_by_comma !----------------------------------------------------------------------- ! subroutine read_stack_array(character_4_read, id_file, num, & - & istack_array) + & istack_array, iend) ! - integer (kind=kint), intent(in) :: id_file, num + integer (kind=kint), intent(in) :: id_file, num + integer (kind=kint), intent(inout) :: istack_array(0:num) + integer (kind=kint), intent(inout) :: iend ! - integer (kind=kint), intent(inout) :: istack_array(0:num) - character(len=255) :: character_4_read + character(len=255) :: character_4_read ! - integer (kind=kint) :: i, ii + integer (kind=kint) :: i, ii ! ! - istack_array(0:num) = -1 + istack_array(0:num) = -1 ! - call skip_comment(character_4_read,id_file) - read(character_4_read,*,end=51) istack_array - 51 continue + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return + read(character_4_read,*,end=51) istack_array + 51 continue ! ! Check number of read data ! - ii = num + 1 - do i = num, 1, -1 - if ( istack_array(i-1) .eq. -1 ) ii = i - end do + ii = num + 1 + do i = num, 1, -1 + if ( istack_array(i-1) .eq. -1 ) ii = i + end do ! ! shift stack array ! - do i = ii-1, 1,-1 - istack_array(i) = istack_array(i-1) - end do - istack_array(0) = 0 + do i = ii-1, 1,-1 + istack_array(i) = istack_array(i-1) + end do + istack_array(0) = 0 ! ! read reast of array ! - if ( ii .le. num ) then - read(id_file,*) (istack_array(i),i=ii, num) - end if + if ( ii .le. num ) then + read(id_file,*) (istack_array(i),i=ii, num) + end if ! end subroutine read_stack_array ! @@ -341,5 +359,13 @@ logical function no_flag(control) end function no_flag ! !----------------------------------------------------------------------- +! + logical function no_file_flag(control) + character(len=kchara), intent(in) :: control +! + no_file_flag = cmp_no_case(control, 'NO_FILE') + end function no_file_flag +! +!----------------------------------------------------------------------- ! end module skip_comment_f diff --git a/src/Fortran_libraries/SERIAL_src/IO/sph_global_1d_idx_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/sph_global_1d_idx_IO.f90 index 51fa1b6e..d3d7ac50 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/sph_global_1d_idx_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/sph_global_1d_idx_IO.f90 @@ -7,9 +7,11 @@ !> @brief Base routines for spectr indexing data IO !! !!@verbatim -!! subroutine read_rtp_gl_1d_table(id_file, sph_IO) -!! subroutine read_rj_gl_1d_table(id_file, sph_IO) +!! subroutine read_rtp_gl_1d_table(id_file, sph_IO, iend) +!! subroutine read_rj_gl_1d_table(id_file, sph_IO, iend) +!! integer(kind = kint), intent(in) :: id_file !! type(sph_IO_data), intent(inout) :: sph_IO +!! integer(kind = kint), intent(inout) :: iend !! !! subroutine write_rtp_gl_1d_table(id_file, sph_IO) !! subroutine write_rj_gl_1d_table(id_file, sph_IO) @@ -32,12 +34,13 @@ module sph_global_1d_idx_IO ! ! ----------------------------------------------------------------------- ! - subroutine read_rtp_gl_1d_table(id_file, sph_IO) + subroutine read_rtp_gl_1d_table(id_file, sph_IO, iend) ! use skip_comment_f ! integer(kind = kint), intent(in) :: id_file type(sph_IO_data), intent(inout) :: sph_IO + integer(kind = kint), intent(inout) :: iend ! integer(kind = kint) :: i ! @@ -48,7 +51,8 @@ subroutine read_rtp_gl_1d_table(id_file, sph_IO) ! call alloc_num_idx_sph_IO(sph_IO) ! - call skip_comment(character_4_read,id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) sph_IO%nidx_sph(1), & & sph_IO%ist_sph(1), sph_IO%ied_sph(1) call alloc_idx_sph_1d1_IO(sph_IO) @@ -57,7 +61,8 @@ subroutine read_rtp_gl_1d_table(id_file, sph_IO) read(id_file,*) sph_IO%idx_gl_1(i), sph_IO%r_gl_1(i) end do ! - call skip_comment(character_4_read,id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) sph_IO%nidx_sph(2), & & sph_IO%ist_sph(2), sph_IO%ied_sph(2) call alloc_idx_sph_1d2_IO(sph_IO) @@ -66,7 +71,8 @@ subroutine read_rtp_gl_1d_table(id_file, sph_IO) read(id_file,*) sph_IO%idx_gl_2(i,1:sph_IO%ncomp_table_1d(2)) end do ! - call skip_comment(character_4_read,id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) sph_IO%nidx_sph(3), & & sph_IO%ist_sph(3), sph_IO%ied_sph(3) call alloc_idx_sph_1d3_IO(sph_IO) @@ -79,12 +85,13 @@ end subroutine read_rtp_gl_1d_table ! ! ----------------------------------------------------------------------- ! - subroutine read_rj_gl_1d_table(id_file, sph_IO) + subroutine read_rj_gl_1d_table(id_file, sph_IO, iend) ! use skip_comment_f ! integer(kind = kint), intent(in) :: id_file type(sph_IO_data), intent(inout) :: sph_IO + integer(kind = kint), intent(inout) :: iend ! integer(kind = kint) :: i ! @@ -95,7 +102,8 @@ subroutine read_rj_gl_1d_table(id_file, sph_IO) ! call alloc_num_idx_sph_IO(sph_IO) ! - call skip_comment(character_4_read,id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) sph_IO%nidx_sph(1), & & sph_IO%ist_sph(1), sph_IO%ied_sph(1) call alloc_idx_sph_1d1_IO(sph_IO) @@ -104,7 +112,8 @@ subroutine read_rj_gl_1d_table(id_file, sph_IO) read(id_file,*) sph_IO%idx_gl_1(i), sph_IO%r_gl_1(i) end do ! - call skip_comment(character_4_read,id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) sph_IO%nidx_sph(2), & & sph_IO%ist_sph(2), sph_IO%ied_sph(2) call alloc_idx_sph_1d2_IO(sph_IO) diff --git a/src/Fortran_libraries/SERIAL_src/IO/sph_modes_grids_data_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/sph_modes_grids_data_IO.f90 index 288ff25d..2f000a10 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/sph_modes_grids_data_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/sph_modes_grids_data_IO.f90 @@ -74,24 +74,32 @@ subroutine read_geom_rtp_data(id_file, id_rank, & if(ierr .ne. 0) return ! ! write(*,*) '! truncation level for spherical harmonics' - call read_gl_resolution_sph(id_file, sph_IO) + call read_gl_resolution_sph(id_file, sph_IO, ierr) + if(ierr .ne. 0) return ! write(*,*) '! segment ID for each direction' - call read_rank_4_sph(id_file, sph_IO) + call read_rank_4_sph(id_file, sph_IO, ierr) + if(ierr .ne. 0) return ! ! write(*,*) '! global ID for each direction' - call read_rtp_gl_1d_table(id_file, sph_IO) + call read_rtp_gl_1d_table(id_file, sph_IO, ierr) + if(ierr .ne. 0) return ! ! write(*,*) '! global radial ID and grid ID' - call read_gl_nodes_sph(id_file, sph_IO) + call read_gl_nodes_sph(id_file, sph_IO, ierr) + if(ierr .ne. 0) return ! ! write(*,*) '! communication table between spectr data' - call read_import_data(id_file, comm_IO) + call read_import_data(id_file, comm_IO, ierr) + if(ierr .ne. 0) return ! ! write(*,*) '! Group data' - call read_group_data(id_file, sph_grps_IO%bc_rtp_grp) - call read_group_data(id_file, sph_grps_IO%radial_rtp_grp) - call read_group_data(id_file, sph_grps_IO%theta_rtp_grp) - call read_group_data(id_file, sph_grps_IO%zonal_rtp_grp) + call read_group_data(id_file, sph_grps_IO%bc_rtp_grp, ierr) + if(ierr .ne. 0) return + call read_group_data(id_file, sph_grps_IO%radial_rtp_grp, ierr) + if(ierr .ne. 0) return + call read_group_data(id_file, sph_grps_IO%theta_rtp_grp, ierr) + if(ierr .ne. 0) return + call read_group_data(id_file, sph_grps_IO%zonal_rtp_grp, ierr) ! end subroutine read_geom_rtp_data ! @@ -118,22 +126,27 @@ subroutine read_spectr_modes_rj_data(id_file, id_rank, & if(ierr .ne. 0) return ! ! write(*,*) '! truncation level for spherical harmonics' - call read_gl_resolution_sph(id_file, sph_IO) + call read_gl_resolution_sph(id_file, sph_IO, ierr) + if(ierr .ne. 0) return ! write(*,*) '! segment ID for each direction' - call read_rank_4_sph(id_file, sph_IO) + call read_rank_4_sph(id_file, sph_IO, ierr) + if(ierr .ne. 0) return ! ! write(*,*) '! global ID for each direction' - call read_rj_gl_1d_table(id_file, sph_IO) + call read_rj_gl_1d_table(id_file, sph_IO, ierr) + if(ierr .ne. 0) return ! ! write(*,*) '! global radial ID and spectr ID' - call read_gl_nodes_sph(id_file, sph_IO) + call read_gl_nodes_sph(id_file, sph_IO, ierr) + if(ierr .ne. 0) return ! ! write(*,*) '! communication table between spectr data' - call read_import_data(id_file, comm_IO) + call read_import_data(id_file, comm_IO, ierr) + if(ierr .ne. 0) return ! ! write(*,*) '! Group data' - call read_group_data(id_file, sph_grps_IO%radial_rj_grp) - call read_group_data(id_file, sph_grps_IO%sphere_rj_grp) + call read_group_data(id_file, sph_grps_IO%radial_rj_grp, ierr) + call read_group_data(id_file, sph_grps_IO%sphere_rj_grp, ierr) ! end subroutine read_spectr_modes_rj_data ! @@ -155,12 +168,17 @@ subroutine read_geom_rtm_data & call read_domain_info(id_file, id_rank, comm_IO, ierr) if(ierr .ne. 0) return ! - call read_gl_resolution_sph(id_file, sph_IO) - call read_rank_4_sph(id_file, sph_IO) - call read_rtp_gl_1d_table(id_file, sph_IO) - call read_gl_nodes_sph(id_file, sph_IO) + call read_gl_resolution_sph(id_file, sph_IO, ierr) + if(ierr .ne. 0) return + call read_rank_4_sph(id_file, sph_IO, ierr) + if(ierr .ne. 0) return + call read_rtp_gl_1d_table(id_file, sph_IO, ierr) + if(ierr .ne. 0) return + call read_gl_nodes_sph(id_file, sph_IO, ierr) + if(ierr .ne. 0) return ! - call read_import_data(id_file, comm_IO) + call read_import_data(id_file, comm_IO, ierr) + if(ierr .ne. 0) return ! end subroutine read_geom_rtm_data ! @@ -182,12 +200,17 @@ subroutine read_spectr_modes_rlm_data & call read_domain_info(id_file, id_rank, comm_IO, ierr) if(ierr .ne. 0) return ! - call read_gl_resolution_sph(id_file, sph_IO) - call read_rank_4_sph(id_file, sph_IO) - call read_rj_gl_1d_table(id_file, sph_IO) - call read_gl_nodes_sph(id_file, sph_IO) + call read_gl_resolution_sph(id_file, sph_IO, ierr) + if(ierr .ne. 0) return + call read_rank_4_sph(id_file, sph_IO, ierr) + if(ierr .ne. 0) return + call read_rj_gl_1d_table(id_file, sph_IO, ierr) + if(ierr .ne. 0) return + call read_gl_nodes_sph(id_file, sph_IO, ierr) + if(ierr .ne. 0) return ! - call read_import_data(id_file, comm_IO) + call read_import_data(id_file, comm_IO, ierr) + if(ierr .ne. 0) return ! end subroutine read_spectr_modes_rlm_data ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/spherical_model_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/spherical_model_IO.f90 index 7ee6ace1..23fe195d 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/spherical_model_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/spherical_model_IO.f90 @@ -7,10 +7,12 @@ !> @brief Data IO routines for spectrum data !! !!@verbatim -!! subroutine read_rank_4_sph(id_file, sph_IO) -!! subroutine read_gl_resolution_sph(id_file, sph_IO) -!! subroutine read_gl_nodes_sph(id_file, sph_IO) +!! subroutine read_rank_4_sph(id_file, sph_IO, iend) +!! subroutine read_gl_resolution_sph(id_file, sph_IO, iend) +!! subroutine read_gl_nodes_sph(id_file, sph_IO, iend) +!! integer(kind = kint), intent(in) :: id_file !! type(sph_IO_data), intent(inout) :: sph_IO +!! integer(kind = kint), intent(inout) :: iend !! !! subroutine write_rank_4_sph(id_file, sph_IO) !! subroutine write_gl_resolution_sph(id_file, sph_IO) @@ -35,54 +37,62 @@ module spherical_model_IO ! ! ----------------------------------------------------------------------- ! - subroutine read_rank_4_sph(id_file, sph_IO) + subroutine read_rank_4_sph(id_file, sph_IO, iend) ! use skip_comment_f ! integer(kind = kint), intent(in) :: id_file type(sph_IO_data), intent(inout) :: sph_IO + integer(kind = kint), intent(inout) :: iend ! ! - call skip_comment(character_4_read,id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) sph_IO%sph_rank(1:sph_IO%numdir_sph) ! end subroutine read_rank_4_sph ! ! ----------------------------------------------------------------------- ! - subroutine read_gl_resolution_sph(id_file, sph_IO) + subroutine read_gl_resolution_sph(id_file, sph_IO, iend) ! use skip_comment_f ! integer(kind = kint), intent(in) :: id_file type(sph_IO_data), intent(inout) :: sph_IO + integer(kind = kint), intent(inout) :: iend ! ! - call skip_comment(character_4_read,id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) sph_IO%nidx_gl_sph(1:sph_IO%numdir_sph) - call skip_comment(character_4_read,id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) sph_IO%ltr_gl ! end subroutine read_gl_resolution_sph ! ! ----------------------------------------------------------------------- ! - subroutine read_gl_nodes_sph(id_file, sph_IO) + subroutine read_gl_nodes_sph(id_file, sph_IO, iend) ! use skip_comment_f ! integer(kind = kint), intent(in) :: id_file type(sph_IO_data), intent(inout) :: sph_IO + integer(kind = kint), intent(inout) :: iend ! integer(kind = kint) :: i ! ! - call skip_comment(character_4_read,id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) sph_IO%numnod_sph ! call alloc_nod_id_sph_IO(sph_IO) ! - call skip_comment(character_4_read,id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) sph_IO%inod_gl_sph(1), & & sph_IO%idx_gl_sph(1,1:sph_IO%numdir_sph) do i = 2, sph_IO%numnod_sph diff --git a/src/Fortran_libraries/SERIAL_src/IO/surface_data_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/surface_data_IO.f90 index 6ee083ee..4bf32dcf 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/surface_data_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/surface_data_IO.f90 @@ -18,7 +18,7 @@ !! type(element_data), intent(in) :: ele_IO !! type(surf_edge_IO_data), intent(in) :: sfed_IO !! -!! subroutine read_surface_geometry(id_file, nod_IO, sfed_IO) +!! subroutine read_surface_geometry(id_file, nod_IO, sfed_IO, ierr) !! type(node_data), intent(inout) :: nod_IO !! type(surf_edge_IO_data), intent(inout) :: sfed_IO !! subroutine write_surface_geometry(id_file, nod_IO, sfed_IO) @@ -26,6 +26,7 @@ !! subroutine write_surface_geometry_cyl(id_file, nod_IO, sfed_IO) !! type(node_data), intent(in) :: nod_IO !! type(surf_edge_IO_data), intent(in) :: sfed_IO +!! integer(kind = kint), intent(inout) :: iend !!@endverbatim ! module surface_data_IO @@ -75,7 +76,8 @@ subroutine read_surface_connection & ! write(id_file,'(a)') '! (type and connection) ' ! write(id_file,'(a)') '!' ! - call read_number_of_element(id_file, ele_IO) + call read_number_of_element(id_file, ele_IO, ierr) + if(ierr .ne. 0) return call read_element_info(id_file, ele_IO) ! ! write(id_file,'(a)') '!' @@ -93,13 +95,14 @@ subroutine read_surface_connection & ! write(id_file,'(a)') '! 3.1 surface ID for import ' ! write(id_file,'(a)') '!' ! - call read_import_data(id_file, comm_IO) + call read_import_data(id_file, comm_IO, ierr) + if(ierr .ne. 0) return ! ! write(id_file,'(a)') '!' ! write(id_file,'(a)') '! 3.2 surface ID for export ' ! write(id_file,'(a)') '!' ! - call read_export_data(id_file, comm_IO) + call read_export_data(id_file, comm_IO, ierr) ! end subroutine read_surface_connection ! @@ -142,34 +145,36 @@ end subroutine write_surface_connection !------------------------------------------------------------------ !------------------------------------------------------------------ ! - subroutine read_surface_geometry(id_file, nod_IO, sfed_IO) + subroutine read_surface_geometry(id_file, nod_IO, sfed_IO, iend) ! use node_geometry_IO ! integer (kind = kint), intent(in) :: id_file type(node_data), intent(inout) :: nod_IO type(surf_edge_IO_data), intent(inout) :: sfed_IO -! + integer(kind = kint), intent(inout) :: iend ! ! write(id_file,'(a)') '!' ! write(id_file,'(a)') '! 4. geometry of surface' ! write(id_file,'(a)') '! 4.1 center of surface' ! write(id_file,'(a)') '!' ! - call read_number_of_node(id_file, nod_IO) + call read_number_of_node(id_file, nod_IO, iend) + if(iend .ne. 0) return call read_geometry_info(id_file, nod_IO) ! ! write(id_file,'(a)') '!' ! write(id_file,'(a)') '! 4.2 normal vector of surface' ! write(id_file,'(a)') '!' ! - call read_vector_in_element(id_file, nod_IO, sfed_IO) + call read_vector_in_element(id_file, nod_IO, sfed_IO, iend) + if(iend .ne. 0) return ! ! write(id_file,'(a)') '!' ! write(id_file,'(a)') '! 4.3 area of surface' ! write(id_file,'(a)') '!' ! - call read_scalar_in_element(id_file, nod_IO, sfed_IO) + call read_scalar_in_element(id_file, nod_IO, sfed_IO, iend) ! end subroutine read_surface_geometry ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_chara2int.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_chara2int.f90 new file mode 100644 index 00000000..57cd00f7 --- /dev/null +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_chara2int.f90 @@ -0,0 +1,424 @@ +!>@file t_control_array_chara2int.f90 +!! module t_control_array_chara2int +!! +!!@author H. Matsui +!!@date Programmed in June, 2014 +!! +!>@brief Subroutines to read char-char-int control arrays +!! +!!@verbatim +!! subroutine init_chara2int_ctl_item_label(label, c2i_item) +!! subroutine read_char2int_ctl_type(c_buf, label, c2i_item) +!! type(buffer_for_control), intent(in) :: c_buf +!! type(read_chara2_int_item), intent(inout) :: c2i_item +!! subroutine write_char2real_ctl_type & +!! & (id_file, level, maxlen, c2i_item) +!! type(read_chara2_int_item), intent(in) :: c2i_item +!! subroutine copy_char2int_ctl(org_c2i, new_c2i) +!! type(read_chara2_int_item), intent(in) :: org_c2i +!! type(read_chara2_int_item), intent(inout) :: new_c2i +!! logical function cmp_read_char2int_item(c2i_item1, c2i_item2) +!! type(read_chara2_int_item), intent(in) :: c2i_item1 +!! type(read_chara2_int_item), intent(in) :: c2i_item2 +!! +!! subroutine alloc_control_array_c2_i(array_c2i) +!! subroutine dealloc_control_array_c2_i(array_c2i) +!! subroutine init_c2_i_ctl_array_label(label, array_c2i) +!! subroutine read_control_array_c2_i & +!! & (id_control, label, array_c2i, c_buf) +!! type(ctl_array_c2i), intent(inout) :: array_c2i +!! type(buffer_for_control), intent(in) :: c_buf +!! subroutine write_control_array_c2_i & +!! & (id_control, level, array_c2i) +!! integer(kind = kint), intent(in) :: id_control +!! character(len=kchara), intent(in) :: label +!! type(ctl_array_c2i), intent(in) :: array_c2i +!! integer(kind = kint), intent(inout) :: level +!! logical function cmp_control_array_c2_i(array1_c2i, array2_c2i) +!! type(ctl_array_c2i), intent(in) :: array1_c2i, array2_c2i +!! +!! subroutine append_control_array_c2_i(read_c2i, array_c2i) +!! type(read_chara2_int_item), intent(inout) :: read_c2i +!! type(ctl_array_c2i), intent(inout) :: array_c2i +!! subroutine dup_control_array_c2_i(org_c2i, tgt_c2i) +!! subroutine copy_control_array_c2_i(num_copy, org_c2i, tgt_c2i) +!! type(ctl_array_c2i), intent(in) :: org_c2i +!! type(ctl_array_c2i), intent(inout) :: tgt_c2i +!! subroutine append_control_item_c2_i(read_c2i, array_c2i) +!! type(read_chara2_int_item), intent(in) :: read_c2i +!! type(ctl_array_c2i), intent(inout) :: array_c2i +!! +!! subroutine append_c2i_to_ctl_array & +!! & (chara1_in, chara2_in, int_in, array_c2i) +!! character(len = kchara), intent(in) :: chara1_in, chara2_in +!! integer(kind = kint), intent(in) :: int_in +!! type(ctl_array_c2i), intent(inout) :: array_c2i +!!@endverbatim +!! +!! + module t_control_array_chara2int +! + use m_precision + use m_machine_parameter +! + implicit none +! +!> structure of control item with three characters + type read_chara2_int_item +!> Item name + character(len=kchara) :: item_name = 'char_item' +!> read flag (If item is read iflag = 1) + integer(kind = kint) :: iflag = 0 +!> array for read character items + character(len=kchara) :: charavalue(2) +!> array for read real item + integer(kind = kint) :: intvalue + end type read_chara2_int_item +! +!> Structure for two charactors and real control array + type ctl_array_c2i +!> Item name + character(len=kchara) :: array_name = 'char_array' +!> number of array items + integer(kind=kint) :: num = 0 +!> array counter + integer(kind=kint) :: icou = 0 +!> array for 1st character + character(len=kchara), allocatable :: c1_tbl(:) +!> array for 2nd character + character(len=kchara), allocatable :: c2_tbl(:) +!> array for 1st real + integer(kind = kint), allocatable :: ivec(:) + end type ctl_array_c2i +! +! -------------------------------------------------------------------- +! + contains +! +! -------------------------------------------------------------------- +! + subroutine init_chara2int_ctl_item_label(label, c2i_item) + character(len=kchara), intent(in) :: label + type(read_chara2_int_item), intent(inout) :: c2i_item +! + c2i_item%item_name = trim(label) + end subroutine init_chara2int_ctl_item_label +! +! ---------------------------------------------------------------------- +! + subroutine read_char2int_ctl_type(c_buf, label, c2i_item) +! + use t_read_control_elements +! + type(buffer_for_control), intent(in) :: c_buf + character(len=kchara), intent(in) :: label + type(read_chara2_int_item), intent(inout) :: c2i_item +! + character(len=kchara) :: tmpchara +! +! + if(c2i_item%iflag.gt.0) return + c2i_item%item_name = trim(label) + if(c_buf%header_chara.ne.label) return +! + read(c_buf%ctl_buffer,*) tmpchara, c2i_item%charavalue(1:2), & + & c2i_item%intvalue + if (iflag_debug .gt. 0) write(*,'(a,a4,a)') & + & trim(c_buf%header_chara), ' 1: ', c2i_item%charavalue(1) + if (iflag_debug .gt. 0) write(*,'(a,a4,a)') & + & trim(c_buf%header_chara), ' 2: ', c2i_item%charavalue(2) + if (iflag_debug .gt. 0) write(*,'(a,a7,i16)') & + & trim(c_buf%header_chara), ' int: ', c2i_item%intvalue + c2i_item%iflag = 1 +! + end subroutine read_char2int_ctl_type +! +! -------------------------------------------------------------------- +! + subroutine write_char2real_ctl_type & + & (id_file, level, maxlen, c2i_item) +! + use write_control_elements +! + integer(kind = kint), intent(in) :: id_file, level + integer(kind = kint), intent(in) :: maxlen + type(read_chara2_int_item), intent(in) :: c2i_item +! +! + if(c2i_item%iflag .eq. 0) return +! + call write_chara2_int_ctl_item(id_file, level, maxlen, & + & c2i_item%item_name, c2i_item%charavalue(1), & + & c2i_item%charavalue(2), c2i_item%intvalue) +! + end subroutine write_char2real_ctl_type +! +! -------------------------------------------------------------------- +! + subroutine copy_char2int_ctl(org_c2i, new_c2i) +! + type(read_chara2_int_item), intent(in) :: org_c2i + type(read_chara2_int_item), intent(inout) :: new_c2i +! +! + new_c2i%item_name = org_c2i%item_name + new_c2i%iflag = org_c2i%iflag + new_c2i%charavalue(1:2) = org_c2i%charavalue(1:2) + new_c2i%intvalue = org_c2i%intvalue +! + end subroutine copy_char2int_ctl +! +! -------------------------------------------------------------------- +! + logical function cmp_read_char2int_item(c2i_item1, c2i_item2) +! + use skip_comment_f +! + type(read_chara2_int_item), intent(in) :: c2i_item1 + type(read_chara2_int_item), intent(in) :: c2i_item2 +! + cmp_read_char2int_item = .FALSE. + if(cmp_no_case(trim(c2i_item1%item_name), & + & trim(c2i_item2%item_name)) .eqv. .FALSE.) return + if(c2i_item1%iflag .ne. c2i_item2%iflag) return + if(c2i_item1%iflag .gt. 0) then + if(cmp_no_case(trim(c2i_item1%charavalue(1)), & + & trim(c2i_item2%charavalue(1))) .eqv. .FALSE.) return + if(cmp_no_case(trim(c2i_item1%charavalue(2)), & + & trim(c2i_item2%charavalue(2))) .eqv. .FALSE.) return + if(c2i_item1%intvalue .ne. c2i_item2%intvalue) return + end if +! + cmp_read_char2int_item = .TRUE. +! + end function cmp_read_char2int_item +! +! ---------------------------------------------------------------------- +! -------------------------------------------------------------------- +! + subroutine alloc_control_array_c2_i(array_c2i) +! + type(ctl_array_c2i), intent(inout) :: array_c2i +! +! + allocate( array_c2i%c1_tbl(array_c2i%num) ) + allocate( array_c2i%c2_tbl(array_c2i%num) ) + allocate( array_c2i%ivec(array_c2i%num) ) +! + if(array_c2i%num .eq. 0) return + array_c2i%ivec = 0.0d0 +! + end subroutine alloc_control_array_c2_i +! +! -------------------------------------------------------------------- +! + subroutine dealloc_control_array_c2_i(array_c2i) +! + type(ctl_array_c2i), intent(inout) :: array_c2i +! +! + if(allocated(array_c2i%c1_tbl) .eqv. .FALSE.) return + deallocate( array_c2i%c1_tbl, array_c2i%c2_tbl, array_c2i%ivec) + array_c2i%num = 0 +! + end subroutine dealloc_control_array_c2_i +! +! -------------------------------------------------------------------- +! -------------------------------------------------------------------- +! + subroutine init_c2_i_ctl_array_label(label, array_c2i) + character(len=kchara), intent(in) :: label + type(ctl_array_c2i), intent(inout) :: array_c2i +! + array_c2i%array_name = trim(label) + end subroutine init_c2_i_ctl_array_label +! +! -------------------------------------------------------------------- +! + subroutine read_control_array_c2_i & + & (id_control, label, array_c2i, c_buf) +! + use t_read_control_elements +! + integer(kind = kint), intent(in) :: id_control + character(len=kchara), intent(in) :: label + type(ctl_array_c2i), intent(inout) :: array_c2i + type(buffer_for_control), intent(inout) :: c_buf +! + type(read_chara2_int_item) :: read_c2i +! +! + if(array_c2i%icou .gt. 0) return + array_c2i%array_name = trim(label) + if(check_array_flag(c_buf, label) .eqv. .FALSE.) return +! + read_c2i%iflag = 0 + array_c2i%num = 0 + call alloc_control_array_c2_i(array_c2i) +! + do + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit + if(check_end_array_flag(c_buf, label)) exit +! + if(c_buf%header_chara.eq.label) then + call read_char2int_ctl_type(c_buf, label, read_c2i) + call append_control_array_c2_i(read_c2i, array_c2i) + end if + end do +! + end subroutine read_control_array_c2_i +! +! -------------------------------------------------------------------- +! + subroutine write_control_array_c2_i & + & (id_control, level, array_c2i) +! + use skip_comment_f + use write_control_elements +! + integer(kind = kint), intent(in) :: id_control + type(ctl_array_c2i), intent(in) :: array_c2i +! + integer(kind = kint), intent(inout) :: level +! + integer(kind = kint) :: i +! +! + if(array_c2i%num .le. 0) return +! + level = write_array_flag_for_ctl(id_control, level, & + & array_c2i%array_name) + do i = 1, array_c2i%num + call write_chara2_int_ctl_item(id_control, level, & + & len_trim(array_c2i%array_name), array_c2i%array_name, & + & array_c2i%c1_tbl(i), array_c2i%c2_tbl(i), array_c2i%ivec(i)) + end do + level = write_end_array_flag_for_ctl(id_control, level, & + & array_c2i%array_name) +! + end subroutine write_control_array_c2_i +! +! -------------------------------------------------------------------- +! + logical function cmp_control_array_c2_i(array1_c2i, array2_c2i) +! + use skip_comment_f +! + type(ctl_array_c2i), intent(in) :: array1_c2i, array2_c2i + integer(kind = kint) :: i +! + cmp_control_array_c2_i = .FALSE. + if(cmp_no_case(trim(array1_c2i%array_name), & + & trim(array2_c2i%array_name)) .eqv. .FALSE.) return + if(array1_c2i%num .ne. array2_c2i%num) return + if(array1_c2i%icou .ne. array2_c2i%icou) return + do i = 1, array1_c2i%num + if(cmp_no_case(trim(array1_c2i%c1_tbl(i)), & + & trim(array2_c2i%c1_tbl(i))) .eqv. .FALSE.) return + if(cmp_no_case(trim(array1_c2i%c2_tbl(i)), & + & trim(array2_c2i%c2_tbl(i))) .eqv. .FALSE.) return + if(array1_c2i%ivec(i) .ne. array2_c2i%ivec(i)) return + end do + cmp_control_array_c2_i = .TRUE. +! + end function cmp_control_array_c2_i +! +! -------------------------------------------------------------------- +! -------------------------------------------------------------------- +! + subroutine append_control_array_c2_i(read_c2i, array_c2i) +! + type(read_chara2_int_item), intent(inout) :: read_c2i + type(ctl_array_c2i), intent(inout) :: array_c2i +! + type(ctl_array_c2i) :: org_c2i +! +! + org_c2i%num = array_c2i%num + call alloc_control_array_c2_i(org_c2i) + call copy_control_array_c2_i(org_c2i%num, array_c2i, org_c2i) + call dealloc_control_array_c2_i(array_c2i) +! + array_c2i%num = org_c2i%num + 1 + call alloc_control_array_c2_i(array_c2i) + call copy_control_array_c2_i(org_c2i%num, org_c2i, array_c2i) + call append_control_item_c2_i(read_c2i, array_c2i) + read_c2i%iflag = 0 +! + call dealloc_control_array_c2_i(org_c2i) +! + end subroutine append_control_array_c2_i +! +! ----------------------------------------------------------------------- +! + subroutine dup_control_array_c2_i(org_c2i, tgt_c2i) +! + type(ctl_array_c2i), intent(in) :: org_c2i + type(ctl_array_c2i), intent(inout) :: tgt_c2i +! +! + tgt_c2i%num = org_c2i%num + call alloc_control_array_c2_i(tgt_c2i) + call copy_control_array_c2_i(org_c2i%num, org_c2i, tgt_c2i) +! + end subroutine dup_control_array_c2_i +! +! ----------------------------------------------------------------------- +! + subroutine copy_control_array_c2_i(num_copy, org_c2i, tgt_c2i) +! + integer(kind = kint), intent(in) :: num_copy + type(ctl_array_c2i), intent(in) :: org_c2i + type(ctl_array_c2i), intent(inout) :: tgt_c2i +! +! + tgt_c2i%array_name = org_c2i%array_name + tgt_c2i%icou = org_c2i%icou +! + if(num_copy .le. 0) return + tgt_c2i%c1_tbl(1:num_copy) = org_c2i%c1_tbl(1:num_copy) + tgt_c2i%c2_tbl(1:num_copy) = org_c2i%c2_tbl(1:num_copy) + tgt_c2i%ivec(1:num_copy) = org_c2i%ivec(1:num_copy) +! + end subroutine copy_control_array_c2_i +! +! ----------------------------------------------------------------------- +! + subroutine append_control_item_c2_i(read_c2i, array_c2i) +! + type(read_chara2_int_item), intent(in) :: read_c2i + type(ctl_array_c2i), intent(inout) :: array_c2i +! +! + array_c2i%icou = array_c2i%icou + read_c2i%iflag + array_c2i%c1_tbl(array_c2i%num) = read_c2i%charavalue(1) + array_c2i%c2_tbl(array_c2i%num) = read_c2i%charavalue(2) + array_c2i%ivec(array_c2i%num) = read_c2i%intvalue +! + end subroutine append_control_item_c2_i +! +! ----------------------------------------------------------------------- +! + subroutine append_c2i_to_ctl_array & + & (chara1_in, chara2_in, int_in, array_c2i) +! + character(len = kchara), intent(in) :: chara1_in, chara2_in + integer(kind = kint), intent(in) :: int_in + type(ctl_array_c2i), intent(inout) :: array_c2i +! + type(read_chara2_int_item) :: read_c2i +! + read_c2i%item_name = ' ' + read_c2i%iflag = 1 + read_c2i%charavalue(1) = trim(chara1_in) + read_c2i%charavalue(2) = trim(chara2_in) + read_c2i%intvalue = int_in +! + call append_control_array_c2_i(read_c2i, array_c2i) +! + end subroutine append_c2i_to_ctl_array +! +! ---------------------------------------------------------------------- +! + end module t_control_array_chara2int diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_chara2real.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_chara2real.f90 index ce001844..f9d9fca8 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_chara2real.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_chara2real.f90 @@ -7,28 +7,35 @@ !>@brief Subroutines to read char-char-real control arrays !! !!@verbatim +!! subroutine init_chara2real_ctl_item_label(label, c2r_item) !! subroutine read_char2real_ctl_type(c_buf, label, c2r_item) !! type(buffer_for_control), intent(in) :: c_buf !! type(read_chara2_real_item), intent(inout) :: c2r_item !! subroutine write_char2real_ctl_type & -!! & (id_file, level, maxlen, label, c2r_item) +!! & (id_file, level, maxlen, c2r_item) !! type(read_chara2_real_item), intent(in) :: c2r_item !! subroutine copy_char2real_ctl(org_c2r, new_c2r) !! type(read_chara2_real_item), intent(in) :: org_c2r !! type(read_chara2_real_item), intent(inout) :: new_c2r +!! logical function cmp_read_char2real_item(c2r_item1, c2r_item2) +!! type(read_chara2_real_item), intent(in) :: c2r_item1 +!! type(read_chara2_real_item), intent(in) :: c2r_item2 !! !! subroutine alloc_control_array_c2_r(array_c2r) !! subroutine dealloc_control_array_c2_r(array_c2r) +!! subroutine init_c2_r_ctl_array_label(label, array_c2r) !! subroutine read_control_array_c2_r & !! & (id_control, label, array_c2r, c_buf) !! type(ctl_array_c2r), intent(inout) :: array_c2r !! type(buffer_for_control), intent(in) :: c_buf !! subroutine write_control_array_c2_r & -!! & (id_control, level, label, array_c2r) +!! & (id_control, level, array_c2r) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: label !! type(ctl_array_c2r), intent(in) :: array_c2r !! integer(kind = kint), intent(inout) :: level +!! logical function cmp_control_array_c2_r(array1_c2r, array2_c2r) +!! type(ctl_array_c2r), intent(in) :: array1_c2r, array2_c2r !! !! subroutine append_control_array_c2_r(read_c2r, array_c2r) !! type(read_chara2_real_item), intent(inout) :: read_c2r @@ -52,6 +59,8 @@ module t_control_array_chara2real ! !> structure of control item with three characters type read_chara2_real_item +!> Item name + character(len=kchara) :: item_name = 'char_item' !> read flag (If item is read iflag = 1) integer(kind = kint) :: iflag = 0 !> array for read character items @@ -62,6 +71,8 @@ module t_control_array_chara2real ! !> Structure for two charactors and real control array type ctl_array_c2r +!> Item name + character(len=kchara) :: array_name = 'char_array' !> number of array items integer(kind=kint) :: num = 0 !> array counter @@ -79,6 +90,15 @@ module t_control_array_chara2real contains ! ! -------------------------------------------------------------------- +! + subroutine init_chara2real_ctl_item_label(label, c2r_item) + character(len=kchara), intent(in) :: label + type(read_chara2_real_item), intent(inout) :: c2r_item +! + c2r_item%item_name = trim(label) + end subroutine init_chara2real_ctl_item_label +! +! ---------------------------------------------------------------------- ! subroutine read_char2real_ctl_type(c_buf, label, c2r_item) ! @@ -91,7 +111,9 @@ subroutine read_char2real_ctl_type(c_buf, label, c2r_item) character(len=kchara) :: tmpchara ! ! - if(c2r_item%iflag.gt.0 .or. c_buf%header_chara.ne.label) return + if(c2r_item%iflag.gt.0) return + c2r_item%item_name = trim(label) + if(c_buf%header_chara.ne.label) return ! read(c_buf%ctl_buffer,*) tmpchara, c2r_item%charavalue(1:2), & & c2r_item%realvalue @@ -108,21 +130,20 @@ end subroutine read_char2real_ctl_type ! -------------------------------------------------------------------- ! subroutine write_char2real_ctl_type & - & (id_file, level, maxlen, label, c2r_item) + & (id_file, level, maxlen, c2r_item) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_file, level integer(kind = kint), intent(in) :: maxlen - character(len=kchara), intent(in) :: label type(read_chara2_real_item), intent(in) :: c2r_item ! ! if(c2r_item%iflag .eq. 0) return ! - call write_chara2_real_ctl_item(id_file, level, maxlen, label, & - & c2r_item%charavalue(1), c2r_item%charavalue(2), & - & c2r_item%realvalue) + call write_chara2_real_ctl_item(id_file, level, maxlen, & + & c2r_item%item_name, c2r_item%charavalue(1), & + & c2r_item%charavalue(2), c2r_item%realvalue) ! end subroutine write_char2real_ctl_type ! @@ -134,6 +155,7 @@ subroutine copy_char2real_ctl(org_c2r, new_c2r) type(read_chara2_real_item), intent(inout) :: new_c2r ! ! + new_c2r%item_name = org_c2r%item_name new_c2r%iflag = org_c2r%iflag new_c2r%charavalue(1:2) = org_c2r%charavalue(1:2) new_c2r%realvalue = org_c2r%realvalue @@ -141,6 +163,31 @@ subroutine copy_char2real_ctl(org_c2r, new_c2r) end subroutine copy_char2real_ctl ! ! -------------------------------------------------------------------- +! + logical function cmp_read_char2real_item(c2r_item1, c2r_item2) +! + use skip_comment_f +! + type(read_chara2_real_item), intent(in) :: c2r_item1 + type(read_chara2_real_item), intent(in) :: c2r_item2 +! + cmp_read_char2real_item = .FALSE. + if(cmp_no_case(trim(c2r_item1%item_name), & + & trim(c2r_item2%item_name)) .eqv. .FALSE.) return + if(c2r_item1%iflag .ne. c2r_item2%iflag) return + if(c2r_item1%iflag .gt. 0) then + if(cmp_no_case(trim(c2r_item1%charavalue(1)), & + & trim(c2r_item2%charavalue(1))) .eqv. .FALSE.) return + if(cmp_no_case(trim(c2r_item1%charavalue(2)), & + & trim(c2r_item2%charavalue(2))) .eqv. .FALSE.) return + if(c2r_item1%realvalue .ne. c2r_item2%realvalue) return + end if +! + cmp_read_char2real_item = .TRUE. +! + end function cmp_read_char2real_item +! +! ---------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine alloc_control_array_c2_r(array_c2r) @@ -172,6 +219,15 @@ end subroutine dealloc_control_array_c2_r ! ! -------------------------------------------------------------------- ! -------------------------------------------------------------------- +! + subroutine init_c2_r_ctl_array_label(label, array_c2r) + character(len=kchara), intent(in) :: label + type(ctl_array_c2r), intent(inout) :: array_c2r +! + array_c2r%array_name = trim(label) + end subroutine init_c2_r_ctl_array_label +! +! -------------------------------------------------------------------- ! subroutine read_control_array_c2_r & & (id_control, label, array_c2r, c_buf) @@ -186,15 +242,17 @@ subroutine read_control_array_c2_r & type(read_chara2_real_item) :: read_c2r ! ! - if(check_array_flag(c_buf, label) .eqv. .FALSE.) return if(array_c2r%icou .gt. 0) return + array_c2r%array_name = trim(label) + if(check_array_flag(c_buf, label) .eqv. .FALSE.) return ! read_c2r%iflag = 0 array_c2r%num = 0 call alloc_control_array_c2_r(array_c2r) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, label)) exit ! if(c_buf%header_chara.eq.label) then @@ -208,13 +266,12 @@ end subroutine read_control_array_c2_r ! -------------------------------------------------------------------- ! subroutine write_control_array_c2_r & - & (id_control, level, label, array_c2r) + & (id_control, level, array_c2r) ! use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: label type(ctl_array_c2r), intent(in) :: array_c2r ! integer(kind = kint), intent(inout) :: level @@ -223,19 +280,45 @@ subroutine write_control_array_c2_r & ! ! if(array_c2r%num .le. 0) return - write(id_control,'(a1)') '!' ! - level = write_array_flag_for_ctl(id_control, level, label) + level = write_array_flag_for_ctl(id_control, level, & + & array_c2r%array_name) do i = 1, array_c2r%num - call write_chara2_real_ctl_item & - & (id_control, level, len_trim(label), label, & + call write_chara2_real_ctl_item(id_control, level, & + & len_trim(array_c2r%array_name), array_c2r%array_name, & & array_c2r%c1_tbl(i), array_c2r%c2_tbl(i), array_c2r%vect(i)) end do - level = write_end_array_flag_for_ctl(id_control, level, label) + level = write_end_array_flag_for_ctl(id_control, level, & + & array_c2r%array_name) ! end subroutine write_control_array_c2_r ! ! -------------------------------------------------------------------- +! + logical function cmp_control_array_c2_r(array1_c2r, array2_c2r) +! + use skip_comment_f +! + type(ctl_array_c2r), intent(in) :: array1_c2r, array2_c2r + integer(kind = kint) :: i +! + cmp_control_array_c2_r = .FALSE. + if(cmp_no_case(trim(array1_c2r%array_name), & + & trim(array2_c2r%array_name)) .eqv. .FALSE.) return + if(array1_c2r%num .ne. array2_c2r%num) return + if(array1_c2r%icou .ne. array2_c2r%icou) return + do i = 1, array1_c2r%num + if(cmp_no_case(trim(array1_c2r%c1_tbl(i)), & + & trim(array2_c2r%c1_tbl(i))) .eqv. .FALSE.) return + if(cmp_no_case(trim(array1_c2r%c2_tbl(i)), & + & trim(array2_c2r%c2_tbl(i))) .eqv. .FALSE.) return + if(array1_c2r%vect(i) .ne. array2_c2r%vect(i)) return + end do + cmp_control_array_c2_r = .TRUE. +! + end function cmp_control_array_c2_r +! +! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine append_control_array_c2_r(read_c2r, array_c2r) @@ -283,9 +366,10 @@ subroutine copy_control_array_c2_r(num_copy, org_c2r, tgt_c2r) type(ctl_array_c2r), intent(in) :: org_c2r type(ctl_array_c2r), intent(inout) :: tgt_c2r ! + tgt_c2r%array_name = org_c2r%array_name + tgt_c2r%icou = org_c2r%icou ! if(num_copy .le. 0) return - tgt_c2r%icou = org_c2r%icou tgt_c2r%c1_tbl(1:num_copy) = org_c2r%c1_tbl(1:num_copy) tgt_c2r%c2_tbl(1:num_copy) = org_c2r%c2_tbl(1:num_copy) tgt_c2r%vect(1:num_copy) = org_c2r%vect(1:num_copy) diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_character.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_character.f90 index 6532ee3c..02da8f5a 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_character.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_character.f90 @@ -7,25 +7,31 @@ !>@brief Subroutines to read character control arrays !! !!@verbatim +!! subroutine init_chara_ctl_item_label(label, chara_item) !! subroutine read_chara_ctl_type(c_buf, label, chara_item) !! type(buffer_for_control), intent(in) :: c_buf !! type(read_character_item), intent(inout) :: chara_item !! subroutine write_chara_ctl_type & -!! & (id_file, level, maxlen, label, chara_item) +!! & (id_file, level, maxlen, chara_item) !! type(read_character_item), intent(in) :: chara_item !! subroutine copy_chara_ctl(org_c1, new_c1) !! type(read_character_item), intent(in) :: org_c1 !! type(read_character_item), intent(inout) :: new_c1 +!! logical function cmp_read_chara_item(c_item1, c_item2) +!! type(read_character_item), intent(in) :: c_item1, c_item2 !! !! subroutine alloc_control_array_chara(array_chara) !! subroutine dealloc_control_array_chara(array_chara) +!! subroutine init_chara_ctl_array_label(label, array_chara) !! subroutine read_control_array_c1 & !! & (id_control, label, array_chara, c_buf) !! type(ctl_array_chara), intent(inout) :: array_chara !! type(buffer_for_control), intent(in) :: c_buf !! subroutine write_control_array_c1 & -!! & (id_control, level, label, array_chara) +!! & (id_control, level, array_chara) !! type(ctl_array_chara), intent(in) :: array_chara +!! logical function cmp_control_array_c1(c_array1, c_array2) +!! type(ctl_array_chara), intent(in) :: c_array1, c_array2 !! !! subroutine append_control_array_c1(read_c1, array_c1) !! type(read_character_item), intent(inout) :: read_c1 @@ -37,6 +43,10 @@ !! subroutine append_control_item_c1(read_c1, array_c1) !! type(read_character_item), intent(in) :: read_c1 !! type(ctl_array_chara), intent(inout) :: array_c1 +!! +!! subroutine append_c_to_ctl_array(chara_in, array_c1) +!! character(len = kchara), intent(in) :: chara_in +!! type(ctl_array_chara), intent(inout) :: array_c1 !!@endverbatim !! !! @@ -49,6 +59,8 @@ module t_control_array_character ! !> structure of control character item type read_character_item +!> Item name + character(len=kchara) :: item_name = 'Chara_item' !> read flag (If item is read iflag = 1) integer(kind = kint) :: iflag = 0 !> array for read character item @@ -57,6 +69,8 @@ module t_control_array_character ! !> Structure for character control array type ctl_array_chara +!> Item name + character(len=kchara) :: array_name = 'Chara_item' !> number of array items integer(kind=kint) :: num = 0 !> array counter @@ -70,6 +84,15 @@ module t_control_array_character contains ! ! ---------------------------------------------------------------------- +! + subroutine init_chara_ctl_item_label(label, chara_item) + character(len=kchara), intent(in) :: label + type(read_character_item), intent(inout) :: chara_item +! + chara_item%item_name = trim(label) + end subroutine init_chara_ctl_item_label +! +! ---------------------------------------------------------------------- ! subroutine read_chara_ctl_type(c_buf, label, chara_item) ! @@ -82,7 +105,9 @@ subroutine read_chara_ctl_type(c_buf, label, chara_item) character(len=kchara) :: tmpchara ! ! - if(chara_item%iflag.gt.0 .or. c_buf%header_chara.ne.label) return + if(chara_item%iflag .gt. 0) return + call init_chara_ctl_item_label(label, chara_item) + if(c_buf%header_chara.ne.label) return ! read(c_buf%ctl_buffer,*) tmpchara, chara_item%charavalue if (iflag_debug .gt. 0) write(*,*) trim(c_buf%header_chara), & @@ -94,19 +119,18 @@ end subroutine read_chara_ctl_type ! ---------------------------------------------------------------------- ! subroutine write_chara_ctl_type & - & (id_file, level, maxlen, label, chara_item) + & (id_file, level, maxlen, chara_item) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_file, level integer(kind = kint), intent(in) :: maxlen - character(len=kchara), intent(in) :: label type(read_character_item), intent(in) :: chara_item ! ! if(chara_item%iflag .eq. 0) return - call write_character_ctl_item & - & (id_file, level, maxlen, label, chara_item%charavalue) + call write_character_ctl_item(id_file, level, maxlen, & + & chara_item%item_name, chara_item%charavalue) ! end subroutine write_chara_ctl_type ! @@ -118,12 +142,34 @@ subroutine copy_chara_ctl(org_c1, new_c1) type(read_character_item), intent(inout) :: new_c1 ! ! + new_c1%item_name = org_c1%item_name new_c1%iflag = org_c1%iflag new_c1%charavalue = org_c1%charavalue ! end subroutine copy_chara_ctl ! ! ---------------------------------------------------------------------- +! + logical function cmp_read_chara_item(c_item1, c_item2) +! + use skip_comment_f +! + type(read_character_item), intent(in) :: c_item1, c_item2 +! + cmp_read_chara_item = .FALSE. + if(cmp_no_case(trim(c_item1%item_name), & + & trim(c_item2%item_name)) .eqv. .FALSE.) return + if(c_item1%iflag .ne. c_item2%iflag) return + if(c_item1%iflag .gt. 0) then + if(cmp_no_case(trim(c_item1%charavalue), & + & trim(c_item2%charavalue)) .eqv. .FALSE.) return + end if +! + cmp_read_chara_item = .TRUE. +! + end function cmp_read_chara_item +! +! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- ! subroutine alloc_control_array_chara(array_chara) @@ -150,6 +196,15 @@ end subroutine dealloc_control_array_chara ! ! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- +! + subroutine init_chara_ctl_array_label(label, array_chara) + character(len=kchara), intent(in) :: label + type(ctl_array_chara), intent(inout) :: array_chara +! + array_chara%array_name = trim(label) + end subroutine init_chara_ctl_array_label +! +! -------------------------------------------------------------------- ! subroutine read_control_array_c1 & & (id_control, label, array_chara, c_buf) @@ -164,15 +219,17 @@ subroutine read_control_array_c1 & type(read_character_item) :: read_c1 ! ! - if(check_array_flag(c_buf, label) .eqv. .FALSE.) return if(array_chara%icou .gt. 0) return + call init_chara_ctl_array_label(label, array_chara) + if(check_array_flag(c_buf, label) .eqv. .FALSE.) return ! read_c1%iflag = 0 array_chara%num = 0 call alloc_control_array_chara(array_chara) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, label)) exit ! if(c_buf%header_chara.eq.label) then @@ -186,13 +243,12 @@ end subroutine read_control_array_c1 ! ---------------------------------------------------------------------- ! subroutine write_control_array_c1 & - & (id_control, level, label, array_chara) + & (id_control, level, array_chara) ! use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: label type(ctl_array_chara), intent(in) :: array_chara ! integer(kind = kint), intent(inout) :: level @@ -201,19 +257,42 @@ subroutine write_control_array_c1 & ! ! if(array_chara%num .le. 0) return - write(id_control,'(a1)') '!' ! - level = write_array_flag_for_ctl(id_control, level, label) + level = write_array_flag_for_ctl(id_control, level, & + & array_chara%array_name) do i = 1, array_chara%num - length = len_trim(label) + length = len_trim(array_chara%array_name) call write_character_ctl_item(id_control, level, length, & - & label, array_chara%c_tbl(i)) + & array_chara%array_name, array_chara%c_tbl(i)) end do - level = write_end_array_flag_for_ctl(id_control, level, label) + level = write_end_array_flag_for_ctl(id_control, level, & + & array_chara%array_name) ! end subroutine write_control_array_c1 ! ! ---------------------------------------------------------------------- +! + logical function cmp_control_array_c1(c_array1, c_array2) +! + use skip_comment_f +! + type(ctl_array_chara), intent(in) :: c_array1, c_array2 + integer(kind = kint) :: i +! + cmp_control_array_c1 = .FALSE. + if(cmp_no_case(trim(c_array1%array_name), & + & trim(c_array2%array_name)) .eqv. .FALSE.) return + if(c_array1%num .ne. c_array2%num) return + if(c_array1%icou .ne. c_array2%icou) return + do i = 1, c_array1%num + if(cmp_no_case(trim(c_array1%c_tbl(i)), & + & trim(c_array2%c_tbl(i))) .eqv. .FALSE.) return + end do + cmp_control_array_c1 = .TRUE. +! + end function cmp_control_array_c1 +! +! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- ! subroutine append_control_array_c1(read_c1, array_c1) @@ -261,9 +340,11 @@ subroutine copy_control_array_c1(num_copy, org_c1, tgt_c1) type(ctl_array_chara), intent(in) :: org_c1 type(ctl_array_chara), intent(inout) :: tgt_c1 ! +! + tgt_c1%array_name = org_c1%array_name + tgt_c1%icou = org_c1%icou ! if(num_copy .le. 0) return - tgt_c1%icou = org_c1%icou tgt_c1%c_tbl(1:num_copy) = org_c1%c_tbl(1:num_copy) ! end subroutine copy_control_array_c1 @@ -282,5 +363,21 @@ subroutine append_control_item_c1(read_c1, array_c1) end subroutine append_control_item_c1 ! ! ---------------------------------------------------------------------- +! + subroutine append_c_to_ctl_array(chara_in, array_c1) +! + character(len = kchara), intent(in) :: chara_in + type(ctl_array_chara), intent(inout) :: array_c1 + type(read_character_item) :: read_c1 +! + read_c1%item_name = ' ' + read_c1%iflag = 1 + read_c1%charavalue = trim(chara_in) +! + call append_control_array_c1(read_c1, array_c1) +! + end subroutine append_c_to_ctl_array +! +! ---------------------------------------------------------------------- ! end module t_control_array_character diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_character2.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_character2.f90 index 72a937a5..8ce78164 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_character2.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_character2.f90 @@ -11,7 +11,7 @@ !! type(buffer_for_control), intent(in) :: c_buf !! type(read_chara2_item), intent(inout) :: chara2_item !! subroutine write_character2_ctl_type & -!! & (id_file, level, label, chara2_item) +!! & (id_file, level, chara2_item) !! type(read_chara2_item), intent(in) :: chara2_item !! subroutine copy_character2_ctl(org_c2, new_c2) !! type(read_chara2_item), intent(in) :: org_c2 @@ -19,12 +19,13 @@ !! !! subroutine alloc_control_array_c2(array_c2) !! subroutine dealloc_control_array_c2(array_c2) +!! subroutine init_chara2_ctl_array_label(label, array_c2) !! subroutine read_control_array_c2 & !! & (id_control, label, array_c2, c_buf) !! type(ctl_array_c2), intent(inout) :: array_c2 !! type(buffer_for_control), intent(in) :: c_buf !! subroutine write_control_array_c2 & -!! & (id_control, level, label, array_c2) +!! & (id_control, level, array_c2) !! type(ctl_array_c2), intent(in) :: array_c2 !! !! subroutine append_control_array_c2(read_c2, array_c2) @@ -49,6 +50,8 @@ module t_control_array_character2 ! !> structure of control item with three characters type read_chara2_item +!> Item name + character(len=kchara) :: item_name = 'char_item' !> read flag (If item is read iflag = 1) integer(kind = kint) :: iflag = 0 !> array for read character items @@ -57,6 +60,8 @@ module t_control_array_character2 ! !> Structure for three charactors control array type ctl_array_c2 +!> Item name + character(len=kchara) :: array_name = 'char_array' !> number of array items integer(kind=kint) :: num = 0 !> array counter @@ -84,7 +89,9 @@ subroutine read_character2_ctl_type(c_buf, label, chara2_item) character(len=kchara) :: tmpchara ! ! - if(chara2_item%iflag.gt.0 .or. c_buf%header_chara.ne.label) return + if(chara2_item%iflag.gt.0) return + chara2_item%item_name = trim(label) + if(c_buf%header_chara.ne.label) return ! read(c_buf%ctl_buffer,*) tmpchara, chara2_item%charavalue(1:2) if (iflag_debug .gt. 0) write(*,'(a,a4,a)') & @@ -98,24 +105,24 @@ end subroutine read_character2_ctl_type ! -------------------------------------------------------------------- ! subroutine write_character2_ctl_type & - & (id_file, level, label, chara2_item) + & (id_file, level, chara2_item) ! use m_constants use write_control_items use write_control_elements ! integer(kind = kint), intent(in) :: id_file, level - character(len=kchara), intent(in) :: label type(read_chara2_item), intent(in) :: chara2_item ! integer(kind = kint) :: maxlen(0:1) ! - maxlen(0) = len_trim(label) + maxlen(0) = len_trim(chara2_item%item_name) maxlen(1) & & = max_len_of_charaarray(ione, chara2_item%charavalue(1)) ! if(chara2_item%iflag .eq. 0) return - call write_character2_ctl_item(id_file, level, maxlen, label, & + call write_character2_ctl_item & + & (id_file, level, maxlen, chara2_item%item_name, & & chara2_item%charavalue(1), chara2_item%charavalue(2)) ! end subroutine write_character2_ctl_type @@ -128,6 +135,7 @@ subroutine copy_character2_ctl(org_c2, new_c2) type(read_chara2_item), intent(inout) :: new_c2 ! ! + new_c2%item_name = org_c2%item_name new_c2%iflag = org_c2%iflag new_c2%charavalue(1:2) = org_c2%charavalue(1:2) ! @@ -161,6 +169,15 @@ end subroutine dealloc_control_array_c2 ! ! -------------------------------------------------------------------- ! -------------------------------------------------------------------- +! + subroutine init_chara2_ctl_array_label(label, array_c2) + character(len=kchara), intent(in) :: label + type(ctl_array_c2), intent(inout) :: array_c2 +! + array_c2%array_name = trim(label) + end subroutine init_chara2_ctl_array_label +! +! -------------------------------------------------------------------- ! subroutine read_control_array_c2 & & (id_control, label, array_c2, c_buf) @@ -175,15 +192,17 @@ subroutine read_control_array_c2 & type(read_chara2_item) :: read_c2 ! ! - if(check_array_flag(c_buf, label) .eqv. .FALSE.) return if(array_c2%icou .gt. 0) return + array_c2%array_name = trim(label) + if(check_array_flag(c_buf, label) .eqv. .FALSE.) return ! read_c2%iflag = 0 array_c2%num = 0 call alloc_control_array_c2(array_c2) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, label)) exit ! if(c_buf%header_chara.eq.label) then @@ -197,13 +216,12 @@ end subroutine read_control_array_c2 ! -------------------------------------------------------------------- ! subroutine write_control_array_c2 & - & (id_control, level, label, array_c2) + & (id_control, level, array_c2) ! use write_control_items use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: label type(ctl_array_c2), intent(in) :: array_c2 ! integer(kind = kint), intent(inout) :: level @@ -213,17 +231,19 @@ subroutine write_control_array_c2 & ! ! if(array_c2%num .le. 0) return - write(id_control,'(a1)') '!' ! - maxlen(0) = len_trim(label) + maxlen(0) = len_trim(array_c2%array_name) maxlen(1) = max_len_of_charaarray(array_c2%num, array_c2%c1_tbl) ! - level = write_array_flag_for_ctl(id_control, level, label) + level = write_array_flag_for_ctl(id_control, level, & + & array_c2%array_name) do i = 1, array_c2%num - call write_character2_ctl_item(id_control, level, maxlen, & - & label, array_c2%c1_tbl(i), array_c2%c2_tbl(i)) + call write_character2_ctl_item & + & (id_control, level, maxlen, array_c2%array_name, & + & array_c2%c1_tbl(i), array_c2%c2_tbl(i)) end do - level = write_end_array_flag_for_ctl(id_control, level, label) + level = write_end_array_flag_for_ctl(id_control, level, & + & array_c2%array_name) ! end subroutine write_control_array_c2 ! @@ -275,9 +295,11 @@ subroutine copy_control_array_c2(num_copy, org_c2, tgt_c2) type(ctl_array_c2), intent(in) :: org_c2 type(ctl_array_c2), intent(inout) :: tgt_c2 ! +! + tgt_c2%array_name = org_c2%array_name + tgt_c2%icou = org_c2%icou ! if(num_copy .le. 0) return - tgt_c2%icou = org_c2%icou tgt_c2%c1_tbl(1:num_copy) = org_c2%c1_tbl(1:num_copy) tgt_c2%c2_tbl(1:num_copy) = org_c2%c2_tbl(1:num_copy) ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_character3.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_character3.f90 index 0de10a03..ae57c1c2 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_character3.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_character3.f90 @@ -7,11 +7,12 @@ !>@brief Structure of control array input with 3 words !! !!@verbatim +!! subroutine init_chara3_ctl_item_label(label, chara3_item) !! subroutine read_character3_ctl_type(c_buf, label, chara3_item) !! type(buffer_for_control), intent(in) :: c_buf !! type(read_chara3_item), intent(inout) :: chara3_item !! subroutine write_character3_ctl_type & -!! & (id_file, level, label, chara3_item) +!! & (id_file, level, chara3_item) !! type(read_chara3_item), intent(in) :: chara3_item !! subroutine copy_character3_ctl(org_c3, new_c3) !! type(read_chara3_item), intent(in) :: org_c3 @@ -19,12 +20,13 @@ !! !! subroutine alloc_control_array_c3(array_c3) !! subroutine dealloc_control_array_c3(array_c3) +!! subroutine init_c3_ctl_array_label(label, array_c3) !! subroutine read_control_array_c3 & !! & (id_control, label, array_c3, c_buf) !! type(ctl_array_c3), intent(inout) :: array_c3 !! type(buffer_for_control), intent(inout) :: c_buf !! subroutine write_control_array_c3 & -!! & (id_control, level, label, array_c3) +!! & (id_control, level, array_c3) !! type(ctl_array_c3), intent(in) :: array_c3 !! !! subroutine append_control_array_c3(read_c3, array_c3) @@ -48,6 +50,8 @@ module t_control_array_character3 ! !> structure of control item with three characters type read_chara3_item +!> Item name + character(len=kchara) :: item_name = 'char_item' !> read flag (If item is read iflag = 1) integer(kind = kint) :: iflag = 0 !> array for read character items @@ -56,6 +60,8 @@ module t_control_array_character3 ! !> Structure for three charactors control array type ctl_array_c3 +!> Item name + character(len=kchara) :: array_name = 'char_array' !> number of array items integer(kind=kint) :: num = 0 !> array counter @@ -73,6 +79,15 @@ module t_control_array_character3 contains ! ! -------------------------------------------------------------------- +! + subroutine init_chara3_ctl_item_label(label, chara3_item) + character(len=kchara), intent(in) :: label + type(read_chara3_item), intent(inout) :: chara3_item +! + chara3_item%item_name = trim(label) + end subroutine init_chara3_ctl_item_label +! +! ---------------------------------------------------------------------- ! subroutine read_character3_ctl_type(c_buf, label, chara3_item) ! @@ -85,8 +100,9 @@ subroutine read_character3_ctl_type(c_buf, label, chara3_item) character(len=kchara) :: tmpchara ! ! - if(chara3_item%iflag.gt.0 & - & .or. c_buf%header_chara.ne.label) return + if(chara3_item%iflag.gt.0) return + chara3_item%item_name = trim(label) + if(c_buf%header_chara.ne.label) return ! read(c_buf%ctl_buffer,*) tmpchara, chara3_item%charavalue(1:3) if (iflag_debug .gt. 0) write(*,'(a,a4,a)') & @@ -102,13 +118,12 @@ end subroutine read_character3_ctl_type ! -------------------------------------------------------------------- ! subroutine write_character3_ctl_type & - & (id_file, level, label, chara3_item) + & (id_file, level, chara3_item) ! use write_control_items use write_control_elements ! integer(kind = kint), intent(in) :: id_file, level - character(len=kchara), intent(in) :: label type(read_chara3_item), intent(in) :: chara3_item ! integer(kind = kint) :: i @@ -117,14 +132,14 @@ subroutine write_character3_ctl_type & ! if(chara3_item%iflag .eq. 0) return ! - maxlen(0) = len_trim(label) + maxlen(0) = len_trim(chara3_item%item_name) do i = 1, 2 maxlen(i) = len_trim(chara3_item%charavalue(i)) & & + iflag_divide(chara3_item%charavalue(i)) end do - call write_character3_ctl_item(id_file, level, maxlen, label, & - & chara3_item%charavalue(1), chara3_item%charavalue(2), & - & chara3_item%charavalue(3)) + call write_character3_ctl_item(id_file, level, maxlen, & + & chara3_item%item_name, chara3_item%charavalue(1), & + & chara3_item%charavalue(2), chara3_item%charavalue(3)) ! end subroutine write_character3_ctl_type ! @@ -136,6 +151,7 @@ subroutine copy_character3_ctl(org_c3, new_c3) type(read_chara3_item), intent(inout) :: new_c3 ! ! + new_c3%item_name = org_c3%item_name new_c3%iflag = org_c3%iflag new_c3%charavalue(1:3) = org_c3%charavalue(1:3) ! @@ -170,6 +186,15 @@ end subroutine dealloc_control_array_c3 ! ! -------------------------------------------------------------------- ! -------------------------------------------------------------------- +! + subroutine init_c3_ctl_array_label(label, array_c3) + character(len=kchara), intent(in) :: label + type(ctl_array_c3), intent(inout) :: array_c3 +! + array_c3%array_name = trim(label) + end subroutine init_c3_ctl_array_label +! +! -------------------------------------------------------------------- ! subroutine read_control_array_c3 & & (id_control, label, array_c3, c_buf) @@ -184,15 +209,17 @@ subroutine read_control_array_c3 & type(read_chara3_item) :: read_c3 ! ! - if(check_array_flag(c_buf, label) .eqv. .FALSE.) return if(array_c3%icou .gt. 0) return + array_c3%array_name = trim(label) + if(check_array_flag(c_buf, label) .eqv. .FALSE.) return ! read_c3%iflag = 0 array_c3%num = 0 call alloc_control_array_c3(array_c3) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, label)) exit ! if(c_buf%header_chara.eq.label) then @@ -206,13 +233,12 @@ end subroutine read_control_array_c3 ! -------------------------------------------------------------------- ! subroutine write_control_array_c3 & - & (id_control, level, label, array_c3) + & (id_control, level, array_c3) ! use write_control_items use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: label type(ctl_array_c3), intent(in) :: array_c3 ! integer(kind = kint), intent(inout) :: level @@ -222,19 +248,20 @@ subroutine write_control_array_c3 & ! ! if(array_c3%num .le. 0) return - write(id_control,'(a1)') '!' ! - maxlen(0) = len_trim(label) + maxlen(0) = len_trim(array_c3%array_name) maxlen(1) = max_len_of_charaarray(array_c3%num, array_c3%c1_tbl) maxlen(2) = max_len_of_charaarray(array_c3%num, array_c3%c2_tbl) ! - level = write_array_flag_for_ctl(id_control, level, label) + level = write_array_flag_for_ctl(id_control, level, & + & array_c3%array_name) do i = 1, array_c3%num call write_character3_ctl_item & - & (id_control, level, maxlen, label, & + & (id_control, level, maxlen, array_c3%array_name, & & array_c3%c1_tbl(i), array_c3%c2_tbl(i), array_c3%c3_tbl(i)) end do - level = write_end_array_flag_for_ctl(id_control, level, label) + level = write_end_array_flag_for_ctl(id_control, level, & + & array_c3%array_name) ! end subroutine write_control_array_c3 ! @@ -272,9 +299,11 @@ subroutine copy_control_array_c3(num_copy, org_c3, tgt_c3) type(ctl_array_c3), intent(in) :: org_c3 type(ctl_array_c3), intent(inout) :: tgt_c3 ! +! + tgt_c3%array_name = org_c3%array_name + tgt_c3%icou = org_c3%icou ! if(num_copy .le. 0) return - tgt_c3%icou = org_c3%icou tgt_c3%c1_tbl(1:num_copy) = org_c3%c1_tbl(1:num_copy) tgt_c3%c2_tbl(1:num_copy) = org_c3%c2_tbl(1:num_copy) tgt_c3%c3_tbl(1:num_copy) = org_c3%c3_tbl(1:num_copy) diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_charaint.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_charaint.f90 index c2310cd1..b8805b89 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_charaint.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_charaint.f90 @@ -7,11 +7,12 @@ !>@brief Subroutines to read char-int control arrays !! !!@verbatim +!! subroutine init_charaint_ctl_item_label(label, ci_item) !! subroutine read_charaint_ctl_type(c_buf, label, ci_item) !! type(buffer_for_control), intent(in) :: c_buf !! type(read_chara_int_item), intent(inout) :: ci_item !! subroutine write_charaint_ctl_type & -!! & (id_file, level, maxlen, label, ci_item) +!! & (id_file, level, maxlen, ci_item) !! type(read_chara_int_item), intent(in) :: ci_item !! subroutine copy_charaint_ctl(org_ci, new_ci) !! type(read_chara_int_item), intent(in) :: org_ci @@ -19,12 +20,13 @@ !! !! subroutine alloc_control_array_c_i(array_ci) !! subroutine dealloc_control_array_c_i(array_ci) +!! subroutine init_c_i_array_label(label, array_ci) !! subroutine read_control_array_c_i & !! & (id_control, label, array_ci, c_buf) !! type(ctl_array_ci), intent(inout) :: array_ci !! type(buffer_for_control), intent(in) :: c_buf !! subroutine write_control_array_c_i & -!! & (id_control, level, label, array_ci) +!! & (id_control, level, array_ci) !! type(ctl_array_ci), intent(in) :: array_ci !! !! subroutine append_control_array_c_i(read_ci, array_ci) @@ -49,6 +51,8 @@ module t_control_array_charaint ! !> structure of control item with three characters type read_chara_int_item +!> Item name + character(len=kchara) :: item_name = 'char_item' !> read flag (If item is read iflag = 1) integer(kind = kint) :: iflag = 0 !> array for read character items @@ -59,6 +63,8 @@ module t_control_array_charaint ! !> Structure for charactor and integer control array type ctl_array_ci +!> Item name + character(len=kchara) :: array_name = 'char_array' !> number of array items integer(kind=kint) :: num = 0 !> array counter @@ -74,6 +80,15 @@ module t_control_array_charaint contains ! ! -------------------------------------------------------------------- +! + subroutine init_charaint_ctl_item_label(label, ci_item) + character(len=kchara), intent(in) :: label + type(read_chara_int_item), intent(inout) :: ci_item +! + ci_item%item_name = trim(label) + end subroutine init_charaint_ctl_item_label +! +! -------------------------------------------------------------------- ! subroutine read_charaint_ctl_type(c_buf, label, ci_item) ! @@ -86,7 +101,9 @@ subroutine read_charaint_ctl_type(c_buf, label, ci_item) character(len=kchara) :: tmpchara ! ! - if(ci_item%iflag.gt.0 .or. c_buf%header_chara.ne.label) return + if(ci_item%iflag.gt.0) return + ci_item%item_name = trim(label) + if(c_buf%header_chara.ne.label) return ! read(c_buf%ctl_buffer,*) tmpchara, ci_item%charavalue, & & ci_item%intvalue @@ -101,20 +118,19 @@ end subroutine read_charaint_ctl_type ! -------------------------------------------------------------------- ! subroutine write_charaint_ctl_type & - & (id_file, level, maxlen, label, ci_item) + & (id_file, level, maxlen, ci_item) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_file, level integer(kind = kint), intent(in) :: maxlen - character(len=kchara), intent(in) :: label type(read_chara_int_item), intent(in) :: ci_item ! ! if(ci_item%iflag .eq. 0) return ! - call write_chara_int_ctl_item(id_file, level, maxlen, label, & - & ci_item%charavalue, ci_item%intvalue) + call write_chara_int_ctl_item(id_file, level, maxlen, & + & ci_item%item_name, ci_item%charavalue, ci_item%intvalue) ! end subroutine write_charaint_ctl_type ! @@ -126,6 +142,7 @@ subroutine copy_charaint_ctl(org_ci, new_ci) type(read_chara_int_item), intent(inout) :: new_ci ! ! + new_ci%item_name = org_ci%item_name new_ci%iflag = org_ci%iflag new_ci%charavalue = org_ci%charavalue new_ci%intvalue = org_ci%intvalue @@ -163,6 +180,15 @@ end subroutine dealloc_control_array_c_i ! ! -------------------------------------------------------------------- ! -------------------------------------------------------------------- +! + subroutine init_c_i_array_label(label, array_ci) + character(len=kchara), intent(in) :: label + type(ctl_array_ci), intent(inout) :: array_ci +! + array_ci%array_name = trim(label) + end subroutine init_c_i_array_label +! +! -------------------------------------------------------------------- ! subroutine read_control_array_c_i & & (id_control, label, array_ci, c_buf) @@ -177,15 +203,17 @@ subroutine read_control_array_c_i & type(read_chara_int_item) :: read_ci ! ! - if(check_array_flag(c_buf, label) .eqv. .FALSE.) return if(array_ci%icou .gt. 0) return + array_ci%array_name = trim(label) + if(check_array_flag(c_buf, label) .eqv. .FALSE.) return ! read_ci%iflag = 0 array_ci%num = 0 call alloc_control_array_c_i(array_ci) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, label)) exit ! if(c_buf%header_chara.eq.label) then @@ -199,13 +227,12 @@ end subroutine read_control_array_c_i ! -------------------------------------------------------------------- ! subroutine write_control_array_c_i & - & (id_control, level, label, array_ci) + & (id_control, level, array_ci) ! use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: label type(ctl_array_ci), intent(in) :: array_ci ! integer(kind = kint), intent(inout) :: level @@ -214,15 +241,16 @@ subroutine write_control_array_c_i & ! ! if(array_ci%num .le. 0) return - write(id_control,'(a1)') '!' ! - level = write_array_flag_for_ctl(id_control, level, label) + level = write_array_flag_for_ctl(id_control, level, & + & array_ci%array_name) do i = 1, array_ci%num - call write_chara_int_ctl_item & - & (id_control, level, len_trim(label), label, & + call write_chara_int_ctl_item(id_control, level, & + & len_trim(array_ci%array_name), array_ci%array_name, & & array_ci%c_tbl(i), array_ci%ivec(i)) end do - level = write_end_array_flag_for_ctl(id_control, level, label) + level = write_end_array_flag_for_ctl(id_control, level, & + & array_ci%array_name) ! end subroutine write_control_array_c_i ! @@ -274,9 +302,11 @@ subroutine copy_control_array_c_i(num_copy, org_ci, tgt_ci) type(ctl_array_ci), intent(in) :: org_ci type(ctl_array_ci), intent(inout) :: tgt_ci ! +! + tgt_ci%array_name = org_ci%array_name + tgt_ci%icou = org_ci%icou ! if(num_copy .le. 0) return - tgt_ci%icou = org_ci%icou tgt_ci%c_tbl(1:num_copy) = org_ci%c_tbl(1:num_copy) tgt_ci%ivec(1:num_copy) = org_ci%ivec(1:num_copy) ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_charaint3.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_charaint3.f90 index 35e6e6d3..f7489016 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_charaint3.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_charaint3.f90 @@ -7,11 +7,12 @@ !>@brief Subroutines to read char-int-int-int control arrays !! !!@verbatim +!! subroutine init_charaint3_ctl_item_label(label, ci3_item) !! subroutine read_charaint3_ctl_type(c_buf, label, ci3_item) !! type(buffer_for_control), intent(in) :: c_buf !! type(read_chara_int3_item), intent(inout) :: ci3_item !! subroutine write_charaint3_ctl_type & -!! & (id_file, level, maxlen, label, ci3_item) +!! & (id_file, level, maxlen, ci3_item) !! type(read_chara_int3_item), intent(in) :: ci3_item !! subroutine copy_charaint3_ctl(org_ci3, new_ci3) !! type(read_chara_int3_item), intent(in) :: org_ci3 @@ -19,20 +20,21 @@ !! !! subroutine alloc_control_array_c_i3(array_ci3) !! subroutine dealloc_control_array_c_i3(array_ci3) +!! subroutine init_c_i3_ctl_array_label(label, array_ci3) !! subroutine read_control_array_c_i3 & !! & (id_control, label, array_ci3, c_buf) !! type(ctl_array_ci3), intent(inout) :: array_ci3 !! type(buffer_for_control), intent(in) :: c_buf !! subroutine write_control_array_c_i3 & -!! & (id_control, level, label, array_ci3) +!! & (id_control, level, array_ci3) !! type(ctl_array_ci3), intent(in) :: array_ci3 !! !! subroutine append_control_array_c_i3(read_ci3, array_ci3) !! type(read_chara_int3_item), intent(inout) :: read_ci3 !! type(ctl_array_ci3), intent(inout) :: array_ci3 -!! subroutine copy_control_array_c_i3(num_copy, org_ci, tgt_ci) -!! type(ctl_array_ci3), intent(in) :: org_ci -!! type(ctl_array_ci3), intent(inout) :: tgt_ci +!! subroutine copy_control_array_c_i3(num_copy, org_ci3, tgt_ci3) +!! type(ctl_array_ci3), intent(in) :: org_ci3 +!! type(ctl_array_ci3), intent(inout) :: tgt_ci3 !! subroutine append_control_item_c_i3(read_ci3, array_ci3) !! type(read_chara_int3_item), intent(in) :: read_ci3 !! type(ctl_array_ci3), intent(inout) :: array_ci3 @@ -48,6 +50,8 @@ module t_control_array_charaint3 ! !> structure of control item with character and three integers type read_chara_int3_item +!> Item name + character(len=kchara) :: item_name = 'chara_item' !> read flag (If item is read iflag = 1) integer(kind = kint) :: iflag = 0 !> array for read character items @@ -58,6 +62,8 @@ module t_control_array_charaint3 ! !> Structure for charactor and integer control array type ctl_array_ci3 +!> Item name + character(len=kchara) :: array_name = 'chara_array' !> number of array items integer(kind=kint) :: num = 0 !> array counter @@ -77,6 +83,15 @@ module t_control_array_charaint3 contains ! ! -------------------------------------------------------------------- +! + subroutine init_charaint3_ctl_item_label(label, ci3_item) + character(len=kchara), intent(in) :: label + type(read_chara_int3_item), intent(inout) :: ci3_item +! + ci3_item%item_name = trim(label) + end subroutine init_charaint3_ctl_item_label +! +! ---------------------------------------------------------------------- ! subroutine read_charaint3_ctl_type(c_buf, label, ci3_item) ! @@ -89,7 +104,9 @@ subroutine read_charaint3_ctl_type(c_buf, label, ci3_item) character(len=kchara) :: tmpchara ! ! - if(ci3_item%iflag.gt.0 .or. c_buf%header_chara.ne.label) return + if(ci3_item%iflag.gt.0) return + ci3_item%item_name = trim(label) + if(c_buf%header_chara.ne.label) return ! read(c_buf%ctl_buffer,*) tmpchara, ci3_item%charavalue, & & ci3_item%intvalue(1:3) @@ -105,18 +122,18 @@ end subroutine read_charaint3_ctl_type ! -------------------------------------------------------------------- ! subroutine write_charaint3_ctl_type & - & (id_file, level, maxlen, label, ci3_item) + & (id_file, level, maxlen, ci3_item) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_file, level, maxlen - character(len=kchara), intent(in) :: label type(read_chara_int3_item), intent(in) :: ci3_item ! ! if(ci3_item%iflag .eq. 0) return ! - call write_chara_int3_ctl_item(id_file, level, maxlen, label, & + call write_chara_int3_ctl_item & + & (id_file, level, maxlen, ci3_item%item_name, & & ci3_item%charavalue, ci3_item%intvalue(1), & & ci3_item%intvalue(2), ci3_item%intvalue(3)) ! @@ -130,6 +147,7 @@ subroutine copy_charaint3_ctl(org_ci3, new_ci3) type(read_chara_int3_item), intent(inout) :: new_ci3 ! ! + new_ci3%item_name = new_ci3%item_name new_ci3%iflag = org_ci3%iflag new_ci3%charavalue = org_ci3%charavalue new_ci3%intvalue(1:3) = org_ci3%intvalue(1:3) @@ -172,6 +190,15 @@ end subroutine dealloc_control_array_c_i3 ! ! -------------------------------------------------------------------- ! -------------------------------------------------------------------- +! + subroutine init_c_i3_ctl_array_label(label, array_ci3) + character(len=kchara), intent(in) :: label + type(ctl_array_ci3), intent(inout) :: array_ci3 +! + array_ci3%array_name = trim(label) + end subroutine init_c_i3_ctl_array_label +! +! -------------------------------------------------------------------- ! subroutine read_control_array_c_i3 & & (id_control, label, array_ci3, c_buf) @@ -186,15 +213,17 @@ subroutine read_control_array_c_i3 & type(read_chara_int3_item) :: read_ci3 ! ! - if(check_array_flag(c_buf, label) .eqv. .FALSE.) return if(array_ci3%icou .gt. 0) return + array_ci3%array_name = trim(label) + if(check_array_flag(c_buf, label) .eqv. .FALSE.) return ! read_ci3%iflag = 0 array_ci3%num = 0 call alloc_control_array_c_i3(array_ci3) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, label)) exit ! if(c_buf%header_chara.eq.label) then @@ -208,13 +237,12 @@ end subroutine read_control_array_c_i3 ! -------------------------------------------------------------------- ! subroutine write_control_array_c_i3 & - & (id_control, level, label, array_ci3) + & (id_control, level, array_ci3) ! use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: label type(ctl_array_ci3), intent(in) :: array_ci3 ! integer(kind = kint), intent(inout) :: level @@ -223,16 +251,17 @@ subroutine write_control_array_c_i3 & ! ! if(array_ci3%num .le. 0) return - write(id_control,'(a1)') '!' ! - level = write_array_flag_for_ctl(id_control, level, label) + level = write_array_flag_for_ctl(id_control, level, & + & array_ci3%array_name) do i = 1, array_ci3%num - call write_chara_int3_ctl_item & - & (id_control, level, len_trim(label), label, & - & array_ci3%c_tbl(i), array_ci3%ivec1(i), & - & array_ci3%ivec2(i), array_ci3%ivec3(i)) + call write_chara_int3_ctl_item(id_control, level, & + & len_trim(array_ci3%array_name), array_ci3%array_name, & + & array_ci3%c_tbl(i), array_ci3%ivec1(i), & + & array_ci3%ivec2(i), array_ci3%ivec3(i)) end do - level = write_end_array_flag_for_ctl(id_control, level, label) + level = write_end_array_flag_for_ctl(id_control, level, & + & array_ci3%array_name) ! end subroutine write_control_array_c_i3 ! @@ -264,19 +293,21 @@ end subroutine append_control_array_c_i3 ! ! ----------------------------------------------------------------------- ! - subroutine copy_control_array_c_i3(num_copy, org_ci, tgt_ci) + subroutine copy_control_array_c_i3(num_copy, org_ci3, tgt_ci3) ! integer(kind = kint), intent(in) :: num_copy - type(ctl_array_ci3), intent(in) :: org_ci - type(ctl_array_ci3), intent(inout) :: tgt_ci + type(ctl_array_ci3), intent(in) :: org_ci3 + type(ctl_array_ci3), intent(inout) :: tgt_ci3 +! ! + tgt_ci3%array_name = org_ci3%array_name + tgt_ci3%icou = org_ci3%icou ! if(num_copy .le. 0) return - tgt_ci%icou = org_ci%icou - tgt_ci%c_tbl(1:num_copy) = org_ci%c_tbl(1:num_copy) - tgt_ci%ivec1(1:num_copy) = org_ci%ivec1(1:num_copy) - tgt_ci%ivec2(1:num_copy) = org_ci%ivec2(1:num_copy) - tgt_ci%ivec3(1:num_copy) = org_ci%ivec3(1:num_copy) + tgt_ci3%c_tbl(1:num_copy) = org_ci3%c_tbl(1:num_copy) + tgt_ci3%ivec1(1:num_copy) = org_ci3%ivec1(1:num_copy) + tgt_ci3%ivec2(1:num_copy) = org_ci3%ivec2(1:num_copy) + tgt_ci3%ivec3(1:num_copy) = org_ci3%ivec3(1:num_copy) ! end subroutine copy_control_array_c_i3 ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_charareal.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_charareal.f90 index f24a426a..0f7f716d 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_charareal.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_charareal.f90 @@ -7,25 +7,32 @@ !>@brief Subroutines to read char-real control arrays !! !!@verbatim +!! subroutine init_charareal_ctl_item_label(label, cr_item) !! subroutine read_charareal_ctl_type(c_buf, label, cr_item) !! type(buffer_for_control), intent(in) :: c_buf !! type(read_chara_real_item), intent(inout) :: cr_item !! subroutine write_charareal_ctl_type & -!! & (id_file, level, maxlen, label, cr_item) +!! & (id_file, level, cr_item) !! type(read_chara_real_item), intent(in) :: cr_item !! subroutine copy_charareal_ctl(org_cr, new_cr) !! type(read_chara_real_item), intent(in) :: org_cr !! type(read_chara_real_item), intent(inout) :: new_cr +!! logical function cmp_read_charreal_item(cr_item1, cr_item2) +!! type(read_chara_real_item), intent(in) :: cr_item1 +!! type(read_chara_real_item), intent(in) :: cr_item2 !! !! subroutine alloc_control_array_c_r(array_cr) !! subroutine dealloc_control_array_c_r(array_cr) +!! subroutine init_c_r_ctl_array_label(label, array_cr) !! subroutine read_control_array_c_r & !! & (id_control, label, array_cr, c_buf) !! type(ctl_array_cr), intent(inout) :: array_cr !! type(buffer_for_control), intent(in) :: c_buf !! subroutine write_control_array_c_r & -!! & (id_control, level, label, array_cr) +!! & (id_control, level, array_cr) !! type(ctl_array_cr), intent(in) :: array_cr +!! logical function cmp_control_array_c_r(array1_cr, array2_cr) +!! type(ctl_array_cr), intent(in) :: array1_cr, array2_cr !! !! subroutine append_control_array_c_r(read_cr, array_cr) !! type(read_chara_real_item), intent(inout) :: read_cr @@ -49,6 +56,8 @@ module t_control_array_charareal ! !> structure of control item with three characters type read_chara_real_item +!> Item name + character(len=kchara) :: item_name = 'char_item' !> read flag (If item is read iflag = 1) integer(kind = kint) :: iflag = 0 !> array for read character items @@ -59,6 +68,8 @@ module t_control_array_charareal ! !> Structure for charactor and real control array type ctl_array_cr +!> Item name + character(len=kchara) :: array_name = 'char_array' !> number of array items integer(kind=kint) :: num = 0 !> array counter @@ -74,6 +85,15 @@ module t_control_array_charareal contains ! ! -------------------------------------------------------------------- +! + subroutine init_charareal_ctl_item_label(label, cr_item) + character(len=kchara), intent(in) :: label + type(read_chara_real_item), intent(inout) :: cr_item +! + cr_item%item_name = trim(label) + end subroutine init_charareal_ctl_item_label +! +! ---------------------------------------------------------------------- ! subroutine read_charareal_ctl_type(c_buf, label, cr_item) ! @@ -86,7 +106,9 @@ subroutine read_charareal_ctl_type(c_buf, label, cr_item) character(len=kchara) :: tmpchara ! ! - if(cr_item%iflag.gt.0 .or. c_buf%header_chara.ne.label) return + if(cr_item%iflag.gt.0) return + cr_item%item_name = trim(label) + if(c_buf%header_chara.ne.label) return ! read(c_buf%ctl_buffer,*) tmpchara, cr_item%charavalue, & & cr_item%realvalue @@ -101,20 +123,23 @@ end subroutine read_charareal_ctl_type ! -------------------------------------------------------------------- ! subroutine write_charareal_ctl_type & - & (id_file, level, maxlen, label, cr_item) + & (id_file, level, cr_item) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_file, level - integer(kind = kint), intent(in) :: maxlen - character(len=kchara), intent(in) :: label type(read_chara_real_item), intent(in) :: cr_item +! + integer(kind = kint) :: maxlen(0:1) ! ! if(cr_item%iflag .eq. 0) return ! - call write_chara_real_ctl_item(id_file, level, maxlen, label, & - & cr_item%charavalue, cr_item%realvalue) + maxlen(0) = len_trim(cr_item%item_name) + maxlen(1) = len_trim(cr_item%charavalue) +! + call write_chara_real_ctl_item(id_file, level, maxlen, & + & cr_item%item_name, cr_item%charavalue, cr_item%realvalue) ! end subroutine write_charareal_ctl_type ! @@ -126,6 +151,7 @@ subroutine copy_charareal_ctl(org_cr, new_cr) type(read_chara_real_item), intent(inout) :: new_cr ! ! + new_cr%item_name = org_cr%item_name new_cr%iflag = org_cr%iflag new_cr%charavalue = org_cr%charavalue new_cr%realvalue = org_cr%realvalue @@ -133,6 +159,29 @@ subroutine copy_charareal_ctl(org_cr, new_cr) end subroutine copy_charareal_ctl ! ! -------------------------------------------------------------------- +! + logical function cmp_read_charreal_item(cr_item1, cr_item2) +! + use skip_comment_f +! + type(read_chara_real_item), intent(in) :: cr_item1 + type(read_chara_real_item), intent(in) :: cr_item2 +! + cmp_read_charreal_item = .FALSE. + if(cmp_no_case(trim(cr_item1%item_name), & + & trim(cr_item2%item_name)) .eqv. .FALSE.) return + if(cr_item1%iflag .ne. cr_item2%iflag) return + if(cr_item1%iflag .gt. 0) then + if(cmp_no_case(trim(cr_item1%charavalue), & + & trim(cr_item2%charavalue)) .eqv. .FALSE.) return + if(cr_item1%realvalue .ne. cr_item2%realvalue) return + end if +! + cmp_read_charreal_item = .TRUE. +! + end function cmp_read_charreal_item +! +! ---------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine alloc_control_array_c_r(array_cr) @@ -163,6 +212,15 @@ end subroutine dealloc_control_array_c_r ! ! -------------------------------------------------------------------- ! -------------------------------------------------------------------- +! + subroutine init_c_r_ctl_array_label(label, array_cr) + character(len=kchara), intent(in) :: label + type(ctl_array_cr), intent(inout) :: array_cr +! + array_cr%array_name = trim(label) + end subroutine init_c_r_ctl_array_label +! +! -------------------------------------------------------------------- ! subroutine read_control_array_c_r & & (id_control, label, array_cr, c_buf) @@ -177,15 +235,17 @@ subroutine read_control_array_c_r & type(read_chara_real_item) :: read_cr ! ! - if(check_array_flag(c_buf, label) .eqv. .FALSE.) return if(array_cr%icou .gt. 0) return + array_cr%array_name = trim(label) + if(check_array_flag(c_buf, label) .eqv. .FALSE.) return ! read_cr%iflag = 0 array_cr%num = 0 call alloc_control_array_c_r(array_cr) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, label)) exit ! if(c_buf%header_chara.eq.label) then @@ -199,34 +259,61 @@ end subroutine read_control_array_c_r ! -------------------------------------------------------------------- ! subroutine write_control_array_c_r & - & (id_control, level, label, array_cr) + & (id_control, level, array_cr) ! use skip_comment_f use write_control_elements + use write_control_items ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: label type(ctl_array_cr), intent(in) :: array_cr ! integer(kind = kint), intent(inout) :: level ! integer(kind = kint) :: i + integer(kind = kint) :: maxlen(0:1) ! ! if(array_cr%num .le. 0) return - write(id_control,'(a1)') '!' ! - level = write_array_flag_for_ctl(id_control, level, label) + maxlen(0) = len_trim(array_cr%array_name) + maxlen(1) = max_len_of_charaarray(array_cr%num, array_cr%c_tbl) +! + level = write_array_flag_for_ctl(id_control, level, & + & array_cr%array_name) do i = 1, array_cr%num - call write_chara_real_ctl_item & - & (id_control, level, len_trim(label), label, & - & array_cr%c_tbl(i), array_cr%vect(i)) + call write_chara_real_ctl_item(id_control, level, maxlen, & + & array_cr%array_name, array_cr%c_tbl(i), array_cr%vect(i)) end do - level = write_end_array_flag_for_ctl(id_control, level, label) + level = write_end_array_flag_for_ctl(id_control, level, & + & array_cr%array_name) ! end subroutine write_control_array_c_r ! ! -------------------------------------------------------------------- +! + logical function cmp_control_array_c_r(array1_cr, array2_cr) +! + use skip_comment_f +! + type(ctl_array_cr), intent(in) :: array1_cr, array2_cr + integer(kind = kint) :: i +! + cmp_control_array_c_r = .FALSE. + if(cmp_no_case(trim(array1_cr%array_name), & + & trim(array2_cr%array_name)) .eqv. .FALSE.) return + if(array1_cr%num .ne. array2_cr%num) return + if(array1_cr%icou .ne. array2_cr%icou) return + do i = 1, array1_cr%num + if(cmp_no_case(trim(array1_cr%c_tbl(i)), & + & trim(array2_cr%c_tbl(i))) .eqv. .FALSE.) return + if(array1_cr%vect(i) .ne. array2_cr%vect(i)) return + end do + cmp_control_array_c_r = .TRUE. +! + end function cmp_control_array_c_r +! +! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine append_control_array_c_r(read_cr, array_cr) @@ -274,9 +361,10 @@ subroutine copy_control_array_c_r(num_copy, org_cr, tgt_cr) type(ctl_array_cr), intent(in) :: org_cr type(ctl_array_cr), intent(inout) :: tgt_cr ! + tgt_cr%array_name = org_cr%array_name + tgt_cr%icou = org_cr%icou ! if(num_copy .le. 0) return - tgt_cr%icou = org_cr%icou tgt_cr%c_tbl(1:num_copy) = org_cr%c_tbl(1:num_copy) tgt_cr%vect(1:num_copy) = org_cr%vect(1:num_copy) ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_charareal2.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_charareal2.f90 index 7bab9981..236e2765 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_charareal2.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_charareal2.f90 @@ -11,7 +11,7 @@ !! type(buffer_for_control), intent(in) :: c_buf !! type(read_chara_real2_item), intent(inout) :: cr2_item !! subroutine write_charreal2_ctl_type & -!! & (id_file, level, maxlen, label, cr2_item) +!! & (id_file, level, maxlen, cr2_item) !! type(read_chara_real2_item), intent(in) :: cr2_item !! subroutine copy_charreal2_ctl(org_cr2, new_cr2) !! type(read_chara_real2_item), intent(in) :: org_cr2 @@ -24,7 +24,7 @@ !! type(ctl_array_cr2), intent(inout) :: array_cr2 !! type(buffer_for_control), intent(inout) :: c_buf !! subroutine write_control_array_c_r2 & -!! & (id_control, level, label, array_cr2) +!! & (id_control, level, array_cr2) !! type(ctl_array_cr2), intent(in) :: array_cr2 !! !! subroutine append_control_array_c_r2(read_cr2, array_cr2) @@ -48,6 +48,8 @@ module t_control_array_charareal2 ! !> structure of control item with three characters type read_chara_real2_item +!> Item name + character(len=kchara) :: item_name = 'char_item' !> read flag (If item is read iflag = 1) integer(kind = kint) :: iflag = 0 !> array for read character items @@ -58,6 +60,8 @@ module t_control_array_charareal2 ! !> Structure for charactor and two reals control array type ctl_array_cr2 +!> Item name + character(len=kchara) :: array_name = 'char_array' !> number of array items integer(kind=kint) :: num = 0 !> array counter @@ -87,7 +91,9 @@ subroutine read_charreal2_ctl_type(c_buf, label, cr2_item) character(len=kchara) :: tmpchara ! ! - if(cr2_item%iflag.gt.0 .or. c_buf%header_chara.ne.label) return + if(cr2_item%iflag.gt.0) return + cr2_item%item_name = trim(label) + if(c_buf%header_chara.ne.label) return ! read(c_buf%ctl_buffer,*) tmpchara, cr2_item%charavalue, & & cr2_item%realvalue(1:2) @@ -103,19 +109,18 @@ end subroutine read_charreal2_ctl_type ! -------------------------------------------------------------------- ! subroutine write_charreal2_ctl_type & - & (id_file, level, maxlen, label, cr2_item) + & (id_file, level, maxlen, cr2_item) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_file, level, maxlen - character(len=kchara), intent(in) :: label type(read_chara_real2_item), intent(in) :: cr2_item ! ! if(cr2_item%iflag .eq. 0) return ! - call write_chara_real2_ctl_item & - & (id_file, level, maxlen, label, cr2_item%charavalue, & + call write_chara_real2_ctl_item(id_file, level, maxlen, & + & cr2_item%item_name, cr2_item%charavalue, & & cr2_item%realvalue(1), cr2_item%realvalue(2)) ! end subroutine write_charreal2_ctl_type @@ -128,6 +133,7 @@ subroutine copy_charreal2_ctl(org_cr2, new_cr2) type(read_chara_real2_item), intent(inout) :: new_cr2 ! ! + new_cr2%item_name = org_cr2%item_name new_cr2%iflag = org_cr2%iflag new_cr2%charavalue = org_cr2%charavalue new_cr2%realvalue(1:2) = org_cr2%realvalue(1:2) @@ -181,15 +187,17 @@ subroutine read_control_array_c_r2 & type(read_chara_real2_item) :: read_cr2 ! ! - if(check_array_flag(c_buf, label) .eqv. .FALSE.) return if(array_cr2%icou .gt. 0) return + array_cr2%array_name = trim(label) + if(check_array_flag(c_buf, label) .eqv. .FALSE.) return ! read_cr2%iflag = 0 array_cr2%num = 0 call alloc_control_array_c_r2(array_cr2) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, label)) exit ! if(c_buf%header_chara.eq.label) then @@ -203,13 +211,12 @@ end subroutine read_control_array_c_r2 ! -------------------------------------------------------------------- ! subroutine write_control_array_c_r2 & - & (id_control, level, label, array_cr2) + & (id_control, level, array_cr2) ! use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: label type(ctl_array_cr2), intent(in) :: array_cr2 ! integer(kind = kint), intent(inout) :: level @@ -218,15 +225,16 @@ subroutine write_control_array_c_r2 & ! ! if(array_cr2%num .le. 0) return - write(id_control,'(a1)') '!' ! - level = write_array_flag_for_ctl(id_control, level, label) + level = write_array_flag_for_ctl(id_control, level, & + & array_cr2%array_name) do i = 1, array_cr2%num - call write_chara_real2_ctl_item & - & (id_control, level, len_trim(label), label, & + call write_chara_real2_ctl_item(id_control, level, & + & len_trim(array_cr2%array_name), array_cr2%array_name, & & array_cr2%c_tbl(i), array_cr2%vec1(i), array_cr2%vec2(i)) end do - level = write_end_array_flag_for_ctl(id_control, level, label) + level = write_end_array_flag_for_ctl(id_control, level, & + & array_cr2%array_name) ! end subroutine write_control_array_c_r2 ! @@ -264,9 +272,11 @@ subroutine copy_control_array_c_r2(num_copy, org_cr2, tgt_cr2) type(ctl_array_cr2), intent(in) :: org_cr2 type(ctl_array_cr2), intent(inout) :: tgt_cr2 ! +! + tgt_cr2%array_name = org_cr2%array_name + tgt_cr2%icou = org_cr2%icou ! if(num_copy .le. 0) return - tgt_cr2%icou = org_cr2%icou tgt_cr2%c_tbl(1:num_copy) = org_cr2%c_tbl(1:num_copy) tgt_cr2%vec1(1:num_copy) = org_cr2%vec1(1:num_copy) tgt_cr2%vec2(1:num_copy) = org_cr2%vec2(1:num_copy) diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_int2real.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_int2real.f90 index 2d27f8b3..0fef6eb4 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_int2real.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_int2real.f90 @@ -11,7 +11,7 @@ !! type(buffer_for_control), intent(in) :: c_buf !! type(read_int2_real_item), intent(inout) :: i2r_item !! subroutine write_int2real_ctl_type & -!! & (id_file, level, maxlen, label, i2r_item) +!! & (id_file, level, maxlen, i2r_item) !! type(read_int2_real_item), intent(in) :: i2r_item !! subroutine copy_int2real_ctl(org_i2r, new_i2r) !! type(read_int2_real_item), intent(in) :: org_i2r @@ -24,7 +24,7 @@ !! type(ctl_array_i2r), intent(inout) :: array_i2r !! type(buffer_for_control), intent(in) :: c_buf !! subroutine write_control_array_i2_r & -!! & (id_control, level, label, array_i2r) +!! & (id_control, level, array_i2r) !! type(ctl_array_i2r), intent(in) :: array_i2r !! !! subroutine append_control_array_i2_r(read_i2r, array_i2r) @@ -48,6 +48,8 @@ module t_control_array_int2real ! !> structure of control item with three characters type read_int2_real_item +!> Item name + character(len=kchara) :: item_name = 'integer_item' !> read flag (If item is read iflag = 1) integer(kind = kint) :: iflag = 0 !> array for read integer items @@ -58,6 +60,8 @@ module t_control_array_int2real ! !> Structure for 1 real and 2 integers control array type ctl_array_i2r +!> Item name + character(len=kchara) :: array_name = 'integer_array' !> number of array items integer(kind=kint) :: num = 0 !> array counter @@ -87,7 +91,9 @@ subroutine read_int2real_ctl_type(c_buf, label, i2r_item) character(len=kchara) :: tmpchara ! ! - if(i2r_item%iflag.gt.0 .or. c_buf%header_chara.ne.label) return + if(i2r_item%iflag.gt.0) return + i2r_item%item_name = trim(label) + if(c_buf%header_chara.ne.label) return ! read(c_buf%ctl_buffer,*) tmpchara, i2r_item%intvalue(1:2), & & i2r_item%realvalue @@ -102,18 +108,18 @@ end subroutine read_int2real_ctl_type ! -------------------------------------------------------------------- ! subroutine write_int2real_ctl_type & - & (id_file, level, maxlen, label, i2r_item) + & (id_file, level, maxlen, i2r_item) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_file, level, maxlen - character(len=kchara), intent(in) :: label type(read_int2_real_item), intent(in) :: i2r_item ! ! if(i2r_item%iflag .eq. 0) return ! - call write_i2_r_ctl_item(id_file, level, maxlen, label, & + call write_i2_r_ctl_item & + & (id_file, level, maxlen, i2r_item%item_name, & & i2r_item%intvalue(1), i2r_item%intvalue(2), & & i2r_item%realvalue) ! @@ -127,6 +133,7 @@ subroutine copy_int2real_ctl(org_i2r, new_i2r) type(read_int2_real_item), intent(inout) :: new_i2r ! ! + new_i2r%item_name = org_i2r%item_name new_i2r%iflag = org_i2r%iflag new_i2r%intvalue(1:2) = org_i2r%intvalue(1:2) new_i2r%realvalue = org_i2r%realvalue @@ -181,15 +188,17 @@ subroutine read_control_array_i2_r & type(read_int2_real_item) :: read_i2r ! ! - if(check_array_flag(c_buf, label) .eqv. .FALSE.) return if(array_i2r%icou .gt. 0) return + array_i2r%array_name = trim(label) + if(check_array_flag(c_buf, label) .eqv. .FALSE.) return ! read_i2r%iflag = 0 array_i2r%num = 0 call alloc_control_array_i2_r(array_i2r) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, label)) exit ! if(c_buf%header_chara.eq.label) then @@ -203,13 +212,12 @@ end subroutine read_control_array_i2_r ! -------------------------------------------------------------------- ! subroutine write_control_array_i2_r & - & (id_control, level, label, array_i2r) + & (id_control, level, array_i2r) ! use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: label type(ctl_array_i2r), intent(in) :: array_i2r ! integer(kind = kint), intent(inout) :: level @@ -218,15 +226,16 @@ subroutine write_control_array_i2_r & ! ! if(array_i2r%num .le. 0) return - write(id_control,'(a1)') '!' ! - level = write_array_flag_for_ctl(id_control, level, label) + level = write_array_flag_for_ctl(id_control, level, & + & array_i2r%array_name) do i = 1, array_i2r%num - call write_i2_r_ctl_item & - & (id_control, level, len_trim(label), label, & + call write_i2_r_ctl_item(id_control, level, & + & len_trim(array_i2r%array_name), array_i2r%array_name, & & array_i2r%int1(i), array_i2r%int2(i), array_i2r%vect(i)) end do - level = write_end_array_flag_for_ctl(id_control, level, label) + level = write_end_array_flag_for_ctl(id_control, level, & + & array_i2r%array_name) ! end subroutine write_control_array_i2_r ! @@ -264,9 +273,11 @@ subroutine copy_control_array_i2_r(num_copy, org_i2r, tgt_i2r) type(ctl_array_i2r), intent(in) :: org_i2r type(ctl_array_i2r), intent(inout) :: tgt_i2r ! +! + tgt_i2r%array_name = org_i2r%array_name + tgt_i2r%icou = org_i2r%icou ! if(num_copy .le. 0) return - tgt_i2r%icou = org_i2r%icou tgt_i2r%int1(1:num_copy) = org_i2r%int1(1:num_copy) tgt_i2r%int2(1:num_copy) = org_i2r%int2(1:num_copy) tgt_i2r%vect(1:num_copy) = org_i2r%vect(1:num_copy) diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_int2real2.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_int2real2.f90 index 6506a61b..1882d9ce 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_int2real2.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_int2real2.f90 @@ -11,7 +11,7 @@ !! type(buffer_for_control), intent(in) :: c_buf !! type(read_int2_real2_item), intent(inout) :: i2r2_item !! subroutine write_int2real2_ctl_type & -!! & (id_file, level, maxlen, label, i2r2_item) +!! & (id_file, level, maxlen, i2r2_item) !! type(read_int2_real2_item), intent(in) :: i2r2_item !! subroutine copy_int2real2_ctl(org_i2r2, new_i2r2) !! type(read_int2_real2_item), intent(in) :: org_i2r2 @@ -24,7 +24,7 @@ !! type(ctl_array_i2r2), intent(inout) :: array_i2r2 !! type(buffer_for_control), intent(in) :: c_buf !! subroutine write_control_array_i2_r2 & -!! & (id_control, level, label, array_i2r2) +!! & (id_control, level, array_i2r2) !! type(ctl_array_i2r2), intent(in) :: array_i2r2 !! !! subroutine append_control_array_i2_r2(read_i2r2, array_i2r2) @@ -49,6 +49,8 @@ module t_control_array_int2real2 ! !> structure of control item with three characters type read_int2_real2_item +!> Item name + character(len=kchara) :: item_name = 'chara_item' !> read flag (If item is read iflag = 1) integer(kind = kint) :: iflag = 0 !> array for read integer items @@ -59,6 +61,8 @@ module t_control_array_int2real2 ! !> Structure for 2 reals and 2 integeres control array type ctl_array_i2r2 +!> Item name + character(len=kchara) :: array_name = 'chara_array' !> number of array items integer(kind=kint) :: num = 0 !> array counter @@ -90,7 +94,9 @@ subroutine read_int2real2_ctl_type(c_buf, label, i2r2_item) character(len=kchara) :: tmpchara ! ! - if(i2r2_item%iflag.gt.0 .or. c_buf%header_chara.ne.label) return + if(i2r2_item%iflag.gt.0) return + i2r2_item%item_name = trim(label) + if(c_buf%header_chara.ne.label) return ! read(c_buf%ctl_buffer,*) tmpchara, i2r2_item%intvalue(1:2), & & i2r2_item%realvalue(1:2) @@ -105,18 +111,18 @@ end subroutine read_int2real2_ctl_type ! -------------------------------------------------------------------- ! subroutine write_int2real2_ctl_type & - & (id_file, level, maxlen, label, i2r2_item) + & (id_file, level, maxlen, i2r2_item) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_file, level, maxlen - character(len=kchara), intent(in) :: label type(read_int2_real2_item), intent(in) :: i2r2_item ! ! if(i2r2_item%iflag .eq. 0) return ! - call write_i2_r2_ctl_item(id_file, level, maxlen, label, & + call write_i2_r2_ctl_item & + & (id_file, level, maxlen, i2r2_item%item_name, & & i2r2_item%intvalue(1), i2r2_item%intvalue(2), & & i2r2_item%realvalue(1), i2r2_item%realvalue(2)) ! @@ -130,6 +136,7 @@ subroutine copy_int2real2_ctl(org_i2r2, new_i2r2) type(read_int2_real2_item), intent(inout) :: new_i2r2 ! ! + new_i2r2%item_name = org_i2r2%item_name new_i2r2%iflag = org_i2r2%iflag new_i2r2%intvalue(1:2) = org_i2r2%intvalue(1:2) new_i2r2%realvalue(1:2) = org_i2r2%realvalue(1:2) @@ -187,6 +194,8 @@ subroutine read_control_array_i2_r2 & type(read_int2_real2_item) :: read_i2r2 ! ! + if(array_i2r2%icou .gt. 0) return + array_i2r2%array_name = trim(label) if(check_array_flag(c_buf, label) .eqv. .FALSE.) return if(array_i2r2%icou .gt. 0) return ! @@ -195,7 +204,8 @@ subroutine read_control_array_i2_r2 & call alloc_control_array_i2_r2(array_i2r2) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, label)) exit ! if(c_buf%header_chara.eq.label) then @@ -209,13 +219,12 @@ end subroutine read_control_array_i2_r2 ! -------------------------------------------------------------------- ! subroutine write_control_array_i2_r2 & - & (id_control, level, label, array_i2r2) + & (id_control, level, array_i2r2) ! use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: label type(ctl_array_i2r2), intent(in) :: array_i2r2 ! integer(kind = kint), intent(inout) :: level @@ -224,16 +233,17 @@ subroutine write_control_array_i2_r2 & ! ! if(array_i2r2%num .le. 0) return - write(id_control,'(a1)') '!' ! - level = write_array_flag_for_ctl(id_control, level, label) + level = write_array_flag_for_ctl(id_control, level, & + & array_i2r2%array_name) do i = 1, array_i2r2%num - call write_i2_r2_ctl_item & - & (id_control, level, len_trim(label), label, & + call write_i2_r2_ctl_item(id_control, level, & + & len_trim(array_i2r2%array_name), array_i2r2%array_name, & & array_i2r2%int1(i), array_i2r2%int2(i), & & array_i2r2%vec1(i), array_i2r2%vec2(i)) end do - level = write_end_array_flag_for_ctl(id_control, level, label) + level = write_end_array_flag_for_ctl(id_control, level, & + & array_i2r2%array_name) ! end subroutine write_control_array_i2_r2 ! @@ -272,9 +282,11 @@ subroutine copy_control_array_i2_r2 & type(ctl_array_i2r2), intent(in) :: org_i2r2 type(ctl_array_i2r2), intent(inout) :: tgt_i2r2 ! +! + tgt_i2r2%array_name = org_i2r2%array_name + tgt_i2r2%icou = org_i2r2%icou ! if(num_copy .le. 0) return - tgt_i2r2%icou = org_i2r2%icou tgt_i2r2%int1(1:num_copy) = org_i2r2%int1(1:num_copy) tgt_i2r2%int2(1:num_copy) = org_i2r2%int2(1:num_copy) tgt_i2r2%vec1(1:num_copy) = org_i2r2%vec1(1:num_copy) diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_intcharreal.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_intcharreal.f90 index df0b2184..f3164d99 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_intcharreal.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_intcharreal.f90 @@ -11,7 +11,7 @@ !! type(buffer_for_control), intent(in) :: c_buf !! type(read_int_chara_real_item), intent(inout) :: icr_item !! subroutine write_intcharreal_ctl_type & -!! & (id_file, level, maxlen, label, icr_item) +!! & (id_file, level, maxlen, icr_item) !! type(read_int_chara_real_item), intent(in) :: icr_item !! subroutine copy_intchrreal_ctl(org_icr, new_icr) !! type(read_int_chara_real_item), intent(in) :: org_icr @@ -24,7 +24,7 @@ !! type(ctl_array_icr), intent(inout) :: array_icr !! type(buffer_for_control), intent(in) :: c_buf !! subroutine write_control_array_i_c_r & -!! & (id_control, level, label, array_icr) +!! & (id_control, level, array_icr) !! type(ctl_array_icr), intent(in) :: array_icr !! !! subroutine append_control_array_i_c_r(read_icr, array_icr) @@ -48,6 +48,8 @@ module t_control_array_intcharreal ! !> structure of control item with three characters type read_int_chara_real_item +!> Item name + character(len=kchara) :: item_name = 'char_item' !> read flag (If item is read iflag = 1) integer(kind = kint) :: iflag = 0 !> array for read integer items @@ -60,6 +62,8 @@ module t_control_array_intcharreal ! !> Structure for integere, charactor, and real control array type ctl_array_icr +!> Item name + character(len=kchara) :: array_name = 'char_array' !> number of array items integer(kind=kint) :: num = 0 !> array counter @@ -89,7 +93,9 @@ subroutine read_intcharreal_ctl_type(c_buf, label, icr_item) character(len=kchara) :: tmpchara ! ! - if(icr_item%iflag.gt.0 .or. c_buf%header_chara.ne.label) return + if(icr_item%iflag.gt.0) return + icr_item%item_name = trim(label) + if(c_buf%header_chara.ne.label) return ! read(c_buf%ctl_buffer,*) tmpchara, icr_item%intvalue, & & icr_item%charavalue, icr_item%realvalue @@ -106,18 +112,18 @@ end subroutine read_intcharreal_ctl_type ! -------------------------------------------------------------------- ! subroutine write_intcharreal_ctl_type & - & (id_file, level, maxlen, label, icr_item) + & (id_file, level, maxlen, icr_item) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_file, level, maxlen - character(len=kchara), intent(in) :: label type(read_int_chara_real_item), intent(in) :: icr_item ! ! if(icr_item%iflag .eq. 0) return ! - call write_i_c_r_ctl_item(id_file, level, maxlen, label, & + call write_i_c_r_ctl_item & + & (id_file, level, maxlen, icr_item%item_name, & & icr_item%intvalue, icr_item%charavalue, icr_item%realvalue) ! end subroutine write_intcharreal_ctl_type @@ -130,6 +136,7 @@ subroutine copy_intchrreal_ctl(org_icr, new_icr) type(read_int_chara_real_item), intent(inout) :: new_icr ! ! + new_icr%item_name = org_icr%item_name new_icr%iflag = org_icr%iflag new_icr%intvalue = org_icr%intvalue new_icr%charavalue = org_icr%charavalue @@ -184,15 +191,17 @@ subroutine read_control_array_i_c_r & type(read_int_chara_real_item) :: read_icr ! ! - if(check_array_flag(c_buf, label) .eqv. .FALSE.) return if(array_icr%icou .gt. 0) return + array_icr%array_name = trim(label) + if(check_array_flag(c_buf, label) .eqv. .FALSE.) return ! read_icr%iflag = 0 array_icr%num = 0 call alloc_control_array_i_c_r(array_icr) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, label)) exit ! if(c_buf%header_chara.eq.label) then @@ -206,13 +215,12 @@ end subroutine read_control_array_i_c_r ! -------------------------------------------------------------------- ! subroutine write_control_array_i_c_r & - & (id_control, level, label, array_icr) + & (id_control, level, array_icr) ! use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: label type(ctl_array_icr), intent(in) :: array_icr ! integer(kind = kint), intent(inout) :: level @@ -221,15 +229,16 @@ subroutine write_control_array_i_c_r & ! ! if(array_icr%num .le. 0) return - write(id_control,'(a1)') '!' ! - level = write_array_flag_for_ctl(id_control, level, label) + level = write_array_flag_for_ctl(id_control, level, & + & array_icr%array_name) do i = 1, array_icr%num - call write_i_c_r_ctl_item & - & (id_control, level, len_trim(label), label, & + call write_i_c_r_ctl_item(id_control, level, & + & len_trim(array_icr%array_name), array_icr%array_name, & & array_icr%ivec(i), array_icr%c_tbl(i), array_icr%vect(i)) end do - level = write_end_array_flag_for_ctl(id_control, level, label) + level = write_end_array_flag_for_ctl(id_control, level, & + & array_icr%array_name) ! end subroutine write_control_array_i_c_r ! @@ -267,9 +276,11 @@ subroutine copy_control_array_i_c_r(num_copy, org_icr, tgt_icr) type(ctl_array_icr), intent(in) :: org_icr type(ctl_array_icr), intent(inout) :: tgt_icr ! +! + tgt_icr%array_name = org_icr%array_name + tgt_icr%icou = org_icr%icou ! if(num_copy .le. 0) return - tgt_icr%icou = org_icr%icou tgt_icr%ivec(1:num_copy) = org_icr%ivec(1:num_copy) tgt_icr%c_tbl(1:num_copy) = org_icr%c_tbl(1:num_copy) tgt_icr%vect(1:num_copy) = org_icr%vect(1:num_copy) diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_integer.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_integer.f90 index 95092668..8225b950 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_integer.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_integer.f90 @@ -7,25 +7,31 @@ !>@brief Subroutines to read control arrays !! !!@verbatim +!! subroutine init_int_ctl_item_label(label, int_item) !! subroutine read_integer_ctl_type(c_buf, label, int_item) !! type(buffer_for_control), intent(in) :: c_buf !! type(read_integer_item), intent(inout) :: int_item !! subroutine write_integer_ctl_type & -!! & (id_file, level, maxlen, label, int_item) +!! & (id_file, level, maxlen, int_item) !! type(read_integer_item), intent(in) :: int_item !! subroutine copy_integer_ctl(org_i1, new_i1) !! type(read_integer_item), intent(in) :: org_i1 !! type(read_integer_item), intent(inout) :: new_i1 +!! logical function cmp_read_integer_item(i_item1, i_item2) +!! type(read_integer_item), intent(in) :: i_item1, i_item2 !! !! subroutine alloc_control_array_int(array_int) !! subroutine dealloc_control_array_int(array_int) +!! subroutine init_int_ctl_array_label(label, array_int) !! subroutine read_control_array_i1 & !! & (id_control, label, array_int, c_buf) !! type(ctl_array_int), intent(inout) :: array_int !! type(buffer_for_control), intent(inout) :: c_buf !! subroutine write_control_array_i1 & -!! & (id_control, level, label, array_int) +!! & (id_control, level, array_int) !! type(ctl_array_int), intent(in) :: array_int +!! logical function cmp_control_array_c1(i_array1, i_array2) +!! type(ctl_array_int), intent(in) :: i_array1, i_array2 !! !! subroutine append_control_array_int(read_i1, array_i1) !! type(read_integer_item), intent(inout) :: read_i1 @@ -48,6 +54,8 @@ module t_control_array_integer ! !> structure of control integer item type read_integer_item +!> Item name + character(len=kchara) :: item_name = 'Integer_item' !> read flag (If item is read iflag = 1) integer(kind = kint) :: iflag = 0 !> array for read integer item @@ -56,6 +64,8 @@ module t_control_array_integer ! !> Structure for integer control array type ctl_array_int +!> Item name + character(len=kchara) :: array_name = 'Integer_array' !> number of array items integer(kind=kint) :: num = 0 !> array counter @@ -69,6 +79,15 @@ module t_control_array_integer contains ! ! -------------------------------------------------------------------- +! + subroutine init_int_ctl_item_label(label, int_item) + character(len=kchara), intent(in) :: label + type(read_integer_item), intent(inout) :: int_item +! + int_item%item_name = trim(label) + end subroutine init_int_ctl_item_label +! +! -------------------------------------------------------------------- ! subroutine read_integer_ctl_type(c_buf, label, int_item) ! @@ -81,31 +100,32 @@ subroutine read_integer_ctl_type(c_buf, label, int_item) character(len=kchara) :: tmpchara ! ! - if(int_item%iflag.gt.0 .or. c_buf%header_chara.ne.label) return + if(int_item%iflag .gt. 0) return + call init_int_ctl_item_label(label, int_item) + if(c_buf%header_chara.ne.label) return ! read(c_buf%ctl_buffer,*) tmpchara, int_item%intvalue if (iflag_debug .gt. 0) write(*,*) trim(c_buf%header_chara), & & int_item%intvalue int_item%iflag = 1 ! - end subroutine read_integer_ctl_type + end subroutine read_integer_ctl_type ! ! -------------------------------------------------------------------- ! subroutine write_integer_ctl_type & - & (id_file, level, maxlen, label, int_item) + & (id_file, level, maxlen, int_item) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_file, level integer(kind = kint), intent(in) :: maxlen - character(len=kchara), intent(in) :: label type(read_integer_item), intent(in) :: int_item ! ! if(int_item%iflag .eq. 0) return - call write_integer_ctl_item & - & (id_file, level, maxlen, label, int_item%intvalue) + call write_integer_ctl_item(id_file, level, maxlen, & + & int_item%item_name, int_item%intvalue) ! end subroutine write_integer_ctl_type ! @@ -118,12 +138,34 @@ subroutine copy_integer_ctl(org_i1, new_i1) type(read_integer_item), intent(inout) :: new_i1 ! ! - new_i1%iflag = org_i1%iflag - new_i1%intvalue = org_i1%intvalue + new_i1%item_name = org_i1%item_name + new_i1%iflag = org_i1%iflag + new_i1%intvalue = org_i1%intvalue ! end subroutine copy_integer_ctl ! ! -------------------------------------------------------------------- +! + logical function cmp_read_integer_item(i_item1, i_item2) +! + use skip_comment_f +! + type(read_integer_item), intent(in) :: i_item1, i_item2 +! + cmp_read_integer_item = .FALSE. + if(cmp_no_case(trim(i_item1%item_name), & + & trim(i_item2%item_name)) .eqv. .FALSE.) return + if(i_item1%iflag .ne. i_item2%iflag) return + if(i_item1%iflag .gt. 0) then + if(i_item1%intvalue .ne. i_item2%intvalue) return + end if +! + cmp_read_integer_item = .TRUE. +! + end function cmp_read_integer_item +! +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- ! subroutine alloc_control_array_int(array_int) ! @@ -152,6 +194,15 @@ end subroutine dealloc_control_array_int ! ! -------------------------------------------------------------------- ! -------------------------------------------------------------------- +! + subroutine init_int_ctl_array_label(label, array_int) + character(len=kchara), intent(in) :: label + type(ctl_array_int), intent(inout) :: array_int +! + array_int%array_name = trim(label) + end subroutine init_int_ctl_array_label +! +! -------------------------------------------------------------------- ! subroutine read_control_array_i1 & & (id_control, label, array_int, c_buf) @@ -166,15 +217,17 @@ subroutine read_control_array_i1 & type(read_integer_item) :: read_i1 ! ! - if(check_array_flag(c_buf, label) .eqv. .FALSE.) return if(array_int%icou .gt. 0) return + call init_int_ctl_array_label(label, array_int) + if(check_array_flag(c_buf, label) .eqv. .FALSE.) return ! read_i1%iflag = 0 array_int%num = 0 call alloc_control_array_int(array_int) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, label)) exit ! if(c_buf%header_chara.eq.label) then @@ -188,13 +241,12 @@ end subroutine read_control_array_i1 ! -------------------------------------------------------------------- ! subroutine write_control_array_i1 & - & (id_control, level, label, array_int) + & (id_control, level, array_int) ! use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: label type(ctl_array_int), intent(in) :: array_int ! integer(kind = kint), intent(inout) :: level @@ -203,19 +255,41 @@ subroutine write_control_array_i1 & ! ! if(array_int%num .le. 0) return - write(id_control,'(a1)') '!' ! - level = write_array_flag_for_ctl(id_control, level, label) + level = write_array_flag_for_ctl(id_control, level, & + & array_int%array_name) do i = 1, array_int%num - length = len_trim(label) + length = len_trim(array_int%array_name) call write_integer_ctl_item(id_control, level, length, & - & label, array_int%ivec(i)) + & array_int%array_name, array_int%ivec(i)) end do - level = write_end_array_flag_for_ctl(id_control, level, label) + level = write_end_array_flag_for_ctl(id_control, level, & + & array_int%array_name) ! end subroutine write_control_array_i1 ! ! -------------------------------------------------------------------- +! + logical function cmp_control_array_c1(i_array1, i_array2) +! + use skip_comment_f +! + type(ctl_array_int), intent(in) :: i_array1, i_array2 + integer(kind = kint) :: i +! + cmp_control_array_c1 = .FALSE. + if(cmp_no_case(trim(i_array1%array_name), & + & trim(i_array2%array_name)) .eqv. .FALSE.) return + if(i_array1%num .ne. i_array2%num) return + if(i_array1%icou .ne. i_array2%icou) return + do i = 1, i_array1%num + if(i_array1%ivec(i) .ne. i_array2%ivec(i)) return + end do + cmp_control_array_c1 = .TRUE. +! + end function cmp_control_array_c1 +! +! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine append_control_array_int(read_i1, array_i1) @@ -249,9 +323,11 @@ subroutine copy_control_array_int(num_copy, org_i1, tgt_i1) type(ctl_array_int), intent(in) :: org_i1 type(ctl_array_int), intent(inout) :: tgt_i1 ! +! + tgt_i1%array_name = org_i1%array_name + tgt_i1%icou = org_i1%icou ! if(num_copy .le. 0) return - tgt_i1%icou = org_i1%icou tgt_i1%ivec(1:num_copy) = org_i1%ivec(1:num_copy) ! end subroutine copy_control_array_int diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_integer2.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_integer2.f90 index 8ceb1818..94f3cf68 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_integer2.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_integer2.f90 @@ -7,11 +7,12 @@ !>@brief Subroutines to read control arrays !! !!@verbatim +!! subroutine init_integer2_ctl_item_label(label, int2_item) !! subroutine read_integer2_ctl_type(c_buf, label, int2_item) !! type(buffer_for_control), intent(in) :: c_buf !! type(read_int2_item), intent(inout) :: int2_item !! subroutine write_integer2_ctl_type & -!! & (id_file, level, maxlen, label, int2_item) +!! & (id_file, level, maxlen, int2_item) !! type(read_int2_item), intent(in) :: int2_item !! subroutine copy_integer2_ctl(org_i2, new_i2) !! type(read_int2_item), intent(in) :: org_i2 @@ -19,12 +20,13 @@ !! !! subroutine alloc_control_array_i2(array_i2) !! subroutine dealloc_control_array_i2(array_i2) +!! subroutine init_int2_ctl_array_label(label, array_i2) !! subroutine read_control_array_i2 & !! & (id_control, label, array_i2, c_buf) !! type(ctl_array_i2), intent(inout) :: array_i2 !! type(buffer_for_control), intent(inout) :: c_buf !! subroutine write_control_array_i2 & -!! & (id_control, level, label, array_i2) +!! & (id_control, level, array_i2) !! type(ctl_array_i2), intent(in) :: array_i2 !! !! subroutine append_control_array_i2(read_i2, array_i2) @@ -51,6 +53,8 @@ module t_control_array_integer2 ! !> structure of control integer item type read_int2_item +!> Item name + character(len=kchara) :: item_name = 'integer_item' !> read flag (If item is read iflag = 1) integer(kind = kint) :: iflag = 0 !> array for read integer item @@ -59,6 +63,8 @@ module t_control_array_integer2 ! !> Structure for 2 integers control array type ctl_array_i2 +!> Item name + character(len=kchara) :: array_name = 'integer_array' !> number of array items integer(kind=kint) :: num = 0 !> array counter @@ -75,6 +81,15 @@ module t_control_array_integer2 contains ! ! -------------------------------------------------------------------- +! + subroutine init_integer2_ctl_item_label(label, int2_item) + character(len=kchara), intent(in) :: label + type(read_int2_item), intent(inout) :: int2_item +! + int2_item%item_name = trim(label) + end subroutine init_integer2_ctl_item_label +! +! -------------------------------------------------------------------- ! subroutine read_integer2_ctl_type(c_buf, label, int2_item) ! @@ -87,7 +102,9 @@ subroutine read_integer2_ctl_type(c_buf, label, int2_item) character(len=kchara) :: tmpchara ! ! - if(int2_item%iflag.gt.0 .or. c_buf%header_chara.ne.label) return + if(int2_item%iflag.gt.0) return + int2_item%item_name = trim(label) + if(c_buf%header_chara.ne.label) return ! read(c_buf%ctl_buffer,*) tmpchara, int2_item%intvalue(1:2) if (iflag_debug .gt. 0) write(*,'(a,a2,2i6)') & @@ -99,18 +116,18 @@ end subroutine read_integer2_ctl_type ! -------------------------------------------------------------------- ! subroutine write_integer2_ctl_type & - & (id_file, level, maxlen, label, int2_item) + & (id_file, level, maxlen, int2_item) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_file, level integer(kind = kint), intent(in) :: maxlen - character(len=kchara), intent(in) :: label type(read_int2_item), intent(in) :: int2_item ! ! if(int2_item%iflag .eq. 0) return - call write_integer2_ctl_item(id_file, level, maxlen, label, & + call write_integer2_ctl_item & + & (id_file, level, maxlen, int2_item%item_name, & & int2_item%intvalue(1), int2_item%intvalue(2)) ! end subroutine write_integer2_ctl_type @@ -122,6 +139,7 @@ subroutine copy_integer2_ctl(org_i2, new_i2) type(read_int2_item), intent(in) :: org_i2 type(read_int2_item), intent(inout) :: new_i2 ! + new_i2%item_name = org_i2%item_name new_i2%iflag = org_i2%iflag new_i2%intvalue(1:2) = org_i2%intvalue(1:2) ! @@ -159,6 +177,15 @@ end subroutine dealloc_control_array_i2 ! ! -------------------------------------------------------------------- ! -------------------------------------------------------------------- +! + subroutine init_int2_ctl_array_label(label, array_i2) + character(len=kchara), intent(in) :: label + type(ctl_array_i2), intent(inout) :: array_i2 +! + array_i2%array_name = trim(label) + end subroutine init_int2_ctl_array_label +! +! -------------------------------------------------------------------- ! subroutine read_control_array_i2 & & (id_control, label, array_i2, c_buf) @@ -173,15 +200,17 @@ subroutine read_control_array_i2 & type(read_int2_item) :: read_i2 ! ! - if(check_array_flag(c_buf, label) .eqv. .FALSE.) return if(array_i2%icou .gt. 0) return + array_i2%array_name = trim(label) + if(check_array_flag(c_buf, label) .eqv. .FALSE.) return ! read_i2%iflag = 0 array_i2%num = 0 call alloc_control_array_i2(array_i2) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, label)) exit ! if(c_buf%header_chara.eq.label) then @@ -195,13 +224,12 @@ end subroutine read_control_array_i2 ! -------------------------------------------------------------------- ! subroutine write_control_array_i2 & - & (id_control, level, label, array_i2) + & (id_control, level, array_i2) ! use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: label type(ctl_array_i2), intent(in) :: array_i2 ! integer(kind = kint), intent(inout) :: level @@ -210,14 +238,16 @@ subroutine write_control_array_i2 & ! ! if(array_i2%num .le. 0) return - write(id_control,'(a1)') '!' ! - level = write_array_flag_for_ctl(id_control, level, label) + level = write_array_flag_for_ctl(id_control, level, & + & array_i2%array_name) do i = 1, array_i2%num call write_integer2_ctl_item(id_control, level, & - & len_trim(label), label, array_i2%int1(i), array_i2%int2(i)) + & len_trim(array_i2%array_name), array_i2%array_name, & + & array_i2%int1(i), array_i2%int2(i)) end do - level = write_end_array_flag_for_ctl(id_control, level, label) + level = write_end_array_flag_for_ctl(id_control, level, & + & array_i2%array_name) ! end subroutine write_control_array_i2 ! @@ -269,9 +299,11 @@ subroutine copy_control_array_i2(num_copy, org_i2, tgt_i2) type(ctl_array_i2), intent(in) :: org_i2 type(ctl_array_i2), intent(inout) :: tgt_i2 ! +! + tgt_i2%array_name = org_i2%array_name + tgt_i2%icou = org_i2%icou ! if(num_copy .le. 0) return - tgt_i2%icou = org_i2%icou tgt_i2%int1(1:num_copy) = org_i2%int1(1:num_copy) tgt_i2%int2(1:num_copy) = org_i2%int2(1:num_copy) ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_integer3.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_integer3.f90 index d285e615..ac52e4e9 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_integer3.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_integer3.f90 @@ -11,7 +11,7 @@ !! type(buffer_for_control), intent(in) :: c_buf !! type(read_int3_item), intent(inout) :: int3_item !! subroutine write_integer3_ctl_type & -!! & (id_control, level, maxlen, label, int3_item) +!! & (id_control, level, maxlen, int3_item) !! type(read_int3_item), intent(in) :: int3_item !! subroutine copy_integer3_ctl(org_i3, new_i3) !! type(read_int3_item), intent(in) :: org_i3 @@ -23,7 +23,7 @@ !! & (id_control, label, array_i3, c_buf) !! type(ctl_array_i3), intent(inout) :: array_i3 !! subroutine write_control_array_i3 & -!! & (id_control, level, label, array_i3) +!! & (id_control, level, array_i3) !! type(ctl_array_i3), intent(in) :: array_i3 !! !! subroutine append_control_array_i3(read_i3, array_i3) @@ -51,6 +51,8 @@ module t_control_array_integer3 ! !> structure of control item with three integers type read_int3_item +!> Item name + character(len=kchara) :: item_name = 'integer_item' !> read flag (If item is read iflag = 1) integer(kind = kint) :: iflag = 0 !> array for read integer items @@ -59,6 +61,8 @@ module t_control_array_integer3 ! !> Structure for 2 integers control array type ctl_array_i3 +!> Item name + character(len=kchara) :: array_name = 'integer_array' !> number of array items integer(kind=kint) :: num = 0 !> array counter @@ -86,7 +90,10 @@ subroutine read_integer3_ctl_type(c_buf, label, int3_item) character(len=kchara) :: tmpchara ! ! - if(int3_item%iflag.gt.0 .or. c_buf%header_chara.ne.label) return +! + if(int3_item%iflag.gt.0) return + int3_item%item_name = trim(label) + if(c_buf%header_chara.ne.label) return ! read(c_buf%ctl_buffer,*) tmpchara, int3_item%intvalue(1:3) if (iflag_debug .gt. 0) write(*,'(a,a2,3i6)') & @@ -98,18 +105,17 @@ end subroutine read_integer3_ctl_type ! -------------------------------------------------------------------- ! subroutine write_integer3_ctl_type & - & (id_control, level, maxlen, label, int3_item) + & (id_control, level, maxlen, int3_item) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_control, level, maxlen - character(len=kchara), intent(in) :: label type(read_int3_item), intent(in) :: int3_item ! if(int3_item%iflag .eq. 0) return - call write_integer3_ctl_item(id_control, level, maxlen, label, & - & int3_item%intvalue(1), int3_item%intvalue(2), & - & int3_item%intvalue(3)) + call write_integer3_ctl_item(id_control, level, maxlen, & + & int3_item%item_name, int3_item%intvalue(1), & + & int3_item%intvalue(2), int3_item%intvalue(3)) ! end subroutine write_integer3_ctl_type ! @@ -120,6 +126,7 @@ subroutine copy_integer3_ctl(org_i3, new_i3) type(read_int3_item), intent(in) :: org_i3 type(read_int3_item), intent(inout) :: new_i3 ! + new_i3%item_name = org_i3%item_name new_i3%iflag = org_i3%iflag new_i3%intvalue(1:3) = org_i3%intvalue(1:3) ! @@ -173,15 +180,17 @@ subroutine read_control_array_i3 & type(read_int3_item) :: read_i3 ! ! - if(check_array_flag(c_buf, label) .eqv. .FALSE.) return if(array_i3%icou .gt. 0) return + array_i3%array_name = trim(label) + if(check_array_flag(c_buf, label) .eqv. .FALSE.) return ! read_i3%iflag = 0 array_i3%num = 0 call alloc_control_array_i3(array_i3) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, label)) exit ! if(c_buf%header_chara.eq.label) then @@ -195,12 +204,11 @@ end subroutine read_control_array_i3 ! -------------------------------------------------------------------- ! subroutine write_control_array_i3 & - & (id_control, level, label, array_i3) + & (id_control, level, array_i3) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: label type(ctl_array_i3), intent(in) :: array_i3 ! integer(kind = kint), intent(inout) :: level @@ -209,15 +217,16 @@ subroutine write_control_array_i3 & ! ! if(array_i3%num .le. 0) return - write(id_control,'(a1)') '!' ! - level = write_array_flag_for_ctl(id_control, level, label) + level = write_array_flag_for_ctl(id_control, level, & + & array_i3%array_name) do i = 1, array_i3%num - call write_integer3_ctl_item & - & (id_control, level, len_trim(label), label, & + call write_integer3_ctl_item(id_control, level, & + & len_trim(array_i3%array_name), array_i3%array_name, & & array_i3%int1(i), array_i3%int2(i), array_i3%int3(i)) end do - level = write_end_array_flag_for_ctl(id_control, level, label) + level = write_end_array_flag_for_ctl(id_control, level, & + & array_i3%array_name) ! end subroutine write_control_array_i3 ! @@ -269,9 +278,10 @@ subroutine copy_control_array_i3(num_copy, org_i3, tgt_i3) type(ctl_array_i3), intent(in) :: org_i3 type(ctl_array_i3), intent(inout) :: tgt_i3 ! + tgt_i3%array_name = org_i3%array_name + tgt_i3%icou = org_i3%icou ! if(num_copy .le. 0) return - tgt_i3%icou = org_i3%icou tgt_i3%int1(1:num_copy) = org_i3%int1(1:num_copy) tgt_i3%int2(1:num_copy) = org_i3%int2(1:num_copy) tgt_i3%int3(1:num_copy) = org_i3%int3(1:num_copy) diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_intreal.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_intreal.f90 index 2e7b0f67..65f15d79 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_intreal.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_intreal.f90 @@ -7,11 +7,12 @@ !>@brief Subroutines to read control arrays !! !!@verbatim +!! subroutine init_intreal_ctl_item_label(label, ir_item) !! subroutine read_intreal_ctl_type(c_buf, label, ir_item) !! type(buffer_for_control), intent(in) :: c_buf !! type(read_int_real_item), intent(inout) :: ir_item !! subroutine write_intreal_ctl_type & -!! & (id_file, level, maxlen, label, ir_item) +!! & (id_file, level, maxlen, ir_item) !! type(read_int_real_item), intent(in) :: ir_item !! subroutine copy_intreal_ctl(org_ir, new_ir) !! type(read_int_real_item), intent(in) :: org_ir @@ -19,12 +20,13 @@ !! !! subroutine alloc_control_array_i_r(array_ir) !! subroutine dealloc_control_array_i_r(array_ir) +!! subroutine init_i_r_array_label(label, array_ir) !! subroutine read_control_array_i_r & !! & (id_control, label, array_ir, c_buf) !! type(ctl_array_ir), intent(inout) :: array_ir !! type(buffer_for_control), intent(in) :: c_buf !! subroutine write_control_array_i_r & -!! & (id_control, level, label, array_ir) +!! & (id_control, level, array_ir) !! type(ctl_array_ir), intent(in) :: array_ir !! !! subroutine append_control_array_i_r(read_ir, array_ir) @@ -48,6 +50,8 @@ module t_control_array_intreal ! !> structure of control item with three characters type read_int_real_item +!> Item name + character(len=kchara) :: item_name = 'integer_item' !> read flag (If item is read iflag = 1) integer(kind = kint) :: iflag = 0 !> array for read integer items @@ -58,6 +62,8 @@ module t_control_array_intreal ! !> Structure for real and integer control array type ctl_array_ir +!> Item name + character(len=kchara) :: array_name = 'integer_array' !> number of array items integer(kind=kint) :: num = 0 !> array counter @@ -73,6 +79,15 @@ module t_control_array_intreal contains ! ! -------------------------------------------------------------------- +! + subroutine init_intreal_ctl_item_label(label, ir_item) + character(len=kchara), intent(in) :: label + type(read_int_real_item), intent(inout) :: ir_item +! + ir_item%item_name = trim(label) + end subroutine init_intreal_ctl_item_label +! +! -------------------------------------------------------------------- ! subroutine read_intreal_ctl_type(c_buf, label, ir_item) ! @@ -85,7 +100,9 @@ subroutine read_intreal_ctl_type(c_buf, label, ir_item) character(len=kchara) :: tmpchara ! ! - if(ir_item%iflag.gt.0 .or. c_buf%header_chara.ne.label) return + if(ir_item%iflag.gt.0) return + ir_item%item_name = trim(label) + if(c_buf%header_chara.ne.label) return ! read(c_buf%ctl_buffer,*) tmpchara, ir_item%intvalue, & & ir_item%realvalue @@ -100,19 +117,18 @@ end subroutine read_intreal_ctl_type ! -------------------------------------------------------------------- ! subroutine write_intreal_ctl_type & - & (id_file, level, maxlen, label, ir_item) + & (id_file, level, maxlen, ir_item) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_file, level, maxlen - character(len=kchara), intent(in) :: label type(read_int_real_item), intent(in) :: ir_item ! ! if(ir_item%iflag .eq. 0) return ! - call write_int_real_ctl_item(id_file, level, maxlen, label, & - & ir_item%intvalue, ir_item%realvalue) + call write_int_real_ctl_item(id_file, level, maxlen, & + & ir_item%item_name, ir_item%intvalue, ir_item%realvalue) ! end subroutine write_intreal_ctl_type ! @@ -124,6 +140,7 @@ subroutine copy_intreal_ctl(org_ir, new_ir) type(read_int_real_item), intent(inout) :: new_ir ! ! + new_ir%item_name = org_ir%item_name new_ir%iflag = org_ir%iflag new_ir%intvalue = org_ir%intvalue new_ir%realvalue = org_ir%realvalue @@ -162,6 +179,15 @@ end subroutine dealloc_control_array_i_r ! ! -------------------------------------------------------------------- ! -------------------------------------------------------------------- +! + subroutine init_i_r_array_label(label, array_ir) + character(len=kchara), intent(in) :: label + type(ctl_array_ir), intent(inout) :: array_ir +! + array_ir%array_name = trim(label) + end subroutine init_i_r_array_label +! +! -------------------------------------------------------------------- ! subroutine read_control_array_i_r & & (id_control, label, array_ir, c_buf) @@ -176,15 +202,17 @@ subroutine read_control_array_i_r & type(read_int_real_item) :: read_ir ! ! - if(check_array_flag(c_buf, label) .eqv. .FALSE.) return if(array_ir%icou .gt. 0) return + array_ir%array_name = trim(label) + if(check_array_flag(c_buf, label) .eqv. .FALSE.) return ! read_ir%iflag = 0 array_ir%num = 0 call alloc_control_array_i_r(array_ir) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, label)) exit ! if(c_buf%header_chara.eq.label) then @@ -198,13 +226,12 @@ end subroutine read_control_array_i_r ! -------------------------------------------------------------------- ! subroutine write_control_array_i_r & - & (id_control, level, label, array_ir) + & (id_control, level, array_ir) ! use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: label type(ctl_array_ir), intent(in) :: array_ir ! integer(kind = kint), intent(inout) :: level @@ -213,15 +240,16 @@ subroutine write_control_array_i_r & ! ! if(array_ir%num .le. 0) return - write(id_control,'(a1)') '!' ! - level = write_array_flag_for_ctl(id_control, level, label) + level = write_array_flag_for_ctl(id_control, level, & + & array_ir%array_name) do i = 1, array_ir%num - call write_int_real_ctl_item & - & (id_control, level, len_trim(label), label, & + call write_int_real_ctl_item(id_control, level, & + & len_trim(array_ir%array_name), array_ir%array_name, & & array_ir%ivec(i), array_ir%vect(i)) end do - level = write_end_array_flag_for_ctl(id_control, level, label) + level = write_end_array_flag_for_ctl(id_control, level, & + & array_ir%array_name) ! end subroutine write_control_array_i_r ! @@ -259,9 +287,10 @@ subroutine copy_control_array_i_r(num_copy, org_ir, tgt_ir) type(ctl_array_ir), intent(in) :: org_ir type(ctl_array_ir), intent(inout) :: tgt_ir ! + tgt_ir%array_name = org_ir%array_name + tgt_ir%icou = org_ir%icou ! if(num_copy .le. 0) return - tgt_ir%icou = org_ir%icou tgt_ir%ivec(1:num_copy) = org_ir%ivec(1:num_copy) tgt_ir%vect(1:num_copy) = org_ir%vect(1:num_copy) ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_real.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_real.f90 index 81fd6f3a..f7fefdfc 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_real.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_real.f90 @@ -7,24 +7,28 @@ !>@brief Subroutines to read control arrays !! !!@verbatim +!! subroutine init_real_ctl_item_label(label, real_item) !! subroutine read_real_ctl_type(c_buf, label, real_item) !! type(buffer_for_control), intent(in) :: c_buf !! type(read_real_item), intent(inout) :: real_item !! subroutine write_real_ctl_type & -!! & (id_file, level, maxlen, label, real_item) +!! & (id_file, level, maxlen, real_item) !! type(read_real_item), intent(in) :: real_item !! subroutine copy_real_ctl(org_r1, new_r1) !! type(read_real_item), intent(in) :: org_r1 !! type(read_real_item), intent(inout) :: new_r1 +!! logical function cmp_read_real_item(r_item1, r_item2) +!! type(read_real_item), intent(in) :: r_item1, r_item2 !! !! subroutine alloc_control_array_real(array_real) !! subroutine dealloc_control_array_real(array_real) +!! subroutine init_real_ctl_array_label(label, array_real) !! subroutine read_control_array_r1 & !! & (id_control, label, array_real, c_buf) !! type(ctl_array_real), intent(inout) :: array_real !! type(buffer_for_control), intent(in) :: c_buf !! subroutine write_control_array_r1 & -!! & (id_control, level, label, array_real) +!! & (id_control, level, array_real) !! type(ctl_array_real), intent(in) :: array_real !! !! subroutine append_control_array_real(read_r1, array_r1) @@ -48,6 +52,8 @@ module t_control_array_real ! !> structure of control real item type read_real_item +!> Item name + character(len=kchara) :: item_name = 'Real_item' !> read flag (If item is read iflag = 1) integer(kind = kint) :: iflag = 0 !> array for read real item @@ -56,6 +62,8 @@ module t_control_array_real ! !> Structure for real control array type ctl_array_real +!> Item name + character(len=kchara) :: array_name = 'Real_array' !> number of array items integer(kind=kint) :: num = 0 !> array counter @@ -69,6 +77,15 @@ module t_control_array_real contains ! ! -------------------------------------------------------------------- +! + subroutine init_real_ctl_item_label(label, real_item) + character(len=kchara), intent(in) :: label + type(read_real_item), intent(inout) :: real_item +! + real_item%item_name = trim(label) + end subroutine init_real_ctl_item_label +! +! ---------------------------------------------------------------------- ! subroutine read_real_ctl_type(c_buf, label, real_item) ! @@ -81,7 +98,9 @@ subroutine read_real_ctl_type(c_buf, label, real_item) character(len=kchara) :: tmpchara ! ! - if(real_item%iflag.gt.0 .or. c_buf%header_chara.ne.label) return + if(real_item%iflag .gt. 0) return + real_item%item_name = trim(label) + if(c_buf%header_chara.ne.label) return ! read(c_buf%ctl_buffer,*) tmpchara, real_item%realvalue if (iflag_debug .gt. 0) write(*,*) trim(c_buf%header_chara), & @@ -93,19 +112,18 @@ end subroutine read_real_ctl_type ! -------------------------------------------------------------------- ! subroutine write_real_ctl_type & - & (id_file, level, maxlen, label, real_item) + & (id_file, level, maxlen, real_item) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_file, level integer(kind = kint), intent(in) :: maxlen - character(len=kchara), intent(in) :: label type(read_real_item), intent(in) :: real_item ! ! if(real_item%iflag .eq. 0) return - call write_real_ctl_item & - & (id_file, level, maxlen, label, real_item%realvalue) + call write_real_ctl_item(id_file, level, maxlen, & + & real_item%item_name, real_item%realvalue) ! end subroutine write_real_ctl_type ! @@ -117,12 +135,34 @@ subroutine copy_real_ctl(org_r1, new_r1) type(read_real_item), intent(inout) :: new_r1 ! ! + new_r1%item_name = org_r1%item_name new_r1%iflag = org_r1%iflag new_r1%realvalue = org_r1%realvalue ! end subroutine copy_real_ctl ! ! -------------------------------------------------------------------- +! + logical function cmp_read_real_item(r_item1, r_item2) +! + use skip_comment_f +! + type(read_real_item), intent(in) :: r_item1, r_item2 +! + cmp_read_real_item = .FALSE. + if(cmp_no_case(trim(r_item1%item_name), & + & trim(r_item2%item_name)) .eqv. .FALSE.) return + if(r_item1%iflag .ne. r_item2%iflag) return +! + if(r_item1%iflag .gt. 0) then + if(r_item1%realvalue .ne. r_item2%realvalue) return + end if +! + cmp_read_real_item = .TRUE. +! + end function cmp_read_real_item +! +! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine alloc_control_array_real(array_real) @@ -152,6 +192,15 @@ end subroutine dealloc_control_array_real ! ! -------------------------------------------------------------------- ! -------------------------------------------------------------------- +! + subroutine init_real_ctl_array_label(label, array_real) + character(len=kchara), intent(in) :: label + type(ctl_array_real), intent(inout) :: array_real +! + array_real%array_name = trim(label) + end subroutine init_real_ctl_array_label +! +! -------------------------------------------------------------------- ! subroutine read_control_array_r1 & & (id_control, label, array_real, c_buf) @@ -166,15 +215,17 @@ subroutine read_control_array_r1 & type(read_real_item) :: read_r1 ! ! - if(check_array_flag(c_buf, label) .eqv. .FALSE.) return if(array_real%icou .gt. 0) return + array_real%array_name = trim(label) + if(check_array_flag(c_buf, label) .eqv. .FALSE.) return ! read_r1%iflag = 0 array_real%num = 0 call alloc_control_array_real(array_real) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, label)) exit ! if(c_buf%header_chara.eq.label) then @@ -188,13 +239,12 @@ end subroutine read_control_array_r1 ! -------------------------------------------------------------------- ! subroutine write_control_array_r1 & - & (id_control, level, label, array_real) + & (id_control, level, array_real) ! use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: label type(ctl_array_real), intent(in) :: array_real ! integer(kind = kint), intent(inout) :: level @@ -203,19 +253,41 @@ subroutine write_control_array_r1 & ! ! if(array_real%num .le. 0) return - write(id_control,'(a1)') '!' ! - level = write_array_flag_for_ctl(id_control, level, label) + level = write_array_flag_for_ctl(id_control, level, & + & array_real%array_name) do i = 1, array_real%num - length = len_trim(label) - call write_real_ctl_item(id_control, level, length, label, & - & array_real%vect(i)) + length = len_trim(array_real%array_name) + call write_real_ctl_item(id_control, level, length, & + & array_real%array_name, array_real%vect(i)) end do - level = write_end_array_flag_for_ctl(id_control, level, label) + level = write_end_array_flag_for_ctl(id_control, level, & + & array_real%array_name) ! end subroutine write_control_array_r1 ! ! -------------------------------------------------------------------- +! + logical function cmp_control_array_r1(r_array1, r_array2) +! + use skip_comment_f +! + type(ctl_array_real), intent(in) :: r_array1, r_array2 + integer(kind = kint) :: i +! + cmp_control_array_r1 = .FALSE. + if(cmp_no_case(trim(r_array1%array_name), & + & trim(r_array2%array_name)) .eqv. .FALSE.) return + if(r_array1%num .ne. r_array2%num) return + if(r_array1%icou .ne. r_array2%icou) return + do i = 1, r_array1%num + if(r_array1%vect(i) .ne. r_array2%vect(i)) return + end do + cmp_control_array_r1 = .TRUE. +! + end function cmp_control_array_r1 +! +! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine append_control_array_real(read_r1, array_r1) @@ -249,9 +321,10 @@ subroutine copy_control_array_real(num_copy, org_r1, tgt_r1) type(ctl_array_real), intent(in) :: org_r1 type(ctl_array_real), intent(inout) :: tgt_r1 ! + tgt_r1%array_name = org_r1%array_name + tgt_r1%icou = org_r1%icou ! if(num_copy .le. 0) return - tgt_r1%icou = org_r1%icou tgt_r1%vect(1:num_copy) = org_r1%vect(1:num_copy) ! end subroutine copy_control_array_real diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_real2.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_real2.f90 index 1f93e876..33d67df5 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_real2.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_real2.f90 @@ -7,25 +7,31 @@ !>@brief Subroutines to read control arrays !! !!@verbatim +!! subroutine init_real2_ctl_item_label(label, real2_item) !! subroutine read_real2_ctl_type(c_buf, label, real2_item) !! type(buffer_for_control), intent(in) :: c_buf !! type(read_real2_item), intent(inout) :: real2_item !! subroutine write_real2_ctl_type & -!! & (id_file, level, maxlen, label, real2_item) +!! & (id_file, level, maxlen, real2_item) !! type(read_real2_item), intent(in) :: real2_item !! subroutine copy_real2_ctl(org_r2, new_r2) !! type(read_real2_item), intent(inout) :: org_r2 !! type(read_real2_item), intent(inout) :: new_r2 +!! logical function cmp_read_real2_item(r2_item1, r2_item2) +!! type(read_real2_item), intent(in) :: r2_item1, r2_item2 !! !! subroutine alloc_control_array_r2(array_r2) !! subroutine dealloc_control_array_r2(array_r2) +!! subroutine init_r2_ctl_array_label(label, array_r2) !! subroutine read_control_array_r2 & !! & (id_control, label, array_r2, c_buf) !! type(ctl_array_r2), intent(inout) :: array_r2 !! type(buffer_for_control), intent(in) :: c_buf !! subroutine write_control_array_r2 & -!! & (id_control, level, label, array_r2) +!! & (id_control, level, array_r2) !! type(ctl_array_r2), intent(in) :: array_r2 +!! logical function cmp_control_array_r2(r2_array1, r2_array2) +!! type(ctl_array_r2), intent(in) :: r2_array1, r2_array2 !! !! subroutine append_control_array_r2(read_r2, array_r2) !! type(read_real2_item), intent(inout) :: read_r2 @@ -49,6 +55,8 @@ module t_control_array_real2 ! !> structure of control item with two reals type read_real2_item +!> Item name + character(len=kchara) :: item_name = 'Real_item' !> read flag (If item is read iflag = 1) integer(kind = kint) :: iflag = 0 !> array for read real items @@ -57,6 +65,8 @@ module t_control_array_real2 ! !> Structure for two reals control array type ctl_array_r2 +!> Item name + character(len=kchara) :: array_name = 'Real_array' !> number of array items integer(kind=kint) :: num = 0 !> array counter @@ -72,6 +82,15 @@ module t_control_array_real2 contains ! ! -------------------------------------------------------------------- +! + subroutine init_real2_ctl_item_label(label, real2_item) + character(len=kchara), intent(in) :: label + type(read_real2_item), intent(inout) :: real2_item +! + real2_item%item_name = trim(label) + end subroutine init_real2_ctl_item_label +! +! -------------------------------------------------------------------- ! subroutine read_real2_ctl_type(c_buf, label, real2_item) ! @@ -84,7 +103,10 @@ subroutine read_real2_ctl_type(c_buf, label, real2_item) character(len=kchara) :: tmpchara ! ! - if(real2_item%iflag.gt.0 .or. c_buf%header_chara.ne.label) return +! + if(real2_item%iflag .gt. 0) return + real2_item%item_name = trim(label) + if(c_buf%header_chara.ne.label) return ! read(c_buf%ctl_buffer,*) tmpchara, real2_item%realvalue(1:2) if (iflag_debug .gt. 0) write(*,'(a,a2,1p3e16.7)') & @@ -96,18 +118,18 @@ end subroutine read_real2_ctl_type ! -------------------------------------------------------------------- ! subroutine write_real2_ctl_type & - & (id_file, level, maxlen, label, real2_item) + & (id_file, level, maxlen, real2_item) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_file, level - character(len=kchara), intent(in) :: label integer(kind = kint), intent(in) :: maxlen type(read_real2_item), intent(in) :: real2_item ! ! if(real2_item%iflag .eq. 0) return - call write_real2_ctl_item(id_file, level, maxlen, label, & + call write_real2_ctl_item & + & (id_file, level, maxlen, real2_item%item_name, & & real2_item%realvalue(1), real2_item%realvalue(2)) ! end subroutine write_real2_ctl_type @@ -120,12 +142,35 @@ subroutine copy_real2_ctl(org_r2, new_r2) type(read_real2_item), intent(inout) :: new_r2 ! ! + new_r2%item_name = org_r2%item_name new_r2%iflag = org_r2%iflag new_r2%realvalue(1:2) = org_r2%realvalue(1:2) ! end subroutine copy_real2_ctl ! ! -------------------------------------------------------------------- +! + logical function cmp_read_real2_item(r2_item1, r2_item2) +! + use skip_comment_f +! + type(read_real2_item), intent(in) :: r2_item1, r2_item2 +! + cmp_read_real2_item = .FALSE. + if(cmp_no_case(trim(r2_item1%item_name), & + & trim(r2_item2%item_name)) .eqv. .FALSE.) return + if(r2_item1%iflag .ne. r2_item2%iflag) return +! + if(r2_item1%iflag .gt. 0) then + if(r2_item1%realvalue(1) .ne. r2_item2%realvalue(1)) return + if(r2_item1%realvalue(2) .ne. r2_item2%realvalue(2)) return + end if +! + cmp_read_real2_item = .TRUE. +! + end function cmp_read_real2_item +! +! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine alloc_control_array_r2(array_r2) @@ -157,6 +202,15 @@ end subroutine dealloc_control_array_r2 ! ! -------------------------------------------------------------------- ! -------------------------------------------------------------------- +! + subroutine init_r2_ctl_array_label(label, array_r2) + character(len=kchara), intent(in) :: label + type(ctl_array_r2), intent(inout) :: array_r2 +! + array_r2%array_name = trim(label) + end subroutine init_r2_ctl_array_label +! +! -------------------------------------------------------------------- ! subroutine read_control_array_r2 & & (id_control, label, array_r2, c_buf) @@ -171,15 +225,17 @@ subroutine read_control_array_r2 & type(read_real2_item) :: read_r2 ! ! - if(check_array_flag(c_buf, label) .eqv. .FALSE.) return if(array_r2%icou .gt. 0) return + array_r2%array_name = trim(label) + if(check_array_flag(c_buf, label) .eqv. .FALSE.) return ! read_r2%iflag = 0 array_r2%num = 0 call alloc_control_array_r2(array_r2) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, label)) exit ! if(c_buf%header_chara.eq.label) then @@ -193,13 +249,12 @@ end subroutine read_control_array_r2 ! -------------------------------------------------------------------- ! subroutine write_control_array_r2 & - & (id_control, level, label, array_r2) + & (id_control, level, array_r2) ! use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: label type(ctl_array_r2), intent(in) :: array_r2 ! integer(kind = kint), intent(inout) :: level @@ -208,18 +263,42 @@ subroutine write_control_array_r2 & ! ! if(array_r2%num .le. 0) return - write(id_control,'(a1)') '!' ! - level = write_array_flag_for_ctl(id_control, level, label) + level = write_array_flag_for_ctl(id_control, level, & + & array_r2%array_name) do i = 1, array_r2%num - call write_real2_ctl_item(id_control, level, len_trim(label), & - & label, array_r2%vec1(i), array_r2%vec2(i)) + call write_real2_ctl_item & + & (id_control, level, len_trim(array_r2%array_name), & + & array_r2%array_name, array_r2%vec1(i), array_r2%vec2(i)) end do - level = write_end_array_flag_for_ctl(id_control, level, label) + level = write_end_array_flag_for_ctl(id_control, level, & + & array_r2%array_name) ! end subroutine write_control_array_r2 ! ! -------------------------------------------------------------------- +! + logical function cmp_control_array_r2(r2_array1, r2_array2) +! + use skip_comment_f +! + type(ctl_array_r2), intent(in) :: r2_array1, r2_array2 + integer(kind = kint) :: i +! + cmp_control_array_r2 = .FALSE. + if(cmp_no_case(trim(r2_array1%array_name), & + & trim(r2_array2%array_name)) .eqv. .FALSE.) return + if(r2_array1%num .ne. r2_array2%num) return + if(r2_array1%icou .ne. r2_array2%icou) return + do i = 1, r2_array1%num + if(r2_array1%vec1(i) .ne. r2_array2%vec1(i)) return + if(r2_array1%vec2(i) .ne. r2_array2%vec2(i)) return + end do + cmp_control_array_r2 = .TRUE. +! + end function cmp_control_array_r2 +! +! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine append_control_array_r2(read_r2, array_r2) @@ -267,9 +346,10 @@ subroutine copy_control_array_r2(num_copy, org_r2, tgt_r2) type(ctl_array_r2), intent(in) :: org_r2 type(ctl_array_r2), intent(inout) :: tgt_r2 ! + tgt_r2%array_name = org_r2%array_name + tgt_r2%icou = org_r2%icou ! if(num_copy .le. 0) return - tgt_r2%icou = org_r2%icou tgt_r2%vec1(1:num_copy) = org_r2%vec1(1:num_copy) tgt_r2%vec2(1:num_copy) = org_r2%vec2(1:num_copy) ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_real3.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_real3.f90 index de322c9f..87b172d8 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_control_array_real3.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_control_array_real3.f90 @@ -7,25 +7,31 @@ !>@brief Subroutines to read control arrays !! !!@verbatim +!! subroutine init_real3_ctl_item_label(label, real3_item) !! subroutine read_real3_ctl_type(c_buf, label, real3_item) !! type(buffer_for_control), intent(in) :: c_buf !! type(read_real3_item), intent(inout) :: real3_item !! subroutine write_real3_ctl_type & -!! & (id_file, level, maxlen, label, real3_item) +!! & (id_file, level, maxlen, real3_item) !! type(read_real3_item), intent(in) :: real3_item !! subroutine copy_real3_ctl(org_r3, new_r3) !! type(read_real3_item), intent(in) :: org_r3 !! type(read_real3_item), intent(inout) :: new_r3 +!! logical function cmp_read_real3_item(r3_item1, r3_item2) +!! type(read_real3_item), intent(in) :: r3_item1, r3_item2 !! !! subroutine alloc_control_array_r3(array_r3) !! subroutine dealloc_control_array_r3(array_r3) +!! subroutine init_r3_ctl_array_label(label, array_r3) !! subroutine read_control_array_r3 & !! & (id_control, label, array_r3, c_buf) !! type(ctl_array_r3), intent(inout) :: array_r3 !! type(buffer_for_control), intent(in) :: c_buf !! subroutine write_control_array_r3 & -!! & (id_control, level, label, array_r3) +!! & (id_control, level, array_r3) !! type(ctl_array_r3), intent(in) :: array_r3 +!! logical function cmp_control_array_r3(r3_array1, r3_array2) +!! type(ctl_array_r3), intent(in) :: r3_array1, r3_array2 !! !! subroutine append_control_array_r3(read_r3, array_r3) !! type(read_real3_item), intent(inout) :: read_r3 @@ -51,6 +57,8 @@ module t_control_array_real3 ! !> structure of control item with three reals type read_real3_item +!> Item name + character(len=kchara) :: item_name = 'Real_item' !> read flag (If item is read iflag = 1) integer(kind = kint) :: iflag = 0 !> array for read real items @@ -59,6 +67,8 @@ module t_control_array_real3 ! !> Structure for three reals control array type ctl_array_r3 +!> Item name + character(len=kchara) :: array_name = 'Real_array' !> number of array items integer(kind=kint) :: num = 0 !> array counter @@ -76,6 +86,15 @@ module t_control_array_real3 contains ! ! -------------------------------------------------------------------- +! + subroutine init_real3_ctl_item_label(label, real3_item) + character(len=kchara), intent(in) :: label + type(read_real3_item), intent(inout) :: real3_item +! + real3_item%item_name = trim(label) + end subroutine init_real3_ctl_item_label +! +! ---------------------------------------------------------------------- ! subroutine read_real3_ctl_type(c_buf, label, real3_item) ! @@ -88,7 +107,9 @@ subroutine read_real3_ctl_type(c_buf, label, real3_item) character(len=kchara) :: tmpchara ! ! - if(real3_item%iflag.gt.0 .or. c_buf%header_chara.ne.label) return + if(real3_item%iflag.gt.0) return + real3_item%item_name = trim(label) + if(c_buf%header_chara.ne.label) return ! read(c_buf%ctl_buffer,*) tmpchara, real3_item%realvalue(1:3) if (iflag_debug .gt. 0) write(*,'(a,a2,1p3e16.7)') & @@ -100,20 +121,19 @@ end subroutine read_real3_ctl_type ! -------------------------------------------------------------------- ! subroutine write_real3_ctl_type & - & (id_file, level, maxlen, label, real3_item) + & (id_file, level, maxlen, real3_item) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_file, level integer(kind = kint), intent(in) :: maxlen - character(len=kchara), intent(in) :: label type(read_real3_item), intent(in) :: real3_item ! ! if(real3_item%iflag .eq. 0) return - call write_real3_ctl_item(id_file, level, maxlen, label, & - & real3_item%realvalue(1), real3_item%realvalue(2), & - & real3_item%realvalue(3)) + call write_real3_ctl_item(id_file, level, maxlen, & + & real3_item%item_name, real3_item%realvalue(1), & + & real3_item%realvalue(2), real3_item%realvalue(3)) ! end subroutine write_real3_ctl_type ! @@ -125,12 +145,36 @@ subroutine copy_real3_ctl(org_r3, new_r3) type(read_real3_item), intent(inout) :: new_r3 ! ! + new_r3%item_name = org_r3%item_name new_r3%iflag = org_r3%iflag new_r3%realvalue(1:3) = org_r3%realvalue(1:3) ! end subroutine copy_real3_ctl ! ! -------------------------------------------------------------------- +! + logical function cmp_read_real3_item(r3_item1, r3_item2) +! + use skip_comment_f +! + type(read_real3_item), intent(in) :: r3_item1, r3_item2 +! + cmp_read_real3_item = .FALSE. + if(cmp_no_case(trim(r3_item1%item_name), & + & trim(r3_item2%item_name)) .eqv. .FALSE.) return + if(r3_item1%iflag .ne. r3_item2%iflag) return +! + if(r3_item1%iflag .gt. 0) then + if(r3_item1%realvalue(1) .ne. r3_item2%realvalue(1)) return + if(r3_item1%realvalue(2) .ne. r3_item2%realvalue(2)) return + if(r3_item1%realvalue(3) .ne. r3_item2%realvalue(3)) return + end if +! + cmp_read_real3_item = .TRUE. +! + end function cmp_read_real3_item +! +! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine alloc_control_array_r3(array_r3) @@ -164,6 +208,15 @@ end subroutine dealloc_control_array_r3 ! ! -------------------------------------------------------------------- ! -------------------------------------------------------------------- +! + subroutine init_r3_ctl_array_label(label, array_r3) + character(len=kchara), intent(in) :: label + type(ctl_array_r3), intent(inout) :: array_r3 +! + array_r3%array_name = trim(label) + end subroutine init_r3_ctl_array_label +! +! -------------------------------------------------------------------- ! subroutine read_control_array_r3 & & (id_control, label, array_r3, c_buf) @@ -178,15 +231,17 @@ subroutine read_control_array_r3 & type(read_real3_item) :: read_r3 ! ! - if(check_array_flag(c_buf, label) .eqv. .FALSE.) return if(array_r3%icou .gt. 0) return + array_r3%array_name = trim(label) + if(check_array_flag(c_buf, label) .eqv. .FALSE.) return ! read_r3%iflag = 0 array_r3%num = 0 call alloc_control_array_r3(array_r3) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, label, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, label)) exit ! if(c_buf%header_chara.eq.label) then @@ -200,13 +255,12 @@ end subroutine read_control_array_r3 ! -------------------------------------------------------------------- ! subroutine write_control_array_r3 & - & (id_control, level, label, array_r3) + & (id_control, level, array_r3) ! use skip_comment_f use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: label type(ctl_array_r3), intent(in) :: array_r3 ! integer(kind = kint), intent(inout) :: level @@ -215,19 +269,44 @@ subroutine write_control_array_r3 & ! ! if(array_r3%num .le. 0) return - write(id_control,'(a1)') '!' ! - level = write_array_flag_for_ctl(id_control, level, label) + level = write_array_flag_for_ctl(id_control, level, & + & array_r3%array_name) do i = 1, array_r3%num call write_real3_ctl_item & - & (id_control, level, len_trim(label), label, & - & array_r3%vec1(i), array_r3%vec2(i), array_r3%vec3(i)) + & (id_control, level, len_trim(array_r3%array_name), & + & array_r3%array_name, array_r3%vec1(i), & + & array_r3%vec2(i), array_r3%vec3(i)) end do - level = write_end_array_flag_for_ctl(id_control, level, label) + level = write_end_array_flag_for_ctl(id_control, level, & + & array_r3%array_name) ! end subroutine write_control_array_r3 ! ! -------------------------------------------------------------------- +! + logical function cmp_control_array_r3(r3_array1, r3_array2) +! + use skip_comment_f +! + type(ctl_array_r3), intent(in) :: r3_array1, r3_array2 + integer(kind = kint) :: i +! + cmp_control_array_r3 = .FALSE. + if(cmp_no_case(trim(r3_array1%array_name), & + & trim(r3_array2%array_name)) .eqv. .FALSE.) return + if(r3_array1%num .ne. r3_array2%num) return + if(r3_array1%icou .ne. r3_array2%icou) return + do i = 1, r3_array1%num + if(r3_array1%vec1(i) .ne. r3_array2%vec1(i)) return + if(r3_array1%vec2(i) .ne. r3_array2%vec2(i)) return + if(r3_array1%vec3(i) .ne. r3_array2%vec3(i)) return + end do + cmp_control_array_r3 = .TRUE. +! + end function cmp_control_array_r3 +! +! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! subroutine append_control_array_r3(read_r3, array_r3) @@ -275,9 +354,10 @@ subroutine copy_control_array_r3(num_copy, org_r3, tgt_r3) type(ctl_array_r3), intent(in) :: org_r3 type(ctl_array_r3), intent(inout) :: tgt_r3 ! + tgt_r3%array_name = org_r3%array_name + tgt_r3%icou = org_r3%icou ! if(num_copy .le. 0) return - tgt_r3%icou = org_r3%icou tgt_r3%vec1(1:num_copy) = org_r3%vec1(1:num_copy) tgt_r3%vec2(1:num_copy) = org_r3%vec2(1:num_copy) tgt_r3%vec3(1:num_copy) = org_r3%vec3(1:num_copy) @@ -292,7 +372,7 @@ subroutine append_control_item_r3(read_r3, array_r3) type(ctl_array_r3), intent(inout) :: array_r3 ! ! - array_r3%icou = array_r3%icou + read_r3%iflag + array_r3%icou = array_r3%icou + read_r3%iflag array_r3%vec1(array_r3%num) = read_r3%realvalue(1) array_r3%vec2(array_r3%num) = read_r3%realvalue(2) array_r3%vec3(array_r3%num) = read_r3%realvalue(3) diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_FEM_mesh.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_FEM_mesh.f90 index 9128ea66..f4f6f65f 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_FEM_mesh.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_FEM_mesh.f90 @@ -7,10 +7,10 @@ !> @brief Control input routine for data file headers !! !!@verbatim +!! subroutine init_FEM_mesh_ctl_label(hd_block, Fmesh_ctl) !! subroutine read_FEM_mesh_control & !! & (id_control, hd_block, Fmesh_ctl, c_buf) -!! subroutine write_FEM_mesh_control & -!! & (id_control, hd_block, Fmesh_ctl, level) +!! subroutine write_FEM_mesh_control(id_control, Fmesh_ctl, level) !! subroutine reset_FEM_mesh_control(Fmesh_ctl) !! type(FEM_mesh_control), intent(inout) :: Fmesh_ctl !! subroutine copy_FEM_mesh_control(org_Fmesh_c, new_Fmesh_c) @@ -46,6 +46,9 @@ module t_ctl_data_4_FEM_mesh ! !> Structure of mesh IO controls and sleeve informations type FEM_mesh_control +!> Block name + character(len=kchara) :: block_name = 'FEM_mesh_ctl' +! type(read_character_item) :: memory_conservation_ctl type(read_character_item) :: FEM_mesh_output_switch type(read_character_item) :: FEM_surface_output_switch @@ -85,10 +88,12 @@ subroutine read_FEM_mesh_control & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(Fmesh_ctl%i_FEM_mesh .gt. 0) return + Fmesh_ctl%block_name = hd_block + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_chara_ctl_type(c_buf, hd_mem_conserve, & @@ -106,15 +111,13 @@ end subroutine read_FEM_mesh_control ! ! --------------------------------------------------------------------- ! - subroutine write_FEM_mesh_control & - & (id_control, hd_block, Fmesh_ctl, level) + subroutine write_FEM_mesh_control(id_control, Fmesh_ctl, level) ! use m_machine_parameter use t_read_control_elements use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(FEM_mesh_control), intent(in) :: Fmesh_ctl ! integer(kind = kint), intent(inout) :: level @@ -129,23 +132,44 @@ subroutine write_FEM_mesh_control & maxlen = max(maxlen, len_trim(hd_FEM_surf_output)) maxlen = max(maxlen, len_trim(hd_FEM_viewer_output)) ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! + level = write_begin_flag_for_ctl(id_control, level, & + & Fmesh_ctl%block_name) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_mem_conserve, Fmesh_ctl%memory_conservation_ctl) + & Fmesh_ctl%memory_conservation_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_FEM_mesh_output, Fmesh_ctl%FEM_mesh_output_switch) + & Fmesh_ctl%FEM_mesh_output_switch) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_FEM_surf_output, Fmesh_ctl%FEM_surface_output_switch) + & Fmesh_ctl%FEM_surface_output_switch) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_FEM_viewer_output, Fmesh_ctl%FEM_viewer_output_switch) + & Fmesh_ctl%FEM_viewer_output_switch) ! - level = write_end_flag_for_ctl(id_control, level, hd_block) + level = write_end_flag_for_ctl(id_control, level, & + & Fmesh_ctl%block_name) ! end subroutine write_FEM_mesh_control ! ! --------------------------------------------------------------------- +! + subroutine init_FEM_mesh_ctl_label(hd_block, Fmesh_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(FEM_mesh_control), intent(inout) :: Fmesh_ctl +! +! + Fmesh_ctl%block_name = hd_block +! + call init_chara_ctl_item_label(hd_mem_conserve, & + & Fmesh_ctl%memory_conservation_ctl) + call init_chara_ctl_item_label(hd_FEM_mesh_output, & + & Fmesh_ctl%FEM_mesh_output_switch) + call init_chara_ctl_item_label(hd_FEM_surf_output, & + & Fmesh_ctl%FEM_surface_output_switch) + call init_chara_ctl_item_label(hd_FEM_viewer_output, & + & Fmesh_ctl%FEM_viewer_output_switch) +! + end subroutine init_FEM_mesh_ctl_label +! +! --------------------------------------------------------------------- ! subroutine reset_FEM_mesh_control(Fmesh_ctl) ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_divide_sphere.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_divide_sphere.f90 index 2d6db82c..b1755ba6 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_divide_sphere.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_divide_sphere.f90 @@ -9,11 +9,12 @@ !!@verbatim !! subroutine dealloc_ndomain_rtp_ctl(sdctl) !! +!! subroutine init_ctl_shell_domain_label(hd_block, sdctl) !! subroutine read_control_shell_domain & !! & (id_control, hd_block, sdctl, c_buf) !! type(sphere_domain_control), intent(inout) :: sdctl -!! subroutine write_control_shell_domain & -!! & (id_file, hd_block, sdctl, level) +!! subroutine write_control_shell_domain(id_file, sdctl, level) +!! type(sphere_domain_control), intent(in) :: sdctl !! !! --------------------------------------------------------------------- !! example of control data @@ -67,6 +68,8 @@ module t_ctl_data_4_divide_sphere ! !> control data structure for spherical shell parallelization type sphere_domain_control +!> Block name + character(len=kchara) :: block_name = 'num_domain_ctl' !> Orsering set control type(read_character_item) :: indices_ordering_set ! @@ -177,10 +180,12 @@ subroutine read_control_shell_domain & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(sdctl%i_domains_sph .gt. 0) return + sdctl%block_name = hd_block + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! ! @@ -221,14 +226,12 @@ end subroutine read_control_shell_domain ! ! --------------------------------------------------------------------- ! - subroutine write_control_shell_domain & - & (id_file, hd_block, sdctl, level) + subroutine write_control_shell_domain(id_file, sdctl, level) ! use t_read_control_elements use write_control_elements ! integer(kind = kint), intent(in) :: id_file - character(len=kchara), intent(in) :: hd_block type(sphere_domain_control), intent(in) :: sdctl ! integer(kind = kint), intent(inout) :: level @@ -242,28 +245,70 @@ subroutine write_control_shell_domain & maxlen = max(maxlen, len_trim(hd_num_radial_domain)) maxlen = max(maxlen, len_trim(hd_num_horiz_domain)) ! - write(id_file,'(a1)') '!' - level = write_begin_flag_for_ctl(id_file, level, hd_block) + level = write_begin_flag_for_ctl(id_file, level,sdctl%block_name) ! call write_chara_ctl_type(id_file, level, maxlen, & - & hd_inner_decomp, sdctl%inner_decomp_ctl) + & sdctl%inner_decomp_ctl) ! call write_integer_ctl_type(id_file, level, maxlen, & - & hd_num_radial_domain, sdctl%num_radial_domain_ctl) + & sdctl%num_radial_domain_ctl) call write_integer_ctl_type(id_file, level, maxlen, & - & hd_num_horiz_domain, sdctl%num_horiz_domain_ctl) + & sdctl%num_horiz_domain_ctl) ! call write_control_array_c_i(id_file, level, & - & hd_ndomain_rtp, sdctl%ndomain_sph_grid_ctl) + & sdctl%ndomain_sph_grid_ctl) call write_control_array_c_i(id_file, level, & - & hd_ndomain_rtm, sdctl%ndomain_legendre_ctl) + & sdctl%ndomain_legendre_ctl) call write_control_array_c_i(id_file, level, & - & hd_ndomain_rj, sdctl%ndomain_spectr_ctl) + & sdctl%ndomain_spectr_ctl) ! - level = write_end_flag_for_ctl(id_file, level, hd_block) + level = write_end_flag_for_ctl(id_file, level, sdctl%block_name) ! end subroutine write_control_shell_domain ! ! --------------------------------------------------------------------- +! + subroutine init_ctl_shell_domain_label(hd_block, sdctl) +! + character(len=kchara), intent(in) :: hd_block + type(sphere_domain_control), intent(inout) :: sdctl +! +! + sdctl%block_name = hd_block +! + call init_chara_ctl_item_label & + & (hd_inner_decomp, sdctl%inner_decomp_ctl) +! + call init_chara_ctl_item_label & + & (hd_rj_inner_loop, sdctl%rj_inner_loop_ctl) + call init_chara_ctl_item_label & + & (hd_rlm_inner_loop, sdctl%rlm_inner_loop_ctl) + call init_chara_ctl_item_label & + & (hd_rtm_inner_loop, sdctl%rtm_inner_loop_ctl) + call init_chara_ctl_item_label & + & (hd_rtp_inner_loop, sdctl%rtp_inner_loop_ctl) + call init_chara_ctl_item_label & + & (hd_indices_ordering_set, sdctl%indices_ordering_set) +! + call init_chara_ctl_item_label & + & (hd_rlm_order_dist, sdctl%rlm_distibution_ctl) + call init_chara_ctl_item_label & + & (hd_simple_r_decomp, sdctl%simple_r_decomp_ctl) +! + call init_int_ctl_item_label & + & (hd_num_radial_domain, sdctl%num_radial_domain_ctl) + call init_int_ctl_item_label & + & (hd_num_horiz_domain, sdctl%num_horiz_domain_ctl) +! + call init_c_i_array_label & + & (hd_ndomain_rtp, sdctl%ndomain_sph_grid_ctl) + call init_c_i_array_label & + & (hd_ndomain_rtm, sdctl%ndomain_legendre_ctl) + call init_c_i_array_label & + & (hd_ndomain_rj, sdctl%ndomain_spectr_ctl) +! + end subroutine init_ctl_shell_domain_label +! +! --------------------------------------------------------------------- ! end module t_ctl_data_4_divide_sphere diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_fields.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_fields.f90 index 2e2dba12..52ebc3d5 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_fields.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_fields.f90 @@ -9,10 +9,14 @@ !!@verbatim !! subroutine dealloc_phys_control(fld_ctl) !! +!! subroutine init_phys_data_ctl_label(hd_block, fld_ctl) !! subroutine read_phys_data_control & !! & (id_control, hd_block, fld_ctl, c_buf) -!! subroutine write_phys_data_control & -!! & (id_control, hd_block, fld_ctl, level) +!! subroutine write_phys_data_control(id_control, fld_ctl, level) +!! integer(kind = kint), intent(in) :: id_control +!! character(len=kchara), intent(in) :: hd_block +!! type(field_control), intent(inout) :: fld_ctl +!! type(buffer_for_control), intent(inout) :: c_buf !! !! --------------------------------------------------------------------- !! @@ -72,6 +76,9 @@ module t_ctl_data_4_fields ! !> Structure of field information control type field_control +!> Control block name + character(len = kchara) :: block_name = 'phys_values_ctl' +! !> Structure for list of field !!@n field_ctl%icou: Read flag for 'nod_value_ctl' !!@n field_ctl%num: Number of field @@ -155,7 +162,8 @@ subroutine read_phys_data_control & if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(fld_ctl%i_phys_values .gt. 0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_c3 & @@ -174,37 +182,59 @@ end subroutine read_phys_data_control ! ! -------------------------------------------------------------------- ! - subroutine write_phys_data_control & - & (id_control, hd_block, fld_ctl, level) + subroutine write_phys_data_control(id_control, fld_ctl, level) ! use t_read_control_elements use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(field_control), intent(in) :: fld_ctl ! integer(kind = kint), intent(inout) :: level ! ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) + if(fld_ctl%i_phys_values .le. 0) return ! + level = write_begin_flag_for_ctl(id_control, level, & + & fld_ctl%block_name) call write_control_array_c3 & - & (id_control, level, hd_field_list, fld_ctl%field_ctl) + & (id_control, level, fld_ctl%field_ctl) ! call write_control_array_c1 & - & (id_control, level, hd_quad_field, fld_ctl%quad_phys) + & (id_control, level, fld_ctl%quad_phys) ! call write_control_array_c_i & - & (id_control, level, hd_scalar_field, fld_ctl%scalar_phys) + & (id_control, level, fld_ctl%scalar_phys) call write_control_array_c_i3 & - & (id_control, level, hd_vector_field, fld_ctl%vector_phys) + & (id_control, level, fld_ctl%vector_phys) ! - level = write_end_flag_for_ctl(id_control, level, hd_block) + level = write_end_flag_for_ctl(id_control, level, & + & fld_ctl%block_name) ! end subroutine write_phys_data_control ! ! -------------------------------------------------------------------- +! + subroutine init_phys_data_ctl_label(hd_block, fld_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(field_control), intent(inout) :: fld_ctl +! +! + fld_ctl%block_name = hd_block +! + call init_c3_ctl_array_label & + & (hd_field_list, fld_ctl%field_ctl) + call init_chara_ctl_array_label & + & (hd_quad_field, fld_ctl%quad_phys) +! + call init_c_i_array_label & + & (hd_scalar_field, fld_ctl%scalar_phys) + call init_c_i3_ctl_array_label & + & (hd_vector_field, fld_ctl%vector_phys) +! + end subroutine init_phys_data_ctl_label +! +! -------------------------------------------------------------------- ! end module t_ctl_data_4_fields diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_platforms.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_platforms.f90 index 1ef57779..fd741ad9 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_platforms.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_platforms.f90 @@ -75,10 +75,10 @@ !> File name for boundary conditions !>@n@param radial_field_file_name !> File name for reference radial data -!>@n@param interpolate_sph_to_fem_ctl +!>@n@param interpolate_sph_to_fem !> File header for interpolation table !> from spherical grid to FEM grid -!>@n@param interpolate_fem_to_sph_ctl +!>@n@param interpolate_fem_to_sph !> File header for interpolation table !> from FEM grid to spherical grid !>@n @@ -102,6 +102,9 @@ module t_ctl_data_4_platforms ! !> Structure of parallel and file information type platform_data_control +!> Block name + character(len=kchara) :: block_name = 'data_files_def' +! !> Structure of number of subdomain control type(read_integer_item) :: ndomain_ctl !> Structure of number of OpenMP threads @@ -131,10 +134,10 @@ module t_ctl_data_4_platforms ! !> Structure of interpolation table file prefix !! from spherical shell to FEM - type(read_character_item) :: interpolate_sph_to_fem_ctl + type(read_character_item) :: interpolate_sph_to_fem !> Structure of interpolation table file prefix !! from FEM to spherical shell - type(read_character_item) :: interpolate_fem_to_sph_ctl + type(read_character_item) :: interpolate_fem_to_sph ! !> Structure of Rayleigh spectr data directory name type(read_character_item) :: rayleigh_spectr_dir @@ -188,8 +191,8 @@ subroutine reset_control_platforms(plt) plt%coriolis_int_file_name%iflag = 0 plt%bc_data_file_name_ctl%iflag = 0 plt%radial_data_file_name_ctl%iflag = 0 - plt%interpolate_sph_to_fem_ctl%iflag = 0 - plt%interpolate_fem_to_sph_ctl%iflag = 0 + plt%interpolate_sph_to_fem%iflag = 0 + plt%interpolate_fem_to_sph%iflag = 0 ! plt%mesh_file_fmt_ctl%iflag = 0 plt%sph_file_fmt_ctl%iflag = 0 @@ -241,10 +244,10 @@ subroutine copy_ctl_data_4_platform(org_plt, new_plt) call copy_chara_ctl(org_plt%rayleigh_field_dir, & & new_plt%rayleigh_field_dir) ! - call copy_chara_ctl(org_plt%interpolate_sph_to_fem_ctl, & - & new_plt%interpolate_sph_to_fem_ctl) - call copy_chara_ctl(org_plt%interpolate_fem_to_sph_ctl, & - & new_plt%interpolate_fem_to_sph_ctl) + call copy_chara_ctl(org_plt%interpolate_sph_to_fem, & + & new_plt%interpolate_sph_to_fem) + call copy_chara_ctl(org_plt%interpolate_fem_to_sph, & + & new_plt%interpolate_fem_to_sph) ! call copy_chara_ctl(org_plt%mesh_file_fmt_ctl, & & new_plt%mesh_file_fmt_ctl) @@ -268,6 +271,7 @@ subroutine copy_ctl_data_4_platform(org_plt, new_plt) & new_plt%del_org_data_ctl) ! new_plt%i_platform = org_plt%i_platform + new_plt%block_name = org_plt%block_name ! end subroutine copy_ctl_data_4_platform ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_sph_monitor.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_sph_monitor.f90 index 2d348feb..54feb404 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_sph_monitor.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_sph_monitor.f90 @@ -8,12 +8,13 @@ !> @brief Monitoring section IO for Control data !! !!@verbatim -!! subroutine append_volume_spectr_ctls(add_vpwr, smonitor_ctl) -!! type(volume_spectr_control), intent(inout) :: add_vpwr -!! type(sph_monitor_control), intent(inout) :: smonitor_ctl !! subroutine dealloc_sph_monitoring_ctl(smonitor_ctl) +!! type(sph_monitor_control), intent(inout) :: smonitor_ctl +!! !! subroutine alloc_volume_spectr_control(smonitor_ctl) -!! subroutine dealloc_volume_spectr_control(smonitor_ctl) +!! subroutine alloc_data_on_circles_ctl(smonitor_ctl) +!! subroutine dealloc_sph_monitoring_ctl(smonitor_ctl) +!! subroutine dealloc_data_on_circles_ctl(smonitor_ctl) !! type(sph_monitor_control), intent(inout) :: smonitor_ctl !! !! ----------------------------------------------------------------- @@ -79,7 +80,7 @@ module t_ctl_data_4_sph_monitor use t_ctl_data_sph_layer_spectr use t_ctl_data_pick_sph_spectr use t_ctl_data_gauss_coefs - use t_ctl_data_circles + use t_ctl_data_mid_equator use t_ctl_data_dynamobench use t_ctl_data_sph_dipolarity use skip_comment_f @@ -88,19 +89,32 @@ module t_ctl_data_4_sph_monitor ! ! type sph_monitor_control +!> Block name + character(len=kchara) :: block_name = 'sph_monitor_ctl' +! +!> array name for volume_spectr_control + character(len=kchara) :: v_pwr_name = 'volume_spectrum_ctl' +!> number of volume_spectr_control integer(kind = kint) :: num_vspec_ctl = 0 +!> array for volume_spectr_control type(volume_spectr_control), allocatable :: v_pwr(:) ! +!> array name for fields_on_circle_ctl + character(len=kchara) :: d_circ_name = 'fields_on_circle_ctl' +! Nunber of circle data + integer(kind = kint) :: num_circ_ctl = 0 +!> Structure for data on circle + type(mid_equator_control), allocatable :: meq_ctl(:) +! +! Structure for layerd spectr type(layerd_spectr_control) :: lp_ctl ! +!> Structure for Gauss coefficient type(gauss_spectr_control) :: g_pwr ! !> Structure for spectr data pickup type(pick_spectr_control) :: pspec_ctl ! -!> Structure for data on a surface - type(data_on_circles_ctl) :: circ_ctls -! !> Structure for dynamo benchmark output type(dynamobench_control) :: dbench_ctl ! @@ -161,7 +175,6 @@ subroutine dealloc_sph_monitoring_ctl(smonitor_ctl) call dealloc_num_spec_layer_ctl(smonitor_ctl%lp_ctl) call dealloc_pick_spectr_control(smonitor_ctl%pspec_ctl) call dealloc_gauss_spectr_control(smonitor_ctl%g_pwr) - call dealloc_data_on_circles_ctl(smonitor_ctl%circ_ctls) call reset_ctl_data_dynamobench(smonitor_ctl%dbench_ctl) call dealloc_sph_dipolarity_ctl(smonitor_ctl%fdip_ctl) ! @@ -180,58 +193,43 @@ subroutine dealloc_sph_monitoring_ctl(smonitor_ctl) smonitor_ctl%comp_Nusselt_file_format%iflag = 0 smonitor_ctl%typ_scale_file_prefix_ctl%iflag = 0 smonitor_ctl%typ_scale_file_format_ctl%iflag = 0 -! - if(smonitor_ctl%num_vspec_ctl .le. 0) return ! do i = 1, smonitor_ctl%num_vspec_ctl call reset_volume_spectr_control(smonitor_ctl%v_pwr(i)) end do call dealloc_volume_spectr_control(smonitor_ctl) +! + do i = 1, smonitor_ctl%num_circ_ctl + call reset_mid_equator_control(smonitor_ctl%meq_ctl(i)) + end do + call dealloc_data_on_circles_ctl(smonitor_ctl) ! end subroutine dealloc_sph_monitoring_ctl ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- +! ----------------------------------------------------------------------- ! - subroutine append_volume_spectr_ctls(add_vpwr, smonitor_ctl) + subroutine alloc_volume_spectr_control(smonitor_ctl) ! - type(volume_spectr_control), intent(inout) :: add_vpwr type(sph_monitor_control), intent(inout) :: smonitor_ctl ! - integer(kind = kint) :: num_tmp = 0 - type(volume_spectr_control), allocatable :: tmp_vpwr(:) -! -! - num_tmp = smonitor_ctl%num_vspec_ctl - allocate(tmp_vpwr(num_tmp)) - call copy_volume_spectr_ctls & - & (num_tmp, smonitor_ctl%v_pwr, tmp_vpwr) -! - call dealloc_volume_spectr_control(smonitor_ctl) - smonitor_ctl%num_vspec_ctl = num_tmp + 1 - call alloc_volume_spectr_control(smonitor_ctl) -! - call copy_volume_spectr_ctls & - & (num_tmp, tmp_vpwr, smonitor_ctl%v_pwr(1)) - deallocate(tmp_vpwr) -! - call copy_volume_spectr_control & - & (add_vpwr, smonitor_ctl%v_pwr(smonitor_ctl%num_vspec_ctl)) - call reset_volume_spectr_control(add_vpwr) + allocate(smonitor_ctl%v_pwr(smonitor_ctl%num_vspec_ctl)) ! - end subroutine append_volume_spectr_ctls + end subroutine alloc_volume_spectr_control ! ! ----------------------------------------------------------------------- -! ----------------------------------------------------------------------- ! - subroutine alloc_volume_spectr_control(smonitor_ctl) + subroutine alloc_data_on_circles_ctl(smonitor_ctl) ! type(sph_monitor_control), intent(inout) :: smonitor_ctl + integer(kind = kint) :: i ! - allocate(smonitor_ctl%v_pwr(smonitor_ctl%num_vspec_ctl)) ! - end subroutine alloc_volume_spectr_control + allocate(smonitor_ctl%meq_ctl(smonitor_ctl%num_circ_ctl)) +! + end subroutine alloc_data_on_circles_ctl ! +! --------------------------------------------------------------------- ! ----------------------------------------------------------------------- ! subroutine dealloc_volume_spectr_control(smonitor_ctl) @@ -244,5 +242,18 @@ subroutine dealloc_volume_spectr_control(smonitor_ctl) end subroutine dealloc_volume_spectr_control ! ! ----------------------------------------------------------------------- +! + subroutine dealloc_data_on_circles_ctl(smonitor_ctl) +! + type(sph_monitor_control), intent(inout) :: smonitor_ctl +! +! + if(allocated(smonitor_ctl%meq_ctl)) & + & deallocate(smonitor_ctl%meq_ctl) + smonitor_ctl%num_circ_ctl = 0 +! + end subroutine dealloc_data_on_circles_ctl +! +! --------------------------------------------------------------------- ! end module t_ctl_data_4_sph_monitor diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_sphere_model.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_sphere_model.f90 index 3a13461d..e5742efb 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_sphere_model.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_sphere_model.f90 @@ -101,6 +101,8 @@ module t_ctl_data_4_sphere_model ! !> control data structure for spherical shell type sphere_data_control +!> Block name + character(len=kchara) :: block_name = 'shell_define_ctl' !> Truncation lavel of spherical harmonics type(read_integer_item) :: ltr_ctl !> longitudinal symmetry diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_time_steps.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_time_steps.f90 index 7f87556b..65efad1e 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_time_steps.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_4_time_steps.f90 @@ -172,6 +172,8 @@ module t_ctl_data_4_time_steps ! !> Structure of time stepping controls type time_data_control +!> Block name + character(len=kchara) :: block_name = 'time_step_ctl' !> First step type(read_integer_item) :: i_step_init_ctl !> End step diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_FEM_sleeve_size.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_FEM_sleeve_size.f90 index 11600a04..577a6c7e 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_FEM_sleeve_size.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_FEM_sleeve_size.f90 @@ -7,6 +7,7 @@ !> @brief Control input routine for data file headers !! !!@verbatim +!! subroutine init_FEM_sleeve_ctl_label(hd_block, sleeve_ctl) !! subroutine read_FEM_sleeve_control & !! & (id_control, hd_block, sleeve_ctl, c_buf) !! type(FEM_sleeve_control), intent(inout) :: sleeve_ctl @@ -43,6 +44,8 @@ module t_ctl_data_FEM_sleeve_size ! !> Structure of Sleeve size controls type FEM_sleeve_control +!> Control block name + character(len = kchara) :: block_name = 'FEM_sleeve_ctl' !> Structure of Sleeve extension mode type(read_character_item) :: sleeve_extension_mode_ctl !> Structure of number of sleeve level @@ -89,7 +92,8 @@ subroutine read_FEM_sleeve_control & if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(sleeve_ctl%i_FEM_sleeve_ctl .gt. 0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! ! @@ -132,23 +136,42 @@ subroutine write_FEM_sleeve_control & maxlen = max(maxlen, len_trim(hd_sleeve_size)) maxlen = max(maxlen, len_trim(hd_reference_vector)) ! - write(id_file,'(a)') '!' -! - call write_chara_ctl_type & - & (id_file, level, maxlen, hd_sleeve_extension_mode, & + level = write_begin_flag_for_ctl(id_file, level, hd_block) + call write_chara_ctl_type(id_file, level, maxlen, & & sleeve_ctl%sleeve_extension_mode_ctl) call write_integer_ctl_type(id_file, level, maxlen, & - & hd_sleeve_level, sleeve_ctl%sleeve_level_ctl) + & sleeve_ctl%sleeve_level_ctl) call write_real_ctl_type(id_file, level, maxlen, & - & hd_sleeve_size, sleeve_ctl%sleeve_size_ctl) + & sleeve_ctl%sleeve_size_ctl) call write_chara_ctl_type(id_file, level, maxlen, & - & hd_reference_vector, sleeve_ctl%ref_vector_ctl) + & sleeve_ctl%ref_vector_ctl) ! level = write_end_flag_for_ctl(id_file, level, hd_block) ! end subroutine write_FEM_sleeve_control ! ! --------------------------------------------------------------------- +! + subroutine init_FEM_sleeve_ctl_label(hd_block, sleeve_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(FEM_sleeve_control), intent(inout) :: sleeve_ctl +! + sleeve_ctl%block_name = hd_block +! + call init_int_ctl_item_label & + & (hd_sleeve_level, sleeve_ctl%sleeve_level_ctl) + call init_real_ctl_item_label & + & (hd_sleeve_size, sleeve_ctl%sleeve_size_ctl) +! + call init_chara_ctl_item_label(hd_sleeve_extension_mode, & + & sleeve_ctl%sleeve_extension_mode_ctl) + call init_chara_ctl_item_label(hd_reference_vector, & + & sleeve_ctl%ref_vector_ctl) +! + end subroutine init_FEM_sleeve_ctl_label +! +! --------------------------------------------------------------------- ! subroutine dealloc_ctl_data_FEM_sleeve(sleeve_ctl) ! @@ -183,6 +206,7 @@ subroutine copy_FEM_sleeve_control(org_sleeve_c, new_sleeve_c) call copy_real_ctl(org_sleeve_c%sleeve_size_ctl, & & new_sleeve_c%sleeve_size_ctl) ! + new_sleeve_c%block_name = org_sleeve_c%block_name new_sleeve_c%i_FEM_sleeve_ctl = org_sleeve_c%i_FEM_sleeve_ctl ! end subroutine copy_FEM_sleeve_control diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_circles.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_circles.f90 index 1ef58cd5..88458521 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_circles.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_circles.f90 @@ -9,22 +9,22 @@ !! !!@verbatim !! subroutine read_data_on_circles_ctl & -!! & (id_control, hd_block, circ_ctls, c_buf) +!! & (id_control, hd_block, smonitor_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block -!! type(data_on_circles_ctl), intent(inout) :: circ_ctls +!! type(sph_monitor_control), intent(inout) :: smonitor_ctl !! type(buffer_for_control), intent(inout) :: c_buf !! subroutine write_data_on_circles_ctl & -!! & (id_control, hd_block, circ_ctls, level) +!! & (id_control, smonitor_ctl, level) !! integer(kind = kint), intent(in) :: id_control -!! character(len=kchara), intent(in) :: hd_block -!! type(data_on_circles_ctl), intent(in) :: circ_ctls +!! type(sph_monitor_control), intent(in) :: smonitor_ctl !! integer(kind = kint), intent(inout) :: level !! -!! subroutine alloc_data_on_circles_ctl(circ_ctls) -!! subroutine dealloc_data_on_circles_ctl(circ_ctls) -!! type(data_on_circles_ctl), intent(inout) :: circ_ctls -!! +!! subroutine append_data_on_circles_ctl(idx_in, hd_block, & +!! & smonitor_ctl) +!! subroutine delete_data_on_circles_ctl(idx_in, smonitor_ctl) +!! integer(kind = kint), intent(in) :: idx_in +!! type(sph_monitor_control), intent(inout) :: smonitor_ctl !! ----------------------------------------------------------------- !! !! control block for pickup spherical harmonics @@ -50,19 +50,11 @@ module t_ctl_data_circles use m_precision ! use t_read_control_elements + use t_ctl_data_4_sph_monitor use t_ctl_data_mid_equator use skip_comment_f ! implicit none -! - type data_on_circles_ctl - integer(kind = kint) :: num_circ_ctl = 0 -!> Structure for data on circle - type(mid_equator_control), allocatable :: meq_ctl(:) - end type data_on_circles_ctl -! - private :: append_data_on_circles_ctl - private :: dup_data_on_circles_ctl ! ! ----------------------------------------------------------------------- ! @@ -71,32 +63,37 @@ module t_ctl_data_circles ! ----------------------------------------------------------------------- ! subroutine read_data_on_circles_ctl & - & (id_control, hd_block, circ_ctls, c_buf) + & (id_control, hd_block, smonitor_ctl, c_buf) ! use t_read_control_elements use skip_comment_f ! integer(kind = kint), intent(in) :: id_control character(len=kchara), intent(in) :: hd_block - type(data_on_circles_ctl), intent(inout) :: circ_ctls + type(sph_monitor_control), intent(inout) :: smonitor_ctl 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(circ_ctls%meq_ctl)) return - circ_ctls%num_circ_ctl = 0 - call alloc_data_on_circles_ctl(circ_ctls) + if(allocated(smonitor_ctl%meq_ctl)) return + smonitor_ctl%num_circ_ctl = 0 + smonitor_ctl%d_circ_name = hd_block + call alloc_data_on_circles_ctl(smonitor_ctl) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, hd_block, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, hd_block)) exit ! if(check_begin_flag(c_buf, hd_block)) then - call append_data_on_circles_ctl(circ_ctls) - write(*,'(3a,i4,a)') 'Control for ', trim(hd_block), ' No. ', & - & circ_ctls%num_circ_ctl, ' is included' + n_append = smonitor_ctl%num_circ_ctl + call append_data_on_circles_ctl(n_append, hd_block, & + & smonitor_ctl) + write(*,'(3a,i4,a)') 'Control for ', trim(hd_block), ' No. ', & + & smonitor_ctl%num_circ_ctl, ' is included' call read_mid_eq_monitor_ctl(id_control, hd_block, & - & circ_ctls%meq_ctl(circ_ctls%num_circ_ctl), c_buf) + & smonitor_ctl%meq_ctl(smonitor_ctl%num_circ_ctl), c_buf) end if end do ! @@ -105,105 +102,102 @@ end subroutine read_data_on_circles_ctl ! -------------------------------------------------------------------- ! subroutine write_data_on_circles_ctl & - & (id_control, hd_block, circ_ctls, level) + & (id_control, smonitor_ctl, level) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block - type(data_on_circles_ctl), intent(in) :: circ_ctls + type(sph_monitor_control), intent(in) :: smonitor_ctl integer(kind = kint), intent(inout) :: level ! integer(kind = kint) :: i ! - write(id_control,'(a1)') '!' - level = write_array_flag_for_ctl(id_control, level, hd_block) - do i = 1, circ_ctls%num_circ_ctl - write(*,'(2a,i4)', ADVANCE='NO') trim(hd_block), ' No. ', i - call write_mid_eq_monitor_ctl(id_control, hd_block, & - & circ_ctls%meq_ctl(i), level) + level = write_array_flag_for_ctl(id_control, level, & + & smonitor_ctl%d_circ_name) + do i = 1, smonitor_ctl%num_circ_ctl + call write_mid_eq_monitor_ctl(id_control, & + & smonitor_ctl%meq_ctl(i), level) end do - level = write_end_array_flag_for_ctl(id_control, level, hd_block) + level = write_end_array_flag_for_ctl(id_control, level, & + & smonitor_ctl%d_circ_name) ! end subroutine write_data_on_circles_ctl ! ! -------------------------------------------------------------------- ! -------------------------------------------------------------------- ! - subroutine alloc_data_on_circles_ctl(circ_ctls) -! - type(data_on_circles_ctl), intent(inout) :: circ_ctls - integer(kind = kint) :: i -! + subroutine append_data_on_circles_ctl(idx_in, hd_block, & + & smonitor_ctl) ! - allocate(circ_ctls%meq_ctl(circ_ctls%num_circ_ctl)) -! - end subroutine alloc_data_on_circles_ctl -! -! --------------------------------------------------------------------- -! - subroutine dealloc_data_on_circles_ctl(circ_ctls) -! - type(data_on_circles_ctl), intent(inout) :: circ_ctls + integer(kind = kint), intent(in) :: idx_in + character(len=kchara), intent(in) :: hd_block + type(sph_monitor_control), intent(inout) :: smonitor_ctl ! - integer(kind = kint) :: i + type(mid_equator_control), allocatable :: tmp_meq_c(:) + integer(kind = kint) :: i, num_tmp ! - if(allocated(circ_ctls%meq_ctl) .eqv. .FALSE.) return ! - do i = 1, circ_ctls%num_circ_ctl - call reset_mid_equator_control(circ_ctls%meq_ctl(i)) + num_tmp = smonitor_ctl%num_circ_ctl + allocate(tmp_meq_c(num_tmp)) + do i = 1, num_tmp + call dup_mid_equator_control(smonitor_ctl%meq_ctl(i), & + tmp_meq_c(i)) end do ! - deallocate(circ_ctls%meq_ctl) - circ_ctls%num_circ_ctl = 0 -! - end subroutine dealloc_data_on_circles_ctl -! -! --------------------------------------------------------------------- -! -------------------------------------------------------------------- -! - subroutine append_data_on_circles_ctl(circ_ctls) -! - type(data_on_circles_ctl), intent(inout) :: circ_ctls -! - type(data_on_circles_ctl) :: tmp_circ_ctls + call dealloc_data_on_circles_ctl(smonitor_ctl) + smonitor_ctl%num_circ_ctl = num_tmp + 1 + call alloc_data_on_circles_ctl(smonitor_ctl) ! + do i = 1, idx_in + call dup_mid_equator_control(tmp_meq_c(i), & + & smonitor_ctl%meq_ctl(i)) + end do + call init_mid_eq_monitor_ctl_label(hd_block, & + & smonitor_ctl%meq_ctl(idx_in+1)) + do i = idx_in+1, num_tmp + call dup_mid_equator_control(tmp_meq_c(i), & + & smonitor_ctl%meq_ctl(i+1)) + end do + deallocate(tmp_meq_c) ! - tmp_circ_ctls%num_circ_ctl = circ_ctls%num_circ_ctl - call alloc_data_on_circles_ctl(tmp_circ_ctls) - call dup_data_on_circles_ctl & - & (tmp_circ_ctls%num_circ_ctl, circ_ctls, tmp_circ_ctls) -! - call dealloc_data_on_circles_ctl(circ_ctls) -! - circ_ctls%num_circ_ctl = tmp_circ_ctls%num_circ_ctl + 1 - call alloc_data_on_circles_ctl(circ_ctls) + end subroutine append_data_on_circles_ctl ! - call dup_data_on_circles_ctl & - & (tmp_circ_ctls%num_circ_ctl, tmp_circ_ctls, circ_ctls) +! ----------------------------------------------------------------------- ! - call dealloc_data_on_circles_ctl(tmp_circ_ctls) + subroutine delete_data_on_circles_ctl(idx_in, smonitor_ctl) ! - end subroutine append_data_on_circles_ctl + integer(kind = kint), intent(in) :: idx_in + type(sph_monitor_control), intent(inout) :: smonitor_ctl ! -! ----------------------------------------------------------------------- + type(mid_equator_control), allocatable :: tmp_meq_c(:) + integer(kind = kint) :: i, num_tmp ! - subroutine dup_data_on_circles_ctl & - & (num_psf, org_circ_ctls, new_circ_ctls) ! - integer(kind = kint), intent(in) :: num_psf - type(data_on_circles_ctl), intent(in) :: org_circ_ctls - type(data_on_circles_ctl), intent(inout) :: new_circ_ctls + if(idx_in.le.0 .or. idx_in.gt.smonitor_ctl%num_vspec_ctl) return + + num_tmp = smonitor_ctl%num_circ_ctl + allocate(tmp_meq_c(num_tmp)) + do i = 1, num_tmp + call dup_mid_equator_control(smonitor_ctl%meq_ctl(i), & + tmp_meq_c(i)) + end do ! - integer(kind = kint) :: i + call dealloc_data_on_circles_ctl(smonitor_ctl) + smonitor_ctl%num_circ_ctl = num_tmp - 1 + call alloc_data_on_circles_ctl(smonitor_ctl) ! - do i = 1, num_psf - call dup_mid_equator_control(org_circ_ctls%meq_ctl(i), & - new_circ_ctls%meq_ctl(i)) + do i = 1, idx_in-1 + call dup_mid_equator_control(tmp_meq_c(i), & + & smonitor_ctl%meq_ctl(i)) end do + do i = idx_in, smonitor_ctl%num_vspec_ctl + call dup_mid_equator_control(tmp_meq_c(i+1), & + & smonitor_ctl%meq_ctl(i)) + end do + deallocate(tmp_meq_c) ! - end subroutine dup_data_on_circles_ctl + end subroutine delete_data_on_circles_ctl ! -! --------------------------------------------------------------------- +! ----------------------------------------------------------------------- ! end module t_ctl_data_circles diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_dimless_numbers.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_dimless_numbers.f90 index d17a09e1..7f4e25f4 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_dimless_numbers.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_dimless_numbers.f90 @@ -8,16 +8,15 @@ !!@n Modified by H. Matsui on Merch, 2006 !! !!@verbatim +!! subroutine init_dimless_ctl_label(hd_block, dless_ctl) !! subroutine read_dimless_ctl & !! & (id_control, hd_block, dless_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(dimless_control), intent(inout) :: dless_ctl !! type(buffer_for_control), intent(inout) :: c_buf -!! subroutine write_dimless_ctl & -!! & (id_control, hd_block, dless_ctl, level) +!! subroutine write_dimless_ctl(id_control, dless_ctl, level) !! integer(kind = kint), intent(in) :: id_control -!! character(len=kchara), intent(in) :: hd_block !! type(dimless_control), intent(in) :: dless_ctl !! integer(kind = kint), intent(inout) :: level !! subroutine dealloc_dimless_ctl(dless_ctl) @@ -62,6 +61,8 @@ module t_ctl_data_dimless_numbers ! !> Structure for list of dimensionless numbers type dimless_control +!> Block name + character(len=kchara) :: block_name = 'dimensionless_ctl' !> Structure for list of dimensionless numbers !!@n dimless%c_tbl: Name of each number !!@n dimless%vect: valus of each number @@ -91,10 +92,12 @@ subroutine read_dimless_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(dless_ctl%i_dimless_ctl .gt. 0) return + dless_ctl%block_name = trim(hd_block) + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_c_r(id_control, & @@ -106,13 +109,11 @@ end subroutine read_dimless_ctl ! ! -------------------------------------------------------------------- ! - subroutine write_dimless_ctl & - & (id_control, hd_block, dless_ctl, level) + subroutine write_dimless_ctl(id_control, dless_ctl, level) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(dimless_control), intent(in) :: dless_ctl ! integer(kind = kint), intent(inout) :: level @@ -120,16 +121,26 @@ subroutine write_dimless_ctl & ! if(dless_ctl%i_dimless_ctl .le. 0) return ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! + level = write_begin_flag_for_ctl(id_control, level, & + & dless_ctl%block_name) call write_control_array_c_r(id_control, level, & - & hd_dimless, dless_ctl%dimless) - level = write_end_flag_for_ctl(id_control, level, hd_block) + & dless_ctl%dimless) + level = write_end_flag_for_ctl(id_control, level, & + & dless_ctl%block_name) ! end subroutine write_dimless_ctl ! ! -------------------------------------------------------------------- +! + subroutine init_dimless_ctl_label(hd_block, dless_ctl) + character(len=kchara), intent(in) :: hd_block + type(dimless_control), intent(inout) :: dless_ctl +! + dless_ctl%block_name = trim(hd_block) + call init_c_r_ctl_array_label(hd_dimless, dless_ctl%dimless) + end subroutine init_dimless_ctl_label +! +! -------------------------------------------------------------------- ! subroutine dealloc_dimless_ctl(dless_ctl) ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_dynamobench.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_dynamobench.f90 index 92bdce23..08fbc892 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_dynamobench.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_dynamobench.f90 @@ -10,6 +10,7 @@ !!@verbatim !! subroutine reset_ctl_data_dynamobench(dbench_ctl) !! type(dynamobench_control), intent(inout) :: dbench_ctl +!! subroutine init_ctl_data_dynamobench_label(hd_block, dbench_ctl) !! subroutine read_ctl_data_dynamobench & !! & (id_control, hd_block, dbench_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -17,9 +18,8 @@ !! type(dynamobench_control), intent(inout) :: dbench_ctl !! type(buffer_for_control), intent(inout) :: c_buf !! subroutine write_ctl_data_dynamobench & -!! & (id_control, hd_block, dbench_ctl, level) +!! & (id_control, dbench_ctl, level) !! integer(kind = kint), intent(in) :: id_control -!! character(len=kchara), intent(in) :: hd_block !! type(dynamobench_control), intent(in) :: dbench_ctl !! integer(kind = kint), intent(inout) :: level !! @@ -54,6 +54,10 @@ module t_ctl_data_dynamobench implicit none ! type dynamobench_control +!> Block name + character(len=kchara) :: block_name & + & = 'dynamo_benchmark_data_ctl' +! !> Structure for dynanmo benchmark data file prefix type(read_character_item) :: dynamobench_file_ctl !> Structure for dynanmo benchmark data file prefix @@ -126,10 +130,12 @@ subroutine read_ctl_data_dynamobench & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(dbench_ctl%i_dynamobench_ctl .gt. 0) return + dbench_ctl%block_name = hd_block + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_chara_ctl_type(c_buf, hd_dbench_prefix, & @@ -154,12 +160,11 @@ end subroutine read_ctl_data_dynamobench ! ----------------------------------------------------------------------- ! subroutine write_ctl_data_dynamobench & - & (id_control, hd_block, dbench_ctl, level) + & (id_control, dbench_ctl, level) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(dynamobench_control), intent(in) :: dbench_ctl ! integer(kind = kint), intent(inout) :: level @@ -176,26 +181,51 @@ subroutine write_ctl_data_dynamobench & maxlen = max(maxlen, len_trim(hd_dbench_spectr_prefix)) maxlen = max(maxlen, len_trim(hd_nphi_mid_eq)) ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! + level = write_begin_flag_for_ctl(id_control, level, & + & dbench_ctl%block_name) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_dbench_prefix, dbench_ctl%dynamobench_file_ctl) + & dbench_ctl%dynamobench_file_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_dbench_format, dbench_ctl%dynamobench_format_ctl) + & dbench_ctl%dynamobench_format_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_dbench_detail_prefix, dbench_ctl%detailed_dbench_file_ctl) + & dbench_ctl%detailed_dbench_file_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_dbench_field_prefix, dbench_ctl%dbench_field_file_ctl) + & dbench_ctl%dbench_field_file_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_dbench_spectr_prefix, dbench_ctl%dbench_spectr_file_ctl) + & dbench_ctl%dbench_spectr_file_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_nphi_mid_eq, dbench_ctl%nphi_mid_eq_ctl) + & dbench_ctl%nphi_mid_eq_ctl) ! - level = write_end_flag_for_ctl(id_control, level, hd_block) + level = write_end_flag_for_ctl(id_control, level, & + & dbench_ctl%block_name) ! end subroutine write_ctl_data_dynamobench ! ! ----------------------------------------------------------------------- +! + subroutine init_ctl_data_dynamobench_label(hd_block, dbench_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(dynamobench_control), intent(inout) :: dbench_ctl +! + dbench_ctl%block_name = hd_block + call init_chara_ctl_item_label(hd_dbench_prefix, & + & dbench_ctl%dynamobench_file_ctl) + call init_chara_ctl_item_label(hd_dbench_format, & + & dbench_ctl%dynamobench_format_ctl) +! + call init_chara_ctl_item_label(hd_dbench_detail_prefix, & + & dbench_ctl%detailed_dbench_file_ctl) + call init_chara_ctl_item_label(hd_dbench_field_prefix, & + & dbench_ctl%dbench_field_file_ctl) + call init_chara_ctl_item_label(hd_dbench_spectr_prefix, & + & dbench_ctl%dbench_spectr_file_ctl) +! + call init_int_ctl_item_label(hd_nphi_mid_eq, & + & dbench_ctl%nphi_mid_eq_ctl) +! + end subroutine init_ctl_data_dynamobench_label +! +! ----------------------------------------------------------------------- ! end module t_ctl_data_dynamobench diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_gauss_coefs.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_gauss_coefs.f90 index e17ac06c..15072976 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_gauss_coefs.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_gauss_coefs.f90 @@ -9,14 +9,14 @@ !! !!@verbatim !! subroutine dealloc_gauss_spectr_control(g_pwr) +!! subroutine init_gauss_spectr_ctl_labels(hd_block, g_pwr) !! subroutine read_gauss_spectr_ctl & !! & (id_control, hd_block, iflag, g_pwr, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(gauss_spectr_control), intent(inout) :: g_pwr !! type(buffer_for_control), intent(inout) :: c_buf -!! subroutine write_gauss_spectr_ctl & -!! & (id_control, hd_block, g_pwr, level) +!! subroutine write_gauss_spectr_ctl(id_control, g_pwr, level) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(gauss_spectr_control), intent(in) :: g_pwr @@ -65,6 +65,8 @@ module t_ctl_data_gauss_coefs ! ! type gauss_spectr_control +!> Block name + character(len=kchara) :: block_name = 'gauss_coefficient_ctl' !> Structure for gauss coefficient file prefix type(read_character_item) :: gauss_coefs_prefix !> Structure for gauss coefficient file format @@ -142,10 +144,11 @@ subroutine read_gauss_spectr_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(g_pwr%i_gauss_coef_ctl .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! ! @@ -169,13 +172,11 @@ end subroutine read_gauss_spectr_ctl ! ! ----------------------------------------------------------------------- ! - subroutine write_gauss_spectr_ctl & - & (id_control, hd_block, g_pwr, level) + subroutine write_gauss_spectr_ctl(id_control, g_pwr, level) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block ! type(gauss_spectr_control), intent(in) :: g_pwr integer(kind = kint), intent(inout) :: level @@ -189,27 +190,52 @@ subroutine write_gauss_spectr_ctl & maxlen = max(maxlen, len_trim(hd_gauss_coefs_head)) maxlen = max(maxlen, len_trim(hd_gauss_coefs_fmt)) ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) + level = write_begin_flag_for_ctl(id_control, level, & + & g_pwr%block_name) + call write_chara_ctl_type(id_control, level, maxlen, & + & g_pwr%gauss_coefs_prefix) + call write_chara_ctl_type(id_control, level, maxlen, & + & g_pwr%gauss_coefs_format) + call write_real_ctl_type(id_control, level, maxlen, & + & g_pwr%gauss_coefs_radius_ctl) ! call write_control_array_i2(id_control, level, & - & hd_pick_gauss_lm, g_pwr%idx_gauss_ctl) + & g_pwr%idx_gauss_ctl) call write_control_array_i1(id_control, level, & - & hd_pick_gauss_l, g_pwr%idx_gauss_l_ctl) + & g_pwr%idx_gauss_l_ctl) call write_control_array_i1(id_control, level, & - & hd_pick_gauss_m, g_pwr%idx_gauss_m_ctl) + & g_pwr%idx_gauss_m_ctl) ! - call write_real_ctl_type(id_control, level, maxlen, & - & hd_gauss_coefs_r, g_pwr%gauss_coefs_radius_ctl) - call write_chara_ctl_type(id_control, level, maxlen, & - & hd_gauss_coefs_head, g_pwr%gauss_coefs_prefix) - call write_chara_ctl_type(id_control, level, maxlen, & - & hd_gauss_coefs_fmt, g_pwr%gauss_coefs_format) -! - level = write_end_flag_for_ctl(id_control, level, hd_block) + level = write_end_flag_for_ctl(id_control, level, & + & g_pwr%block_name) ! end subroutine write_gauss_spectr_ctl ! ! ----------------------------------------------------------------------- +! + subroutine init_gauss_spectr_ctl_labels(hd_block, g_pwr) +! + character(len=kchara), intent(in) :: hd_block + type(gauss_spectr_control), intent(inout) :: g_pwr +! +! + g_pwr%block_name = hd_block + call init_int2_ctl_array_label & + & (hd_pick_gauss_lm, g_pwr%idx_gauss_ctl) + call init_int_ctl_array_label & + & (hd_pick_gauss_l, g_pwr%idx_gauss_l_ctl) + call init_int_ctl_array_label & + & (hd_pick_gauss_m, g_pwr%idx_gauss_m_ctl) +! + call init_real_ctl_item_label(hd_gauss_coefs_r, & + & g_pwr%gauss_coefs_radius_ctl) + call init_chara_ctl_item_label(hd_gauss_coefs_head, & + & g_pwr%gauss_coefs_prefix) + call init_chara_ctl_item_label(hd_gauss_coefs_fmt, & + & g_pwr%gauss_coefs_format) +! + end subroutine init_gauss_spectr_ctl_labels +! +! ----------------------------------------------------------------------- ! end module t_ctl_data_gauss_coefs diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_mid_equator.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_mid_equator.f90 index 8a3c32ea..441365a3 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_mid_equator.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_mid_equator.f90 @@ -10,16 +10,15 @@ !!@verbatim !! subroutine reset_mid_equator_control(meq_ctl) !! type(mid_equator_control), intent(inout) :: meq_ctl +!! subroutine init_mid_eq_monitor_ctl_label(hd_block, meq_ctl) !! subroutine read_mid_eq_monitor_ctl & !! & (id_control, hd_block, meq_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(mid_equator_control), intent(inout) :: meq_ctl !! type(buffer_for_control), intent(inout) :: c_buf -!! subroutine write_mid_eq_monitor_ctl & -!! & (id_control, hd_block, meq_ctl, level) +!! subroutine write_mid_eq_monitor_ctl(id_control, meq_ctl, level) !! integer(kind = kint), intent(in) :: id_control -!! character(len=kchara), intent(in) :: hd_block !! type(mid_equator_control), intent(in) :: meq_ctl !! integer(kind = kint), intent(inout) :: level !! @@ -57,6 +56,8 @@ module t_ctl_data_mid_equator implicit none ! type mid_equator_control +!> Block name + character(len=kchara) :: block_name = 'fields_on_circle_ctl' !> Structure for field on circle data file prefix type(read_character_item) :: circle_field_file_ctl !> Structure for spectr on circle data file prefix @@ -142,6 +143,8 @@ subroutine dup_mid_equator_control(org_meq_ctl, new_meq_ctl) & new_meq_ctl%pick_s_ctl) call copy_real_ctl(org_meq_ctl%pick_z_ctl, & & new_meq_ctl%pick_z_ctl) +! + new_meq_ctl%block_name = org_meq_ctl%block_name new_meq_ctl%i_mid_equator_ctl = org_meq_ctl%i_mid_equator_ctl ! end subroutine dup_mid_equator_control @@ -159,10 +162,11 @@ subroutine read_mid_eq_monitor_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(meq_ctl%i_mid_equator_ctl .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_chara_ctl_type(c_buf, hd_fld_on_circ_prefix, & @@ -189,13 +193,11 @@ end subroutine read_mid_eq_monitor_ctl ! ! ----------------------------------------------------------------------- ! - subroutine write_mid_eq_monitor_ctl & - & (id_control, hd_block, meq_ctl, level) + subroutine write_mid_eq_monitor_ctl(id_control, meq_ctl, level) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(mid_equator_control), intent(in) :: meq_ctl ! integer(kind = kint), intent(inout) :: level @@ -213,31 +215,60 @@ subroutine write_mid_eq_monitor_ctl & maxlen = max(maxlen, len_trim(hd_spec_on_circ_prefix)) maxlen = max(maxlen, len_trim(hd_fld_on_circ_format)) ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! + level = write_begin_flag_for_ctl(id_control, level, & + & meq_ctl%block_name) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_fld_on_circ_prefix, meq_ctl%circle_field_file_ctl) + & meq_ctl%circle_field_file_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_spec_on_circ_prefix, meq_ctl%circle_spectr_file_ctl) + & meq_ctl%circle_spectr_file_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_fld_on_circ_format, meq_ctl%circle_file_format_ctl) + & meq_ctl%circle_file_format_ctl) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_circle_coord, meq_ctl%pick_circle_coord_ctl) + & meq_ctl%pick_circle_coord_ctl) +! + call write_integer_ctl_type(id_control, level, maxlen, & + & meq_ctl%nphi_mid_eq_ctl) ! call write_real_ctl_type(id_control, level, maxlen, & - & hd_pick_s_ctl, meq_ctl%pick_s_ctl) + & meq_ctl%pick_s_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_pick_z_ctl, meq_ctl%pick_z_ctl) -! - call write_integer_ctl_type(id_control, level, maxlen, & - & hd_nphi_mid_eq, meq_ctl%nphi_mid_eq_ctl) + & meq_ctl%pick_z_ctl) ! - level = write_end_flag_for_ctl(id_control, level, hd_block) + level = write_end_flag_for_ctl(id_control, level, & + & meq_ctl%block_name) ! end subroutine write_mid_eq_monitor_ctl ! ! ----------------------------------------------------------------------- +! + subroutine init_mid_eq_monitor_ctl_label(hd_block, meq_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(mid_equator_control), intent(inout) :: meq_ctl +! +! + meq_ctl%block_name = hd_block + call init_chara_ctl_item_label(hd_fld_on_circ_prefix, & + & meq_ctl%circle_field_file_ctl) + call init_chara_ctl_item_label(hd_spec_on_circ_prefix, & + & meq_ctl%circle_spectr_file_ctl) + call init_chara_ctl_item_label(hd_fld_on_circ_format, & + & meq_ctl%circle_file_format_ctl) +! + call init_real_ctl_item_label & + & (hd_pick_s_ctl, meq_ctl%pick_s_ctl) + call init_real_ctl_item_label & + & (hd_pick_z_ctl, meq_ctl%pick_z_ctl) +! + call init_int_ctl_item_label(hd_nphi_mid_eq, & + & meq_ctl%nphi_mid_eq_ctl) +! + call init_chara_ctl_item_label(hd_circle_coord, & + & meq_ctl%pick_circle_coord_ctl) +! + end subroutine init_mid_eq_monitor_ctl_label +! +! ----------------------------------------------------------------------- ! end module t_ctl_data_mid_equator diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_pick_sph_spectr.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_pick_sph_spectr.f90 index b3425ad8..73466089 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_pick_sph_spectr.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_pick_sph_spectr.f90 @@ -9,14 +9,14 @@ !! !!@verbatim !! subroutine dealloc_pick_spectr_control(pspec_ctl) +!! subroutine init_pickup_spectr_ctl_labels(hd_block, pspec_ctl) !! subroutine read_pickup_spectr_ctl & !! & (id_control, hd_block, pspec_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(pick_spectr_control), intent(inout) :: pspec_ctl !! type(buffer_for_control), intent(inout) :: c_buf -!! subroutine write_pickup_spectr_ctl & -!! & (id_control, hd_block, pspec_ctl, level) +!! subroutine write_pickup_spectr_ctl(id_control, pspec_ctl, level) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(pick_spectr_control), intent(in) :: pspec_ctl @@ -78,6 +78,8 @@ module t_ctl_data_pick_sph_spectr ! !> Structure for spectr data pickup type pick_spectr_control +!> Block name + character(len=kchara) :: block_name = 'pickup_spectr_ctl' !> Structure for picked spectrum file prefix type(read_character_item) :: picked_mode_head_ctl !> Structure for picked spectrum file format (ascii or gzip) @@ -166,10 +168,11 @@ subroutine read_pickup_spectr_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(pspec_ctl%i_pick_sph .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! ! @@ -196,13 +199,11 @@ end subroutine read_pickup_spectr_ctl ! ! ----------------------------------------------------------------------- ! - subroutine write_pickup_spectr_ctl & - & (id_control, hd_block, pspec_ctl, level) + subroutine write_pickup_spectr_ctl(id_control, pspec_ctl, level) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(pick_spectr_control), intent(in) :: pspec_ctl ! integer(kind = kint), intent(inout) :: level @@ -215,30 +216,58 @@ subroutine write_pickup_spectr_ctl & maxlen = len_trim(hd_picked_mode_head) maxlen = max(maxlen, len_trim(hd_picked_mode_format)) ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! + level = write_begin_flag_for_ctl(id_control, level, & + & pspec_ctl%block_name) call write_control_array_i1(id_control, level, & - & hd_pick_layer, pspec_ctl%idx_pick_layer_ctl) + & pspec_ctl%idx_pick_layer_ctl) call write_control_array_r1(id_control, level, & - & hd_pick_radius, pspec_ctl%pick_radius_ctl) + & pspec_ctl%pick_radius_ctl) ! call write_control_array_i2(id_control, level, & - & hd_pick_sph_lm, pspec_ctl%idx_pick_sph_ctl) + & pspec_ctl%idx_pick_sph_ctl) call write_control_array_i1(id_control, level, & - & hd_pick_sph_l, pspec_ctl%idx_pick_sph_l_ctl) + & pspec_ctl%idx_pick_sph_l_ctl) call write_control_array_i1(id_control, level, & - & hd_pick_sph_m, pspec_ctl%idx_pick_sph_m_ctl) + & pspec_ctl%idx_pick_sph_m_ctl) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_picked_mode_head, pspec_ctl%picked_mode_head_ctl) + & pspec_ctl%picked_mode_head_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_picked_mode_format, pspec_ctl%picked_mode_fmt_ctl) + & pspec_ctl%picked_mode_fmt_ctl) ! - level = write_end_flag_for_ctl(id_control, level, hd_block) + level = write_end_flag_for_ctl(id_control, level, & + & pspec_ctl%block_name) ! end subroutine write_pickup_spectr_ctl ! ! ----------------------------------------------------------------------- +! + subroutine init_pickup_spectr_ctl_labels(hd_block, pspec_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(pick_spectr_control), intent(inout) :: pspec_ctl +! + pspec_ctl%block_name = hd_block +! + call init_int_ctl_array_label & + & (hd_pick_layer, pspec_ctl%idx_pick_layer_ctl) + call init_real_ctl_array_label & + & (hd_pick_radius, pspec_ctl%pick_radius_ctl) +! + call init_int2_ctl_array_label & + & (hd_pick_sph_lm, pspec_ctl%idx_pick_sph_ctl) + call init_int_ctl_array_label & + & (hd_pick_sph_l, pspec_ctl%idx_pick_sph_l_ctl) + call init_int_ctl_array_label & + & (hd_pick_sph_m, pspec_ctl%idx_pick_sph_m_ctl) +! + call init_chara_ctl_item_label(hd_picked_mode_head, & + & pspec_ctl%picked_mode_head_ctl) + call init_chara_ctl_item_label(hd_picked_mode_format, & + & pspec_ctl%picked_mode_fmt_ctl) +! + end subroutine init_pickup_spectr_ctl_labels +! +! ----------------------------------------------------------------------- ! end module t_ctl_data_pick_sph_spectr diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_sph_dipolarity.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_sph_dipolarity.f90 index d426c026..9cfc1a49 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_sph_dipolarity.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_sph_dipolarity.f90 @@ -8,6 +8,7 @@ !> @brief Monitoring section IO for Control data !! !!@verbatim +!! subroutine init_sph_dipolarity_ctl_label(hd_block, fdip_ctl) !! subroutine read_sph_dipolarity_ctl & !! & (id_control, hd_block, fdip_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -53,6 +54,8 @@ module t_ctl_data_sph_dipolarity ! !> Structure for dipolarity setting type sph_dipolarity_control +!> Block name + character(len=kchara) :: block_name = 'sph_dipolarity_ctl' !> Structure for truncation lavel for dipolarity type(ctl_array_int) :: fdip_truncation_ctl ! @@ -93,10 +96,11 @@ subroutine read_sph_dipolarity_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(fdip_ctl%i_dipolarity_ctl .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_i1(id_control, hd_fdip_truncation, & @@ -112,13 +116,11 @@ end subroutine read_sph_dipolarity_ctl ! ! ----------------------------------------------------------------------- ! - subroutine write_sph_dipolarity_ctl & - & (id_control, hd_block, fdip_ctl, level) + subroutine write_sph_dipolarity_ctl(id_control, fdip_ctl, level) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(sph_dipolarity_control), intent(in) :: fdip_ctl ! integer(kind = kint), intent(inout) :: level @@ -132,21 +134,38 @@ subroutine write_sph_dipolarity_ctl & maxlen = max(maxlen, len_trim(hd_fdip_file_prefix)) maxlen = max(maxlen, len_trim(hd_fdip_file_format)) ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! - call write_control_array_i1(id_control, level, & - & hd_fdip_truncation, fdip_ctl%fdip_truncation_ctl) + level = write_begin_flag_for_ctl(id_control, level, & + & fdip_ctl%block_name) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_fdip_file_prefix,fdip_ctl%fdip_file_prefix_ctl) + & fdip_ctl%fdip_file_prefix_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_fdip_file_format, fdip_ctl%fdip_file_format_ctl) -! - level = write_end_flag_for_ctl(id_control, level, hd_block) + & fdip_ctl%fdip_file_format_ctl) + + call write_control_array_i1(id_control, level, & + & fdip_ctl%fdip_truncation_ctl) + level = write_end_flag_for_ctl(id_control, level, & + & fdip_ctl%block_name) ! end subroutine write_sph_dipolarity_ctl ! ! ----------------------------------------------------------------------- +! + subroutine init_sph_dipolarity_ctl_label(hd_block, fdip_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(sph_dipolarity_control), intent(inout) :: fdip_ctl +! + fdip_ctl%block_name = hd_block + call init_int_ctl_array_label(hd_fdip_truncation, & + & fdip_ctl%fdip_truncation_ctl) + call init_chara_ctl_item_label(hd_fdip_file_prefix, & + & fdip_ctl%fdip_file_prefix_ctl) + call init_chara_ctl_item_label(hd_fdip_file_format, & + & fdip_ctl%fdip_file_format_ctl) +! + end subroutine init_sph_dipolarity_ctl_label +! +! ----------------------------------------------------------------------- ! subroutine dealloc_sph_dipolarity_ctl(fdip_ctl) ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_sph_layer_spectr.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_sph_layer_spectr.f90 index e09ef0d6..16eb6618 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_sph_layer_spectr.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_sph_layer_spectr.f90 @@ -8,16 +8,15 @@ !> @brief control date for volume averaged spectr data !! !!@verbatim +!! subroutine init_layerd_spectr_ctl_labels(hd_block, lp_ctl) !! subroutine read_layerd_spectr_ctl & !! & (id_control, hd_block, lp_ctl, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(layerd_spectr_control), intent(inout) :: lp_ctl !! type(buffer_for_control), intent(inout) :: c_buf -!! subroutine write_layerd_spectr_ctl & -!! & (id_control, hd_block, lp_ctl, level) +!! subroutine write_layerd_spectr_ctl(id_control, lp_ctl, level) !! integer(kind = kint), intent(in) :: id_control -!! character(len=kchara), intent(in) :: hd_block !! type(layerd_spectr_control), intent(in) :: lp_ctl !! integer(kind = kint), intent(inout) :: level !! subroutine dealloc_num_spec_layer_ctl(lp_ctl) @@ -65,6 +64,9 @@ module t_ctl_data_sph_layer_spectr ! ! type layerd_spectr_control +!> Block name + character(len=kchara) :: block_name = 'layered_spectrum_ctl' +! !> Structure for layered spectrum file prefix type(read_character_item) :: layered_pwr_spectr_prefix !> Structure for layered spectrum file format @@ -129,10 +131,11 @@ subroutine read_layerd_spectr_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if (lp_ctl%i_layer_spectr_ctl .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_i1(id_control, & @@ -160,13 +163,11 @@ end subroutine read_layerd_spectr_ctl ! ! ----------------------------------------------------------------------- ! - subroutine write_layerd_spectr_ctl & - & (id_control, hd_block, lp_ctl, level) + subroutine write_layerd_spectr_ctl(id_control, lp_ctl, level) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(layerd_spectr_control), intent(in) :: lp_ctl ! integer(kind = kint), intent(inout) :: level @@ -185,33 +186,62 @@ subroutine write_layerd_spectr_ctl & maxlen = max(maxlen, len_trim(hd_diff_lm_spectr_switch)) maxlen = max(maxlen, len_trim(hd_axis_spectr_switch)) ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! + level = write_begin_flag_for_ctl(id_control, level, & + & lp_ctl%block_name) call write_control_array_i1(id_control, level, & - & hd_spctr_layer, lp_ctl%idx_spec_layer_ctl) + & lp_ctl%idx_spec_layer_ctl) call write_control_array_r1(id_control, level, & - & hd_spctr_radius, lp_ctl%layer_radius_ctl) + & lp_ctl%layer_radius_ctl) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_layer_rms_head, lp_ctl%layered_pwr_spectr_prefix) + & lp_ctl%layered_pwr_spectr_prefix) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_layer_rms_fmt, lp_ctl%layered_pwr_spectr_format) + & lp_ctl%layered_pwr_spectr_format) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_degree_spectr_switch, lp_ctl%degree_spectra_switch) + & lp_ctl%degree_spectra_switch) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_order_spectr_switch, lp_ctl%order_spectra_switch) + & lp_ctl%order_spectra_switch) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_diff_lm_spectr_switch, lp_ctl%diff_lm_spectra_switch) + & lp_ctl%diff_lm_spectra_switch) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_axis_spectr_switch, lp_ctl%axis_power_switch) -! - level = write_end_flag_for_ctl(id_control, level, hd_block) + & lp_ctl%axis_power_switch) + level = write_end_flag_for_ctl(id_control, level, & + & lp_ctl%block_name) ! end subroutine write_layerd_spectr_ctl ! ! ----------------------------------------------------------------------- +! + subroutine init_layerd_spectr_ctl_labels(hd_block, lp_ctl) +! + character(len=kchara), intent(in) :: hd_block + type(layerd_spectr_control), intent(inout) :: lp_ctl +! +! + lp_ctl%block_name = hd_block + call init_int_ctl_array_label & + & (hd_spctr_layer, lp_ctl%idx_spec_layer_ctl) + call init_real_ctl_array_label & + & (hd_spctr_radius, lp_ctl%layer_radius_ctl) +! + call init_chara_ctl_item_label(hd_layer_rms_head, & + & lp_ctl%layered_pwr_spectr_prefix) + call init_chara_ctl_item_label(hd_layer_rms_fmt, & + & lp_ctl%layered_pwr_spectr_format) +! + call init_chara_ctl_item_label(hd_degree_spectr_switch, & + & lp_ctl%degree_spectra_switch) + call init_chara_ctl_item_label(hd_order_spectr_switch, & + & lp_ctl%order_spectra_switch) + call init_chara_ctl_item_label(hd_diff_lm_spectr_switch, & + & lp_ctl%diff_lm_spectra_switch) + call init_chara_ctl_item_label(hd_axis_spectr_switch, & + & lp_ctl%axis_power_switch) +! + end subroutine init_layerd_spectr_ctl_labels +! +! ----------------------------------------------------------------------- ! subroutine dealloc_num_spec_layer_ctl(lp_ctl) ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_sph_vol_spectr.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_sph_vol_spectr.f90 index 95fcfa75..3bd782a9 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_sph_vol_spectr.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_ctl_data_sph_vol_spectr.f90 @@ -8,23 +8,20 @@ !> @brief control date for volume averaged spectr data !! !!@verbatim -!! subroutine copy_volume_spectr_ctls(num_ctl, org_vpwr, new_vpwr) -!! type(volume_spectr_control), intent(in) :: org_vpwr(num_ctl) -!! type(volume_spectr_control), intent(inout) :: new_vpwr(num_ctl) !! subroutine copy_volume_spectr_control(org_vpwr, new_vpwr) !! type(volume_spectr_control), intent(in) :: org_vpwr !! type(volume_spectr_control), intent(inout) :: new_vpwr !! +!! subroutine init_each_vol_spectr_labels(hd_block, v_pwr) +!! type(volume_spectr_control), intent(inout) :: v_pwr !! subroutine read_each_vol_spectr_ctl & !! & (id_control, hd_block, v_pwr, c_buf) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! type(volume_spectr_control), intent(inout) :: v_pwr !! type(buffer_for_control), intent(inout) :: c_buf -!! subroutine write_each_vol_spectr_ctl & -!! & (id_control, hd_block, v_pwr, level) +!! subroutine write_each_vol_spectr_ctl(id_control, v_pwr, level) !! integer(kind = kint), intent(in) :: id_control -!! character(len=kchara), intent(in) :: hd_block !! type(volume_spectr_control), intent(in) :: v_pwr !! integer(kind = kint), intent(inout) :: level !! subroutine reset_volume_spectr_control(v_pwr) @@ -76,6 +73,8 @@ module t_ctl_data_sph_vol_spectr ! ! type volume_spectr_control +!> Block name + character(len=kchara) :: block_name = 'volume_spectrum_ctl' !> file name for volume mean square type(read_character_item) :: volume_spec_file_ctl !> file name for volume average @@ -128,22 +127,6 @@ module t_ctl_data_sph_vol_spectr contains ! ! ----------------------------------------------------------------------- -! - subroutine copy_volume_spectr_ctls(num_ctl, org_vpwr, new_vpwr) -! - integer(kind = kint), intent(in) :: num_ctl - type(volume_spectr_control), intent(in) :: org_vpwr(num_ctl) - type(volume_spectr_control), intent(inout) :: new_vpwr(num_ctl) -! - integer(kind = kint) :: i -! - do i = 1, num_ctl - call copy_volume_spectr_control(org_vpwr(i), new_vpwr(i)) - end do -! - end subroutine copy_volume_spectr_ctls -! -! ----------------------------------------------------------------------- ! subroutine copy_volume_spectr_control(org_vpwr, new_vpwr) ! @@ -171,6 +154,9 @@ subroutine copy_volume_spectr_control(org_vpwr, new_vpwr) & new_vpwr%inner_radius_ctl) call copy_real_ctl(org_vpwr%outer_radius_ctl, & & new_vpwr%outer_radius_ctl) +! + new_vpwr%i_vol_spectr_ctl = org_vpwr%i_vol_spectr_ctl + new_vpwr%block_name = org_vpwr%block_name ! end subroutine copy_volume_spectr_control ! @@ -186,10 +172,11 @@ subroutine read_each_vol_spectr_ctl & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(v_pwr%i_vol_spectr_ctl .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_chara_ctl_type(c_buf, hd_vol_pwr, & @@ -219,13 +206,11 @@ end subroutine read_each_vol_spectr_ctl ! ! ----------------------------------------------------------------------- ! - subroutine write_each_vol_spectr_ctl & - & (id_control, hd_block, v_pwr, level) + subroutine write_each_vol_spectr_ctl(id_control, v_pwr, level) ! use write_control_elements ! integer(kind = kint), intent(in) :: id_control - character(len=kchara), intent(in) :: hd_block type(volume_spectr_control), intent(in) :: v_pwr ! integer(kind = kint), intent(inout) :: level @@ -245,35 +230,68 @@ subroutine write_each_vol_spectr_ctl & maxlen = max(maxlen, len_trim(hd_diff_lm_spectr_switch)) maxlen = max(maxlen, len_trim(hd_axis_spectr_switch)) ! - write(id_control,'(a1)') '!' - level = write_begin_flag_for_ctl(id_control, level, hd_block) -! + level = write_begin_flag_for_ctl(id_control, level, & + & v_pwr%block_name) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_vol_pwr, v_pwr%volume_spec_file_ctl) + & v_pwr%volume_spec_file_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_vol_fmt, v_pwr%volume_spec_format_ctl) + & v_pwr%volume_spec_format_ctl) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_degree_spectr_switch, v_pwr%degree_v_spectra_switch) + & v_pwr%degree_v_spectra_switch) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_order_spectr_switch, v_pwr%order_v_spectra_switch) + & v_pwr%order_v_spectra_switch) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_diff_lm_spectr_switch, v_pwr%diff_v_lm_spectra_switch) + & v_pwr%diff_v_lm_spectra_switch) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_axis_spectr_switch, v_pwr%axis_v_power_switch) + & v_pwr%axis_v_power_switch) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_vol_ave, v_pwr%volume_ave_file_ctl) + & v_pwr%volume_ave_file_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_inner_r, v_pwr%inner_radius_ctl) + & v_pwr%inner_radius_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_outer_r, v_pwr%outer_radius_ctl) -! - level = write_end_flag_for_ctl(id_control, level, hd_block) + & v_pwr%outer_radius_ctl) + level = write_end_flag_for_ctl(id_control, level, & + & v_pwr%block_name) ! end subroutine write_each_vol_spectr_ctl ! ! ----------------------------------------------------------------------- +! + subroutine init_each_vol_spectr_labels(hd_block, v_pwr) +! + use write_control_elements +! + character(len=kchara), intent(in) :: hd_block + type(volume_spectr_control), intent(inout) :: v_pwr +! +! + v_pwr%block_name = hd_block + call init_chara_ctl_item_label(hd_vol_pwr, & + & v_pwr%volume_spec_file_ctl) + call init_chara_ctl_item_label(hd_vol_fmt, & + & v_pwr%volume_spec_format_ctl) +! + call init_chara_ctl_item_label(hd_degree_spectr_switch, & + & v_pwr%degree_v_spectra_switch) + call init_chara_ctl_item_label(hd_order_spectr_switch, & + & v_pwr%order_v_spectra_switch) + call init_chara_ctl_item_label(hd_diff_lm_spectr_switch, & + & v_pwr%diff_v_lm_spectra_switch) + call init_chara_ctl_item_label(hd_axis_spectr_switch, & + & v_pwr%axis_v_power_switch) +! + call init_chara_ctl_item_label(hd_vol_ave, & + & v_pwr%volume_ave_file_ctl) + call init_real_ctl_item_label(hd_inner_r, & + & v_pwr%inner_radius_ctl) + call init_real_ctl_item_label(hd_outer_r, & + & v_pwr%outer_radius_ctl) +! + end subroutine init_each_vol_spectr_labels +! +! ----------------------------------------------------------------------- ! ----------------------------------------------------------------------- ! subroutine reset_volume_spectr_control(v_pwr) diff --git a/src/Fortran_libraries/SERIAL_src/IO/t_read_control_elements.f90 b/src/Fortran_libraries/SERIAL_src/IO/t_read_control_elements.f90 index 05abf26f..5a89594a 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/t_read_control_elements.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/t_read_control_elements.f90 @@ -8,6 +8,8 @@ !! !!@verbatim !! subroutine load_one_line_from_control(id_control, c_buf) +!! integer(kind = kint), intent(in) :: id_control +!! character(len=kchara), intent(in) :: label !! type(buffer_for_control), intent(inout) :: c_buf !! !! character(len = kchara) function first_word(c_buf) @@ -20,13 +22,11 @@ !! logical function check_end_flag(c_buf, label) !! logical function check_array_flag(c_buf, label) !! logical function check_end_array_flag(c_buf, label) -!! type(buffer_for_control), intent(in) :: c_buf +!! type(buffer_for_control), intent(inout) :: c_buf !! !! subroutine monitor_read_control_label(c_buf) !! subroutine monitor_read_control_buffer(c_buf) !! type(buffer_for_control), intent(in) :: c_buf -!! -!! subroutine set_control_labels(label_f, label_c) !!@endverbatim !! module t_read_control_elements @@ -49,6 +49,10 @@ module t_read_control_elements character(len = kchara) :: header_chara !> temporal character for reading line character(len = 255) :: ctl_buffer +!> nesting level of control blocks + integer(kind = kint) :: level = 0 +!> flag for end of file + integer(kind = kint) :: iend = 0 end type buffer_for_control ! ! -------------------------------------------------------------------- @@ -57,15 +61,23 @@ module t_read_control_elements ! ! -------------------------------------------------------------------- ! - subroutine load_one_line_from_control(id_control, c_buf) + subroutine load_one_line_from_control(id_control, label, c_buf) ! use skip_comment_f ! integer(kind = kint), intent(in) :: id_control + character(len=kchara), intent(in) :: label type(buffer_for_control), intent(inout) :: c_buf ! ! - call skip_comment(c_buf%ctl_buffer, id_control) + call skip_comment(id_control, c_buf%ctl_buffer, c_buf%iend) +! + if(c_buf%iend .gt. 0) then + write(*,*) 'End of file is detected in reading ', & + & trim(label), ' block.' + return + end if +! c_buf%header_chara = first_word(c_buf) ! end subroutine load_one_line_from_control @@ -125,7 +137,7 @@ logical function check_begin_flag(c_buf, label) ! use skip_comment_f ! - type(buffer_for_control), intent(in) :: c_buf + type(buffer_for_control), intent(inout) :: c_buf character(len=kchara), intent(in) :: label ! ! @@ -159,7 +171,7 @@ logical function check_end_flag(c_buf, label) ! use skip_comment_f ! - type(buffer_for_control), intent(in) :: c_buf + type(buffer_for_control), intent(inout) :: c_buf character(len=kchara), intent(in) :: label ! ! @@ -176,7 +188,7 @@ logical function check_array_flag(c_buf, label) ! use skip_comment_f ! - type(buffer_for_control), intent(in) :: c_buf + type(buffer_for_control), intent(inout) :: c_buf character(len=kchara), intent(in) :: label ! character(len=kchara) :: tmpchara @@ -200,7 +212,7 @@ logical function check_end_array_flag(c_buf, label) ! use skip_comment_f ! - type(buffer_for_control), intent(in) :: c_buf + type(buffer_for_control), intent(inout) :: c_buf character(len=kchara), intent(in) :: label ! ! @@ -237,18 +249,5 @@ subroutine monitor_read_control_buffer(c_buf) end subroutine monitor_read_control_buffer ! ! -------------------------------------------------------------------- -! -------------------------------------------------------------------- -! - subroutine set_control_labels(label_f, label_c) -! - character(len = kchara), intent(inout) :: label_c - character(len = kchara), intent(in) :: label_f -! -! - write(label_c, '(a,a1)') trim(label_f) // char(0) -! - end subroutine set_control_labels -! -! ---------------------------------------------------------------------- ! end module t_read_control_elements diff --git a/src/Fortran_libraries/SERIAL_src/IO/time_data_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/time_data_IO.f90 index e8600a65..4ae6c121 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/time_data_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/time_data_IO.f90 @@ -11,8 +11,9 @@ !! subroutine read_step_data_buffer(textbuf, id_rank, t_IO) !! !! subroutine write_step_data(id_file, id_rank, t_IO) -!! subroutine read_step_data(id_file, t_IO) +!! subroutine read_step_data(id_file, t_IO, iend) !! type(time_data), intent(inout) :: t_IO +!! integer(kind = kint), intent(inout) :: iend !!@endverbatim !! !!@n @param id_rank Process ID @@ -112,22 +113,26 @@ end subroutine write_step_data ! ! ------------------------------------------------------------------- ! - subroutine read_step_data(id_file, t_IO) + subroutine read_step_data(id_file, t_IO, iend) ! use skip_comment_f ! integer(kind = kint), intent(in) :: id_file type(time_data), intent(inout) :: t_IO + integer(kind = kint), intent(inout) :: iend ! character(len=255) :: character_4_read integer(kind = kint) :: itmp ! ! - call skip_comment(character_4_read,id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) itmp - call skip_comment(character_4_read,id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) t_IO%i_time_step - call skip_comment(character_4_read,id_file) + call skip_comment(id_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*,err=99, end=99) & & t_IO%time, t_IO%dt ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/ucd_IO_select.F90 b/src/Fortran_libraries/SERIAL_src/IO/ucd_IO_select.F90 index 407dc88e..6400ac66 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/ucd_IO_select.F90 +++ b/src/Fortran_libraries/SERIAL_src/IO/ucd_IO_select.F90 @@ -257,7 +257,7 @@ subroutine sel_read_udt_param & if(ucd_param%iflag_format .eq. iflag_udt) then call read_alloc_udt_params(id_rank, file_name, ucd) else if(ucd_param%iflag_format .eq. iflag_vtd) then - call read_alloc_vtk_phys(id_rank, file_name, ucd) + call read_alloc_vtk_phys(id_rank, file_name, ucd, ierr) ! else if(ucd_param%iflag_format .eq. iflag_udt_bin) then call read_alloc_psf_bin_file(file_name, np_udt, t_IO, ucd) @@ -283,7 +283,8 @@ subroutine sel_read_udt_param & call read_alloc_ucd_2_fld_header_b & & (id_rank, file_name, t_IO, ucd, ierr) else - call read_alloc_ucd_2_fld_file(id_rank, file_name, t_IO, ucd) + call read_alloc_ucd_2_fld_file & + & (id_rank, file_name, t_IO, ucd, ierr) end if ! if(ierr .gt. 0) stop "sel_read_udt_file error" @@ -313,7 +314,7 @@ subroutine sel_read_alloc_udt_file & if(ucd_param%iflag_format .eq. iflag_udt) then call read_alloc_udt_file(id_rank, file_name, ucd) else if(ucd_param%iflag_format .eq. iflag_vtd) then - call read_alloc_vtk_phys(id_rank, file_name, ucd) + call read_alloc_vtk_phys(id_rank, file_name, ucd, ierr) ! else if(ucd_param%iflag_format .eq. iflag_udt_bin) then call read_alloc_psf_bin_file(file_name, np_udt, t_IO, ucd) @@ -339,7 +340,8 @@ subroutine sel_read_alloc_udt_file & call read_alloc_ucd_2_fld_file_b & & (id_rank, file_name, t_IO, ucd, ierr) else - call read_alloc_ucd_2_fld_file(id_rank, file_name, t_IO, ucd) + call read_alloc_ucd_2_fld_file & + & (id_rank, file_name, t_IO, ucd, ierr) end if ! if(ierr .gt. 0) stop "sel_read_udt_file error" @@ -359,6 +361,7 @@ subroutine sel_read_alloc_ucd_file & type(ucd_data), intent(inout) :: ucd ! character(len=kchara) :: file_name, grid_name + integer(kind = kint) :: ierr = 0 ! ! file_name = set_parallel_ucd_file_name(ucd_param%file_prefix, & @@ -378,10 +381,10 @@ subroutine sel_read_alloc_ucd_file & if (ucd_param%iflag_format .eq. iflag_ucd) then call read_alloc_ucd_file(id_rank, file_name, ucd) else if(ucd_param%iflag_format .eq. iflag_vtk) then - call read_alloc_vtk_file(id_rank, file_name, ucd) + call read_alloc_vtk_file(id_rank, file_name, ucd, ierr) else if(ucd_param%iflag_format .eq. iflag_vtd) then call read_alloc_vtk_grid(id_rank, grid_name, ucd) - call read_alloc_vtk_phys(id_rank, file_name, ucd) + call read_alloc_vtk_phys(id_rank, file_name, ucd, ierr) ! else if(ucd_param%iflag_format .eq. iflag_ucd_bin) then call read_alloc_iso_bin_file(file_name, t_IO, ucd) @@ -412,6 +415,8 @@ subroutine sel_read_alloc_ucd_file & call read_alloc_grd_file(id_rank, grid_name, ucd) call read_alloc_udt_file(id_rank, file_name, ucd) end if +! + if(ierr .gt. 0) stop 'Field file read error' ! end subroutine sel_read_alloc_ucd_file ! @@ -463,7 +468,7 @@ subroutine sel_read_udt_file & else if (ucd_param%iflag_format .eq. iflag_bin) then call read_ucd_2_fld_file_b(id_rank, file_name, t_IO, ucd, ierr) else - call read_ucd_2_fld_file(id_rank, file_name, t_IO, ucd) + call read_ucd_2_fld_file(id_rank, file_name, t_IO, ucd, ierr) end if ! if(ierr .gt. 0) stop "sel_read_udt_file error" diff --git a/src/Fortran_libraries/SERIAL_src/IO/ucd_field_file_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/ucd_field_file_IO.f90 index 1aaf4935..ed1c3cb4 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/ucd_field_file_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/ucd_field_file_IO.f90 @@ -11,11 +11,13 @@ !! type(time_data), intent(in) :: t_IO !! type(ucd_data), intent(in) :: ucd !! -!! subroutine read_ucd_2_fld_file(id_rank, file_name, t_IO, ucd) +!! subroutine read_ucd_2_fld_file & +!! & (id_rank, file_name, t_IO, ucd, iend) !! subroutine read_alloc_ucd_2_fld_file & -!! & (id_rank, file_name, t_IO, ucd) +!! & (id_rank, file_name, t_IO, ucd, iend) !! type(time_data), intent(inout) :: t_IO !! type(ucd_data), intent(inout) :: ucd +!! integer(kind = kint), intent(inout) :: iend !!@endverbatim !! !!@param id_rank process ID @@ -72,7 +74,8 @@ end subroutine write_ucd_2_fld_file !------------------------------------------------------------------ !------------------------------------------------------------------ ! - subroutine read_ucd_2_fld_file(id_rank, file_name, t_IO, ucd) + subroutine read_ucd_2_fld_file & + & (id_rank, file_name, t_IO, ucd, iend) ! use skip_comment_f ! @@ -80,6 +83,7 @@ subroutine read_ucd_2_fld_file(id_rank, file_name, t_IO, ucd) integer, intent(in) :: id_rank type(time_data), intent(inout) :: t_IO type(ucd_data), intent(inout) :: ucd + integer(kind = kint), intent(inout) :: iend ! character(len=255) :: character_4_read ! @@ -89,14 +93,17 @@ subroutine read_ucd_2_fld_file(id_rank, file_name, t_IO, ucd) ! open(id_fld_file, file = file_name, form = 'formatted') ! - call read_step_data(id_fld_file, t_IO) + call read_step_data(id_fld_file, t_IO, iend) + if(iend .gt. 0) return ! - call skip_comment(character_4_read, id_fld_file) + call skip_comment(id_fld_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) ucd%nnod, ucd%num_field read(id_fld_file,*) ucd%num_comp(1:ucd%num_field) ! call read_field_data(id_fld_file, ucd%nnod, ucd%num_field, & - & ucd%ntot_comp, ucd%num_comp, ucd%phys_name, ucd%d_ucd) + & ucd%ntot_comp, ucd%num_comp, ucd%phys_name, ucd%d_ucd, iend) + if(iend .gt. 0) return ! close (id_fld_file) ! @@ -105,7 +112,7 @@ end subroutine read_ucd_2_fld_file !------------------------------------------------------------------ ! subroutine read_alloc_ucd_2_fld_file & - & (id_rank, file_name, t_IO, ucd) + & (id_rank, file_name, t_IO, ucd, iend) ! use skip_comment_f ! @@ -113,6 +120,7 @@ subroutine read_alloc_ucd_2_fld_file & integer, intent(in) :: id_rank type(time_data), intent(inout) :: t_IO type(ucd_data), intent(inout) :: ucd + integer(kind = kint), intent(inout) :: iend ! character(len=255) :: character_4_read ! @@ -122,9 +130,11 @@ subroutine read_alloc_ucd_2_fld_file & ! open(id_fld_file, file = file_name, form = 'formatted') ! - call read_step_data(id_fld_file, t_IO) + call read_step_data(id_fld_file, t_IO, iend) + if(iend .gt. 0) return ! - call skip_comment(character_4_read, id_fld_file) + call skip_comment(id_fld_file, character_4_read, iend) + if(iend .gt. 0) return read(character_4_read,*) ucd%nnod, ucd%num_field ! call allocate_ucd_phys_name(ucd) @@ -135,7 +145,8 @@ subroutine read_alloc_ucd_2_fld_file & ! call read_field_data(id_fld_file, & & ucd%nnod, ucd%num_field, ucd%ntot_comp, & - & ucd%num_comp, ucd%phys_name, ucd%d_ucd) + & ucd%num_comp, ucd%phys_name, ucd%d_ucd, iend) + if(iend .gt. 0) return ! close (id_fld_file) ! diff --git a/src/Fortran_libraries/SERIAL_src/IO/udt_to_VTK_data_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/udt_to_VTK_data_IO.f90 index 5c371cd0..9f46de5f 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/udt_to_VTK_data_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/udt_to_VTK_data_IO.f90 @@ -12,7 +12,7 @@ !! type(ucd_data), intent(in) :: ucd !! !! subroutine read_udt_field_from_VTK(id_vtk, ucd) -!! subroutine read_alloc_udt_field_from_VTK(id_vtk, ucd) +!! subroutine read_alloc_udt_field_from_VTK(id_vtk, ucd, iend) !! subroutine read_ucd_mesh_from_VTK(id_vtk, ucd) !! subroutine read_alloc_ucd_mesh_from_VTK(id_vtk, ucd) !! type(ucd_data), intent(inout) :: ucd @@ -77,13 +77,14 @@ subroutine read_udt_field_from_VTK(id_vtk, ucd) integer(kind = kint), intent(in) :: id_vtk type(ucd_data), intent(inout) :: ucd ! - integer(kind = kint) :: i_field, iflag_end, ncomp_field + integer(kind = kint) :: i_field, iflag_end, ncomp_field, iend character(len=kchara) :: field_name real(kind = kreal), allocatable :: d_tmp(:,:) integer(kind=kint_gl) :: nnod ! ! - call read_vtk_fields_head(id_vtk, nnod) + call read_vtk_fields_head(id_vtk, nnod, iend) + if(iend .gt. 0) write(*,*) 'Error in file' if(nnod .ne. ucd%nnod) write(*,*) 'Error in number of node' ! i_field = 0 @@ -118,10 +119,11 @@ end subroutine read_udt_field_from_VTK ! !----------------------------------------------------------------------- ! - subroutine read_alloc_udt_field_from_VTK(id_vtk, ucd) + subroutine read_alloc_udt_field_from_VTK(id_vtk, ucd, iend) ! integer(kind = kint), intent(in) :: id_vtk type(ucd_data), intent(inout) :: ucd + integer(kind = kint), intent(inout) :: iend ! type(ucd_data) :: tmp ! @@ -130,7 +132,8 @@ subroutine read_alloc_udt_field_from_VTK(id_vtk, ucd) real(kind = kreal), allocatable :: d_tmp(:,:) ! ! - call read_vtk_fields_head(id_vtk, ucd%nnod) + call read_vtk_fields_head(id_vtk, ucd%nnod, iend) + if(iend .gt. 0) write(*,*) 'Error in file' ! tmp%nnod = ucd%nnod ucd%num_field = 0 diff --git a/src/Fortran_libraries/SERIAL_src/IO/vtk_data_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/vtk_data_IO.f90 index 30e8e7b3..1117196d 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/vtk_data_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/vtk_data_IO.f90 @@ -17,11 +17,12 @@ !! subroutine write_vtk_connect_data & !! & (id_vtk, ntot_ele, nnod_ele, nele, ie) !! -!! subroutine read_vtk_fields_head(id_vtk, nnod) +!! subroutine read_vtk_fields_head(id_vtk, nnod, iend) !! subroutine read_vtk_each_field_head & !! & (id_vtk, iflag_end, ncomp_field, field_name) !! subroutine read_vtk_each_field & !! & (id_vtk, ntot_nod, ncomp_field, nnod, d_nod) +!! integer(kind = kint), intent(inout) :: iend !! !! subroutine read_vtk_node_head(id_vtk, nnod) !! subroutine read_vtk_connect_head(id_vtk, nele, nnod_ele) @@ -205,17 +206,19 @@ end subroutine write_vtk_data ! ----------------------------------------------------------------------- ! ---------------------------------------------------------------------- ! - subroutine read_vtk_fields_head(id_vtk, nnod) + subroutine read_vtk_fields_head(id_vtk, nnod, iend) ! use skip_comment_f ! integer(kind = kint), intent(in) :: id_vtk integer(kind=kint_gl), intent(inout) :: nnod + integer(kind = kint), intent(inout) :: iend ! character(len=kchara) :: tmpchara, label ! ! - call skip_comment(tmpchara, id_vtk) + call skip_comment(id_vtk, tmpchara, iend) + if(iend .gt. 0) return read(tmpchara,*) label, nnod ! end subroutine read_vtk_fields_head diff --git a/src/Fortran_libraries/SERIAL_src/IO/vtk_file_IO.f90 b/src/Fortran_libraries/SERIAL_src/IO/vtk_file_IO.f90 index ccc4490f..b76c696c 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/vtk_file_IO.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/vtk_file_IO.f90 @@ -25,8 +25,8 @@ !! character(len=kchara), intent(in) :: file_name !! type(ucd_data), intent(inout) :: ucd !! -!! subroutine read_alloc_vtk_file(id_rank, file_name, ucd) -!! subroutine read_alloc_vtk_phys(id_rank, file_name, ucd) +!! subroutine read_alloc_vtk_file(id_rank, file_name, ucd, iend) +!! subroutine read_alloc_vtk_phys(id_rank, file_name, ucd, iend) !! subroutine read_alloc_vtk_grid(id_rank, file_name, ucd) !! integer, intent(in) :: id_rank !! character(len=kchara), intent(in) :: file_name @@ -214,11 +214,12 @@ end subroutine read_vtk_grid ! ----------------------------------------------------------------------- ! ----------------------------------------------------------------------- ! - subroutine read_alloc_vtk_file(id_rank, file_name, ucd) + subroutine read_alloc_vtk_file(id_rank, file_name, ucd, iend) ! integer, intent(in) :: id_rank character(len=kchara), intent(in) :: file_name type(ucd_data), intent(inout) :: ucd + integer(kind = kint), intent(inout) :: iend ! ! if(id_rank.le.0 .or. i_debug .gt. 0) write(*,*) & @@ -227,18 +228,19 @@ subroutine read_alloc_vtk_file(id_rank, file_name, ucd) open(id_vtk_file, file=file_name, & & form='formatted', status ='old') call read_alloc_ucd_mesh_from_VTK(id_vtk_file, ucd) - call read_alloc_udt_field_from_VTK(id_vtk_file, ucd) + call read_alloc_udt_field_from_VTK(id_vtk_file, ucd, iend) close(id_vtk_file) ! end subroutine read_alloc_vtk_file ! !----------------------------------------------------------------------- ! - subroutine read_alloc_vtk_phys(id_rank, file_name, ucd) + subroutine read_alloc_vtk_phys(id_rank, file_name, ucd, iend) ! character(len=kchara), intent(in) :: file_name integer, intent(in) :: id_rank type(ucd_data), intent(inout) :: ucd + integer(kind = kint), intent(inout) :: iend ! ! if(id_rank.le.0 .or. i_debug .gt. 0) write(*,*) & @@ -246,7 +248,7 @@ subroutine read_alloc_vtk_phys(id_rank, file_name, ucd) ! open(id_vtk_file, file=file_name, & & form='formatted', status ='old') - call read_alloc_udt_field_from_VTK(id_vtk_file, ucd) + call read_alloc_udt_field_from_VTK(id_vtk_file, ucd, iend) close(id_vtk_file) ! end subroutine read_alloc_vtk_phys diff --git a/src/Fortran_libraries/SERIAL_src/IO/write_control_elements.f90 b/src/Fortran_libraries/SERIAL_src/IO/write_control_elements.f90 index 3ccd01a8..08bfc80a 100644 --- a/src/Fortran_libraries/SERIAL_src/IO/write_control_elements.f90 +++ b/src/Fortran_libraries/SERIAL_src/IO/write_control_elements.f90 @@ -34,11 +34,13 @@ !! subroutine write_integer3_ctl_item & !! & (id_file, level, maxlen, label, int1, int2, int3) !! subroutine write_chara_real_ctl_item & -!! & (id_file, level, maxlen, label, chara_data, real_data) +!! & (id_file, level, maxlen, label, chara1, real_data) !! subroutine write_chara_real2_ctl_item(id_file, level, maxlen, & !! & label, chara_data, real1, real2) !! subroutine write_chara2_real_ctl_item(id_file, level, maxlen, & !! & label, chara1, chara2, real_data) +!! subroutine write_chara2_int_ctl_item(id_file, level, maxlen, & +!! & label, chara1, chara2, int_data) !! subroutine write_chara_int_ctl_item & !! & (id_file, level, maxlen, label, chara_data, int_data) !! subroutine write_i2_r_ctl_item & @@ -63,6 +65,12 @@ !! character(len=kchara), intent(in) :: label !! character(len=kchara), intent(in) :: fname(num) !! integer(kind = kint), intent(inout) :: level +!! +!! subroutine write_multi_ctl_file_message(label, num, level) +!! subroutine write_one_ctl_file_message(label, level, file_name) +!! subroutine write_included_message(label, level) +!! integer (kind=kint), intent(in) :: num, level +!! character(len=kchara), intent(in) :: label, file_name !!@endverbatim !! !!@n @param ctl_name label for control block @@ -96,6 +104,9 @@ module write_control_elements ! implicit none ! +!> file ID to output on screen + integer(kind = kint), parameter :: id_monitor = 6 +! !> Label to start a control block character(len=kchara), parameter :: hd_begin = 'begin' !> Label to end a control block @@ -383,25 +394,26 @@ end subroutine write_integer3_ctl_item ! -------------------------------------------------------------------- ! subroutine write_chara_real_ctl_item & - & (id_file, level, maxlen, label, chara_data, real_data) + & (id_file, level, maxlen, label, chara1, real_data) ! use write_control_items ! integer(kind = kint), intent(in) :: id_file, level - integer(kind = kint), intent(in) :: maxlen + integer(kind = kint), intent(in) :: maxlen(0:1) character(len=kchara), intent(in) :: label - character(len=kchara), intent(in) :: chara_data + character(len=kchara), intent(in) :: chara1 real(kind = kreal), intent(in) :: real_data ! - integer(kind = kint) :: nspace0 -! - nspace0 = maxlen - len_trim(label) + 4 + integer(kind = kint) :: nspace0, nspace1 ! + nspace0 = maxlen(0) - len_trim(label) + nspace1 = maxlen(1) - len_trim(chara1) - 2 * iflag_divide(chara1) ! call write_space_4_parse(id_file, level) call write_ctl_chara_cont(id_file, label) call write_spaces(id_file, nspace0) - call write_ctl_chara_cont(id_file, chara_data) + call write_ctl_chara_cont(id_file, chara1) + call write_spaces(id_file, nspace1) write(id_file,'(a2,1pE25.15e3)') ' ', real_data ! end subroutine write_chara_real_ctl_item @@ -458,6 +470,32 @@ subroutine write_chara2_real_ctl_item(id_file, level, maxlen, & end subroutine write_chara2_real_ctl_item ! ! -------------------------------------------------------------------- +! + subroutine write_chara2_int_ctl_item(id_file, level, maxlen, & + & label, chara1, chara2, int_data) +! + use write_control_items +! + integer(kind = kint), intent(in) :: id_file, level + integer(kind = kint), intent(in) :: maxlen + character(len=kchara), intent(in) :: label + character(len=kchara), intent(in) :: chara1, chara2 + integer(kind = kint), intent(in) :: int_data +! + integer(kind = kint) :: nspace0 +! + nspace0 = maxlen - len_trim(label) + 4 +! + call write_space_4_parse(id_file, level) + call write_ctl_chara_cont(id_file, label) + call write_spaces(id_file, nspace0) + call write_ctl_chara_cont(id_file, chara1) + call write_ctl_chara_cont(id_file, chara2) + write(id_file,'(i16)') int_data +! + end subroutine write_chara2_int_ctl_item +! +! -------------------------------------------------------------------- ! subroutine write_chara_int_ctl_item & & (id_file, level, maxlen, label, chara_data, int_data) @@ -677,5 +715,51 @@ subroutine write_file_names_from_ctl_line & end subroutine write_file_names_from_ctl_line ! ! -------------------------------------------------------------------- +! -------------------------------------------------------------------- +! + subroutine write_multi_ctl_file_message(label, num, level) + use write_control_items + integer (kind=kint), intent(in) :: num, level + character(len=kchara), intent(in) :: label +! + write(id_monitor,'(a)',ADVANCE='NO') '! ' + call write_space_4_parse(id_monitor, level) + write(id_monitor,'(2a)',ADVANCE='NO') 'Control for ', trim(label) + if(num .le. 0) return +! + write(id_monitor,'(a,i4)', ADVANCE='NO') ' No. ', num +! + end subroutine write_multi_ctl_file_message +! +! -------------------------------------------------------------------- +! + subroutine write_one_ctl_file_message(label, level, file_name) + use write_control_items + integer (kind=kint), intent(in) :: level + character(len=kchara), intent(in) :: label, file_name +! + write(id_monitor,'(a)',ADVANCE='NO') '! ' + call write_space_4_parse(id_monitor, level) + write(id_monitor,'(4a)') 'Control for ', trim(label), & + & ' is read from file... ', trim(file_name) +! + end subroutine write_one_ctl_file_message +! +! -------------------------------------------------------------------- +! + subroutine write_included_message(label, level) + use write_control_items + integer (kind=kint), intent(in) :: level + character(len=kchara), intent(in) :: label +! + write(id_monitor,'(a)',ADVANCE='NO') '! ' + call write_space_4_parse(id_monitor, level) + write(id_monitor,'(3a)') 'Control for ', trim(label), & + & ' is included.' +! + end subroutine write_included_message +! +! -------------------------------------------------------------------- +! -------------------------------------------------------------------- ! end module write_control_elements diff --git a/src/Fortran_libraries/SERIAL_src/IO_ZLIB/Makefile b/src/Fortran_libraries/SERIAL_src/IO_ZLIB/Makefile index 5a46c670..fcdcc891 100644 --- a/src/Fortran_libraries/SERIAL_src/IO_ZLIB/Makefile +++ b/src/Fortran_libraries/SERIAL_src/IO_ZLIB/Makefile @@ -13,7 +13,9 @@ MOD_ZLIB_IO = $(addsuffix .o,$(basename $(SOURCES)) ) dir_list: @echo 'ZLIB_IO_DIR = $(ZLIB_IO_DIR)' >> $(MAKENAME) -lib_archve: +libtarget: + +lib_archve: libtarget @echo ' $$(AR) $$(ARFLUGS) rcsv $$@ $$(MOD_ZLIB_IO)' >> $(MAKENAME) mod_list: diff --git a/src/Fortran_libraries/SERIAL_src/IO_ZLIB/input_old_file_sel_4_zlib.F90 b/src/Fortran_libraries/SERIAL_src/IO_ZLIB/input_old_file_sel_4_zlib.F90 index 79ef8ff7..9de5354d 100644 --- a/src/Fortran_libraries/SERIAL_src/IO_ZLIB/input_old_file_sel_4_zlib.F90 +++ b/src/Fortran_libraries/SERIAL_src/IO_ZLIB/input_old_file_sel_4_zlib.F90 @@ -10,12 +10,17 @@ !! !!@verbatim !! subroutine sel_read_alloc_field_file & -!! & (id_rank, istep_fld, file_IO, fld_IO) +!! & (id_rank, istep_fld, file_IO, fld_IO, ierr_IO) +!! integer, intent(in) :: id_rank +!! integer(kind = kint), intent(in) :: istep_fld +!! type(field_IO_params), intent(in) :: file_IO +!! type(field_IO), intent(inout) :: fld_IO +!! integer(kind = kint), intent(inout) :: ierr_IO !! !! subroutine sel_read_rst_file & -!! & (id_rank, istep_fld, file_IO, t_IO, fld_IO) +!! & (id_rank, istep_fld, file_IO, t_IO, fld_IO, ierr_IO) !! subroutine sel_read_rst_comps & -!! & (id_rank, istep_fld, file_IO, t_IO, fld_IO) +!! & (id_rank, istep_fld, file_IO, t_IO, fld_IO, ierr_IO) !! type(field_IO_params), intent(in) :: file_IO !! type(time_data), intent(inout) :: t_IO !! type(field_IO), intent(inout) :: fld_IO @@ -44,7 +49,7 @@ module input_old_file_sel_4_zlib !------------------------------------------------------------------ ! subroutine sel_read_alloc_field_file & - & (id_rank, istep_fld, file_IO, fld_IO) + & (id_rank, istep_fld, file_IO, fld_IO, ierr_IO) ! use field_file_IO use set_field_file_names @@ -53,6 +58,8 @@ subroutine sel_read_alloc_field_file & integer(kind = kint), intent(in) :: istep_fld type(field_IO_params), intent(in) :: file_IO type(field_IO), intent(inout) :: fld_IO + integer(kind = kint), intent(inout) :: ierr_IO +! character(len=kchara) :: file_name ! ! @@ -67,7 +74,8 @@ subroutine sel_read_alloc_field_file & end if #endif ! - call read_and_allocate_field_file(file_name, id_rank, fld_IO) + call read_and_allocate_field_file(file_name, id_rank, & + & fld_IO, ierr_IO) ! end subroutine sel_read_alloc_field_file ! @@ -75,7 +83,7 @@ end subroutine sel_read_alloc_field_file !------------------------------------------------------------------ ! subroutine sel_read_rst_file & - & (id_rank, istep_fld, file_IO, t_IO, fld_IO) + & (id_rank, istep_fld, file_IO, t_IO, fld_IO, ierr_IO) ! use rst_data_IO_by_fld use set_parallel_file_name @@ -85,9 +93,9 @@ subroutine sel_read_rst_file & type(field_IO_params), intent(in) :: file_IO type(time_data), intent(inout) :: t_IO type(field_IO), intent(inout) :: fld_IO + integer(kind = kint), intent(inout) :: ierr_IO ! character(len=kchara) :: file_name, fname_tmp - integer(kind = kint) :: ierr_IO = 0 ! ! if(istep_fld .lt. 0) then @@ -106,15 +114,14 @@ subroutine sel_read_rst_file & end if #endif ! - call read_rst_file(id_rank, file_name, t_IO, fld_IO) -! + call read_rst_file(id_rank, file_name, t_IO, fld_IO, ierr_IO) ! end subroutine sel_read_rst_file ! !------------------------------------------------------------------ ! subroutine sel_read_rst_comps & - & (id_rank, istep_fld, file_IO, t_IO, fld_IO) + & (id_rank, istep_fld, file_IO, t_IO, fld_IO, ierr_IO) ! use rst_data_IO_by_fld use set_parallel_file_name @@ -124,9 +131,9 @@ subroutine sel_read_rst_comps & type(field_IO_params), intent(in) :: file_IO type(time_data), intent(inout) :: t_IO type(field_IO), intent(inout) :: fld_IO + integer(kind=kint), intent(inout) :: ierr_IO ! character(len=kchara) :: file_name, fname_tmp - integer(kind=kint) :: ierr ! ! if(istep_fld .lt. 0) then @@ -138,12 +145,14 @@ subroutine sel_read_rst_comps & ! #ifdef ZLIB_IO if(file_IO%iflag_format .eq. id_gzip_txt_file_fmt) then - call read_gz_rst_comps(id_rank, file_name, t_IO, fld_IO, ierr) + call read_gz_rst_comps(id_rank, file_name, & + & t_IO, fld_IO, ierr_IO) return end if #endif ! - call read_rst_data_comps(id_rank, file_name, t_IO, fld_IO) + call read_rst_data_comps(id_rank, file_name, & + & t_IO, fld_IO, ierr_IO) ! end subroutine sel_read_rst_comps ! diff --git a/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/Makefile b/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/Makefile index 0bc90b83..6f55f0bb 100644 --- a/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/Makefile +++ b/src/Fortran_libraries/SERIAL_src/SPH_SPECTR_src/Makefile @@ -13,7 +13,9 @@ MOD_SPH_SPECTR = $(addsuffix .o,$(basename $(SOURCES)) ) dir_list: @echo 'SPH_SPECTR_DIR = $(SPH_SPECTR_DIR)' >> $(MAKENAME) -lib_archve: +libtarget: + +lib_archve: libtarget @echo ' $$(AR) $$(ARFLUGS) rcsv $$@ $$(MOD_SPH_SPECTR)' >> $(MAKENAME) mod_list: diff --git a/src/Fortran_libraries/SERIAL_src/gauss_integration/Makefile b/src/Fortran_libraries/SERIAL_src/gauss_integration/Makefile index 24ab9008..b2822133 100644 --- a/src/Fortran_libraries/SERIAL_src/gauss_integration/Makefile +++ b/src/Fortran_libraries/SERIAL_src/gauss_integration/Makefile @@ -14,7 +14,9 @@ MOD_GAUSS = $(addsuffix .o,$(basename $(SOURCES)) ) dir_list: @echo 'GAUSSDIR = $(GAUSSDIR)' >> $(MAKENAME) -lib_archve: +libtarget: + +lib_archve: libtarget @echo ' $$(AR) $$(ARFLUGS) rcsv $$@ $$(MOD_GAUSS)' >> $(MAKENAME) mod_list: diff --git a/src/Fortran_libraries/SERIAL_src/spherical_harmonics/Makefile b/src/Fortran_libraries/SERIAL_src/spherical_harmonics/Makefile index bcf61326..cc37281d 100644 --- a/src/Fortran_libraries/SERIAL_src/spherical_harmonics/Makefile +++ b/src/Fortran_libraries/SERIAL_src/spherical_harmonics/Makefile @@ -13,7 +13,9 @@ MOD_SPH = $(addsuffix .o,$(basename $(SOURCES)) ) dir_list: @echo 'SPH_DIR = $(SPH_DIR)' >> $(MAKENAME) -lib_archve: +libtarget: + +lib_archve: libtarget @echo ' $$(AR) $$(ARFLUGS) rcsv $$@ $$(MOD_SPH)' >> $(MAKENAME) mod_list: diff --git a/src/Fortran_libraries/SOLVER_src/direct_solver/Makefile b/src/Fortran_libraries/SOLVER_src/direct_solver/Makefile index 94ce3b02..9031cfba 100644 --- a/src/Fortran_libraries/SOLVER_src/direct_solver/Makefile +++ b/src/Fortran_libraries/SOLVER_src/direct_solver/Makefile @@ -13,7 +13,9 @@ MOD_SOLVER_LU = $(addsuffix .o,$(basename $(SOURCES)) ) dir_list: @echo 'SOLVER_LU_DIR = $(SOLVER_LU_DIR)' >> $(MAKENAME) -lib_archve: +libtarget: + +lib_archve: libtarget @echo ' ''$$(AR)' '$$(ARFLUGS)' rcsv '$$@' '$$(MOD_SOLVER_LU)' >> $(MAKENAME) diff --git a/src/Fortran_libraries/UTILS_src/MERGE/Makefile b/src/Fortran_libraries/UTILS_src/MERGE/Makefile index 9d81763b..9cfbc346 100644 --- a/src/Fortran_libraries/UTILS_src/MERGE/Makefile +++ b/src/Fortran_libraries/UTILS_src/MERGE/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_MERGE)' >> $(MAKENAME) mod_list: diff --git a/src/Fortran_libraries/UTILS_src/MERGE/new_SPH_restart.f90 b/src/Fortran_libraries/UTILS_src/MERGE/new_SPH_restart.f90 index 067b12c5..5dbbd92e 100644 --- a/src/Fortran_libraries/UTILS_src/MERGE/new_SPH_restart.f90 +++ b/src/Fortran_libraries/UTILS_src/MERGE/new_SPH_restart.f90 @@ -168,6 +168,7 @@ subroutine load_old_fmt_sph_data(istep, org_fst_param, & !> Field data IO structure for original data type(field_IO) :: org_fst_IO integer(kind = kint) :: n_point + integer(kind = kint) :: ierr_IO = 0 integer :: irank_new, iloop, ip ! ! @@ -176,7 +177,9 @@ subroutine load_old_fmt_sph_data(istep, org_fst_param, & ip = irank_new + 1 ! call sel_read_alloc_field_file & - & (irank_new, istep, org_fst_param, org_fst_IO) + & (irank_new, istep, org_fst_param, org_fst_IO, ierr_IO) + if(ierr_IO .gt. 0) call calypso_MPI_abort(ierr_IO, & + & 'Read file error in sel_read_alloc_field_file') ! if(irank_new .lt. org_sph_array%num_pe) then n_point = org_sph_array%sph(ip)%sph_rj%nnod_rj diff --git a/src/Fortran_libraries/UTILS_src/MERGE/t_control_data_4_merge.f90 b/src/Fortran_libraries/UTILS_src/MERGE/t_control_data_4_merge.f90 index 38d38442..d7a1ab93 100644 --- a/src/Fortran_libraries/UTILS_src/MERGE/t_control_data_4_merge.f90 +++ b/src/Fortran_libraries/UTILS_src/MERGE/t_control_data_4_merge.f90 @@ -7,7 +7,7 @@ !>@brief Control data for merge program !! !!@verbatim -!! subroutine read_control_4_merge(mgd_ctl) +!! subroutine read_control_4_merge(ctl_file_name, mgd_ctl) !! subroutine read_control_assemble_sph(mgd_ctl) !! subroutine reset_merge_control_data(mgd_ctl) !! type(control_data_4_merge), intent(inout) :: mgd_ctl @@ -29,14 +29,12 @@ module t_control_data_4_merge implicit none ! integer (kind = kint), parameter :: control_file_code = 13 - character (len = kchara), parameter & - & :: control_file_name = 'control_merge' - character (len = kchara), parameter & - & :: ctl_assemble_sph_name = 'control_assemble_sph' -! ! !> Structure for merged program control type control_data_4_merge +!> Block name + character(len=kchara) :: block_name = 'assemble_control' +! !> File name to read original spherical shell control file character (len = kchara) :: fname_src_psph_ctl !> Structure for file information for original data @@ -103,7 +101,6 @@ module t_control_data_4_merge & :: hd_magnetic_field_ratio = 'magnetic_field_ratio_ctl' ! private :: control_file_code - private :: ctl_assemble_sph_name, control_file_name private :: hd_assemble private :: hd_platform, hd_new_data, hd_model, hd_control private :: hd_phys_values, hd_time_step, hd_new_time_step @@ -120,43 +117,57 @@ module t_control_data_4_merge ! ! ----------------------------------------------------------------------- ! - subroutine read_control_4_merge(mgd_ctl) + subroutine read_control_4_merge(file_name, mgd_ctl) ! + character (len = kchara), intent(in) :: file_name type(control_data_4_merge), intent(inout) :: mgd_ctl ! type(buffer_for_control) :: c_buf1 ! ! - open (control_file_code, file = control_file_name) + c_buf1%level = 0 + open (control_file_code, file = file_name) ! do - call load_one_line_from_control(control_file_code, c_buf1) - call read_merge_control_data(control_file_code, hd_assemble, & + call load_one_line_from_control(control_file_code, & + & hd_assemble, c_buf1) + if(c_buf1%iend .gt. 0) exit +! + call read_merge_control_data(control_file_code, hd_assemble, & & mgd_ctl, c_buf1) if(mgd_ctl%i_assemble .gt. 0) exit end do close(control_file_code) +! + if(c_buf1%iend .gt. 0) mgd_ctl%i_assemble = c_buf1%iend ! end subroutine read_control_4_merge ! ! ----------------------------------------------------------------------- ! - subroutine read_control_assemble_sph(mgd_ctl) + subroutine read_control_assemble_sph(file_name, mgd_ctl) ! + character (len = kchara), intent(in) :: file_name type(control_data_4_merge), intent(inout) :: mgd_ctl ! type(buffer_for_control) :: c_buf1 ! ! - open (control_file_code, file = ctl_assemble_sph_name) + c_buf1%level = 0 + open (control_file_code, file = file_name) ! do - call load_one_line_from_control(control_file_code, c_buf1) - call read_merge_control_data(control_file_code, hd_assemble, & - & mgd_ctl, c_buf1) + call load_one_line_from_control(control_file_code, & + & hd_assemble, c_buf1) + if(c_buf1%iend .gt. 0) exit +! + call read_merge_control_data(control_file_code, hd_assemble, & + & mgd_ctl, c_buf1) if(mgd_ctl%i_assemble .gt. 0) exit end do close(control_file_code) +! + if(c_buf1%iend .gt. 0) mgd_ctl%i_assemble = c_buf1%iend ! end subroutine read_control_assemble_sph ! @@ -176,10 +187,17 @@ subroutine read_merge_control_data & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(mgd_ctl%i_assemble .gt. 0) return + call init_platforms_labels(hd_platform, mgd_ctl%source_plt) + call init_platforms_labels(hd_new_data, mgd_ctl%assemble_plt) + call init_parallel_shell_ctl_label(hd_orgsph_shell, & + & mgd_ctl%src_psph_ctl) + call init_parallel_shell_ctl_label(hd_newsph_shell, & + & mgd_ctl%asbl_psph_ctl) + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_platforms & @@ -236,10 +254,13 @@ subroutine read_merge_field_data & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(mgd_ctl%i_model .gt. 0) return + call init_phys_data_ctl_label(hd_phys_values, & + & mgd_ctl%fld_mge_ctl) + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_phys_data_control & @@ -276,10 +297,14 @@ subroutine read_merge_step_data & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(mgd_ctl%i_control .gt. 0) return + call init_ctl_time_step_label(hd_time_step, mgd_ctl%t_mge_ctl) + call init_ctl_time_step_label(hd_new_time_step, & + & mgd_ctl%t2_mge_ctl) + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_time_step_data & @@ -318,7 +343,8 @@ subroutine read_newrst_control & if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(mgd_ctl%i_newrst_magne .gt. 0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_real_ctl_type(c_buf, hd_magnetic_field_ratio, & diff --git a/src/Fortran_libraries/UTILS_src/MESH/Makefile b/src/Fortran_libraries/UTILS_src/MESH/Makefile index f6bb5c60..7c783926 100644 --- a/src/Fortran_libraries/UTILS_src/MESH/Makefile +++ b/src/Fortran_libraries/UTILS_src/MESH/Makefile @@ -13,7 +13,9 @@ MOD_MESH = $(addsuffix .o,$(basename $(SOURCES)) ) dir_list: @echo 'MESHDIR = $(MESHDIR)' >> $(MAKENAME) -lib_archve: +libtarget: + +lib_archve: libtarget @echo ' $$(AR) $$(ARFLUGS) rcsv $$@ $$(MOD_MESH)' >> $(MAKENAME) diff --git a/src/Fortran_libraries/VIZ_src/surfacing/Makefile b/src/Fortran_libraries/VIZ_src/surfacing/Makefile index 1272132e..3ca79ec4 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/Makefile +++ b/src/Fortran_libraries/VIZ_src/surfacing/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_SURFACING)' \ >> $(MAKENAME) diff --git a/src/Fortran_libraries/VIZ_src/surfacing/Makefile.depends b/src/Fortran_libraries/VIZ_src/surfacing/Makefile.depends index 0dec8880..3867d05f 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/Makefile.depends +++ b/src/Fortran_libraries/VIZ_src/surfacing/Makefile.depends @@ -1,6 +1,6 @@ FEM_to_PSF_bridge.o: $(PSF_SECTION_DIR)/FEM_to_PSF_bridge.f90 m_precision.o m_machine_parameter.o t_mesh_data.o t_phys_data.o t_comm_table.o t_VIZ_step_parameter.o t_mesh_SR.o parallel_FEM_mesh_init.o const_element_comm_tables.o $(F90) -c $(F90OPTFLAGS) $< -bcast_ctl_data_surfacings.o: $(PSF_SECTION_DIR)/bcast_ctl_data_surfacings.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_control_data_surfacings.o calypso_mpi_int.o bcast_control_arrays.o bcast_section_control_data.o +bcast_ctl_data_surfacings.o: $(PSF_SECTION_DIR)/bcast_ctl_data_surfacings.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_control_data_surfacings.o transfer_to_long_integers.o calypso_mpi_char.o calypso_mpi_int.o bcast_control_arrays.o bcast_section_control_data.o $(F90) -c $(F90OPTFLAGS) $< bcast_section_control_data.o: $(PSF_SECTION_DIR)/bcast_section_control_data.f90 m_precision.o m_constants.o m_machine_parameter.o calypso_mpi.o t_control_data_sections.o t_control_data_4_psf.o calypso_mpi_int.o calypso_mpi_char.o transfer_to_long_integers.o t_control_data_isosurfaces.o t_control_data_4_iso.o bcast_control_arrays.o t_control_data_4_fld_on_psf.o t_control_data_4_psf_def.o t_control_data_4_iso_def.o $(F90) -c $(F90OPTFLAGS) $< @@ -12,17 +12,19 @@ convert_components_4_viz.o: $(PSF_SECTION_DIR)/convert_components_4_viz.f90 m_pr $(F90) -c $(F90OPTFLAGS) $< copy_psf_data_to_SR.o: $(PSF_SECTION_DIR)/copy_psf_data_to_SR.f90 m_precision.o t_ucd_data.o $(F90) -c $(F90OPTFLAGS) $< -ctl_data_isosurface_IO.o: $(PSF_SECTION_DIR)/ctl_data_isosurface_IO.f90 m_precision.o m_constants.o m_machine_parameter.o t_control_data_4_iso.o t_read_control_elements.o t_control_array_character.o t_control_data_4_iso_def.o t_control_data_4_fld_on_psf.o calypso_mpi.o skip_comment_f.o write_control_elements.o +ctl_data_isosurface_IO.o: $(PSF_SECTION_DIR)/ctl_data_isosurface_IO.f90 m_precision.o m_constants.o m_machine_parameter.o t_control_data_4_iso.o t_read_control_elements.o t_control_array_character.o t_control_data_4_iso_def.o t_control_data_4_fld_on_psf.o calypso_mpi.o skip_comment_f.o ctl_file_field_on_psf_IO.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< -ctl_data_section_IO.o: $(PSF_SECTION_DIR)/ctl_data_section_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_array_character2.o t_control_data_4_psf_def.o t_control_data_4_fld_on_psf.o t_control_data_4_psf.o calypso_mpi.o ctl_file_section_def_IO.o write_control_elements.o +ctl_data_section_IO.o: $(PSF_SECTION_DIR)/ctl_data_section_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_array_character2.o t_control_data_4_psf_def.o t_control_data_4_fld_on_psf.o t_control_data_4_psf.o calypso_mpi.o ctl_file_section_def_IO.o ctl_file_field_on_psf_IO.o write_control_elements.o ctl_data_section_def_IO.o $(F90) -c $(F90OPTFLAGS) $< ctl_data_section_def_IO.o: $(PSF_SECTION_DIR)/ctl_data_section_def_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_psf_def.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< +ctl_file_field_on_psf_IO.o: $(PSF_SECTION_DIR)/ctl_file_field_on_psf_IO.f90 m_precision.o m_machine_parameter.o t_control_data_4_fld_on_psf.o t_read_control_elements.o write_control_elements.o skip_comment_f.o + $(F90) -c $(F90OPTFLAGS) $< ctl_file_isosurfaces_IO.o: $(PSF_SECTION_DIR)/ctl_file_isosurfaces_IO.f90 m_precision.o m_machine_parameter.o t_control_data_4_iso.o t_control_data_isosurfaces.o t_read_control_elements.o ctl_data_isosurface_IO.o skip_comment_f.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< ctl_file_section_def_IO.o: $(PSF_SECTION_DIR)/ctl_file_section_def_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_character.o t_control_array_chara2real.o skip_comment_f.o ctl_data_section_def_IO.o write_control_elements.o $(F90) -c $(F90OPTFLAGS) $< -ctl_file_sections_IO.o: $(PSF_SECTION_DIR)/ctl_file_sections_IO.f90 m_precision.o m_machine_parameter.o t_control_data_4_psf.o t_control_data_sections.o t_read_control_elements.o ctl_data_section_IO.o skip_comment_f.o write_control_elements.o +ctl_file_sections_IO.o: $(PSF_SECTION_DIR)/ctl_file_sections_IO.f90 m_precision.o m_machine_parameter.o t_control_data_4_psf.o t_control_data_sections.o t_read_control_elements.o ctl_data_section_IO.o write_control_elements.o skip_comment_f.o $(F90) -c $(F90OPTFLAGS) $< find_node_and_patch_psf.o: $(PSF_SECTION_DIR)/find_node_and_patch_psf.f90 m_precision.o m_machine_parameter.o t_solver_SR.o t_solver_SR_int8.o t_psf_geometry_list.o t_psf_patch_data.o m_geometry_constants.o calypso_mpi.o calypso_mpi_int.o t_control_params_4_psf.o t_mesh_data.o t_surface_group_connect.o t_psf_case_table.o set_nodes_for_psf.o set_patches_for_psf.o const_element_comm_tables.o $(F90) -c $(F90OPTFLAGS) $< @@ -60,7 +62,7 @@ m_intersection_data_8.o: $(PSF_SECTION_DIR)/m_intersection_data_8.f90 m_precisio $(F90) -c $(F90OPTFLAGS) $< m_intersection_data_9.o: $(PSF_SECTION_DIR)/m_intersection_data_9.f90 m_precision.o $(F90) -c $(F90OPTFLAGS) $< -m_section_coef_flags.o: $(PSF_SECTION_DIR)/m_section_coef_flags.f90 m_precision.o m_constants.o t_multi_flag_labels.o t_read_control_elements.o skip_comment_f.o +m_section_coef_flags.o: $(PSF_SECTION_DIR)/m_section_coef_flags.f90 m_precision.o m_constants.o t_multi_flag_labels.o t_control_array_character.o skip_comment_f.o $(F90) -c $(F90OPTFLAGS) $< output_4_psf.o: $(PSF_SECTION_DIR)/output_4_psf.f90 m_precision.o calypso_mpi.o t_time_data.o t_ucd_data.o t_file_IO_parameter.o t_psf_patch_data.o set_ucd_data_to_type.o parallel_ucd_IO_select.o ucd_IO_select.o $(F90) -c $(F90OPTFLAGS) $< @@ -72,7 +74,7 @@ search_ele_list_for_psf.o: $(PSF_SECTION_DIR)/search_ele_list_for_psf.f90 m_prec $(F90) -c $(F90OPTFLAGS) $< set_area_4_viz.o: $(PSF_SECTION_DIR)/set_area_4_viz.f90 m_precision.o $(F90) -c $(F90OPTFLAGS) $< -set_coefs_of_sections.o: $(PSF_SECTION_DIR)/set_coefs_of_sections.f90 m_precision.o m_constants.o m_error_IDs.o m_section_coef_flags.o t_control_data_4_psf_def.o t_psf_patch_data.o set_cross_section_coefs.o t_read_control_elements.o +set_coefs_of_sections.o: $(PSF_SECTION_DIR)/set_coefs_of_sections.f90 m_precision.o m_constants.o m_error_IDs.o m_section_coef_flags.o t_control_data_4_psf_def.o t_psf_patch_data.o set_cross_section_coefs.o $(F90) -c $(F90OPTFLAGS) $< set_const_4_sections.o: $(PSF_SECTION_DIR)/set_const_4_sections.f90 m_precision.o m_constants.o m_machine_parameter.o t_control_params_4_psf.o t_geometry_data.o t_psf_geometry_list.o t_control_params_4_iso.o t_phys_data.o mag_of_field_smp.o cvt_xyz_vector_2_sph_smp.o cvt_xyz_vector_2_cyl_smp.o cal_subtract_smp.o copy_field_smp.o $(F90) -c $(F90OPTFLAGS) $< @@ -86,7 +88,7 @@ set_field_comp_for_viz.o: $(PSF_SECTION_DIR)/set_field_comp_for_viz.f90 m_precis $(F90) -c $(F90OPTFLAGS) $< set_fields_for_psf.o: $(PSF_SECTION_DIR)/set_fields_for_psf.f90 m_precision.o m_machine_parameter.o t_psf_patch_data.o t_control_params_4_psf.o t_edge_data.o t_phys_data.o t_psf_geometry_list.o t_control_params_4_iso.o set_nodal_field_for_psf.o m_geometry_constants.o set_components_flags.o convert_components_4_viz.o set_psf_nodes_4_by_surf_grp.o $(F90) -c $(F90OPTFLAGS) $< -set_iso_control.o: $(PSF_SECTION_DIR)/set_iso_control.f90 m_precision.o m_machine_parameter.o t_mesh_data.o t_group_data.o t_control_data_4_iso.o t_control_params_4_iso.o t_phys_data.o t_psf_patch_data.o t_file_IO_parameter.o calypso_mpi.o t_read_control_elements.o t_control_data_isosurfaces.o t_control_data_sections.o set_field_comp_for_viz.o mpi_abort_by_missing_zlib.o m_error_IDs.o m_file_format_switch.o set_isosurface_file_ctl.o delete_data_files.o skip_comment_f.o +set_iso_control.o: $(PSF_SECTION_DIR)/set_iso_control.f90 m_precision.o m_machine_parameter.o calypso_mpi.o t_mesh_data.o t_group_data.o t_control_data_4_iso.o t_control_params_4_iso.o t_phys_data.o t_psf_patch_data.o t_file_IO_parameter.o t_read_control_elements.o t_control_data_isosurfaces.o t_control_data_sections.o set_field_comp_for_viz.o mpi_abort_by_missing_zlib.o m_error_IDs.o m_file_format_switch.o set_isosurface_file_ctl.o delete_data_files.o skip_comment_f.o $(F90) -c $(F90OPTFLAGS) $< set_isosurface_file_ctl.o: $(PSF_SECTION_DIR)/set_isosurface_file_ctl.f90 m_precision.o t_group_data.o t_control_data_4_iso_def.o t_psf_patch_data.o set_area_4_viz.o t_control_array_character.o t_file_IO_parameter.o m_field_file_format.o m_merged_field_fmt_labels.o t_multi_flag_labels.o $(F90) -c $(F90OPTFLAGS) $< @@ -126,15 +128,15 @@ t_control_data_4_psf.o: $(PSF_SECTION_DIR)/t_control_data_4_psf.f90 m_precision. $(F90) -c $(F90OPTFLAGS) $< t_control_data_4_psf_def.o: $(PSF_SECTION_DIR)/t_control_data_4_psf_def.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 $(F90) -c $(F90OPTFLAGS) $< -t_control_data_isosurfaces.o: $(PSF_SECTION_DIR)/t_control_data_isosurfaces.f90 m_precision.o m_machine_parameter.o t_control_data_4_iso.o t_control_array_character3.o +t_control_data_isosurfaces.o: $(PSF_SECTION_DIR)/t_control_data_isosurfaces.f90 m_precision.o m_machine_parameter.o t_control_data_4_iso.o t_control_array_character3.o ctl_data_isosurface_IO.o $(F90) -c $(F90OPTFLAGS) $< -t_control_data_sections.o: $(PSF_SECTION_DIR)/t_control_data_sections.f90 m_precision.o m_machine_parameter.o t_control_data_4_psf.o t_control_array_character3.o +t_control_data_sections.o: $(PSF_SECTION_DIR)/t_control_data_sections.f90 m_precision.o m_machine_parameter.o t_control_data_4_psf.o t_control_array_character3.o ctl_data_section_IO.o $(F90) -c $(F90OPTFLAGS) $< t_control_data_surfacings.o: $(PSF_SECTION_DIR)/t_control_data_surfacings.f90 m_precision.o m_machine_parameter.o t_control_data_sections.o t_control_data_isosurfaces.o t_control_array_real.o t_control_array_character.o t_control_array_integer.o t_ctl_data_4_time_steps.o t_control_array_character3.o $(F90) -c $(F90OPTFLAGS) $< -t_control_params_4_iso.o: $(PSF_SECTION_DIR)/t_control_params_4_iso.f90 m_precision.o calypso_mpi.o m_error_IDs.o set_area_4_viz.o set_field_comp_for_viz.o t_control_data_4_iso_def.o t_group_data.o t_phys_data.o t_psf_patch_data.o m_file_format_switch.o t_file_IO_parameter.o t_control_data_4_fld_on_psf.o skip_comment_f.o t_read_control_elements.o +t_control_params_4_iso.o: $(PSF_SECTION_DIR)/t_control_params_4_iso.f90 m_precision.o set_area_4_viz.o set_field_comp_for_viz.o t_control_data_4_iso_def.o t_group_data.o t_phys_data.o t_psf_patch_data.o m_file_format_switch.o m_section_coef_flags.o t_file_IO_parameter.o t_control_data_4_fld_on_psf.o skip_comment_f.o $(F90) -c $(F90OPTFLAGS) $< -t_control_params_4_psf.o: $(PSF_SECTION_DIR)/t_control_params_4_psf.f90 m_precision.o m_error_IDs.o m_file_format_switch.o t_control_data_4_psf_def.o t_group_data.o t_psf_patch_data.o set_area_4_viz.o set_cross_section_coefs.o set_coefs_of_sections.o +t_control_params_4_psf.o: $(PSF_SECTION_DIR)/t_control_params_4_psf.f90 m_precision.o m_error_IDs.o m_file_format_switch.o t_control_data_4_psf_def.o t_group_data.o t_psf_patch_data.o set_area_4_viz.o m_section_coef_flags.o set_cross_section_coefs.o set_coefs_of_sections.o $(F90) -c $(F90OPTFLAGS) $< t_cross_section.o: $(PSF_SECTION_DIR)/t_cross_section.f90 calypso_mpi.o m_precision.o m_constants.o m_machine_parameter.o t_time_data.o t_mesh_data.o t_comm_table.o t_phys_data.o t_psf_geometry_list.o t_psf_patch_data.o t_ucd_data.o t_solver_SR.o t_solver_SR_int8.o t_psf_case_table.o t_surface_group_connect.o t_file_IO_parameter.o t_control_params_4_psf.o t_control_data_sections.o m_work_time.o m_elapsed_labels_4_VIZ.o m_geometry_constants.o set_psf_control.o search_ele_list_for_psf.o set_const_4_sections.o find_node_and_patch_psf.o set_fields_for_psf.o output_4_psf.o set_ucd_data_to_type.o m_field_file_format.o $(F90) -c $(F90OPTFLAGS) $< diff --git a/src/Fortran_libraries/VIZ_src/surfacing/bcast_ctl_data_surfacings.f90 b/src/Fortran_libraries/VIZ_src/surfacing/bcast_ctl_data_surfacings.f90 index fd9408ca..0825f262 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/bcast_ctl_data_surfacings.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/bcast_ctl_data_surfacings.f90 @@ -28,6 +28,8 @@ module bcast_ctl_data_surfacings subroutine bcast_surfacing_controls(surfacing_ctls) ! use t_control_data_surfacings + use transfer_to_long_integers + use calypso_mpi_char use calypso_mpi_int use bcast_control_arrays use bcast_section_control_data @@ -48,6 +50,8 @@ subroutine bcast_surfacing_controls(surfacing_ctls) ! call bcast_ctl_type_c1(surfacing_ctls%output_ucd_fmt_s_ctl) ! + call calypso_mpi_bcast_character & + & (surfacing_ctls%block_name, cast_long(kchara), 0) call calypso_mpi_bcast_one_int & & (surfacing_ctls%i_surfacing_control, 0) ! diff --git a/src/Fortran_libraries/VIZ_src/surfacing/bcast_section_control_data.f90 b/src/Fortran_libraries/VIZ_src/surfacing/bcast_section_control_data.f90 index d94dcb82..1c1bd2af 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/bcast_section_control_data.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/bcast_section_control_data.f90 @@ -47,6 +47,8 @@ subroutine bcast_files_4_psf_ctl(psf_ctls) integer (kind=kint) :: i_psf ! ! + call calypso_mpi_bcast_character(psf_ctls%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(psf_ctls%num_psf_ctl, 0) if(psf_ctls%num_psf_ctl .le. 0) return ! @@ -74,6 +76,8 @@ subroutine bcast_files_4_iso_ctl(iso_ctls) integer (kind=kint) :: i_iso ! ! + call calypso_mpi_bcast_character(iso_ctls%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(iso_ctls%num_iso_ctl, 0) if(iso_ctls%num_iso_ctl .le. 0) return ! @@ -105,6 +109,8 @@ subroutine bcast_psf_control_data(psf_c) call calypso_mpi_bcast_one_int(psf_c%i_output_field, 0) call calypso_mpi_bcast_character(psf_c%fname_section_ctl, & & cast_long(kchara), 0) + call calypso_mpi_bcast_character(psf_c%fname_fld_on_psf, & + & cast_long(kchara), 0) ! call bcast_ctl_type_c1(psf_c%psf_file_head_ctl) call bcast_ctl_type_c1(psf_c%psf_output_type_ctl) @@ -119,13 +125,17 @@ end subroutine bcast_psf_control_data subroutine bcast_iso_control_data(iso_c) ! use t_control_data_4_iso - use calypso_mpi_int use bcast_control_arrays + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(iso_ctl), intent(inout) :: iso_c ! ! call calypso_mpi_bcast_one_int(iso_c%i_iso_ctl, 0) + call calypso_mpi_bcast_character(iso_c%fname_fld_on_iso, & + & cast_long(kchara), 0) ! call bcast_ctl_type_c1(iso_c%iso_file_head_ctl) call bcast_ctl_type_c1(iso_c%iso_file_head_ctl) @@ -142,8 +152,10 @@ end subroutine bcast_iso_control_data subroutine bcast_fld_on_psf_control(fld_on_psf_c) ! use t_control_data_4_fld_on_psf - use calypso_mpi_int use bcast_control_arrays + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(field_on_psf_ctl), intent(inout) :: fld_on_psf_c ! @@ -152,6 +164,8 @@ subroutine bcast_fld_on_psf_control(fld_on_psf_c) call bcast_ctl_type_c1(fld_on_psf_c%output_type_ctl) call bcast_ctl_array_c2(fld_on_psf_c%field_output_ctl) ! + call calypso_mpi_bcast_character(fld_on_psf_c%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(fld_on_psf_c%i_iso_result, 0) ! end subroutine bcast_fld_on_psf_control @@ -161,12 +175,16 @@ end subroutine bcast_fld_on_psf_control subroutine bcast_section_def_control(psf_def_c) ! use t_control_data_4_psf_def - use calypso_mpi_int use bcast_control_arrays + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(psf_define_ctl), intent(inout) :: psf_def_c ! ! + call calypso_mpi_bcast_character(psf_def_c%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(psf_def_c%i_surface_define, 0) ! call bcast_ctl_array_cr(psf_def_c%psf_coefs_ctl) @@ -188,8 +206,10 @@ end subroutine bcast_section_def_control subroutine bcast_iso_define_control(iso_def_c) ! use t_control_data_4_iso_def - use calypso_mpi_int use bcast_control_arrays + use calypso_mpi_int + use calypso_mpi_char + use transfer_to_long_integers ! type(iso_define_ctl), intent(inout) :: iso_def_c ! @@ -199,6 +219,8 @@ subroutine bcast_iso_define_control(iso_def_c) call bcast_ctl_type_r1(iso_def_c%isosurf_value_ctl) call bcast_ctl_type_c1(iso_def_c%isosurf_data_ctl) ! + call calypso_mpi_bcast_character(iso_def_c%block_name, & + & cast_long(kchara), 0) call calypso_mpi_bcast_one_int(iso_def_c%i_iso_define, 0) ! end subroutine bcast_iso_define_control diff --git a/src/Fortran_libraries/VIZ_src/surfacing/control_data_surfacing_IO.f90 b/src/Fortran_libraries/VIZ_src/surfacing/control_data_surfacing_IO.f90 index 5e5f9c15..cb31006e 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/control_data_surfacing_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/control_data_surfacing_IO.f90 @@ -7,6 +7,7 @@ !> @brief Control data structure for visualization controls !! !!@verbatim +!! subroutine init_surfacing_ctl_label(hd_block, surfacing_ctls) !! subroutine s_read_surfacing_controls & !! & (id_control, hd_block, surfacing_ctls, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -19,9 +20,6 @@ !! character(len=kchara), intent(in) :: hd_block !! type(surfacing_controls), intent(in) :: surfacing_ctls !! integer(kind = kint), intent(inout) :: level -!! -!! integer(kind = kint) function num_label_surfacings() -!! subroutine set_label_surfacings(names) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! begin visual_control !! delta_t_sectioning_ctl 1.0e-3 @@ -80,9 +78,6 @@ module control_data_surfacing_IO ! character(len=kchara), parameter, private & & :: hd_output_fld_file_fmt = 'output_field_file_fmt_ctl' -! - integer(kind = kint), parameter, private & - & :: n_label_surfacings = 9 ! ! -------------------------------------------------------------------- ! @@ -105,10 +100,15 @@ subroutine s_read_surfacing_controls & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(surfacing_ctls%i_surfacing_control .gt. 0) return + call init_psf_ctls_labels(hd_section_ctl, & + & surfacing_ctls%psf_s_ctls) + call init_iso_ctls_labels(hd_isosurf_ctl, & + & surfacing_ctls%iso_s_ctls) + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! ! @@ -167,66 +167,68 @@ subroutine write_surfacing_controls & maxlen = max(maxlen, len_trim(hd_delta_t_ucd)) maxlen = max(maxlen, len_trim(hd_i_step_ucd)) ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) -! call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_section, surfacing_ctls%delta_t_psf_s_ctl) + & surfacing_ctls%delta_t_psf_s_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_section, surfacing_ctls%i_step_psf_s_ctl) + & surfacing_ctls%i_step_psf_s_ctl) call write_files_4_psf_ctl(id_control, & & hd_section_ctl, surfacing_ctls%psf_s_ctls, level) ! - write(id_control,'(a1)') '!' call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_isosurf, surfacing_ctls%delta_t_iso_s_ctl) + & surfacing_ctls%delta_t_iso_s_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_isosurf, surfacing_ctls%i_step_iso_s_ctl) + & surfacing_ctls%i_step_iso_s_ctl) call write_files_4_iso_ctl(id_control, & & hd_isosurf_ctl, surfacing_ctls%iso_s_ctls, level) ! - write(id_control,'(a1)') '!' call write_real_ctl_type(id_control, level, maxlen, & - & hd_delta_t_ucd, surfacing_ctls%delta_t_ucd_s_ctl) + & surfacing_ctls%delta_t_ucd_s_ctl) call write_integer_ctl_type(id_control, level, maxlen, & - & hd_i_step_ucd, surfacing_ctls%i_step_ucd_s_ctl) + & surfacing_ctls%i_step_ucd_s_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_output_fld_file_fmt, surfacing_ctls%output_ucd_fmt_s_ctl) + & surfacing_ctls%output_ucd_fmt_s_ctl) ! level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_surfacing_controls ! ! -------------------------------------------------------------------- -! --------------------------------------------------------------------- ! - integer(kind = kint) function num_label_surfacings() - num_label_surfacings = n_label_surfacings - return - end function num_label_surfacings + subroutine init_surfacing_ctl_label(hd_block, surfacing_ctls) ! -! ---------------------------------------------------------------------- + use ctl_file_sections_IO + use ctl_file_isosurfaces_IO ! - subroutine set_label_surfacings(names) + character(len=kchara), intent(in) :: hd_block + type(surfacing_controls), intent(inout) :: surfacing_ctls ! - character(len = kchara), intent(inout) & - & :: names(n_label_surfacings) ! + surfacing_ctls%block_name = hd_block + call init_psf_ctls_labels(hd_section_ctl, & + & surfacing_ctls%psf_s_ctls) + call init_iso_ctls_labels(hd_isosurf_ctl, & + & surfacing_ctls%iso_s_ctls) ! - call set_control_labels(hd_i_step_section, names( 1)) - call set_control_labels(hd_delta_t_section, names( 2)) - call set_control_labels(hd_section_ctl, names( 3)) + call init_real_ctl_item_label(hd_delta_t_section, & + & surfacing_ctls%delta_t_psf_s_ctl) + call init_real_ctl_item_label(hd_delta_t_isosurf, & + & surfacing_ctls%delta_t_iso_s_ctl) + call init_real_ctl_item_label(hd_delta_t_ucd, & + & surfacing_ctls%delta_t_ucd_s_ctl) ! - call set_control_labels(hd_i_step_isosurf, names( 4)) - call set_control_labels(hd_delta_t_isosurf, names( 5)) - call set_control_labels(hd_isosurf_ctl, names( 6)) + call init_int_ctl_item_label(hd_i_step_section, & + & surfacing_ctls%i_step_psf_s_ctl) + call init_int_ctl_item_label(hd_i_step_isosurf, & + & surfacing_ctls%i_step_iso_s_ctl) + call init_int_ctl_item_label(hd_i_step_ucd, & + & surfacing_ctls%i_step_ucd_s_ctl) ! - call set_control_labels(hd_i_step_ucd, names( 7)) - call set_control_labels(hd_delta_t_ucd, names( 8)) - call set_control_labels(hd_output_fld_file_fmt, names( 9)) + call init_chara_ctl_item_label(hd_output_fld_file_fmt, & + & surfacing_ctls%output_ucd_fmt_s_ctl) ! - end subroutine set_label_surfacings + end subroutine init_surfacing_ctl_label ! -! --------------------------------------------------------------------- +! -------------------------------------------------------------------- ! end module control_data_surfacing_IO diff --git a/src/Fortran_libraries/VIZ_src/surfacing/ctl_data_isosurface_IO.f90 b/src/Fortran_libraries/VIZ_src/surfacing/ctl_data_isosurface_IO.f90 index 0f997a15..6c92f5dc 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/ctl_data_isosurface_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/ctl_data_isosurface_IO.f90 @@ -6,6 +6,7 @@ !>@brief control data for each isosurface !! !!@verbatim +!! subroutine init_iso_ctl_stract(hd_block, iso_c) !! subroutine s_read_iso_control_data & !! & (id_control, hd_block, iso_c, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -19,10 +20,6 @@ !! type(iso_ctl), intent(in) :: iso_c !! integer(kind = kint), intent(inout) :: level !! -!! integer(kind = kint) function num_label_iso_ctl() -!! integer(kind = kint) function num_label_iso_ctl_w_dpl() -!! subroutine set_label_iso_ctl(names) -!! subroutine set_label_iso_ctl_w_dpl(names) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! example of control for Kemo's surface rendering !! @@ -105,11 +102,6 @@ module ctl_data_isosurface_IO & :: hd_iso_file_head = 'iso_file_head' character(len=kchara), parameter, private & & :: hd_iso_result = 'isosurf_result_define' -! - integer(kind = kint), parameter :: n_label_iso_ctl = 4 - integer(kind = kint), parameter :: n_label_iso_ctl_w_dpl = 6 -! - private :: n_label_iso_ctl, n_label_iso_ctl_w_dpl ! ! --------------------------------------------------------------------- ! @@ -121,6 +113,7 @@ subroutine s_read_iso_control_data & & (id_control, hd_block, iso_c, c_buf) ! use skip_comment_f + use ctl_file_field_on_psf_IO ! integer(kind = kint), intent(in) :: id_control character(len=kchara), intent(in) :: hd_block @@ -131,12 +124,15 @@ subroutine s_read_iso_control_data & if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(iso_c%i_iso_ctl.gt.0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! - call read_fld_on_psf_control(id_control, hd_field_on_iso, & + call sel_read_ctl_field_on_psf_file & + & (id_control, hd_field_on_iso, iso_c%fname_fld_on_iso, & & iso_c%fld_on_iso_c, c_buf) - call read_fld_on_psf_control(id_control, hd_iso_result, & + call sel_read_ctl_field_on_psf_file & + & (id_control, hd_iso_result, iso_c%fname_fld_on_iso, & & iso_c%fld_on_iso_c, c_buf) ! call read_iso_define_data & @@ -159,6 +155,7 @@ subroutine write_iso_control_data & & (id_control, hd_block, iso_c, level) ! use write_control_elements + use ctl_file_field_on_psf_IO ! integer(kind = kint), intent(in) :: id_control character(len=kchara), intent(in) :: hd_block @@ -173,66 +170,40 @@ subroutine write_iso_control_data & maxlen = len_trim(hd_isosurf_prefix) maxlen = max(maxlen, len_trim(hd_iso_out_type)) ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) -! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_isosurf_prefix, iso_c%iso_file_head_ctl) + & iso_c%iso_file_head_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_iso_out_type, iso_c%iso_output_type_ctl) + & iso_c%iso_output_type_ctl) ! call write_iso_define_data(id_control, hd_iso_define, & & iso_c%iso_def_c, level) - call write_fld_on_psf_control(id_control, hd_field_on_iso, & - & iso_c%fld_on_iso_c, level) -! + call sel_write_ctl_field_on_psf_file(id_control, hd_field_on_iso, & + & iso_c%fname_fld_on_iso, iso_c%fld_on_iso_c, level) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_iso_control_data ! ! -------------------------------------------------------------------- -! -------------------------------------------------------------------- -! - integer(kind = kint) function num_label_iso_ctl() - num_label_iso_ctl = n_label_iso_ctl - return - end function num_label_iso_ctl -! -! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_label_iso_ctl_w_dpl() - num_label_iso_ctl_w_dpl = n_label_iso_ctl_w_dpl - return - end function num_label_iso_ctl_w_dpl -! -! ---------------------------------------------------------------------- -! - subroutine set_label_iso_ctl(names) ! - character(len = kchara), intent(inout) & - & :: names(n_label_iso_ctl) + subroutine init_iso_ctl_stract(hd_block, iso_c) ! + character(len=kchara), intent(in) :: hd_block + type(iso_ctl), intent(inout) :: iso_c ! - call set_control_labels(hd_isosurf_prefix, names( 1)) - call set_control_labels(hd_iso_out_type, names( 2)) - call set_control_labels(hd_iso_define, names( 3)) - call set_control_labels(hd_field_on_iso, names( 4)) -! - end subroutine set_label_iso_ctl -! -! --------------------------------------------------------------------- -! - subroutine set_label_iso_ctl_w_dpl(names) -! - character(len = kchara), intent(inout) & - & :: names(n_label_iso_ctl_w_dpl) ! + iso_c%block_name = hd_block + call init_iso_define_control(hd_iso_define, iso_c%iso_def_c) + call init_fld_on_psf_control(hd_field_on_iso, iso_c%fld_on_iso_c) ! - call set_label_iso_ctl(names(1)) - call set_control_labels(hd_iso_file_head, names( 5)) - call set_control_labels(hd_iso_result, names( 6)) + call init_chara_ctl_item_label(hd_isosurf_prefix, & + & iso_c%iso_file_head_ctl) + call init_chara_ctl_item_label(hd_iso_file_head, & + & iso_c%iso_file_head_ctl) + call init_chara_ctl_item_label(hd_iso_out_type, & + & iso_c%iso_output_type_ctl) ! - end subroutine set_label_iso_ctl_w_dpl + end subroutine init_iso_ctl_stract ! ! --------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/VIZ_src/surfacing/ctl_data_section_IO.f90 b/src/Fortran_libraries/VIZ_src/surfacing/ctl_data_section_IO.f90 index 8fed8588..978bdc25 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/ctl_data_section_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/ctl_data_section_IO.f90 @@ -7,6 +7,7 @@ !>@brief control ID data for surfacing module !! !!@verbatim +!! subroutine init_psf_ctl_stract(psf_c) !! subroutine s_read_psf_control_data & !! & (id_control, hd_block, psf_c, c_buf) !! integer(kind = kint), intent(in) :: id_control @@ -19,11 +20,6 @@ !! character(len=kchara), intent(in) :: hd_block !! type(psf_ctl), intent(inout) :: psf_c !! integer(kind = kint), intent(inout) :: level -!! -!! integer(kind = kint) function num_label_psf_ctl() -!! integer(kind = kint) function num_label_psf_ctl_w_dpl() -!! subroutine set_label_psf_ctl(names) -!! subroutine set_label_psf_ctl_w_dpl(names) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!! example of control for Kemo's surface rendering !! @@ -153,11 +149,6 @@ module ctl_data_section_IO ! Deprecated flag character(len=kchara), parameter & & :: hd_psf_file_head = 'psf_file_head' -! - integer(kind = kint), parameter :: n_label_psf_ctl = 4 - integer(kind = kint), parameter :: n_label_psf_ctl_w_dpl = 5 -! - private :: n_label_psf_ctl, n_label_psf_ctl_w_dpl ! ! --------------------------------------------------------------------- ! @@ -169,6 +160,8 @@ subroutine s_read_psf_control_data & & (id_control, hd_block, psf_c, c_buf) ! use ctl_file_section_def_IO + use ctl_file_field_on_psf_IO + use write_control_elements ! integer(kind = kint), intent(in) :: id_control character(len=kchara), intent(in) :: hd_block @@ -177,18 +170,25 @@ subroutine s_read_psf_control_data & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(psf_c%i_psf_ctl .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! - call sel_read_ctl_pvr_section_def & - & (id_control, hd_surface_define, psf_c%fname_section_ctl, & - & psf_c%psf_def_c, c_buf) + 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_surface_define, izero, c_buf%level) + call sel_read_ctl_pvr_section_def(id_control, & + & hd_surface_define, psf_c%fname_section_ctl, & + & psf_c%psf_def_c, c_buf) + end if ! - call read_fld_on_psf_control(id_control, hd_output_field, & - & psf_c%fld_on_psf_c, c_buf) + call sel_read_ctl_field_on_psf_file & + & (id_control, hd_output_field, psf_c%fname_fld_on_psf, & + & psf_c%fld_on_psf_c, c_buf) ! call read_chara_ctl_type(c_buf, hd_psf_file_prefix, & & psf_c%psf_file_head_ctl) @@ -207,6 +207,7 @@ subroutine write_psf_control_data & & (id_control, hd_block, psf_c, level) ! use ctl_file_section_def_IO + use ctl_file_field_on_psf_IO use write_control_elements ! integer(kind = kint), intent(in) :: id_control @@ -223,63 +224,41 @@ subroutine write_psf_control_data & maxlen = len_trim(hd_psf_file_prefix) maxlen = max(maxlen, len_trim(hd_psf_out_type)) ! - write(id_control,'(a1)') '!' + level = write_begin_flag_for_ctl(id_control, level, hd_block) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_psf_file_prefix, psf_c%psf_file_head_ctl) + & psf_c%psf_file_head_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_psf_out_type, psf_c%psf_output_type_ctl) + & psf_c%psf_output_type_ctl) ! call sel_write_ctl_pvr_section_def(id_control, hd_surface_define, & & psf_c%fname_section_ctl, psf_c%psf_def_c, level) - call write_fld_on_psf_control(id_control, hd_output_field, & - & psf_c%fld_on_psf_c, level) + call sel_write_ctl_field_on_psf_file(id_control, hd_output_field, & + & psf_c%fname_fld_on_psf, psf_c%fld_on_psf_c, level) ! level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_psf_control_data ! ! -------------------------------------------------------------------- -! -------------------------------------------------------------------- -! - integer(kind = kint) function num_label_psf_ctl() - num_label_psf_ctl = n_label_psf_ctl - return - end function num_label_psf_ctl -! -! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_label_psf_ctl_w_dpl() - num_label_psf_ctl_w_dpl = n_label_psf_ctl_w_dpl - return - end function num_label_psf_ctl_w_dpl ! -! ---------------------------------------------------------------------- + subroutine init_psf_ctl_stract(hd_block, psf_c) ! - subroutine set_label_psf_ctl(names) + use ctl_data_section_def_IO ! - character(len = kchara), intent(inout) & - & :: names(n_label_psf_ctl) -! -! - call set_control_labels(hd_psf_file_prefix, names( 1)) - call set_control_labels(hd_psf_out_type, names( 2)) - call set_control_labels(hd_surface_define, names( 3)) - call set_control_labels(hd_output_field, names( 4)) -! - end subroutine set_label_psf_ctl -! -! --------------------------------------------------------------------- -! - subroutine set_label_psf_ctl_w_dpl(names) + character(len=kchara), intent(in) :: hd_block + type(psf_ctl), intent(inout) :: psf_c ! - character(len = kchara), intent(inout) & - & :: names(n_label_psf_ctl_w_dpl) ! + psf_c%block_name = hd_block + call init_psf_def_ctl_stract(hd_surface_define, psf_c%psf_def_c) + call init_fld_on_psf_control(hd_output_field, psf_c%fld_on_psf_c) ! - call set_label_psf_ctl(names(1)) - call set_control_labels(hd_psf_file_head, names( 5)) + call init_chara_ctl_item_label(hd_psf_file_prefix, & + & psf_c%psf_file_head_ctl) + call init_chara_ctl_item_label(hd_psf_out_type, & + & psf_c%psf_output_type_ctl) ! - end subroutine set_label_psf_ctl_w_dpl + end subroutine init_psf_ctl_stract ! ! --------------------------------------------------------------------- ! diff --git a/src/Fortran_libraries/VIZ_src/surfacing/ctl_data_section_def_IO.f90 b/src/Fortran_libraries/VIZ_src/surfacing/ctl_data_section_def_IO.f90 index e4420e61..73e7f5aa 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/ctl_data_section_def_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/ctl_data_section_def_IO.f90 @@ -7,6 +7,7 @@ !>@brief control ID data for surfacing module !! !!@verbatim +!! subroutine init_psf_def_ctl_stract(hd_block, psf_def_c) !! subroutine read_section_def_control & !! & (id_control, hd_block, psf_def_c, psf_def_c) !! integer(kind = kint), intent(in) :: id_control @@ -19,9 +20,6 @@ !! character(len=kchara), intent(in) :: hd_block !! type(psf_define_ctl), intent(in) :: psf_def_c !! integer(kind = kint), intent(inout) :: level -!! -!! integer(kind = kint) function num_label_psf_define_control() -!! subroutine set_label_psf_define_control(names) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!! example of control for Kemo's surface rendering !! @@ -139,13 +137,10 @@ module ctl_data_section_def_IO & :: hd_group_name = 'group_name' character(len=kchara), parameter & & :: hd_psf_area = 'section_area_ctl' -! - integer(kind = kint), parameter :: n_label_psf_define_ctl = 8 ! private :: hd_section_method, hd_psf_area private :: hd_normal_ctl, hd_center_ctl, hd_axis_ctl private :: hd_coefs_ctl, hd_radius, hd_group_name - private :: n_label_psf_define_ctl ! ! --------------------------------------------------------------------- ! @@ -166,7 +161,8 @@ subroutine read_section_def_control & if(psf_def_c%i_surface_define .gt. 0) return ! do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_c_r(id_control, & @@ -214,64 +210,66 @@ subroutine write_section_def_control & maxlen = max(maxlen, len_trim(hd_radius)) maxlen = max(maxlen, len_trim(hd_group_name)) ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) -! call write_control_array_c1(id_control, level, & - & hd_psf_area, psf_def_c%psf_area_ctl) + & psf_def_c%psf_area_ctl) ! - write(id_control,'(a1)') '!' call write_chara_ctl_type(id_control, level, maxlen, & - & hd_section_method, psf_def_c%section_method_ctl) + & psf_def_c%section_method_ctl) ! - write(id_control,'(a1)') '!' call write_control_array_c_r(id_control, level, & - & hd_coefs_ctl, psf_def_c%psf_coefs_ctl) + & psf_def_c%psf_coefs_ctl) ! call write_control_array_c_r(id_control, level, & - & hd_normal_ctl, psf_def_c%psf_normal_ctl) + & psf_def_c%psf_normal_ctl) call write_control_array_c_r(id_control, level, & - & hd_axis_ctl, psf_def_c%psf_axis_ctl) + & psf_def_c%psf_axis_ctl) ! call write_control_array_c_r(id_control, level, & - & hd_center_ctl, psf_def_c%psf_center_ctl) + & psf_def_c%psf_center_ctl) call write_real_ctl_type(id_control, level, maxlen, & - & hd_radius, psf_def_c%radius_psf_ctl) + & psf_def_c%radius_psf_ctl) ! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_group_name, psf_def_c%psf_group_name_ctl) -! + & psf_def_c%psf_group_name_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_section_def_control ! ! -------------------------------------------------------------------- -! -------------------------------------------------------------------- ! - integer(kind = kint) function num_label_psf_define_control() - num_label_psf_define_control = n_label_psf_define_ctl - return - end function num_label_psf_define_control + subroutine init_psf_def_ctl_stract(hd_block, psf_def_c) ! -! ---------------------------------------------------------------------- + character(len=kchara), intent(in) :: hd_block + type(psf_define_ctl), intent(inout) :: psf_def_c ! - subroutine set_label_psf_define_control(names) ! - character(len = kchara), intent(inout) & - & :: names(n_label_psf_define_ctl) + psf_def_c%radius_psf_ctl%realvalue = 0.0d0 + psf_def_c%psf_area_ctl%num = 0 + psf_def_c%block_name = hd_block ! + call init_c_r_ctl_array_label & + & (hd_coefs_ctl, psf_def_c%psf_coefs_ctl) + call init_c_r_ctl_array_label & + & (hd_center_ctl, psf_def_c%psf_center_ctl) + call init_c_r_ctl_array_label & + & (hd_normal_ctl, psf_def_c%psf_normal_ctl) + call init_c_r_ctl_array_label & + & (hd_axis_ctl, psf_def_c%psf_axis_ctl) ! - call set_control_labels(hd_section_method, names( 1)) - call set_control_labels(hd_coefs_ctl, names( 2)) - call set_control_labels(hd_normal_ctl, names( 3)) - call set_control_labels(hd_axis_ctl, names( 4)) - call set_control_labels(hd_center_ctl, names( 5)) - call set_control_labels(hd_radius, names( 6)) - call set_control_labels(hd_group_name, names( 7)) - call set_control_labels(hd_psf_area, names( 8)) + call init_chara_ctl_array_label & + & (hd_psf_area, psf_def_c%psf_area_ctl) ! - end subroutine set_label_psf_define_control + call init_real_ctl_item_label & + & (hd_radius, psf_def_c%radius_psf_ctl) ! -! --------------------------------------------------------------------- + call init_chara_ctl_item_label & + & (hd_section_method, psf_def_c%section_method_ctl) + call init_chara_ctl_item_label & + & (hd_group_name, psf_def_c%psf_group_name_ctl) +! + end subroutine init_psf_def_ctl_stract +! +! -------------------------------------------------------------------- ! end module ctl_data_section_def_IO diff --git a/src/Fortran_libraries/VIZ_src/surfacing/ctl_file_field_on_psf_IO.f90 b/src/Fortran_libraries/VIZ_src/surfacing/ctl_file_field_on_psf_IO.f90 new file mode 100644 index 00000000..c01572fc --- /dev/null +++ b/src/Fortran_libraries/VIZ_src/surfacing/ctl_file_field_on_psf_IO.f90 @@ -0,0 +1,184 @@ +!>@file ctl_file_field_on_psf_IO.f90 +!!@brief module ctl_file_field_on_psf_IO +!! +!!@date Programmed by H.Matsui in May, 2006 +! +!>@brief control data for cross sections +!! +!!@verbatim +!! subroutine sel_read_ctl_field_on_psf_file(id_control, hd_block, & +!! & file_name, fld_on_psf_c, c_buf) +!! subroutine read_ctl_field_on_psf_file(id_control, file_name, & +!! & hd_block, fld_on_psf_c) +!! integer(kind = kint), intent(in) :: id_control +!! character(len=kchara), intent(in) :: hd_block +!! character(len = kchara), intent(inout) :: file_name +!! type(field_on_psf_ctl), intent(inout) :: fld_on_psf_c +!! type(buffer_for_control), intent(inout) :: c_buf +!! +!! subroutine sel_write_ctl_field_on_psf_file(id_control, hd_block,& +!! & file_name, fld_on_psf_c, level) +!! subroutine write_ctl_field_on_psf_file(id_control, file_name, & +!! & hd_block, fld_on_psf_c) +!! integer(kind = kint), intent(in) :: id_control +!! character(len = kchara), intent(in) :: file_name +!! character(len=kchara), intent(in) :: hd_block +!! type(field_on_psf_ctl), intent(in) :: fld_on_psf_c +!! integer(kind = kint), intent(inout) :: level +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! file field_on_isosurf 'ctl_iso_temp_value' +!! begin field_on_isosurf +!! result_type constant +!! result_value 0.7 +!! array output_field 2 +!! output_field velocity vector end +!! output_field magnetic_field radial end +!! end array output_field +!! end field_on_isosurf +!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!@endverbatim +! + module ctl_file_field_on_psf_IO +! + use m_precision +! + use m_machine_parameter + use t_control_data_4_fld_on_psf +! + implicit none +! +! -------------------------------------------------------------------- +! + contains +! +! --------------------------------------------------------------------- +! + subroutine sel_read_ctl_field_on_psf_file(id_control, hd_block, & + & file_name, fld_on_psf_c, c_buf) +! + use t_read_control_elements +! + use write_control_elements + use skip_comment_f +! + integer(kind = kint), intent(in) :: id_control + character(len=kchara), intent(in) :: hd_block + character(len = kchara), intent(inout) :: file_name + type(field_on_psf_ctl), intent(inout) :: fld_on_psf_c + type(buffer_for_control), intent(inout) :: c_buf +! +! + if(check_file_flag(c_buf, hd_block)) then + file_name = third_word(c_buf) +! + call write_one_ctl_file_message & + & (hd_block, c_buf%level, file_name) + call read_ctl_field_on_psf_file((id_control+2), file_name, & + & hd_block, fld_on_psf_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_fld_on_psf_control(id_control, hd_block, & + & fld_on_psf_c, c_buf) + end if +! + end subroutine sel_read_ctl_field_on_psf_file +! +! -------------------------------------------------------------------- +! + subroutine read_ctl_field_on_psf_file(id_control, file_name, & + & hd_block, fld_on_psf_c, c_buf) +! + use t_read_control_elements +! +! + integer(kind = kint), intent(in) :: id_control + character(len = kchara), intent(in) :: file_name + character(len=kchara), intent(in) :: hd_block + type(field_on_psf_ctl), intent(inout) :: fld_on_psf_c + type(buffer_for_control), intent(inout) :: c_buf +! +! + c_buf%level = c_buf%level + 1 + write(*,'(a)') trim(file_name) + open(id_control, file=file_name, status='old') +! + do + call load_one_line_from_control(id_control, hd_block, c_buf) + if(c_buf%iend .gt. 0) exit +! + call read_fld_on_psf_control(id_control, hd_block, & + & fld_on_psf_c, c_buf) + if(fld_on_psf_c%i_iso_result .gt. 0) exit + end do + close(id_control) +! + c_buf%level = c_buf%level - 1 +! + end subroutine read_ctl_field_on_psf_file +! +! --------------------------------------------------------------------- +! --------------------------------------------------------------------- +! + subroutine sel_write_ctl_field_on_psf_file(id_control, hd_block, & + & file_name, fld_on_psf_c, level) +! + use t_read_control_elements + use write_control_elements + use skip_comment_f +! + integer(kind = kint), intent(in) :: id_control + character(len = kchara), intent(in) :: file_name + character(len=kchara), intent(in) :: hd_block + type(field_on_psf_ctl), intent(in) :: fld_on_psf_c + integer(kind = kint), intent(inout) :: level +! +! + if(no_file_flag(file_name)) then + call write_fld_on_psf_control(id_control, hd_block, & + & fld_on_psf_c, level) + else if(id_control .eq. id_monitor) then + write(*,'(4a)') '! ', trim(hd_block), & + & ' should be written to file ... ', trim(file_name) + call write_fld_on_psf_control(id_control, hd_block, & + & fld_on_psf_c, level) + else + write(*,'(3a)', ADVANCE='NO') trim(hd_block), & + & ' is written to file ... ', trim(file_name) + call write_file_name_for_ctl_line(id_control, level, & + & hd_block, file_name) + call write_ctl_field_on_psf_file((id_control+2), file_name, & + & hd_block, fld_on_psf_c) + end if +! + end subroutine sel_write_ctl_field_on_psf_file +! +! -------------------------------------------------------------------- +! + subroutine write_ctl_field_on_psf_file(id_control, file_name, & + & hd_block, fld_on_psf_c) +! + use t_read_control_elements + use t_control_data_4_fld_on_psf +! + integer(kind = kint), intent(in) :: id_control + character(len = kchara), intent(in) :: file_name + character(len=kchara), intent(in) :: hd_block + type(field_on_psf_ctl), intent(in) :: fld_on_psf_c +! + integer(kind = kint) :: level +! +! + level = 0 + open(id_control, file=file_name) + call write_fld_on_psf_control(id_control, hd_block, & + & fld_on_psf_c, level) + close(id_control) +! + end subroutine write_ctl_field_on_psf_file +! +! --------------------------------------------------------------------- +! + end module ctl_file_field_on_psf_IO diff --git a/src/Fortran_libraries/VIZ_src/surfacing/ctl_file_isosurfaces_IO.f90 b/src/Fortran_libraries/VIZ_src/surfacing/ctl_file_isosurfaces_IO.f90 index 4f50b416..57347ce3 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/ctl_file_isosurfaces_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/ctl_file_isosurfaces_IO.f90 @@ -10,8 +10,6 @@ !! & (id_control, hd_block, iso_ctls, c_buf) !! subroutine sel_read_control_4_iso_file(id_control, hd_block, & !! & file_name, iso_ctl_struct, c_buf) -!! subroutine read_control_4_iso_file & -!! & (id_control, file_name, hd_block, iso_ctl_struct) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! character(len = kchara), intent(inout) :: file_name @@ -55,6 +53,8 @@ module ctl_file_isosurfaces_IO character(len=kchara), parameter & & :: hd_iso_ctl = 'isosurf_rendering' private :: hd_isosurf_ctl, hd_iso_ctl +! + private :: read_control_4_iso_file ! ! -------------------------------------------------------------------- ! @@ -68,26 +68,30 @@ subroutine read_files_4_iso_ctl & use t_read_control_elements use ctl_data_isosurface_IO use skip_comment_f + use write_control_elements ! integer(kind = kint), intent(in) :: id_control character(len=kchara), intent(in) :: hd_block type(isosurf_controls), intent(inout) :: iso_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 - iso_ctls%num_iso_ctl = 0 call alloc_iso_ctl_stract(iso_ctls) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, hd_block, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, hd_block)) exit ! if(check_file_flag(c_buf, hd_block) & & .or. check_begin_flag(c_buf, hd_block)) then - call append_new_isosurface_control(iso_ctls) - write(*,'(3a,i4)', ADVANCE='NO') 'Control for ', & - & trim(hd_block), ' No. ', iso_ctls%num_iso_ctl + n_append = iso_ctls%num_iso_ctl + call append_isosurface_control(n_append, hd_block, iso_ctls) +! + call write_multi_ctl_file_message & + & (hd_block, iso_ctls%num_iso_ctl, c_buf%level) call sel_read_control_4_iso_file(id_control, hd_block, & & iso_ctls%fname_iso_ctl(iso_ctls%num_iso_ctl), & & iso_ctls%iso_ctl_struct(iso_ctls%num_iso_ctl), c_buf) @@ -115,13 +119,13 @@ subroutine sel_read_control_4_iso_file(id_control, hd_block, & if(check_file_flag(c_buf, hd_block)) then file_name = third_word(c_buf) ! - write(*,'(a)', ADVANCE='NO') ' is read file from ... ' + write(*,'(a)', ADVANCE='NO') ' is read from file... ' call read_control_4_iso_file((id_control+2), file_name, & - & hd_block, iso_ctl_struct) + & hd_block, iso_ctl_struct, c_buf) else if(check_begin_flag(c_buf, hd_block)) then file_name = 'NO_FILE' ! - write(*,*) ' is included' + write(*,'(a)') ' is included' call s_read_iso_control_data(id_control, hd_block, & & iso_ctl_struct, c_buf) end if @@ -130,8 +134,8 @@ end subroutine sel_read_control_4_iso_file ! ! -------------------------------------------------------------------- ! - subroutine read_control_4_iso_file & - & (id_control, file_name, hd_block, iso_ctl_struct) + subroutine read_control_4_iso_file(id_control, file_name, & + & hd_block, iso_ctl_struct, c_buf) ! use t_read_control_elements use t_control_data_4_iso @@ -141,24 +145,28 @@ subroutine read_control_4_iso_file & character(len = kchara), intent(in) :: file_name character(len=kchara), intent(in) :: hd_block type(iso_ctl), intent(inout) :: iso_ctl_struct -! - type(buffer_for_control) :: c_buf1 + type(buffer_for_control), intent(inout) :: c_buf ! ! + c_buf%level = c_buf%level + 1 write(*,*) 'Isosurface control file: ', trim(file_name) open(id_control, file=file_name, status='old') ! do - call load_one_line_from_control(id_control, c_buf1) + call load_one_line_from_control(id_control, hd_block, c_buf) + if(c_buf%iend .gt. 0) exit +! call s_read_iso_control_data & - & (id_control, hd_block, iso_ctl_struct, c_buf1) + & (id_control, hd_block, iso_ctl_struct, c_buf) call s_read_iso_control_data & - & (id_control, hd_isosurf_ctl, iso_ctl_struct, c_buf1) + & (id_control, hd_isosurf_ctl, iso_ctl_struct, c_buf) call s_read_iso_control_data & - & (id_control, hd_iso_ctl, iso_ctl_struct, c_buf1) + & (id_control, hd_iso_ctl, iso_ctl_struct, c_buf) if(iso_ctl_struct%i_iso_ctl .gt. 0) exit end do close(id_control) +! + c_buf%level = c_buf%level - 1 ! end subroutine read_control_4_iso_file ! @@ -177,10 +185,10 @@ subroutine write_files_4_iso_ctl & ! integer(kind = kint) :: i ! - write(id_control,'(a1)') '!' level = write_array_flag_for_ctl(id_control, level, hd_block) do i = 1, iso_ctls%num_iso_ctl - write(*,'(2a,i4)', ADVANCE='NO') trim(hd_block), ' No. ', i + write(*,'(3a,i4)', ADVANCE='NO') '! ', trim(hd_block), & + & ' No. ', i call sel_write_control_4_iso_file & & (id_control, hd_block, iso_ctls%fname_iso_ctl(i), & & iso_ctls%iso_ctl_struct(i), level) @@ -206,11 +214,18 @@ subroutine sel_write_control_4_iso_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 + write(*,'(a)') ' is included.' + call write_iso_control_data(id_control, hd_block, & + & iso_ctl_struct, level) + else if(id_control .eq. id_monitor) then + write(*,'(2a)') & + & ' should be written to file ... ', trim(file_name) call write_iso_control_data(id_control, hd_block, & & iso_ctl_struct, level) else - write(*,'(a)', ADVANCE='NO') ' is write file to ... ' + write(*,'(3a)') trim(hd_block), & + & ' is written to file ... ', trim(file_name) call write_file_name_for_ctl_line(id_control, level, & & hd_block, file_name) call write_control_4_iso_file((id_control+2), file_name, & @@ -237,7 +252,6 @@ subroutine write_control_4_iso_file & ! ! level = 0 - write(*,*) 'Isosurface control file: ', trim(file_name) open(id_control, file=file_name) call write_iso_control_data & & (id_control, hd_block, iso_ctl_struct, level) diff --git a/src/Fortran_libraries/VIZ_src/surfacing/ctl_file_section_def_IO.f90 b/src/Fortran_libraries/VIZ_src/surfacing/ctl_file_section_def_IO.f90 index f13137d5..105eeea1 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/ctl_file_section_def_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/ctl_file_section_def_IO.f90 @@ -9,8 +9,6 @@ !!@verbatim !! subroutine sel_read_ctl_pvr_section_def(id_control, hd_block, & !! & fname_sect_ctl, psf_def_c, c_buf) -!! subroutine read_ctl_file_pvr_section_def & -!! & (id_control, fname_sect_ctl, psf_def_c) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! character(len = kchara), intent(inout) :: fname_sect_ctl @@ -72,14 +70,15 @@ subroutine sel_read_ctl_pvr_section_def(id_control, hd_block, & ! ! if(check_file_flag(c_buf, hd_block)) then - write(*,'(2a)', ADVANCE='NO') & - & trim(hd_block), ' is read from file... ' fname_sect_ctl = third_word(c_buf) +! + write(*,'(2a)') ' is read from ... ', trim(fname_sect_ctl) call read_ctl_file_pvr_section_def(id_control+2, & - & fname_sect_ctl, hd_block, psf_def_c) + & fname_sect_ctl, hd_block, psf_def_c, c_buf) else if(check_begin_flag(c_buf, hd_block)) then - write(*,'(2a)') trim(hd_block), ' is included.' fname_sect_ctl = 'NO_FILE' +! + write(*,'(a)') ' is included.' call read_section_def_control(id_control, hd_block, & & psf_def_c, c_buf) end if @@ -89,7 +88,7 @@ end subroutine sel_read_ctl_pvr_section_def ! --------------------------------------------------------------------- ! subroutine read_ctl_file_pvr_section_def & - & (id_control, fname_sect_ctl, hd_block, psf_def_c) + & (id_control, fname_sect_ctl, hd_block, psf_def_c, c_buf) ! use ctl_data_section_def_IO ! @@ -97,22 +96,25 @@ subroutine read_ctl_file_pvr_section_def & character(len = kchara), intent(in) :: fname_sect_ctl character(len=kchara), intent(in) :: hd_block type(psf_define_ctl), intent(inout) :: psf_def_c -! - type(buffer_for_control) :: c_buf1 + type(buffer_for_control), intent(inout) :: c_buf ! ! - write(*,*) trim(fname_sect_ctl), ' for surface definition' + c_buf%level = c_buf%level + 1 open(id_control, file = fname_sect_ctl, status='old') ! do - call load_one_line_from_control(id_control, c_buf1) - if(check_end_flag(c_buf1, hd_block)) exit + 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 +! call read_section_def_control(id_control, hd_block, & - & psf_def_c, c_buf1) + & psf_def_c, c_buf) if(psf_def_c%i_surface_define .gt. 0) exit end do ! close(id_control) +! + c_buf%level = c_buf%level - 1 ! end subroutine read_ctl_file_pvr_section_def ! @@ -133,10 +135,17 @@ subroutine sel_write_ctl_pvr_section_def(id_control, hd_block, & integer(kind = kint), intent(inout) :: level ! ! - if(cmp_no_case(fname_sect_ctl,'NO_FILE')) then + if(no_file_flag(fname_sect_ctl)) then + call write_section_def_control(id_control, hd_block, & + & psf_def_c, level) + else if(id_control .eq. id_monitor) then + write(*,'(4a)') '! ', trim(hd_block), & + & ' should be written to file ... ', trim(fname_sect_ctl) call write_section_def_control(id_control, hd_block, & & psf_def_c, level) else + write(*,'(3a)', ADVANCE='NO') trim(hd_block), & + & ' is written to file ... ', trim(fname_sect_ctl) call write_file_name_for_ctl_line(id_control, level, & & hd_block, fname_sect_ctl) call write_ctl_file_pvr_section_def & @@ -160,7 +169,7 @@ subroutine write_ctl_file_pvr_section_def & integer(kind = kint) :: level ! ! - write(*,*) trim(fname_sect_ctl), ' for surface definition' + write(*,*) trim(fname_sect_ctl) level = 0 open(id_control, file = fname_sect_ctl) call write_section_def_control(id_control, hd_block, & diff --git a/src/Fortran_libraries/VIZ_src/surfacing/ctl_file_sections_IO.f90 b/src/Fortran_libraries/VIZ_src/surfacing/ctl_file_sections_IO.f90 index d100f50b..0b8f848a 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/ctl_file_sections_IO.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/ctl_file_sections_IO.f90 @@ -10,8 +10,6 @@ !! & (id_control, hd_block, psf_ctls, c_buf) !! subroutine sel_read_control_4_psf_file(id_control, hd_block, & !! & file_name, psf_ctl_struct, c_buf) -!! subroutine read_control_4_psf_file(id_control, file_name, & -!! & hd_block, psf_ctl_struct) !! integer(kind = kint), intent(in) :: id_control !! character(len=kchara), intent(in) :: hd_block !! character(len = kchara), intent(inout) :: file_name @@ -56,6 +54,8 @@ module ctl_file_sections_IO character(len=kchara), parameter & & :: hd_psf_ctl = 'surface_rendering' private :: hd_section_ctl, hd_psf_ctl +! + private :: read_control_4_psf_file ! ! -------------------------------------------------------------------- ! @@ -68,6 +68,7 @@ subroutine read_files_4_psf_ctl & ! use t_read_control_elements use ctl_data_section_IO + use write_control_elements use skip_comment_f ! integer(kind = kint), intent(in) :: id_control @@ -75,6 +76,7 @@ subroutine read_files_4_psf_ctl & type(section_controls), intent(inout) :: psf_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(psf_ctls%psf_ctl_struct)) return @@ -82,14 +84,17 @@ subroutine read_files_4_psf_ctl & call alloc_psf_ctl_stract(psf_ctls) ! do - call load_one_line_from_control(id_control, c_buf) + call load_one_line_from_control(id_control, hd_block, c_buf) + if(c_buf%iend .gt. 0) exit if(check_end_array_flag(c_buf, hd_block)) exit ! if(check_file_flag(c_buf, hd_block) & & .or. check_begin_flag(c_buf, hd_block)) then - call append_new_section_control(psf_ctls) - write(*,'(3a,i4)', ADVANCE='NO') 'Control for ', & - & trim(hd_block), ' No. ', psf_ctls%num_psf_ctl + n_append = psf_ctls%num_psf_ctl + call append_section_control(n_append, hd_block, psf_ctls) +! + call write_multi_ctl_file_message & + & (hd_block, psf_ctls%num_psf_ctl, c_buf%level) call sel_read_control_4_psf_file(id_control, hd_block, & & psf_ctls%fname_psf_ctl(psf_ctls%num_psf_ctl), & & psf_ctls%psf_ctl_struct(psf_ctls%num_psf_ctl), c_buf) @@ -117,9 +122,9 @@ subroutine sel_read_control_4_psf_file(id_control, hd_block, & if(check_file_flag(c_buf, hd_block)) then file_name = third_word(c_buf) ! - write(*,'(a)', ADVANCE='NO') ' is read file from ... ' + write(*,'(a)', ADVANCE='NO') ' is read from file ... ' call read_control_4_psf_file((id_control+2), file_name, & - & hd_block, psf_ctl_struct) + & hd_block, psf_ctl_struct, c_buf) else if(check_begin_flag(c_buf, hd_block)) then file_name = 'NO_FILE' ! @@ -133,7 +138,7 @@ end subroutine sel_read_control_4_psf_file ! -------------------------------------------------------------------- ! subroutine read_control_4_psf_file(id_control, file_name, & - & hd_block, psf_ctl_struct) + & hd_block, psf_ctl_struct, c_buf) ! use t_read_control_elements use t_control_data_4_psf @@ -144,24 +149,28 @@ subroutine read_control_4_psf_file(id_control, file_name, & character(len = kchara), intent(in) :: file_name character(len=kchara), intent(in) :: hd_block type(psf_ctl), intent(inout) :: psf_ctl_struct -! - type(buffer_for_control) :: c_buf1 + type(buffer_for_control), intent(inout) :: c_buf ! ! + c_buf%level = c_buf%level + 1 write(*,'(a)') trim(file_name) open(id_control, file=file_name, status='old') ! do - call load_one_line_from_control(id_control, c_buf1) + call load_one_line_from_control(id_control, hd_block, c_buf) + if(c_buf%iend .gt. 0) exit +! call s_read_psf_control_data(id_control, hd_block, & - & psf_ctl_struct, c_buf1) + & psf_ctl_struct, c_buf) call s_read_psf_control_data(id_control, hd_section_ctl, & - & psf_ctl_struct, c_buf1) + & psf_ctl_struct, c_buf) call s_read_psf_control_data(id_control, hd_psf_ctl, & - & psf_ctl_struct, c_buf1) + & psf_ctl_struct, c_buf) if(psf_ctl_struct%i_psf_ctl .gt. 0) exit end do close(id_control) +! + c_buf%level = c_buf%level - 1 ! end subroutine read_control_4_psf_file ! @@ -180,13 +189,13 @@ subroutine write_files_4_psf_ctl & ! integer(kind = kint) :: i ! - write(id_control,'(a1)') '!' level = write_array_flag_for_ctl(id_control, level, hd_block) do i = 1, psf_ctls%num_psf_ctl - write(*,'(2a,i4)', ADVANCE='NO') trim(hd_block), ' No. ', i - call sel_write_control_4_psf_file(id_control, hd_block, & - & psf_ctls%fname_psf_ctl(i), psf_ctls%psf_ctl_struct(i), & - & level) + write(*,'(3a,i4)', ADVANCE='NO') '! ', trim(hd_block), & + & ' No. ', i + call sel_write_control_4_psf_file(id_control, hd_block, & + & psf_ctls%fname_psf_ctl(i), psf_ctls%psf_ctl_struct(i), & + & level) end do level = write_end_array_flag_for_ctl(id_control, level, hd_block) ! @@ -209,11 +218,17 @@ subroutine sel_write_control_4_psf_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 + write(*,'(a)') ' is included.' + call write_psf_control_data(id_control, hd_block, & + & psf_ctl_struct, level) + else if(id_control .eq. id_monitor) then + write(*,'(2a)') ' should be written to file ... ', & + & trim(file_name) call write_psf_control_data(id_control, hd_block, & & psf_ctl_struct, level) else - write(*,'(a)', ADVANCE='NO') ' is write file ... ' + write(*,'(2a)') ' is written to file ... ', trim(file_name) call write_file_name_for_ctl_line(id_control, level, & & hd_block, file_name) call write_control_4_psf_file((id_control+2), file_name, & @@ -239,7 +254,6 @@ subroutine write_control_4_psf_file(id_control, file_name, & integer(kind = kint) :: level ! ! - write(*,'(a)') trim(file_name) level = 0 open(id_control, file=file_name) call write_psf_control_data(id_control, hd_block, & diff --git a/src/Fortran_libraries/VIZ_src/surfacing/m_section_coef_flags.f90 b/src/Fortran_libraries/VIZ_src/surfacing/m_section_coef_flags.f90 index 2d52734d..356678eb 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/m_section_coef_flags.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/m_section_coef_flags.f90 @@ -22,10 +22,11 @@ !! subroutine set_primary_section_coef_flag(dir_ctl) !! character(len=kchara), intent(inout) :: dir_ctl !! -!! integer(kind = kint) function num_label_psf_coefs() -!! integer(kind = kint) function num_label_psf_dirs() -!! subroutine set_label_psf_coefs(names) -!! subroutine set_label_psf_dirs(names) +!! subroutine psf_coef_label_array(array_c) +!! subroutine psf_dirs_label_array(array_c) +!! subroutine iso_type_label_array(array_c) +!! subroutine psf_def_type_label_array(array_c) +!! type(ctl_array_chara), intent(inout) :: array_c !!@endverbatim ! module m_section_coef_flags @@ -85,32 +86,18 @@ module m_section_coef_flags type(multi_flag_labels), save :: c_labels ! ! -!> primary flag for square of X: 'X^2 ' - character(len=kchara), save :: cflag_x_sq -!> primary flag for square of Y: 'Y^2 ' - character(len=kchara), save :: cflag_y_sq -!> primary flag for square of Z: 'Z^2 ' - character(len=kchara), save :: cflag_z_sq + character(len = kchara), parameter :: cflag_eq = 'equation' + character(len = kchara), parameter :: cflag_pln = 'plane' + character(len = kchara), parameter :: cflag_sph = 'sphere' + character(len = kchara), parameter :: cflag_elp = 'ellipsoid' + character(len = kchara), parameter :: cflag_hyp = 'hyperboloid' + character(len = kchara), parameter :: cflag_prb = 'paraboloid' + character(len = kchara), parameter :: cflag_grp = 'group' ! -!> primary flag for xy: 'XY' - character(len=kchara), save :: cflag_xy -!> primary flag for yz: 'YZ' - character(len=kchara), save :: cflag_yz -!> primary flag for zx: 'ZX' - character(len=kchara), save :: cflag_zx ! -!> primary flag for x: 'X' - character(len=kchara), save :: cflag_x -!> primary flag for y: 'Y' - character(len=kchara), save :: cflag_y -!> primary flag for z: 'Z' - character(len=kchara), save :: cflag_z + character(len=kchara), parameter :: cflag_const_iso = 'constant' + character(len=kchara), parameter :: cflag_field_iso = 'field' ! -!> primary flag for Constant: 'Const' - character(len=kchara), save :: cflag_const -! - integer(kind = kint), parameter :: n_label_psf_coefs = 10 - integer(kind = kint), parameter :: n_label_psf_dirs = 3 ! private :: x_sq_name, y_sq_name, z_sq_name private :: xy_name, yz_name, zx_name @@ -118,7 +105,6 @@ module m_section_coef_flags ! private :: init_section_coef_flags, dealloc_section_coef_flags private :: set_each_coef_4_psf, set_each_param_2_vector - private :: init_primary_section_coef_flag ! ! --------------------------------------------------------------------- ! @@ -161,7 +147,6 @@ subroutine set_parameter_2_vectors & integer(kind = kint) :: i ! ! - call init_primary_section_coef_flag() vector(1:3) = zero do i = 1, num_vect call set_each_param_2_vector(ctl_name(i), vect_ctl(i), vector) @@ -179,28 +164,27 @@ subroutine set_primary_section_coef_flag(dir_ctl) ! ! call init_section_coef_flags() - call init_primary_section_coef_flag() ! if (check_mul_flags(dir_ctl, x_sq_labels)) then - prim_name = cflag_x_sq + prim_name = x_sq_name(3) else if(check_mul_flags(dir_ctl, y_sq_labels)) then - prim_name = cflag_y_sq + prim_name = y_sq_name(3) else if(check_mul_flags(dir_ctl, z_sq_labels)) then - prim_name = cflag_z_sq + prim_name = z_sq_name(3) else if(check_mul_flags(dir_ctl, xy_labels)) then - prim_name = cflag_xy + prim_name = xy_name(1) else if(check_mul_flags(dir_ctl, yz_labels)) then - prim_name = cflag_yz + prim_name = yz_name(1) else if(check_mul_flags(dir_ctl, zx_labels)) then - prim_name = cflag_zx + prim_name = zx_name(1) else if(check_mul_flags(dir_ctl, x_labels)) then - prim_name = cflag_x + prim_name = x_name(1) else if(check_mul_flags(dir_ctl, y_labels)) then - prim_name = cflag_y + prim_name = y_name(1) else if(check_mul_flags(dir_ctl, z_labels)) then - prim_name = cflag_z + prim_name = z_name(1) else if(check_mul_flags(dir_ctl, c_labels)) then - prim_name = cflag_const + prim_name = c_name(1) end if dir_ctl = trim(prim_name) // char(0) ! @@ -209,61 +193,78 @@ subroutine set_primary_section_coef_flag(dir_ctl) end subroutine set_primary_section_coef_flag ! ! --------------------------------------------------------------------- +! --------------------------------------------------------------------- ! - integer(kind = kint) function num_label_psf_coefs() - num_label_psf_coefs = n_label_psf_coefs - return - end function num_label_psf_coefs -! -! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_label_psf_dirs() - num_label_psf_dirs = n_label_psf_dirs - return - end function num_label_psf_dirs + subroutine psf_coef_label_array(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c +! + character(len=kchara) :: tmpchara +! + array_c%array_name = ' ' + array_c%num = 0 + call alloc_control_array_chara(array_c) +! + tmpchara = x_sq_name(3) + call append_c_to_ctl_array(tmpchara, array_c) + tmpchara = y_sq_name(3) + call append_c_to_ctl_array(tmpchara, array_c) + tmpchara = z_sq_name(3) + call append_c_to_ctl_array(tmpchara, array_c) + tmpchara = xy_name(1) + call append_c_to_ctl_array(tmpchara, array_c) + tmpchara = yz_name(1) + call append_c_to_ctl_array(tmpchara, array_c) + tmpchara = zx_name(1) + call append_c_to_ctl_array(tmpchara, array_c) + tmpchara = x_name(1) + call append_c_to_ctl_array(tmpchara, array_c) + tmpchara = y_name(1) + call append_c_to_ctl_array(tmpchara, array_c) + tmpchara = z_name(1) + call append_c_to_ctl_array(tmpchara, array_c) + tmpchara = c_name(1) + call append_c_to_ctl_array(tmpchara, array_c) +! + end subroutine psf_coef_label_array ! ! ---------------------------------------------------------------------- ! - subroutine set_label_psf_coefs(names) -! - use t_read_control_elements + subroutine psf_dirs_label_array(array_c) + use t_control_array_character + type(ctl_array_chara), intent(inout) :: array_c ! - character(len = kchara), intent(inout) & - & :: names(n_label_psf_coefs) + character(len=kchara) :: tmpchara ! + array_c%array_name = ' ' + array_c%num = 0 + call alloc_control_array_chara(array_c) ! - call init_primary_section_coef_flag() - call set_control_labels(cflag_x_sq, names( 1)) - call set_control_labels(cflag_y_sq, names( 2)) - call set_control_labels(cflag_z_sq, names( 3)) - call set_control_labels(cflag_xy, names( 4)) - call set_control_labels(cflag_yz, names( 5)) - call set_control_labels(cflag_zx, names( 6)) - call set_control_labels(cflag_x, names( 7)) - call set_control_labels(cflag_y, names( 8)) - call set_control_labels(cflag_z, names( 9)) - call set_control_labels(cflag_const, names(10)) + tmpchara = x_name(1) + call append_c_to_ctl_array(tmpchara, array_c) + tmpchara = y_name(1) + call append_c_to_ctl_array(tmpchara, array_c) + tmpchara = z_name(1) + call append_c_to_ctl_array(tmpchara, array_c) ! - end subroutine set_label_psf_coefs + end subroutine psf_dirs_label_array ! -! --------------------------------------------------------------------- -! - subroutine set_label_psf_dirs(names) -! - use t_read_control_elements +! ---------------------------------------------------------------------- ! - character(len = kchara), intent(inout) & - & :: names(n_label_psf_dirs) + subroutine iso_type_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 init_primary_section_coef_flag() - call set_control_labels(cflag_x, names( 1)) - call set_control_labels(cflag_y, names( 2)) - call set_control_labels(cflag_z, names( 3)) + call append_c_to_ctl_array(cflag_const_iso, array_c) + call append_c_to_ctl_array(cflag_field_iso, array_c) ! - end subroutine set_label_psf_dirs + end subroutine iso_type_label_array ! -! --------------------------------------------------------------------- +! ---------------------------------------------------------------------- ! --------------------------------------------------------------------- ! subroutine init_section_coef_flags() @@ -301,6 +302,26 @@ subroutine dealloc_section_coef_flags() end subroutine dealloc_section_coef_flags ! ! --------------------------------------------------------------------- +! + subroutine psf_def_type_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_eq, array_c) + call append_c_to_ctl_array(cflag_pln, array_c) + call append_c_to_ctl_array(cflag_sph, array_c) + call append_c_to_ctl_array(cflag_elp, array_c) + call append_c_to_ctl_array(cflag_hyp, array_c) + call append_c_to_ctl_array(cflag_prb, array_c) + call append_c_to_ctl_array(cflag_grp, array_c) +! + end subroutine psf_def_type_label_array +! +! ---------------------------------------------------------------------- ! --------------------------------------------------------------------- ! subroutine set_each_coef_4_psf(dir_ctl, coef_ctl, c_surf) @@ -347,35 +368,16 @@ subroutine set_each_param_2_vector(ctl_name, vect_ctl, vector) real(kind = kreal), intent(inout) :: vector(3) ! ! - if (cmp_no_case(ctl_name, cflag_x)) then + if (cmp_no_case(ctl_name, x_name(1))) then vector(1) = vect_ctl - else if (cmp_no_case(ctl_name, cflag_y)) then + else if (cmp_no_case(ctl_name, y_name(1))) then vector(2) = vect_ctl - else if (cmp_no_case(ctl_name, cflag_z)) then + else if (cmp_no_case(ctl_name, z_name(1))) then vector(3) = vect_ctl end if ! end subroutine set_each_param_2_vector ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- -! - subroutine init_primary_section_coef_flag -! -! - cflag_x_sq = x_sq_name(3) - cflag_y_sq = y_sq_name(3) - cflag_z_sq = z_sq_name(3) - cflag_xy = xy_name(1) - cflag_yz = yz_name(1) - cflag_zx = zx_name(1) - cflag_x = x_name(1) - cflag_y = y_name(1) - cflag_z = z_name(1) - cflag_const = c_name(1) -! - end subroutine init_primary_section_coef_flag -! -! --------------------------------------------------------------------- ! end module m_section_coef_flags diff --git a/src/Fortran_libraries/VIZ_src/surfacing/set_coefs_of_sections.f90 b/src/Fortran_libraries/VIZ_src/surfacing/set_coefs_of_sections.f90 index 59ccd762..4f20a4e2 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/set_coefs_of_sections.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/set_coefs_of_sections.f90 @@ -13,10 +13,6 @@ !! real(kind = kreal) function side_of_plane(const_psf, xx) !! subroutine cal_normal_of_plane(const_psf, xx, normal) !! subroutine cal_normal4_of_plane(const_psf, xx4, normal4) -!! -!! integer(kind = kint) function num_label_psf_def_type() -!! integer(kind = kint) function num_label_psf_def_type_grp() -!! subroutine set_label_psf_def_type_grp(names) !!@endverbatim ! module set_coefs_of_sections @@ -25,20 +21,6 @@ module set_coefs_of_sections use m_constants ! implicit none -! - character(len = kchara), parameter :: cflag_eq = 'equation' - character(len = kchara), parameter :: cflag_pln = 'plane' - character(len = kchara), parameter :: cflag_sph = 'sphere' - character(len = kchara), parameter :: cflag_elp = 'ellipsoid' - character(len = kchara), parameter :: cflag_hyp = 'hyperboloid' - character(len = kchara), parameter :: cflag_prb = 'paraboloid' - character(len = kchara), parameter :: cflag_grp = 'group' -! - integer(kind = kint), parameter :: n_label_psf_def_type = 6 - integer(kind = kint), parameter :: n_label_psf_def_type_grp = 7 -! - private :: cflag_pln, cflag_sph, cflag_elp - private :: cflag_hyp, cflag_prb ! ! --------------------------------------------------------------------- ! @@ -178,40 +160,5 @@ subroutine cal_normal4_of_plane(const_psf, xx4, normal4) end subroutine cal_normal4_of_plane ! ! --------------------------------------------------------------------- -! -------------------------------------------------------------------- -! - integer(kind = kint) function num_label_psf_def_type() - num_label_psf_def_type = n_label_psf_def_type - return - end function num_label_psf_def_type -! -! ---------------------------------------------------------------------- -! - integer(kind = kint) function num_label_psf_def_type_grp() - num_label_psf_def_type_grp = n_label_psf_def_type_grp - return - end function num_label_psf_def_type_grp -! -! ---------------------------------------------------------------------- -! - subroutine set_label_psf_def_type_grp(names) -! - use t_read_control_elements -! - character(len = kchara), intent(inout) & - & :: names(n_label_psf_def_type_grp) -! -! - call set_control_labels(cflag_eq, names( 1)) - call set_control_labels(cflag_pln, names( 2)) - call set_control_labels(cflag_sph, names( 3)) - call set_control_labels(cflag_elp, names( 4)) - call set_control_labels(cflag_hyp, names( 5)) - call set_control_labels(cflag_prb, names( 6)) - call set_control_labels(cflag_grp, names( 7)) -! - end subroutine set_label_psf_def_type_grp -! -! --------------------------------------------------------------------- ! end module set_coefs_of_sections diff --git a/src/Fortran_libraries/VIZ_src/surfacing/set_field_comp_for_viz.f90 b/src/Fortran_libraries/VIZ_src/surfacing/set_field_comp_for_viz.f90 index 4d21d9f9..228eb754 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/set_field_comp_for_viz.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/set_field_comp_for_viz.f90 @@ -1,8 +1,12 @@ -!set_field_comp_for_viz.f90 -! module set_field_comp_for_viz -! -! programmed by H.Matsui on May. 2006 +!>@file set_field_comp_for_viz.f90 +!!@brief module set_field_comp_for_viz +!! +!!@author H. Matsui +!!@date Programmed in May., 2006 ! +!>@brief set field components for visualizartions +!! +!!@verbatim !! subroutine check_field_4_viz(num_nod_phys, phys_nod_name, & !! & n_field_ctl, field_name, num_field, num_field_vis) !! subroutine set_components_4_viz(num_nod_phys, phys_nod_name, & @@ -13,7 +17,7 @@ !! & ncomp_org, rst_name) !! !! subroutine count_total_comps_4_viz(psf_fld) -! +!!@endverbatim module set_field_comp_for_viz ! use m_precision diff --git a/src/Fortran_libraries/VIZ_src/surfacing/set_iso_control.f90 b/src/Fortran_libraries/VIZ_src/surfacing/set_iso_control.f90 index ce88372d..33129537 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/set_iso_control.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/set_iso_control.f90 @@ -23,6 +23,7 @@ module set_iso_control ! use m_precision use m_machine_parameter + use calypso_mpi ! use t_mesh_data use t_group_data @@ -48,7 +49,6 @@ module set_iso_control subroutine s_set_iso_control(num_iso, group, nod_fld, & & iso_ctls, iso_param, iso_def, iso_mesh, iso_file_IO) ! - use calypso_mpi use t_read_control_elements use t_control_data_isosurfaces use t_control_data_sections @@ -160,6 +160,8 @@ end subroutine count_control_4_iso subroutine set_control_4_iso & & (iso_c, ele_grp, num_nod_phys, phys_nod_name, & & iso_fld, iso_param, iso_def) +! + use m_error_IDs ! type(group_data), intent(in) :: ele_grp ! @@ -170,11 +172,17 @@ subroutine set_control_4_iso & type(phys_data), intent(inout) :: iso_fld type(psf_parameters), intent(inout) :: iso_param type(isosurface_define), intent(inout) :: iso_def +! + integer(kind = kint) :: ierr ! ! call alloc_area_group_psf(iso_param) call set_control_iso_def(iso_c%iso_def_c, ele_grp, & - & num_nod_phys, phys_nod_name, iso_param, iso_def) + & num_nod_phys, phys_nod_name, iso_param, iso_def, ierr) + if(ierr .gt. 0) then + call calypso_MPI_abort(ierr_VIZ, 'set scalar for rendering') + end if +! ! call set_control_4_field_on_iso & & (iso_c%fld_on_iso_c, num_nod_phys, phys_nod_name, & diff --git a/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_fld_on_psf.f90 b/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_fld_on_psf.f90 index d87e9769..3eabedc9 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_fld_on_psf.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_fld_on_psf.f90 @@ -6,7 +6,7 @@ !>@brief control data for field on isosurface !! !!@verbatim -!! subroutine init_fld_on_psf_control(fld_on_psf_c) +!! subroutine init_fld_on_psf_control(hd_block, fld_on_psf_c) !! subroutine dealloc_fld_on_psf_control(fld_on_psf_c) !! type(field_on_psf_ctl), intent(inout) :: fld_on_psf_c !! subroutine dup_fld_on_psf_control & @@ -31,8 +31,6 @@ !! type(field_on_psf_ctl), intent(in) :: fld_on_psf_c !! type(ctl_array_c3), intent(inout) :: field_ctl !! -!! integer(kind = kint) function num_label_fld_on_psf_control() -!! subroutine set_label_fld_on_psf_control(names) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! example of control for Kemo's surface rendering !! @@ -73,6 +71,9 @@ module t_control_data_4_fld_on_psf ! !> Structure of fields on isosurface control type field_on_psf_ctl +!> Block name + character(len=kchara) :: block_name = 'output_field_define' +! !> Structure for list of output field !!@n field_output_ctl%c1_tbl: Name of field !!@n field_output_ctl%c2_tbl: Name of component @@ -92,8 +93,6 @@ module t_control_data_4_fld_on_psf & :: hd_iso_result_field = 'output_field' character(len=kchara), parameter & & :: hd_result_value = 'result_value' -! - integer(kind = kint), parameter :: n_label_fld_on_psf_ctl = 3 ! private :: hd_result_type, hd_iso_result_field, hd_result_value ! @@ -103,13 +102,23 @@ module t_control_data_4_fld_on_psf ! ! --------------------------------------------------------------------- ! - subroutine init_fld_on_psf_control(fld_on_psf_c) + subroutine init_fld_on_psf_control(hd_block, fld_on_psf_c) ! + character(len=kchara), intent(in) :: hd_block type(field_on_psf_ctl), intent(inout) :: fld_on_psf_c ! ! fld_on_psf_c%field_output_ctl%num = 0 fld_on_psf_c%output_value_ctl%realvalue = 0.0d0 +! + fld_on_psf_c%block_name = hd_block + call init_chara2_ctl_array_label & + & (hd_iso_result_field, fld_on_psf_c%field_output_ctl) +! + call init_chara_ctl_item_label(hd_result_type, & + & fld_on_psf_c%output_type_ctl) + call init_real_ctl_item_label(hd_result_value, & + & fld_on_psf_c%output_value_ctl) ! end subroutine init_fld_on_psf_control ! @@ -147,7 +156,8 @@ subroutine dup_fld_on_psf_control & call dup_control_array_c2(org_fld_on_iso_c%field_output_ctl, & & new_fld_on_iso_c%field_output_ctl) ! - new_fld_on_iso_c%i_iso_result = org_fld_on_iso_c%i_iso_result + new_fld_on_iso_c%block_name = org_fld_on_iso_c%block_name + new_fld_on_iso_c%i_iso_result = org_fld_on_iso_c%i_iso_result ! end subroutine dup_fld_on_psf_control ! @@ -163,10 +173,11 @@ subroutine read_fld_on_psf_control & type(buffer_for_control), intent(inout) :: c_buf ! ! - if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(fld_on_psf_c%i_iso_result .gt. 0) return + if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_control_array_c2(id_control, & @@ -202,19 +213,15 @@ subroutine write_fld_on_psf_control & maxlen = len_trim(hd_result_type) maxlen = max(maxlen, len_trim(hd_result_value)) ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) -! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_result_type, fld_on_psf_c%output_type_ctl) + & fld_on_psf_c%output_type_ctl) ! call write_real_ctl_type(id_control, level, maxlen, & - & hd_result_value, fld_on_psf_c%output_value_ctl) + & fld_on_psf_c%output_value_ctl) ! - write(id_control,'(a1)') '!' call write_control_array_c2(id_control, level, & - & hd_iso_result_field, fld_on_psf_c%field_output_ctl) -! + & fld_on_psf_c%field_output_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_fld_on_psf_control @@ -241,27 +248,5 @@ subroutine add_fields_on_psf_to_fld_ctl(fld_on_psf_c, field_ctl) end subroutine add_fields_on_psf_to_fld_ctl ! ! --------------------------------------------------------------------- -! -------------------------------------------------------------------- -! - integer(kind = kint) function num_label_fld_on_psf_control() - num_label_fld_on_psf_control = n_label_fld_on_psf_ctl - return - end function num_label_fld_on_psf_control -! -! ---------------------------------------------------------------------- -! - subroutine set_label_fld_on_psf_control(names) -! - character(len = kchara), intent(inout) & - & :: names(n_label_fld_on_psf_ctl) -! -! - call set_control_labels(hd_result_type, names( 1)) - call set_control_labels(hd_iso_result_field, names( 2)) - call set_control_labels(hd_result_value, names( 3)) -! - end subroutine set_label_fld_on_psf_control -! -! --------------------------------------------------------------------- ! end module t_control_data_4_fld_on_psf diff --git a/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_iso.f90 b/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_iso.f90 index 099c92e7..dbd4d4b9 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_iso.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_iso.f90 @@ -6,7 +6,6 @@ !>@brief control data for each isosurface !! !!@verbatim -!! subroutine init_iso_ctl_stract(iso_c) !! subroutine dealloc_cont_dat_4_iso(iso_c) !! type(iso_ctl), intent(inout) :: iso_c !! subroutine dup_control_4_iso(org_iso_c, new_iso_c) @@ -83,8 +82,13 @@ module t_control_data_4_iso implicit none ! type iso_ctl +!> Block name + character(len=kchara) :: block_name = 'isosurface_ctl' +! !> Structure of isosurface define control type(iso_define_ctl) :: iso_def_c +!> file name for fields on isosurface control + character(len=kchara) :: fname_fld_on_iso = 'NO_FILE' !> Structure of fields on isosurface control type(field_on_psf_ctl) :: fld_on_iso_c ! @@ -102,18 +106,6 @@ module t_control_data_4_iso contains ! ! --------------------------------------------------------------------- -! - subroutine init_iso_ctl_stract(iso_c) -! - type(iso_ctl), intent(inout) :: iso_c -! -! - call init_iso_define_control(iso_c%iso_def_c) - call init_fld_on_psf_control(iso_c%fld_on_iso_c) -! - end subroutine init_iso_ctl_stract -! -! --------------------------------------------------------------------- ! subroutine dealloc_cont_dat_4_iso(iso_c) ! @@ -143,7 +135,9 @@ subroutine dup_control_4_iso(org_iso_c, new_iso_c) call copy_chara_ctl(org_iso_c%iso_output_type_ctl, & & new_iso_c%iso_output_type_ctl) ! - new_iso_c%i_iso_ctl = org_iso_c%i_iso_ctl + new_iso_c%i_iso_ctl = org_iso_c%i_iso_ctl + new_iso_c%block_name = org_iso_c%block_name + new_iso_c%fname_fld_on_iso = org_iso_c%fname_fld_on_iso ! call dup_iso_define_control & & (org_iso_c%iso_def_c, new_iso_c%iso_def_c) diff --git a/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_iso_def.f90 b/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_iso_def.f90 index 23633638..ebf0b69d 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_iso_def.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_iso_def.f90 @@ -6,7 +6,7 @@ !>@brief control data for each isosurface !! !!@verbatim -!! subroutine init_iso_define_control(iso_def_c) +!! subroutine init_iso_define_control(hd_block, iso_def_c) !! subroutine dealloc_iso_define_control(iso_def_c) !! type(iso_define_ctl), intent(inout) :: iso_def_c !! subroutine dup_iso_define_control(org_iso_def_c, new_iso_def_c) @@ -82,6 +82,9 @@ module t_control_data_4_iso_def ! !> Structure of isosurface define control type iso_define_ctl +!> Block name + character(len=kchara) :: block_name = 'isosurf_define' +! !> Structure for field name for isosurface type(read_character_item) :: isosurf_data_ctl !> Structure for component name for isosurface @@ -107,11 +110,8 @@ module t_control_data_4_iso_def & :: hd_iso_value = 'isosurf_value' character(len=kchara), parameter & & :: hd_iso_area = 'isosurf_area_ctl' -! - integer(kind = kint), parameter :: n_label_iso_define_ctl = 4 ! private :: hd_iso_area, hd_iso_value, hd_iso_comp, hd_iso_field - private :: n_label_iso_define_ctl ! ! --------------------------------------------------------------------- ! @@ -119,13 +119,24 @@ module t_control_data_4_iso_def ! ! --------------------------------------------------------------------- ! - subroutine init_iso_define_control(iso_def_c) + subroutine init_iso_define_control(hd_block, iso_def_c) ! + character(len=kchara), intent(in) :: hd_block type(iso_define_ctl), intent(inout) :: iso_def_c ! ! iso_def_c%isosurf_value_ctl%realvalue = 0.0d0 iso_def_c%iso_area_ctl%num = 0 +! + iso_def_c%block_name = hd_block + call init_chara_ctl_item_label & + & (hd_iso_field, iso_def_c%isosurf_data_ctl) + call init_chara_ctl_item_label & + & (hd_iso_comp, iso_def_c%isosurf_comp_ctl) + call init_real_ctl_item_label & + & (hd_iso_value, iso_def_c%isosurf_value_ctl) + call init_chara_ctl_array_label & + & (hd_iso_area, iso_def_c%iso_area_ctl) ! end subroutine init_iso_define_control ! @@ -165,7 +176,8 @@ subroutine dup_iso_define_control(org_iso_def_c, new_iso_def_c) call copy_chara_ctl(org_iso_def_c%isosurf_data_ctl, & & new_iso_def_c%isosurf_data_ctl) ! - new_iso_def_c%i_iso_define = org_iso_def_c%i_iso_define + new_iso_def_c%block_name = org_iso_def_c%block_name + new_iso_def_c%i_iso_define = org_iso_def_c%i_iso_define ! end subroutine dup_iso_define_control ! @@ -184,7 +196,8 @@ subroutine read_iso_define_data & if(check_begin_flag(c_buf, hd_block) .eqv. .FALSE.) return if(iso_def_c%i_iso_define .gt. 0) return do - call load_one_line_from_control(id_control, c_buf) + 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 ! call read_chara_ctl_type & @@ -223,48 +236,21 @@ subroutine write_iso_define_data & maxlen = max(maxlen, len_trim(hd_iso_comp)) maxlen = max(maxlen, len_trim(hd_iso_value)) ! - write(id_control,'(a1)') '!' level = write_begin_flag_for_ctl(id_control, level, hd_block) -! call write_chara_ctl_type(id_control, level, maxlen, & - & hd_iso_field, iso_def_c%isosurf_data_ctl) + & iso_def_c%isosurf_data_ctl) call write_chara_ctl_type(id_control, level, maxlen, & - & hd_iso_comp, iso_def_c%isosurf_comp_ctl) + & iso_def_c%isosurf_comp_ctl) ! call write_real_ctl_type(id_control, level, maxlen, & - & hd_iso_value, iso_def_c%isosurf_value_ctl) + & iso_def_c%isosurf_value_ctl) ! - write(id_control,'(a1)') '!' call write_control_array_c1(id_control, level, & - & hd_iso_area, iso_def_c%iso_area_ctl) -! + & iso_def_c%iso_area_ctl) level = write_end_flag_for_ctl(id_control, level, hd_block) ! end subroutine write_iso_define_data ! ! -------------------------------------------------------------------- -! -------------------------------------------------------------------- -! - integer(kind = kint) function num_label_iso_define_control() - num_label_iso_define_control = n_label_iso_define_ctl - return - end function num_label_iso_define_control -! -! ---------------------------------------------------------------------- -! - subroutine set_label_iso_define_control(names) -! - character(len = kchara), intent(inout) & - & :: names(n_label_iso_define_ctl) -! -! - call set_control_labels(hd_iso_field, names( 1)) - call set_control_labels(hd_iso_comp, names( 2)) - call set_control_labels(hd_iso_value, names( 3)) - call set_control_labels(hd_iso_area, names( 4)) -! - end subroutine set_label_iso_define_control -! -! --------------------------------------------------------------------- ! end module t_control_data_4_iso_def diff --git a/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_psf.f90 b/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_psf.f90 index ee582268..3c0153cc 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_psf.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_psf.f90 @@ -7,7 +7,6 @@ !>@brief control ID data for surfacing module !! !!@verbatim -!! subroutine init_psf_ctl_stract(psf_c) !! subroutine dealloc_cont_dat_4_psf(psf_c) !! type(psf_ctl), intent(inout) :: psf_c !! subroutine dup_control_4_psf(org_psf_c, new_psf_c) @@ -133,10 +132,15 @@ module t_control_data_4_psf ! ! type psf_ctl +!> Block name + character(len=kchara) :: block_name = 'cross_section_ctl' +! !> file name for surface definision character(len=kchara) :: fname_section_ctl !> Structure of cross section definition type(psf_define_ctl) :: psf_def_c +!> file name for fields on isosurface control + character(len=kchara) :: fname_fld_on_psf !> Structure of fields on isosurface control type(field_on_psf_ctl) :: fld_on_psf_c ! @@ -156,17 +160,6 @@ module t_control_data_4_psf contains ! ! --------------------------------------------------------------------- -! - subroutine init_psf_ctl_stract(psf_c) -! - type(psf_ctl), intent(inout) :: psf_c -! - call init_psf_def_ctl_stract(psf_c%psf_def_c) - call init_fld_on_psf_control(psf_c%fld_on_psf_c) -! - end subroutine init_psf_ctl_stract -! -! --------------------------------------------------------------------- ! subroutine dealloc_cont_dat_4_psf(psf_c) ! @@ -203,6 +196,8 @@ subroutine dup_control_4_psf(org_psf_c, new_psf_c) & new_psf_c%psf_output_type_ctl) ! new_psf_c%fname_section_ctl = org_psf_c%fname_section_ctl + new_psf_c%fname_fld_on_psf = org_psf_c%fname_fld_on_psf + new_psf_c%block_name = org_psf_c%block_name new_psf_c%i_psf_ctl = org_psf_c%i_psf_ctl new_psf_c%i_output_field = org_psf_c%i_output_field ! diff --git a/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_psf_def.f90 b/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_psf_def.f90 index a92eb9cd..86511158 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_psf_def.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_4_psf_def.f90 @@ -7,7 +7,6 @@ !>@brief control ID data for surfacing module !! !!@verbatim -!! subroutine init_psf_def_ctl_stract(psf_def_c) !! subroutine dealloc_cont_dat_4_psf_def(psf_def_c) !! type(psf_define_ctl), intent(inout) :: psf_def_c !! subroutine dup_control_4_psf_def(org_psf_def_c, new_psf_def_c) @@ -115,6 +114,9 @@ module t_control_data_4_psf_def ! !> Structure of cross section definition type psf_define_ctl +!> Block name + character(len=kchara) :: block_name = 'surface_define' +! !> Structure for cross section type type(read_character_item) :: section_method_ctl ! @@ -177,17 +179,6 @@ module t_control_data_4_psf_def contains ! ! --------------------------------------------------------------------- -! - subroutine init_psf_def_ctl_stract(psf_def_c) -! - type(psf_define_ctl), intent(inout) :: psf_def_c -! - psf_def_c%radius_psf_ctl%realvalue = 0.0d0 - psf_def_c%psf_area_ctl%num = 0 -! - end subroutine init_psf_def_ctl_stract -! -! --------------------------------------------------------------------- ! subroutine dealloc_cont_dat_4_psf_def(psf_def_c) ! @@ -229,6 +220,7 @@ subroutine dup_control_4_psf_def(org_psf_def_c, new_psf_def_c) type(psf_define_ctl), intent(inout) :: new_psf_def_c ! ! + new_psf_def_c%block_name = org_psf_def_c%block_name new_psf_def_c%i_surface_define = org_psf_def_c%i_surface_define ! call copy_chara_ctl(org_psf_def_c%section_method_ctl, & diff --git a/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_isosurfaces.f90 b/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_isosurfaces.f90 index 83e843c1..f17016fa 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_isosurfaces.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_isosurfaces.f90 @@ -6,12 +6,20 @@ !>@brief control data for isosurfaces !! !!@verbatim +!! subroutine alloc_iso_ctl_stract(iso_ctls) !! subroutine dealloc_iso_ctl_stract(iso_ctls) +!! subroutine init_iso_ctls_labels(hd_block, iso_ctls) +!! character(len=kchara), intent(in) :: hd_block !! type(isosurf_controls), intent(inout) :: iso_ctls !! !! subroutine add_fields_4_isos_to_fld_ctl(iso_ctls, field_ctl) !! type(isosurf_controls), intent(in) :: iso_ctls !! type(ctl_array_c3), intent(inout) :: field_ctl +!! +!! subroutine append_isosurface_control(idx_in, hd_block, iso_ctls) +!! subroutine delete_isosurface_control(idx_in, iso_ctls) +!! type(isosurf_controls), intent(inout) :: iso_ctls +!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! array isosurface_ctl 2 !! file isosurface_ctl 'ctl_iso_p_n1e4' @@ -31,6 +39,9 @@ module t_control_data_isosurfaces ! ! type isosurf_controls +!> Control block name + character(len = kchara) :: block_name = 'isosurface_ctl' +!> # of Structure for isosurface control integer(kind = kint) :: num_iso_ctl = 0 !> file name for isosurface control character(len = kchara), allocatable :: fname_iso_ctl(:) @@ -38,14 +49,22 @@ module t_control_data_isosurfaces type(iso_ctl), allocatable :: iso_ctl_struct(:) end type isosurf_controls ! -! - private :: dup_control_4_isos -! ! -------------------------------------------------------------------- ! contains ! ! --------------------------------------------------------------------- +! + subroutine alloc_iso_ctl_stract(iso_ctls) +! + type(isosurf_controls), intent(inout) :: iso_ctls +! + allocate(iso_ctls%iso_ctl_struct(iso_ctls%num_iso_ctl)) + allocate(iso_ctls%fname_iso_ctl(iso_ctls%num_iso_ctl)) +! + end subroutine alloc_iso_ctl_stract +! +! --------------------------------------------------------------------- ! subroutine dealloc_iso_ctl_stract(iso_ctls) ! @@ -64,6 +83,19 @@ subroutine dealloc_iso_ctl_stract(iso_ctls) end subroutine dealloc_iso_ctl_stract ! ! --------------------------------------------------------------------- +! + subroutine init_iso_ctls_labels(hd_block, iso_ctls) +! + character(len=kchara), intent(in) :: hd_block + type(isosurf_controls), intent(inout) :: iso_ctls +! + iso_ctls%num_iso_ctl = 0 + iso_ctls%block_name = hd_block +! + end subroutine init_iso_ctls_labels +! +! --------------------------------------------------------------------- +! --------------------------------------------------------------------- ! subroutine add_fields_4_isos_to_fld_ctl(iso_ctls, field_ctl) ! @@ -84,61 +116,90 @@ end subroutine add_fields_4_isos_to_fld_ctl ! --------------------------------------------------------------------- ! --------------------------------------------------------------------- ! - subroutine append_new_isosurface_control(iso_ctls) + subroutine append_isosurface_control(idx_in, hd_block, iso_ctls) +! + use ctl_data_isosurface_IO ! + integer(kind = kint), intent(in) :: idx_in + character(len=kchara), intent(in) :: hd_block type(isosurf_controls), intent(inout) :: iso_ctls ! type(isosurf_controls) :: tmp_iso_c + integer(kind = kint) :: i ! +! + if(idx_in.lt.0 .or. idx_in.gt.iso_ctls%num_iso_ctl) return ! tmp_iso_c%num_iso_ctl = iso_ctls%num_iso_ctl call alloc_iso_ctl_stract(tmp_iso_c) - call dup_control_4_isos & - & (tmp_iso_c%num_iso_ctl, iso_ctls, tmp_iso_c) + do i = 1, iso_ctls%num_iso_ctl + call dup_control_4_iso(iso_ctls%iso_ctl_struct(i), & + & tmp_iso_c%iso_ctl_struct(i)) + tmp_iso_c%fname_iso_ctl(i) = iso_ctls%fname_iso_ctl(i) + end do ! call dealloc_iso_ctl_stract(iso_ctls) -! iso_ctls%num_iso_ctl = tmp_iso_c%num_iso_ctl + 1 call alloc_iso_ctl_stract(iso_ctls) ! - call dup_control_4_isos & - & (tmp_iso_c%num_iso_ctl, tmp_iso_c, iso_ctls) + do i = 1, idx_in + call dup_control_4_iso(tmp_iso_c%iso_ctl_struct(i), & + iso_ctls%iso_ctl_struct(i)) + iso_ctls%fname_iso_ctl(i) = tmp_iso_c%fname_iso_ctl(i) + end do + call init_iso_ctl_stract(hd_block, & + & iso_ctls%iso_ctl_struct(idx_in+1)) + iso_ctls%fname_iso_ctl(idx_in+1) = 'NO_FILE' + do i = idx_in+1, tmp_iso_c%num_iso_ctl + call dup_control_4_iso(tmp_iso_c%iso_ctl_struct(i), & + & iso_ctls%iso_ctl_struct(i+1)) + iso_ctls%fname_iso_ctl(i+1) = tmp_iso_c%fname_iso_ctl(i) + end do ! call dealloc_iso_ctl_stract(tmp_iso_c) ! - end subroutine append_new_isosurface_control + end subroutine append_isosurface_control ! ! ----------------------------------------------------------------------- ! - subroutine dup_control_4_isos & - & (num_iso, org_iso_ctls, new_iso_ctls) + subroutine delete_isosurface_control(idx_in, iso_ctls) ! - integer(kind = kint), intent(in) :: num_iso - type(isosurf_controls), intent(in) :: org_iso_ctls - type(isosurf_controls), intent(inout) :: new_iso_ctls + integer(kind = kint), intent(in) :: idx_in + type(isosurf_controls), intent(inout) :: iso_ctls ! + type(isosurf_controls) :: tmp_iso_c integer(kind = kint) :: i ! - do i = 1, num_iso - call dup_control_4_iso(org_iso_ctls%iso_ctl_struct(i), & - new_iso_ctls%iso_ctl_struct(i)) - end do - new_iso_ctls%fname_iso_ctl(1:num_iso) & - & = org_iso_ctls%fname_iso_ctl(1:num_iso) ! - end subroutine dup_control_4_isos + if(idx_in.le.0 .or. idx_in.gt.iso_ctls%num_iso_ctl) return ! -! --------------------------------------------------------------------- + tmp_iso_c%num_iso_ctl = iso_ctls%num_iso_ctl + call alloc_iso_ctl_stract(tmp_iso_c) + do i = 1, iso_ctls%num_iso_ctl + call dup_control_4_iso(iso_ctls%iso_ctl_struct(i), & + & tmp_iso_c%iso_ctl_struct(i)) + tmp_iso_c%fname_iso_ctl(i) = iso_ctls%fname_iso_ctl(i) + end do ! - subroutine alloc_iso_ctl_stract(iso_ctls) + call dealloc_iso_ctl_stract(iso_ctls) + iso_ctls%num_iso_ctl = tmp_iso_c%num_iso_ctl - 1 + call alloc_iso_ctl_stract(iso_ctls) ! - type(isosurf_controls), intent(inout) :: iso_ctls + do i = 1, idx_in-1 + call dup_control_4_iso(tmp_iso_c%iso_ctl_struct(i), & + & iso_ctls%iso_ctl_struct(i)) + iso_ctls%fname_iso_ctl(i) = tmp_iso_c%fname_iso_ctl(i) + end do + do i = idx_in, iso_ctls%num_iso_ctl + call dup_control_4_iso(tmp_iso_c%iso_ctl_struct(i+1), & + & iso_ctls%iso_ctl_struct(i)) + iso_ctls%fname_iso_ctl(i+1) = tmp_iso_c%fname_iso_ctl(i) + end do ! - allocate(iso_ctls%iso_ctl_struct(iso_ctls%num_iso_ctl)) - allocate(iso_ctls%fname_iso_ctl(iso_ctls%num_iso_ctl)) + call dealloc_iso_ctl_stract(tmp_iso_c) ! - end subroutine alloc_iso_ctl_stract + end subroutine delete_isosurface_control ! -! --------------------------------------------------------------------- +! ----------------------------------------------------------------------- ! end module t_control_data_isosurfaces diff --git a/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_sections.f90 b/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_sections.f90 index d5e13783..60a81fa9 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_sections.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_sections.f90 @@ -8,9 +8,14 @@ !!@verbatim !! subroutine alloc_psf_ctl_stract(psf_ctls) !! subroutine dealloc_psf_ctl_stract(psf_ctls) +!! subroutine init_psf_ctls_labels(hd_block, psf_ctls) +!! character(len=kchara), intent(in) :: hd_block +!! type(section_controls), intent(inout) :: psf_ctls !! -!! subroutine append_new_section_control(psf_ctls) +!! subroutine append_section_control(idx_in, hd_block, psf_ctls) +!! subroutine delete_section_control(idx_in, psf_ctls) !! type(section_controls), intent(inout) :: psf_ctls +!! !! subroutine add_fields_4_psfs_to_fld_ctl(psf_ctls, field_ctl) !! type(section_controls), intent(in) :: psf_ctls !! type(ctl_array_c3), intent(inout) :: field_ctl @@ -32,14 +37,15 @@ module t_control_data_sections ! ! type section_controls +!> Control block name + character(len = kchara) :: block_name = 'cross_section_ctl' +!> # of Structure for isosurface control integer(kind = kint) :: num_psf_ctl = 0 !> External section control file names character(len = kchara), allocatable :: fname_psf_ctl(:) !> Structure of sections control type(psf_ctl), allocatable :: psf_ctl_struct(:) end type section_controls -! - private :: dup_control_4_psfs ! ! -------------------------------------------------------------------- ! @@ -50,20 +56,14 @@ module t_control_data_sections subroutine alloc_psf_ctl_stract(psf_ctls) ! type(section_controls), intent(inout) :: psf_ctls - integer(kind = kint) :: i ! ! allocate(psf_ctls%psf_ctl_struct(psf_ctls%num_psf_ctl)) allocate(psf_ctls%fname_psf_ctl(psf_ctls%num_psf_ctl)) -! - do i = 1, psf_ctls%num_psf_ctl - call init_psf_ctl_stract(psf_ctls%psf_ctl_struct(i)) - end do ! end subroutine alloc_psf_ctl_stract ! ! --------------------------------------------------------------------- -! --------------------------------------------------------------------- ! subroutine dealloc_psf_ctl_stract(psf_ctls) ! @@ -83,7 +83,19 @@ subroutine dealloc_psf_ctl_stract(psf_ctls) end subroutine dealloc_psf_ctl_stract ! ! --------------------------------------------------------------------- -! -------------------------------------------------------------------- +! + subroutine init_psf_ctls_labels(hd_block, psf_ctls) +! + character(len=kchara), intent(in) :: hd_block + type(section_controls), intent(inout) :: psf_ctls +! + psf_ctls%num_psf_ctl = 0 + psf_ctls%block_name = hd_block +! + end subroutine init_psf_ctls_labels +! +! --------------------------------------------------------------------- +! --------------------------------------------------------------------- ! subroutine add_fields_4_psfs_to_fld_ctl(psf_ctls, field_ctl) ! @@ -105,50 +117,90 @@ end subroutine add_fields_4_psfs_to_fld_ctl ! --------------------------------------------------------------------- ! -------------------------------------------------------------------- ! - subroutine append_new_section_control(psf_ctls) + subroutine append_section_control(idx_in, hd_block, psf_ctls) +! + use ctl_data_section_IO ! + integer(kind = kint), intent(in) :: idx_in + character(len=kchara), intent(in) :: hd_block type(section_controls), intent(inout) :: psf_ctls ! type(section_controls) :: tmp_psf_c + integer(kind = kint) :: i +! ! + if(idx_in.lt.0 .or. idx_in.gt.psf_ctls%num_psf_ctl) return ! tmp_psf_c%num_psf_ctl = psf_ctls%num_psf_ctl call alloc_psf_ctl_stract(tmp_psf_c) - call dup_control_4_psfs & - & (tmp_psf_c%num_psf_ctl, psf_ctls, tmp_psf_c) + do i = 1, tmp_psf_c%num_psf_ctl + call dup_control_4_psf(psf_ctls%psf_ctl_struct(i), & + tmp_psf_c%psf_ctl_struct(i)) + tmp_psf_c%fname_psf_ctl(i) = psf_ctls%fname_psf_ctl(i) + end do ! call dealloc_psf_ctl_stract(psf_ctls) -! psf_ctls%num_psf_ctl = tmp_psf_c%num_psf_ctl + 1 call alloc_psf_ctl_stract(psf_ctls) ! - call dup_control_4_psfs & - & (tmp_psf_c%num_psf_ctl, tmp_psf_c, psf_ctls) + do i = 1, idx_in + call dup_control_4_psf(tmp_psf_c%psf_ctl_struct(i), & + psf_ctls%psf_ctl_struct(i)) + psf_ctls%fname_psf_ctl(i) = tmp_psf_c%fname_psf_ctl(i) + end do + call init_psf_ctl_stract(hd_block, & + & psf_ctls%psf_ctl_struct(idx_in+1)) + psf_ctls%fname_psf_ctl(idx_in+1) = 'NO_FILE' + do i = idx_in+1, tmp_psf_c%num_psf_ctl + call dup_control_4_psf(tmp_psf_c%psf_ctl_struct(i), & + & psf_ctls%psf_ctl_struct(i+1)) + psf_ctls%fname_psf_ctl(i+1) = tmp_psf_c%fname_psf_ctl(i) + end do ! call dealloc_psf_ctl_stract(tmp_psf_c) ! - end subroutine append_new_section_control + end subroutine append_section_control ! ! ----------------------------------------------------------------------- ! - subroutine dup_control_4_psfs & - & (num_psf, org_psf_ctls, new_psf_ctls) + subroutine delete_section_control(idx_in, psf_ctls) ! - integer(kind = kint), intent(in) :: num_psf - type(section_controls), intent(in) :: org_psf_ctls - type(section_controls), intent(inout) :: new_psf_ctls + integer(kind = kint), intent(in) :: idx_in + type(section_controls), intent(inout) :: psf_ctls ! + type(section_controls) :: tmp_psf_c integer(kind = kint) :: i ! - do i = 1, num_psf - call dup_control_4_psf(org_psf_ctls%psf_ctl_struct(i), & - new_psf_ctls%psf_ctl_struct(i)) +! + if(idx_in.le.0 .or. idx_in.gt.psf_ctls%num_psf_ctl) return +! + tmp_psf_c%num_psf_ctl = psf_ctls%num_psf_ctl + call alloc_psf_ctl_stract(tmp_psf_c) + do i = 1, tmp_psf_c%num_psf_ctl + call dup_control_4_psf(psf_ctls%psf_ctl_struct(i), & + tmp_psf_c%psf_ctl_struct(i)) + tmp_psf_c%fname_psf_ctl(i) = psf_ctls%fname_psf_ctl(i) + end do +! + call dealloc_psf_ctl_stract(psf_ctls) + psf_ctls%num_psf_ctl = tmp_psf_c%num_psf_ctl - 1 + call alloc_psf_ctl_stract(psf_ctls) +! + do i = 1, idx_in-1 + call dup_control_4_psf(tmp_psf_c%psf_ctl_struct(i), & + psf_ctls%psf_ctl_struct(i)) + psf_ctls%fname_psf_ctl(i) = tmp_psf_c%fname_psf_ctl(i) + end do + do i = idx_in, psf_ctls%num_psf_ctl + call dup_control_4_psf(tmp_psf_c%psf_ctl_struct(i+1), & + & psf_ctls%psf_ctl_struct(i)) + psf_ctls%fname_psf_ctl(i) = tmp_psf_c%fname_psf_ctl(i+1) end do - new_psf_ctls%fname_psf_ctl(1:num_psf) & - & = org_psf_ctls%fname_psf_ctl(1:num_psf) ! - end subroutine dup_control_4_psfs + call dealloc_psf_ctl_stract(tmp_psf_c) ! -! --------------------------------------------------------------------- + end subroutine delete_section_control +! +! ----------------------------------------------------------------------- ! end module t_control_data_sections diff --git a/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_surfacings.f90 b/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_surfacings.f90 index 0db24931..a2173ccf 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_surfacings.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/t_control_data_surfacings.f90 @@ -55,6 +55,9 @@ module t_control_data_surfacings ! !> Structures of surfacing controls type surfacing_controls +!> Control block name + character(len = kchara) :: block_name = 'visual_control' +! !> Structures of setioning controls type(section_controls) :: psf_s_ctls !> Structures of isosurface controls diff --git a/src/Fortran_libraries/VIZ_src/surfacing/t_control_params_4_iso.f90 b/src/Fortran_libraries/VIZ_src/surfacing/t_control_params_4_iso.f90 index a201c0fe..45cadd10 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/t_control_params_4_iso.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/t_control_params_4_iso.f90 @@ -15,6 +15,7 @@ !! type(iso_define_ctl), intent(in) :: iso_def_c !! type(psf_parameters), intent(inout) :: iso_param !! type(isosurface_define), intent(inout) :: iso_def +!! integer(kind = kint), intent(inout) :: ierr !! subroutine count_control_4_field_on_iso & !! & (fld_on_iso_c, num_nod_phys, phys_nod_name, & !! & iso_fld, iso_def) @@ -36,14 +37,9 @@ module t_control_params_4_iso ! implicit none ! -! - character(len=kchara), parameter :: cflag_const_iso = 'constant' - character(len=kchara), parameter :: cflag_field_iso = 'field' ! integer(kind = kint), parameter :: iflag_constant_iso = -1 integer(kind = kint), parameter :: iflag_field_iso = 1 -! - integer(kind = kint), parameter :: n_label_iso_type = 2 ! type isosurface_define integer(kind = kint) :: id_isosurf_data @@ -61,10 +57,8 @@ module t_control_params_4_iso ! --------------------------------------------------------------------- ! subroutine set_control_iso_def(iso_def_c, ele_grp, & - & num_nod_phys, phys_nod_name, iso_param, iso_def) + & num_nod_phys, phys_nod_name, iso_param, iso_def, ierr) ! - use calypso_mpi - use m_error_IDs use set_area_4_viz use set_field_comp_for_viz use t_control_data_4_iso_def @@ -81,11 +75,13 @@ subroutine set_control_iso_def(iso_def_c, ele_grp, & ! type(psf_parameters), intent(inout) :: iso_param type(isosurface_define), intent(inout) :: iso_def + integer(kind = kint), intent(inout) :: ierr ! integer(kind = kint) :: ncomp, ncomp_org character(len=kchara) :: tmpchara ! ! + ierr = 0 call s_set_area_4_viz(ele_grp%num_grp, ele_grp%grp_name, & & iso_def_c%iso_area_ctl%num, iso_def_c%iso_area_ctl%c_tbl, & & iso_param%nele_grp_area, iso_param%id_ele_grp_area) @@ -95,8 +91,7 @@ subroutine set_control_iso_def(iso_def_c, ele_grp, & & iso_def_c%isosurf_comp_ctl%charavalue, & & iso_def%id_isosurf_data, iso_def%id_isosurf_comp, & & ncomp, ncomp_org, tmpchara) - if (ncomp .gt. 1) call calypso_MPI_abort(ierr_VIZ, & - & 'set scalar for rendering') + if (ncomp .gt. 1) ierr = 1 ! iso_def%isosurf_value = iso_def_c%isosurf_value_ctl%realvalue ! @@ -109,6 +104,7 @@ subroutine count_control_4_field_on_iso & & iso_fld, iso_def) ! use m_file_format_switch + use m_section_coef_flags use set_field_comp_for_viz use t_group_data use t_file_IO_parameter @@ -203,28 +199,5 @@ subroutine set_control_4_field_on_iso & end subroutine set_control_4_field_on_iso ! ! --------------------------------------------------------------------- -! ----------------------------------------------------------------------- -! - integer(kind = kint) function num_label_iso_type() - num_label_iso_type = n_label_iso_type - return - end function num_label_iso_type -! -! ---------------------------------------------------------------------- -! - subroutine set_label_iso_type(names) -! - use t_read_control_elements -! - character(len = kchara), intent(inout) & - & :: names(n_label_iso_type) -! -! - call set_control_labels(cflag_const_iso, names( 1)) - call set_control_labels(cflag_field_iso, names( 2)) -! - end subroutine set_label_iso_type -! -! --------------------------------------------------------------------- ! end module t_control_params_4_iso diff --git a/src/Fortran_libraries/VIZ_src/surfacing/t_control_params_4_psf.f90 b/src/Fortran_libraries/VIZ_src/surfacing/t_control_params_4_psf.f90 index 09371e58..cd15ddb8 100644 --- a/src/Fortran_libraries/VIZ_src/surfacing/t_control_params_4_psf.f90 +++ b/src/Fortran_libraries/VIZ_src/surfacing/t_control_params_4_psf.f90 @@ -101,6 +101,7 @@ subroutine set_control_psf_define & & (psf_def_c, ele_grp, sf_grp, psf_param, psf_def, ierr) ! use m_error_IDs + use m_section_coef_flags use t_control_data_4_psf_def use t_group_data use t_psf_patch_data diff --git a/src/Jupyter/.ipynb_checkpoints/Calypso_control_editor-checkpoint.ipynb b/src/Jupyter/.ipynb_checkpoints/Calypso_control_editor-checkpoint.ipynb new file mode 100644 index 00000000..37985201 --- /dev/null +++ b/src/Jupyter/.ipynb_checkpoints/Calypso_control_editor-checkpoint.ipynb @@ -0,0 +1,2080 @@ +{ + "cells": [ + { + "cell_type": "markdown", + "id": "9318663a-3b69-4b33-9579-be512f928bc3", + "metadata": { + "tags": [] + }, + "source": [ + "# Simple control file editor\n", + "\n", + "This notebook is used to update control files for Calypso. The first (this) section contains programs to load, edit, and store control files. The second section is the description of control items. In Jupyter Lab, you can display the control parameter descriptions and control block editor side by side, and edit control data by looking at the descritions of the control parameters.\n", + "\n", + "The follwing routines are used in this editor:\n", + "\n", + "- `[Instance] = Control_Obj()` \n", + "Initialize class for control data named [Instance].\n", + "- `[Instance].new_control_data([block_names])` \n", + "Create new control data with empty block named [block_names] to [Instance].\n", + "- `[Instance].read_control_file([file_name])` \n", + "Read and store control data from [file_name] to [Instance].\n", + "- `[Instance].write_control_file([file_name])` \n", + "Write control data in [Instance].\n", + "- `[List_Instance] = Show_Block_Names([Instance], [Block_names])` \n", + "List block and external control file names.\n", + "- `[Widget_instance] = Control_Block_Editor([Instance], [Block_names])` \n", + "Open a editor for control block or array including special editors." + ] + }, + { + "cell_type": "markdown", + "id": "c74ee88f-39eb-45e1-80c0-df509b6cc488", + "metadata": { + "tags": [] + }, + "source": [ + "## Prepare functions to edit control blocks\n", + "The preparation consists of five steps. The first is loading required libraries, and the next step is loading class to store and edit control data." + ] + }, + { + "cell_type": "markdown", + "id": "25a391bb-58bc-4609-9eed-0baf93e77fa1", + "metadata": { + "tags": [] + }, + "source": [ + "#### Loading libraries\n", + "\n", + "Load libraries for this notebook are loaded. \n", + "- os \n", + "Interface to operation systems. It is one of the standard libraries.\n", + "- re \n", + "Treat regular expression. It is one of the standard libraries.\n", + "\n", + "- IPython \n", + "A rich architecture for interactive computing (https://ipython.org)\n", + "- ipywidets \n", + "Interactive HTML widgets for Jupyter notebooks and the IPython kernel. (https://pypi.org/project/ipywidgets/)" + ] + }, + { + "cell_type": "code", + "execution_count": 60, + "id": "2ecbc3fd-8dc3-4807-8232-13d1a1b56037", + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "