1!
2! Copyright (C) 2002-2011 Quantum ESPRESSO group
3! This file is distributed under the terms of the
4! GNU General Public License. See the file `License'
5! in the root directory of the present distribution,
6! or http://www.gnu.org/copyleft/gpl.txt .
7!
8
9! This module contains subroutines to print computed quantities to
10! standard output and ASCII file
11
12MODULE printout_base
13
14  IMPLICIT NONE
15  SAVE
16
17  CHARACTER(LEN=256) :: fort_unit(30:44)
18  ! ...  fort_unit = fortran units for saving physical quantity
19
20CONTAINS
21
22
23  SUBROUTINE printout_base_init( )
24
25     USE io_files,  ONLY: tmp_dir, prefix
26     USE io_global, ONLY: ionode, ionode_id
27     USE mp_global, ONLY: intra_image_comm
28     USE mp, ONLY: mp_bcast
29
30     INTEGER :: iunit, ierr, ios
31     CHARACTER(LEN=256) :: pprefix
32     ! ...  prefix combined with the output path
33
34     pprefix = TRIM( tmp_dir ) // TRIM( prefix )
35
36     ierr = 0
37
38     IF( ionode ) THEN
39        fort_unit(30) = trim(pprefix)//'.con'
40        fort_unit(31) = trim(pprefix)//'.eig'
41        fort_unit(32) = trim(pprefix)//'.pol'
42        fort_unit(33) = trim(pprefix)//'.evp'
43        fort_unit(34) = trim(pprefix)//'.vel'
44        fort_unit(35) = trim(pprefix)//'.pos'
45        fort_unit(36) = trim(pprefix)//'.cel'
46        fort_unit(37) = trim(pprefix)//'.for'
47        fort_unit(38) = trim(pprefix)//'.str'
48        fort_unit(39) = trim(pprefix)//'.nos'
49        fort_unit(40) = trim(pprefix)//'.the'
50        fort_unit(41) = trim(pprefix)//'.spr'  ! wannier spread
51        fort_unit(42) = trim(pprefix)//'.wfc'  ! wannier function
52        fort_unit(43) = trim(pprefix)//'.hrs'  ! hirshfeld volumes
53        fort_unit(44) = trim(pprefix)//'.ncg'  ! number of cgsteps
54        DO iunit = LBOUND( fort_unit, 1 ), UBOUND( fort_unit, 1 )
55           OPEN(UNIT=iunit, FILE=fort_unit(iunit), &
56               STATUS='unknown', POSITION='append', IOSTAT = ios )
57           CLOSE( iunit )
58           ierr = ierr + ABS(ios)
59        END DO
60     END IF
61
62     CALL mp_bcast(ierr, ionode_id, intra_image_comm)
63     IF( ierr /= 0 ) THEN
64        CALL errore(' printout_base_init ', &
65              ' error in opening files '//TRIM(pprefix)//'.XXX',ierr)
66     END IF
67
68    RETURN
69  END SUBROUTINE printout_base_init
70
71
72  SUBROUTINE printout_base_open( suffix )
73    CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: suffix
74    INTEGER :: iunit
75    LOGICAL :: ok=.true.
76    ! ...  Open units 30, 31, ... 44 for simulation output
77    IF( PRESENT( suffix ) ) THEN
78       IF( LEN( suffix ) /= 3 ) &
79          CALL errore(" printout_base_open ", " wrong suffix ", 1 )
80       ok = .false.
81    END IF
82    DO iunit = LBOUND( fort_unit, 1 ), UBOUND( fort_unit, 1 )
83       IF( PRESENT( suffix ) ) THEN
84          IF( index( fort_unit(iunit), suffix, back=.TRUE. ) == &
85              ( len_trim( fort_unit(iunit) ) - 2 )                ) THEN
86             OPEN( UNIT=iunit, FILE=fort_unit(iunit), STATUS='unknown', POSITION='append')
87             ok = .true.
88          END IF
89       ELSE
90          OPEN( UNIT=iunit, FILE=fort_unit(iunit), STATUS='unknown', POSITION='append')
91       END IF
92    END DO
93    IF( PRESENT( suffix ) ) THEN
94       IF( .NOT. ok ) &
95          CALL errore(" printout_base_open ", " file with suffix "//suffix//" not found ", 1 )
96    END IF
97    RETURN
98  END SUBROUTINE printout_base_open
99
100
101  FUNCTION printout_base_unit( suffix )
102    !   return the unit corresponding to a given suffix
103    CHARACTER(LEN=*), INTENT(IN) :: suffix
104    INTEGER :: printout_base_unit
105    INTEGER :: iunit
106    LOGICAL :: ok
107    IF( LEN( suffix ) /= 3 ) &
108       CALL errore(" printout_base_unit ", " wrong suffix ", 1 )
109    ok = .false.
110    DO iunit = LBOUND( fort_unit, 1 ), UBOUND( fort_unit, 1 )
111       IF( index( fort_unit(iunit), suffix, back=.TRUE. ) == ( len_trim( fort_unit(iunit) ) - 2 ) ) THEN
112          printout_base_unit = iunit
113          ok = .true.
114       END IF
115    END DO
116    IF( .NOT. ok ) &
117       CALL errore(" printout_base_unit ", " file with suffix "//suffix//" not found ", 1 )
118    RETURN
119  END FUNCTION printout_base_unit
120
121
122  FUNCTION printout_base_name( suffix )
123    !  return the full name of a print out file with a given suffix
124    CHARACTER(LEN=*), INTENT(IN) :: suffix
125    CHARACTER(LEN=256) :: printout_base_name
126    INTEGER :: iunit
127    LOGICAL :: ok
128    IF( LEN( suffix ) /= 3 ) &
129       CALL errore(" printout_base_name ", " wrong suffix ", 1 )
130    ok = .false.
131    DO iunit = LBOUND( fort_unit, 1 ), UBOUND( fort_unit, 1 )
132       IF( index( fort_unit(iunit), suffix, back=.TRUE. ) == ( len_trim( fort_unit(iunit) ) - 2 ) ) THEN
133          printout_base_name = fort_unit(iunit)
134          ok = .true.
135       END IF
136    END DO
137    IF( .NOT. ok ) &
138       CALL errore(" printout_base_name ", " file with suffix "//suffix//" not found ", 1 )
139    RETURN
140  END FUNCTION printout_base_name
141
142
143
144  SUBROUTINE printout_base_close( suffix )
145    CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: suffix
146    INTEGER :: iunit
147    LOGICAL :: topen
148    LOGICAL :: ok
149    ! ...   Close and flush unit 30, ... 44
150    IF( PRESENT( suffix ) ) THEN
151       IF( LEN( suffix ) /= 3 ) &
152          CALL errore(" printout_base_close ", " wrong suffix ", 1 )
153       ok = .false.
154    END IF
155    DO iunit = LBOUND( fort_unit, 1 ), UBOUND( fort_unit, 1 )
156       IF( PRESENT( suffix ) ) THEN
157          IF( index( fort_unit(iunit), suffix, back=.TRUE. ) == ( len_trim( fort_unit(iunit) ) - 2 ) ) THEN
158             INQUIRE( UNIT=iunit, OPENED=topen )
159             IF( topen ) CLOSE(iunit)
160             ok = .true.
161          END IF
162       ELSE
163          INQUIRE( UNIT=iunit, OPENED=topen )
164          IF (topen) CLOSE(iunit)
165       END IF
166    END DO
167    IF( PRESENT( suffix ) ) THEN
168       IF( .NOT. ok ) &
169          CALL errore(" printout_base_close ", " file with suffix "//suffix//" not found ", 1 )
170    END IF
171    RETURN
172  END SUBROUTINE printout_base_close
173
174
175  SUBROUTINE printout_pos( iunit, tau, nat, ityp, what, nfi, tps, label, fact, head )
176    !
177    USE kinds
178    !
179    INTEGER,          INTENT(IN)           :: iunit, nat, ityp(:)
180    REAL(DP),        INTENT(IN)           :: tau( :, : )
181    CHARACTER(LEN=3), INTENT(IN), OPTIONAL :: what
182    INTEGER,          INTENT(IN), OPTIONAL :: nfi
183    REAL(DP),        INTENT(IN), OPTIONAL :: tps
184    CHARACTER(LEN=3), INTENT(IN), OPTIONAL :: label( : )
185    REAL(DP),        INTENT(IN), OPTIONAL :: fact
186    CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: head
187    !
188    INTEGER   :: ia, k
189    REAL(DP) :: f
190    !
191    IF( PRESENT( fact ) ) THEN
192       f = fact
193    ELSE
194       f = 1.0_DP
195    END IF
196    !
197    IF( PRESENT( head ) ) THEN
198       WRITE( iunit, 10 ) head
199    END IF
200    !
201    IF( PRESENT( what ) ) THEN
202       IF ( what == 'xyz' ) WRITE( iunit, *) nat
203    END IF
204    !
205    IF( PRESENT( nfi ) .AND. PRESENT( tps ) ) THEN
206       WRITE( iunit, 30 ) nfi, tps
207    ELSE IF( PRESENT( what ) ) THEN
208       IF( what == 'pos' ) THEN
209          WRITE( iunit, 40 )
210       ELSE IF( what == 'vel' ) THEN
211          WRITE( iunit, 50 )
212       ELSE IF( what == 'for' ) THEN
213          WRITE( iunit, 60 )
214       END IF
215    END IF
216    !
217    IF( PRESENT( label ) ) THEN
218       DO ia = 1, nat
219         WRITE( iunit, 255 ) label(ityp(ia)), ( f * tau(k,ia),k = 1,3)
220       END DO
221    ELSE
222       DO ia = 1, nat
223         WRITE( iunit, 252 ) (tau(k,ia),k = 1,3)
224       END DO
225    END IF
226 10 FORMAT(3X,A)
227 30 FORMAT(I8,1X,F13.8)
228 40 FORMAT(3X,'ATOMIC_POSITIONS')
229 50 FORMAT(3X,'ATOMIC_VELOCITIES')
230 60 FORMAT(3X,'Forces acting on atoms (au):')
231255 FORMAT(3X,A3,3E25.14)
232252 FORMAT(3E25.14)
233    RETURN
234  END SUBROUTINE printout_pos
235
236
237
238  SUBROUTINE printout_cell( iunit, h, nfi, tps )
239    !
240    USE kinds
241    !
242    INTEGER,   INTENT(IN)           :: iunit
243    REAL(DP), INTENT(IN)           :: h(3,3)
244    INTEGER,   INTENT(IN), OPTIONAL :: nfi
245    REAL(DP), INTENT(IN), OPTIONAL :: tps
246    !
247    INTEGER :: i, j
248    !
249    IF( PRESENT( nfi ) .AND. PRESENT( tps ) ) THEN
250       WRITE( iunit, 30 ) nfi, tps
251    ELSE
252       WRITE( iunit, 40 )
253    END IF
254    !
255    DO i = 1, 3
256       WRITE( iunit, 100 ) (h(i,j),j=1,3)
257    END DO
258    !
259 30 FORMAT(I8,1X,F13.8)
260 40 FORMAT(3X,'CELL_PARAMETERS')
261100 FORMAT(3F14.8)
262    RETURN
263  END SUBROUTINE printout_cell
264
265
266
267  SUBROUTINE printout_stress( iunit, str, nfi, tps )
268    !
269    USE kinds
270    !
271    INTEGER,   INTENT(IN)           :: iunit
272    REAL(DP), INTENT(IN)           :: str(3,3)
273    INTEGER,   INTENT(IN), OPTIONAL :: nfi
274    REAL(DP), INTENT(IN), OPTIONAL :: tps
275    !
276    INTEGER :: i, j
277    !
278    IF( PRESENT( nfi ) .AND. PRESENT( tps ) ) THEN
279       WRITE( iunit, 30 ) nfi, tps
280    ELSE
281       WRITE( iunit, 40 )
282    END IF
283    !
284    DO i = 1, 3
285       WRITE( iunit, 100 ) (str(i,j),j=1,3)
286    END DO
287    !
288 30 FORMAT(I8,1X,F13.8)
289 40 FORMAT(3X,'Total stress (GPa)')
290100 FORMAT(3(F18.8,1X))
291    RETURN
292  END SUBROUTINE printout_stress
293
294  SUBROUTINE printout_vefftsvdw( iunit, veff, nat, nfi, tps )
295    !
296    USE kinds
297    !
298    INTEGER,   INTENT(IN)           :: iunit, nat
299    REAL(DP), INTENT(IN)           :: veff(nat)
300    INTEGER,   INTENT(IN), OPTIONAL :: nfi
301    REAL(DP), INTENT(IN), OPTIONAL :: tps
302    !
303    INTEGER :: i, j
304    !
305    IF( PRESENT( nfi ) .AND. PRESENT( tps ) ) THEN
306       WRITE( iunit, 30 ) nfi, tps
307    ELSE
308       WRITE( iunit, 40 )
309    END IF
310    !
311    DO i = 1, nat
312       WRITE( iunit, 100 ) veff(i)
313    END DO
314    !
315 30 FORMAT(I8,1X,F13.8)
316 40 FORMAT(3X,'Veff tsvdw')
317100 FORMAT(F20.10)
318    RETURN
319  END SUBROUTINE printout_vefftsvdw
320
321  SUBROUTINE printout_wfc( iunit, wfc_temp, nband, nfi, tps, iss )
322    !
323    USE kinds
324    !
325    INTEGER,   INTENT(IN)           :: iunit, nband
326    REAL(DP), INTENT(IN)           :: wfc_temp(3,nband)
327    INTEGER,   INTENT(IN)           :: nfi
328    REAL(DP), INTENT(IN)           :: tps
329    INTEGER, INTENT(IN), OPTIONAL  :: iss
330    !
331    INTEGER :: i, j
332    !
333    IF( PRESENT( iss ) ) THEN
334       WRITE( iunit, 40 ) nfi, tps, iss
335    ELSE
336       WRITE( iunit, 30 ) nfi, tps
337    END IF
338    !
339    DO i = 1, nband
340       WRITE( iunit, 100 ) (wfc_temp(j,i),j=1,3)
341    END DO
342    !
343 30 FORMAT(I8,1X,F13.8)
344 40 FORMAT(I7,1X,F11.8,1X,"spin=",I5)
345100 FORMAT(3E25.14)
346    RETURN
347  END SUBROUTINE printout_wfc
348    !------------------------------------------------------------------------
349    SUBROUTINE save_print_counter( iter, wunit )
350      !------------------------------------------------------------------------
351      !
352      ! ... a counter indicating the last successful printout iteration is saved
353      !
354      USE io_global, ONLY: ionode, ionode_id
355      USE io_files, ONLY : iunpun, create_directory, restart_dir
356      USE mp, ONLY: mp_bcast
357      USE mp_images, ONLY : intra_image_comm
358      !
359      IMPLICIT NONE
360      !
361      INTEGER,          INTENT(IN) :: iter
362      INTEGER,          INTENT(IN) :: wunit
363      !
364      INTEGER            :: ierr
365      CHARACTER(LEN=256) :: filename, dirname
366      !
367      !
368      dirname = restart_dir( wunit )
369      !
370      CALL create_directory( TRIM( dirname ) )
371      !
372      IF ( ionode ) THEN
373         !
374         filename = TRIM( dirname ) // 'print_counter'
375         !
376         OPEN( UNIT = iunpun, FILE = filename, FORM = 'formatted', &
377                 STATUS = 'unknown', IOSTAT = ierr )
378         !
379      END IF
380      !
381      CALL mp_bcast( ierr, ionode_id, intra_image_comm )
382      !
383      CALL errore( 'save_print_counter', &
384                   'cannot open restart file for writing', ierr )
385      !
386      IF ( ionode ) THEN
387         !
388         WRITE ( iunpun, '("LAST SUCCESSFUL PRINTOUT AT STEP:",/,i5 )' ) iter
389         !
390         CLOSE ( iunpun, STATUS = 'keep' )
391         !
392      END IF
393      !
394      RETURN
395      !
396    END SUBROUTINE save_print_counter
397    !
398    !------------------------------------------------------------------------
399    SUBROUTINE read_print_counter( nprint_nfi, runit )
400      !------------------------------------------------------------------------
401      !
402      ! ... the counter indicating the last successful printout iteration
403      ! ... is read here
404      !
405      USE io_global, ONLY: ionode, ionode_id
406      USE io_files, ONLY : iunpun, restart_dir
407      USE mp, ONLY: mp_bcast
408      USE mp_images, ONLY : intra_image_comm
409      !
410      IMPLICIT NONE
411      !
412      INTEGER,          INTENT(OUT) :: nprint_nfi
413      INTEGER,          INTENT(IN)  :: runit
414      !
415      INTEGER            :: ierr
416      CHARACTER(LEN=256) :: filename, dirname
417      !
418      !
419      dirname = restart_dir( runit )
420      !
421      IF ( ionode ) THEN
422         !
423         filename = TRIM( dirname ) // 'print_counter'
424         !
425         OPEN( UNIT = iunpun, FILE = filename, FORM = 'formatted', &
426                 STATUS = 'old', IOSTAT = ierr )
427         !
428         IF ( ierr > 0 ) THEN
429            !
430            nprint_nfi = -1
431            !
432         ELSE
433            !
434            READ ( iunpun, * )
435            READ ( iunpun, * ) nprint_nfi
436            !
437            CLOSE ( iunpun, STATUS = 'keep' )
438            !
439         END IF
440         !
441      END IF
442      !
443      CALL mp_bcast( nprint_nfi, ionode_id, intra_image_comm )
444      !
445      RETURN
446      !
447    END SUBROUTINE read_print_counter
448    !
449END MODULE printout_base
450