def_files.F90 10.8 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
!!-------------------------------------------------------
!!---- Relaxed Selected Excitation (RelaxSE)
!!-------------------------------------------------------
!!---- This file is part of RelaxSE
!!---- 
!!---- The RelaxSE project is distributed under LGPL. In agreement with the
!!---- Intergovernmental Convention of the ILL, this software cannot be used
!!---- in military applications.
!!---- 
!!---- Copyright (C) 2016-2021  Institut Laue-Langevin (ILL), Grenoble, FRANCE
!!----                          Institut Neel - CNRS-UPR2940 (CNRS), Grenoble, FRANCE
!!---- 
!!---- Authors: Elisa REBOLINI (ILL)             rebolini@ill.fr
!!----          Marie-Bernadette LEPETIT (CNRS)  Marie-Bernadette.Lepetit@neel.cnrs.fr
!!---- 
!!---- RelaxSE is free software; you can redistribute it and/or
!!---- modify it under the terms of the GNU Lesser General Public
!!---- License as published by the Free Software Foundation; either
!!---- version 3.0 of the License, or (at your option) any later version.
!!---- 
!!---- RelaxSE is distributed in the hope that it will be useful,
!!---- but WITHOUT ANY WARRANTY; without even the implied warranty of
!!---- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
!!---- Lesser General Public License for more details.
!!---- 
!!---- You should have received a copy of the GNU Lesser General Public
!!---- License along with this library; if not, see <http://www.gnu.org/licenses/>.
!!---- 


!> @brief Generate the file names and open them
!> @author Marie-Bernadette Lepetit
subroutine def_files(prog_info)
!!$ Défini les noms de fichiers
!!$ Fait les open  
!!$ -------- Donness globales ---------------------------------
  use files
  use utils_char
  use info
!!$ -------- Donnes locales -----------------------------------
  implicit none

  type(prog_infotype), intent(inout) :: prog_info

  Integer :: n
  Character*2 :: file_input
  Character*3 :: file_output, file_det, file_mat
  Character*4 :: file_fock,  file_bmat, file_ref0, file_mat2, file_bdet, file_info
  Character*6 :: file_traone, file_traint
  Character*7 :: file_restart
  Character*40 :: blan40

  CHARACTER(LEN=8)     :: date      ! returned values from DATE_AND_TIME()
  CHARACTER(LEN=10)    :: time
  CHARACTER(LEN=5)     :: zone
  INTEGER,DIMENSION(8) :: values

  logical :: lexist_mat
  Character*40 :: filename_mat
!!$============================================================
!!$ -------- Code ---------------------------------------------
!!$-----
!!$ doit definir les noms de fichiers à  associer aux unites logiques

!!$-----
!!$----- Initialisations 
!!$-----
  blan40='                                        '
  file_input  = "in"
  file_output = "out"
  
  file_info   = "sass"
  file_ref0   = "ref0"

  file_fock   = "fock"  
  file_traone = "TraOne"
  file_traint = "TraInt"
  
  file_det    = "det"
  file_bdet   = "bdet"
  
  file_restart= "restart" ! infos pour restart de la procedure de Davidson
  
  file_bmat   = "bmat" !Hamiltonian matrix in binary format
  file_mat    = "mat" !Hamiltonian matrix
  file_mat2   = "mat2" !Hamiltonian matrix with indices
  
!!$-----
!!$----- Transferts de donnes depuis Molcas ou autre
!!$-----
  open(f_input,file="INPUT",form="formatted")
  call read_sassinp(f_input, prog_info)

  ! Ouverture du fichier de sortie
  if (prog_info%Yprefix) then
     call noblancs(prog_info%prefix,n)
     if (prog_info%id_cpu.eq.0) then
        open (unit=f_output,file=prog_info%prefix(1:n)//"."//file_output, &
             form="formatted")
     endif
  else
     if (prog_info%id_cpu.eq.0) then
        open (f_output,file=file_output,form="formatted")
     end if
  endif

  if (prog_info%id_cpu.eq.0) then
     ! Premières impressions
     write(f_output,*) '***********************************************'
     write(f_output,*)
     write(f_output,*) "  Relaxed Selected Excitation (RelaxSE)"
     write(f_output,*)
     write(f_output,*) "  The RelaxSE project is distributed under https://spdx.org/licenses/LGPL-3.0-or-later.html"
     write(f_output,*)
     write(f_output,*) "  Copyright (C) 2016-2021  Institut Laue-Langevin (ILL), Grenoble, FRANCE"
     write(f_output,*) "                           Institut Neel, (CNRS), Grenoble, FRANCE"
     write(f_output,*)
     write(f_output,*) "  Authors: Elisa REBOLINI (ILL)            rebolini@ill.fr"
     write(f_output,*) "           Marie-Bernadette LEPETIT (CNRS) Marie-Bernadette.Lepetit@neel.cnrs.fr"
     write(f_output,*)
     write(f_output,*) '***********************************************'
#ifdef VAR_DEBUG
     write(f_output,'(A,L1)') ' DEBUG Version', debug
#else
     write(f_output,'(A)') ' RELEASE Version'
#endif
#ifdef VAR_MPI
     write(f_output,'(A,I0,A)') ' MPI version - running on ',&
          prog_info%nb_cpu,' CPUs'
#endif
#ifdef VAR_OMP
     write(f_output,'(A,I0,A)') ' OMP version - running on ',&
          prog_info%nb_thread,' threads'
#endif
     call date_and_time(date, time, zone, values)
     write(f_output,*) 'Calculation started on ', date(7:8),'-',date(5:6),&
          '-',date(1:4), ' at ', time(1:2),':',time(3:4)
     write(f_output,*)

     write(f_output,'(X,2A)') '>>> Method ',prog_info%method

     write(f_output,*) ">>> Ouverture des fichiers"
     write(f_output,9001) file_output, prog_info%prefix(1:n)//"."//file_output
  endif

  if (prog_info%Yprefix) then
     if (prog_info%iprint .gt. 1) then
        open (f_fock,file=prog_info%prefix(1:n)//"."//file_fock,&
             form="formatted")
     endif
     open (f_ref0,file=prog_info%prefix(1:n)//"."//file_ref0,&
          form="formatted")
     open (f_det,file=prog_info%prefix(1:n)//"."//file_det,&
          form="formatted")
     open (f_bdet,file=prog_info%prefix(1:n)//"."//file_bdet,&
          form="unformatted")
     open (f_info,file=prog_info%prefix(1:n)//"."//file_info,&
          form="unformatted")
     open (f_restart,file=prog_info%prefix(1:n)//"."//file_restart,&
          form="unformatted")

     if (prog_info%lreadHmat) then
        write(filename_mat,'(3A)') prog_info%prefix(1:n),".",file_mat
        inquire(file=filename_mat, exist=lexist_mat)
        if (.not. lexist_mat) &
             call SASS_quit('lreadHmat requires in .mat file in input',f_output)
     endif

     open (f_mat,file=prog_info%prefix(1:n)//"."//file_mat,form="formatted")
     open (f_mat2,file=prog_info%prefix(1:n)//"."//file_mat2,form="formatted")
     open (f_bmat,file=prog_info%prefix(1:n)//"."//file_bmat,form="unformatted")

     if (prog_info%id_cpu.eq.0) then
        if (prog_info%iprint .gt. 1) then
           write(f_output,9001) file_fock, prog_info%prefix(1:n)//"."//file_fock
        endif
        write(f_output,9001) file_ref0, prog_info%prefix(1:n)//"."//file_ref0
        write(f_output,9001) file_det, prog_info%prefix(1:n)//"."//file_det
        write(f_output,9001) file_bdet, prog_info%prefix(1:n)//"."//file_bdet
        write(f_output,9001) file_info, prog_info%prefix(1:n)//"."//file_info
        write(f_output,9001) file_restart, prog_info%prefix(1:n)//"."//file_restart
        write(f_output,9001) file_mat, prog_info%prefix(1:n)//"."//file_mat
        write(f_output,9001) file_mat2, prog_info%prefix(1:n)//"."//file_mat2
        write(f_output,9001) file_bmat, prog_info%prefix(1:n)//"."//file_bmat
        
     endif
  else
     if (prog_info%iprint .gt. 1) then
        open (f_fock,file=file_fock,form="formatted")
     endif
     open (f_ref0,file=file_ref0,form="formatted")
     open (f_det,file=file_det,form="formatted")
     open (f_bdet,file=file_bdet,form="unformatted")
     open (f_info,file=file_info,form="unformatted")
     open (f_restart,file=file_restart,form="unformatted")
     
     open (f_mat,file=file_mat,form="formatted")
     open (f_mat2,file=file_mat2,form="formatted")
     open (f_bmat,file=file_bmat,form="unformatted")

     if (prog_info%id_cpu.eq.0) then
        if (prog_info%iprint .gt. 1) then
           write(f_output,9001) file_fock, file_fock
        endif
        write(f_output,9001) file_ref0, file_ref0
        write(f_output,9001) file_det, file_det
        write(f_output,9001) file_bdet, file_bdet
        write(f_output,9001) file_info, file_info
        write(f_output,9001) file_restart, file_restart
        write(f_output,9001) file_mat, file_mat
        write(f_output,9001) file_mat2, file_mat2
        write(f_output,9001) file_bmat, file_bmat
        
     endif
  end if

  

!!$==================================================================== 
9001 format(a5," :",a80)
End subroutine def_files


!$====================================================================
!> @brief Read the SASS input and store it in the prog_info
!> @author Elisa Rebolini
!> @date Oct 2017
!
!> @param[in] iunit Input file unit
!> @param[inout] prog_info Type for all program info
!$====================================================================
subroutine read_sassinp(iunit, prog_info)

  use dimensions
  !use donnees
  use utils_char
  use info

  implicit none

  integer, intent(in)                :: iunit
  type(prog_infotype), intent(inout) :: prog_info

  Character*40 :: blan40
  integer :: n
  character*8 :: method
  Logical :: Yprefix, prt_cipci, print_det, restart
  logical :: lexplicitHmat, lreadHmat, mpi_load_balance
  Character*40 :: prefix
  Integer (KIND=kd_int) :: iprint, idiag, iprintHmat, sizebatch
  logical, dimension(9) :: nodet_block

  namelist /sassinp/  prefix, iprint, idiag, print_det, &
       prt_cipci, method, restart, lexplicitHmat, lreadHmat, mpi_load_balance, nodet_block, &
       iprintHmat, sizebatch

  !Initialisation 
  blan40='                                        '
  method="SAS+S"
  Yprefix =.false.
  iprint = 0
  idiag = 1
  print_det = .false.
  prt_cipci = .false.
  prefix = blan40
  restart = .false.
  lexplicitHmat = .false.
  lreadHmat = .false.
  iprintHmat = 0
  mpi_load_balance = .true.
  sizebatch = 40
  nodet_block = (/ .false., .false., .false., .false., .false., &
       .false., .false., .false., .false. /)
  
  read(iunit, sassinp)

  if (prefix.ne.blan40) then 
     Yprefix = .true.
     !call lowercase(prefix)
     call noblancs(prefix,n)
  end if

  prog_info%Yprefix = Yprefix
  prog_info%prefix = prefix(1:n)
  
  prog_info%iprint = iprint
  prog_info%idiag = idiag
  prog_info%print_det = print_det
  if (prt_cipci) then
     call SASS_quit('Print cipci not implemented',6)
  endif
  prog_info%prt_cipci = prt_cipci
  
  call lowercase(method)
  call noblancs(method,n)
  prog_info%method = method(1:n)
  prog_info%methodAct = method(1:3)
  prog_info%methodExc = method(5:n)
  
  prog_info%restart = restart
  prog_info%lexplicit = lexplicitHmat
  prog_info%lreadHmat = lreadHmat
  prog_info%iprintHmat = iprintHmat
  prog_info%sizebatch = sizebatch
  prog_info%mpi_load_balance = mpi_load_balance
  prog_info%nodet_block = nodet_block

#ifndef VAR_NOGEN
  if (iprintHmat .gt. 0) then
     call SASS_quit('Only possible to print Hmat when compiled with --nogen',6)
  endif
#endif
  
end subroutine read_sassinp

!!$ Local Variables:
!!$   coding: utf-8-unix
!!$ End: