1!
2! Copyright (C) 2013 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!
8SUBROUTINE c2libpwscf(lib_comm,nim,npt,npl,nta,nbn,ndg,retval,infile) BIND(C)
9  !----------------------------------------------------------------------------
10  !
11  ! ... C wrapper for library interface to the Pwscf
12  USE ISO_C_BINDING
13  !
14  IMPLICIT NONE
15  !
16  INTEGER (kind=C_INT), VALUE :: lib_comm, nim, npt, npl, nta, nbn, ndg
17  INTEGER (kind=C_INT), INTENT(OUT) :: retval
18  CHARACTER (kind=C_CHAR), INTENT(IN) :: infile(*)
19  INTEGER  :: i, lib_comm_, nim_, npt_, npl_, nta_, nbn_, ndg_, retval_
20  CHARACTER(LEN=80)  :: infile_
21  !
22  ! ... Copy C data types to Fortran data types
23  lib_comm_ = lib_comm
24  nim_ = nim
25  npt_ = npt
26  npl_ = npl
27  nta_ = nta
28  nbn_ = nbn
29  ndg_ = ndg
30  retval = 0
31  infile_ = ' '
32  !
33  ! ... Copying a string from C to Fortran is a bit ugly.
34  DO i=1,80
35      IF (infile(i) == C_NULL_CHAR) EXIT
36      infile_ = TRIM(infile_) // infile(i)
37  END DO
38  !
39  CALL f2libpwscf(lib_comm_,nim_,npt_,npl_,nta_,nbn_,ndg_,retval_,infile_)
40  retval = retval_
41  !
42END SUBROUTINE c2libpwscf
43!
44!----------------------------------------------------------------------------
45SUBROUTINE f2libpwscf(lib_comm,nim,npt,npl,nta,nbn,ndg,retval,infile)
46  !----------------------------------------------------------------------------
47  !
48  ! ... Library interface to the Plane Wave Self-Consistent Field code
49  !
50  USE environment,       ONLY : environment_start
51  USE mp_global,         ONLY : mp_startup
52  USE mp_bands,          ONLY : intra_bgrp_comm, inter_bgrp_comm
53  USE mp_pools,          ONLY  : intra_pool_comm
54  USE read_input,        ONLY : read_input_file
55  USE command_line_options, ONLY: set_command_line
56  USE parallel_include
57  !
58  IMPLICIT NONE
59  !
60  include 'laxlib.fh'
61  !
62  INTEGER, INTENT(IN)    :: lib_comm, nim, npt, npl, nta, nbn, ndg
63  INTEGER, INTENT(INOUT) :: retval
64  CHARACTER(LEN=80)      :: infile
65  !
66  INTEGER                :: ndiag_
67#if defined(DEBUG_QECOUPLE)
68  INTEGER :: me, num, ierr
69  CALL MPI_COMM_SIZE(lib_comm,num,ierr)
70  IF (ierr /= MPI_SUCCESS) THEN
71      CALL MPI_ERROR_STRING(ierr, infile, 80, retval)
72      PRINT*,'MPI Error: ', infile
73      STOP 100
74  END IF
75  CALL MPI_COMM_RANK(lib_comm,me,ierr)
76  IF (me == 0) THEN
77      PRINT*, 'Calling PW library interface with these flags:'
78      PRINT*, 'communicator index: ', lib_comm
79      PRINT*, 'communicator size:  ', num
80      PRINT*, 'nimage: ', nim
81      PRINT*, 'npool:  ', npl
82      PRINT*, 'ntaskg: ', nta
83      PRINT*, 'nband:  ', nbn
84      PRINT*, 'ndiag:  ', ndg
85      PRINT*, 'input:  "',TRIM(infile),'"'
86  END IF
87#endif
88  !
89  CALL set_command_line( nimage=nim, npool=npl, ntg=nta, &
90      nband=nbn, ndiag=ndg )
91  CALL mp_startup ( my_world_comm=lib_comm , start_images = .true. )
92  ndiag_ = ndg
93  CALL laxlib_start( ndiag_ , lib_comm, intra_pool_comm, do_distr_diag_inside_bgrp_ = .false.)
94  CALL set_mpi_comm_4_solvers ( intra_pool_comm, intra_bgrp_comm, inter_bgrp_comm)
95  CALL environment_start ( 'PWSCF' )
96  !
97  CALL read_input_file ('PW', infile )
98  !
99  ! ... Perform actual calculation
100  !
101  CALL run_pwscf  ( retval )
102  !
103  CALL laxlib_end()
104  CALL stop_run( retval )
105  !
106END SUBROUTINE f2libpwscf
107
108