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 c2libcpv(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 f2libcpv(lib_comm_,nim_,npt_,npl_,nta_,nbn_,ndg_,retval_,infile_) 40 retval = retval_ 41 ! 42END SUBROUTINE c2libcpv 43! 44!---------------------------------------------------------------------------- 45SUBROUTINE f2libcpv(lib_comm,nim,npt,npl,nta,nbn,ndg,retval,infile) 46 !---------------------------------------------------------------------------- 47 ! 48 ! ... Library interface to the QE CPV code 49 ! 50 USE input, ONLY : iosys_pseudo, iosys 51 USE read_input, ONLY : read_input_file 52 USE mp_global, ONLY : mp_startup 53 USE mp_pools, ONLY : intra_pool_comm 54 USE mp_world, ONLY : world_comm 55 USE mp_bands, ONLY : inter_bgrp_comm, intra_bgrp_comm 56 USE io_global, ONLY : ionode, ionode_id 57 USE environment, ONLY : environment_start 58 USE check_stop, ONLY : check_stop_init 59 USE mp_images, ONLY : intra_image_comm 60 USE command_line_options, ONLY : set_command_line 61 USE parallel_include 62 ! 63 IMPLICIT NONE 64 ! 65 include 'laxlib.fh' 66 ! 67 INTEGER, INTENT(IN) :: lib_comm, nim, npt, npl, nta, nbn, ndg 68 INTEGER, INTENT(INOUT) :: retval 69 CHARACTER(LEN=80) :: infile 70 ! 71 INTEGER :: ndiag_ 72 LOGICAL :: diag_in_band_group_ = .true. 73#if defined(DEBUG_QECOUPLE) 74 INTEGER :: me, num, ierr 75 CALL MPI_COMM_SIZE(lib_comm,num,ierr) 76 IF (ierr /= MPI_SUCCESS) THEN 77 CALL MPI_ERROR_STRING(ierr, infile, 80, retval) 78 PRINT*,'MPI Error: ', infile 79 STOP 100 80 END IF 81 CALL MPI_COMM_RANK(lib_comm,me,ierr) 82 IF (me == 0) THEN 83 PRINT*, 'Calling CPV library interface with these flags:' 84 PRINT*, 'communicator index: ', lib_comm 85 PRINT*, 'communicator size: ', num 86 PRINT*, 'nimage: ', nim 87 PRINT*, 'npool: ', npl 88 PRINT*, 'ntaskg: ', nta 89 PRINT*, 'nband: ', nbn 90 PRINT*, 'ndiag: ', ndg 91 PRINT*, 'input: "',TRIM(infile),'"' 92 END IF 93#endif 94 ! 95 CALL set_command_line( nimage=nim, npool=npl, ntg=nta, & 96 nband=nbn, ndiag=ndg ) 97 ! 98 CALL mp_startup ( my_world_comm=lib_comm ) 99 ndiag_ = ndg 100 CALL laxlib_start ( ndiag_, world_comm, intra_bgrp_comm, & 101 do_distr_diag_inside_bgrp_ = diag_in_band_group_) 102 CALL set_mpi_comm_4_solvers( intra_pool_comm, intra_bgrp_comm, inter_bgrp_comm) 103 CALL environment_start ( 'CP' ) 104 ! 105 IF(ionode) CALL plugin_arguments() 106 CALL plugin_arguments_bcast(ionode_id,intra_image_comm) 107 ! 108 ! ... open, read, close the input file 109 ! 110 CALL read_input_file( 'CP', infile ) 111 ! 112 ! ... read in pseudopotentials files and then 113 ! ... copy pseudopotential parameters into internal variables 114 ! 115 CALL iosys_pseudo() 116 ! 117 ! ... copy-in input parameters from input_parameter module 118 ! 119 CALL iosys() 120 ! 121 ! call to void routine for user define / plugin patches initializations 122 ! temporary moved to init_run 123! CALL plugin_initialization() 124 ! 125 CALL check_stop_init() 126 ! 127 CALL cpr_loop( 1 ) 128 ! 129 CALL laxlib_end() 130 CALL stop_run() 131 retval = 0 132 ! 133END SUBROUTINE f2libcpv 134