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 : !!***
|
