Branch data Line data Source code
1 : : !!****m* ABINIT/m_init10
2 : : !! NAME
3 : : !! m_init10
4 : : !!
5 : : !! FUNCTION
6 : : !! It should be "contained" in multibinit but abilint does not accept "contains" in programs.
7 : : !!
8 : : !! COPYRIGHT
9 : : !! Copyright (C) 2008-2026 ABINIT group ()
10 : : !! This file is distributed under the terms of the
11 : : !! GNU General Public License, see ~abinit/COPYING
12 : : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : : !!
14 : : !! SOURCE
15 : :
16 : : #if defined HAVE_CONFIG_H
17 : : #include "config.h"
18 : : #endif
19 : :
20 : : #include "abi_common.h"
21 : :
22 : : module m_init10
23 : :
24 : : use defs_basis
25 : : use m_errors
26 : : use m_abicore
27 : : use m_fstrings, only : int2char4, rmquotes, sjoin, strcat, basename
28 : : use m_multibinit_dataset, only: multibinit_dtset_type
29 : :
30 : : implicit none
31 : :
32 : : private
33 : : !!***
34 : :
35 : : public :: init10
36 : : public :: postfix_fnames
37 : : !!***
38 : :
39 : : contains
40 : : !!***
41 : :
42 : :
43 : : !!****f* ABINIT/init10
44 : : !!
45 : : !! NAME
46 : : !! init10
47 : : !!
48 : : !! FUNCTION
49 : : !! Initialize the code multibinit: write heading and make the first i/os
50 : : !!
51 : : !! INPUTS
52 : : !! character(len=fnlen) input_path: gives the name of the input file.
53 : : !! If not given, the files file are then used with a deprecation message.
54 : : !! OUTPUT
55 : : !! character(len=fnlen) filnam(18)=character strings giving file names
56 : : !!
57 : : !! NOTES
58 : : !! 1. Should be executed by one processor only.
59 : : !! 2. File names refer to following files, in order:
60 : : !! (1) Formatted input file
61 : : !! (2) Formatted output file
62 : : !! (3) Input for reference structure and harmonic part (DDB file or XML)
63 : : !! (4) Input for XML with polynomial coefficients (DDB file)
64 : : !! (5) Input for HIST Training-Set file (netcdf .nc format)
65 : : !! (6) Input for HIST Test-Set file (netcdf .nc format)
66 : : !! (7-18) Input Derivative Database (XML format)
67 : : !!
68 : : !! SOURCE
69 : :
70 : 73 : subroutine init10(input_path, filnam,comm)
71 : :
72 : : use defs_basis
73 : : use m_xmpi
74 : : use m_errors
75 : :
76 : : use m_fstrings, only : int2char4
77 : : use m_io_tools, only : open_file
78 : :
79 : : !Arguments -------------------------------
80 : : !scalars
81 : : integer,intent(in) :: comm
82 : : character(len=fnlen), intent(in) :: input_path
83 : : !arrays
84 : : character(len=fnlen),intent(out) :: filnam(18)
85 : :
86 : : !Local variables--------------------------
87 : : !scalars
88 : : integer,parameter :: master=0
89 : : integer :: me,nproc,ierr
90 : : integer :: ii,io, i1, i2
91 : :
92 : : character(len=fnlen) :: fname
93 : : ! *********************************************************************
94 : :
95 : : !Determine who I am in comm
96 : 73 : me = xmpi_comm_rank(comm)
97 : 73 : nproc = xmpi_comm_size(comm)
98 : :
99 [ + + ]: 1387 : filnam(:) = ""
100 : :
101 [ + + ]: 73 : if (me==master)then
102 [ - + ]: 49 : if (len_trim(input_path) == 0) then
103 : : ! Legacy Files file mode.
104 : 0 : write(std_out, "(2a)")" DeprecationWarning: ",ch10
105 : 0 : write(std_out, "(a)") " The files file has been deprecated in Abinit9 and will be removed in Abinit10."
106 : 0 : write(std_out, "(a)")" Use the syntax `multibinit t01.abi` where t01.abi is an input."
107 : : !Read the file names
108 : 0 : write(std_out,*)' Give name for formatted input file : '
109 : 0 : read(std_in, '(a)',IOSTAT=io) filnam(1)
110 [ # # ]: 0 : write(std_out,'(a,a)' )'- ',trim(filnam(1))
111 : 0 : write(std_out,*)' Give name for formatted output file : '
112 : 0 : read(std_in, '(a)',IOSTAT=io) filnam(2)
113 [ # # ]: 0 : write(std_out,'(a,a)' )'- ',trim(filnam(2))
114 : 0 : write(std_out,*)' Give name for input derivative database of reference structure',&
115 : 0 : & ' (DDB or XML file): '
116 : 0 : read(std_in, '(a)',IOSTAT=io) filnam(3)
117 [ # # ]: 0 : write(std_out,'(a,a)' )'- ',trim(filnam(3))
118 : 0 : write(std_out,*)' Give name for input coefficients from fitted polynomial',&
119 : 0 : & ' (XML file or enter no): '
120 : 0 : read(std_in, '(a)',IOSTAT=io) filnam(4)
121 [ # # ]: 0 : write(std_out,'(a,a)' )'- ',trim(filnam(4))
122 : 0 : write(std_out,*)' Give name for training-set file',&
123 : 0 : & ' (netcdf file or enter no): '
124 : 0 : read(std_in, '(a)',IOSTAT=io) filnam(5)
125 [ # # ]: 0 : write(std_out,'(a,a)' )'- ',trim(filnam(5))
126 : 0 : write(std_out,*)' Give name for test-set file',&
127 : 0 : & ' (netcdf file or enter no): '
128 : 0 : read(std_in, '(a)',IOSTAT=io) filnam(6)
129 [ # # ]: 0 : write(std_out,'(a,a)' )'- ',trim(filnam(6))
130 : 0 : ii = 7
131 [ # # # # ]: 0 : do while (io>=0 .and. ii<19)
132 : 0 : write(std_out,*)' Give name for input derivative database (DDB or XML file): '
133 : 0 : read(std_in, '(a)',IOSTAT=io) filnam(ii)
134 [ # # ]: 0 : write(std_out,'(a,a)' )'- ',trim(filnam(ii))
135 [ # # ]: 0 : if(trim(filnam(ii))==" ") exit
136 : 0 : ii = ii + 1
137 : : end do
138 : : else
139 : 49 : filnam(1)=input_path
140 [ + - ]: 49 : filnam(2) = trim(input_path)//".abo"
141 : :
142 [ + - ]: 49 : fname = basename(input_path)
143 : 49 : i1 = index(fname, ".")
144 [ + - ]: 49 : if (i1 > 1) then
145 : 49 : i2 = index(input_path, ".", back=.True.)
146 [ + - ]: 49 : filnam(2) = input_path(:i2) // "abo"
147 : : ! The rest filnam(3:) are set after reading from input file.
148 : : ! as in postfix_filenames subroutine
149 : : end if
150 : : end if
151 : : end if
152 : :
153 : :
154 : : !Communicate filenames to all processors
155 : 73 : call xmpi_bcast (filnam, master, comm, ierr)
156 : :
157 : 73 : end subroutine init10
158 : : !!***
159 : :
160 : :
161 : :
162 : : !===============================================================
163 : : ! Change the extension of a filename. e.g. run.abo -> run_hist.nc
164 : : !> @ fname: the old fname
165 : : !> @ new_ext: the new extension. e.g. .nc or _hist.nc
166 : : !===============================================================
167 : : function change_extension(fname, new_ext) result (ret)
168 : : character(len=fnlen), intent(in) :: fname, new_ext
169 : : character(len=fnlen) :: tmp_fname
170 : : character(len=fnlen) :: ret
171 : : integer :: i1, i2
172 : : tmp_fname=basename(fname)
173 : : i1 = index(tmp_fname, ".")
174 : : if (i1 > 1) then
175 : : i2 = index(fname, ".", back=.True.)
176 : : ret = fname(:i2) // trim(new_ext)
177 : : end if
178 : : end function change_extension
179 : :
180 : : !===============================================================
181 : : ! Sync the filename info from files file and from input file
182 : : !> @ input_path: input file
183 : : !> @ filnam : the filenames from files file
184 : : !> @ params: data read from inputfile
185 : : !===============================================================
186 : 73 : subroutine postfix_fnames(input_path, filnam, params)
187 : : ! TODO: hexu: Once the files file is to be fully removed, remove the filnam variable.
188 : : character(len=fnlen), intent(inout) :: input_path, filnam(18)
189 : : type(multibinit_dtset_type), intent(inout) :: params
190 : : ! if using files file, set the params%*_fname according to filnam
191 : : integer :: i
192 [ - + ]: 73 : if (len_trim(input_path)==0) then
193 [ # # ]: 0 : if (len_trim(params%spin_pot_fname)==0) params%spin_pot_fname=filnam(3)
194 [ # # ]: 0 : if (len_trim(params%latt_pot_fname)==0) params%latt_pot_fname=filnam(3)
195 [ # # ]: 0 : if (len_trim(params%slc_pot_fname)==0) params%slc_pot_fname=filnam(3)
196 : : ! TODO lattice model
197 [ # # ]: 0 : if (len_trim(params%latt_harm_pot_fname)==0) params%latt_harm_pot_fname=filnam(3)
198 [ # # ]: 0 : if (len_trim(params%latt_anharm_pot_fname)==0) params%latt_anharm_pot_fname=filnam(4)
199 [ # # ]: 0 : if (len_trim(params%latt_training_set_fname)==0) params%latt_training_set_fname=filnam(5)
200 [ # # ]: 0 : if (len_trim(params%latt_test_set_fname)==0) params%latt_test_set_fname=filnam(6)
201 [ # # ]: 0 : do i=1, 12
202 [ # # ]: 0 : if (len_trim(params%latt_ddb_fnames(i))==0) params%latt_ddb_fnames(i)=filnam(6+i)
203 : : end do
204 : : else
205 : 73 : filnam(2)=params%outdata_prefix
206 [ + + ]: 73 : if(len_trim(params%latt_pot_fname) > 0) then
207 : 5 : filnam(3)=params%latt_pot_fname
208 [ + + ]: 68 : else if(len_trim(params%latt_harm_pot_fname) > 0) then
209 : 67 : filnam(3)=params%latt_harm_pot_fname
210 : : else
211 : 1 : filnam(3)=''
212 : : endif
213 : 73 : filnam(4)=params%latt_anharm_pot_fname
214 : 73 : filnam(5)=params%latt_training_set_fname
215 : 73 : filnam(6)=params%latt_test_set_fname
216 [ + + ]: 949 : do i=1, 12
217 : 949 : filnam(i+6)=params%latt_ddb_fnames(i)
218 : : end do
219 : : end if
220 : :
221 : 73 : end subroutine postfix_fnames
222 : :
223 : :
224 : :
225 : : end module m_init10
226 : : !!***
|
