diff --git a/CPV/Makefile b/CPV/Makefile index f3da5cab1..cd8d6ce0b 100644 --- a/CPV/Makefile +++ b/CPV/Makefile @@ -103,6 +103,7 @@ smlam.o \ spharmonic.o \ spline.o \ stop_pw.o \ +stop_run.o \ stress.o \ turbo.o \ util.o \ diff --git a/CPV/cpr.f90 b/CPV/cpr.f90 index 763a89887..33891d9aa 100644 --- a/CPV/cpr.f90 +++ b/CPV/cpr.f90 @@ -81,10 +81,9 @@ SUBROUTINE cprmain( tau, fion_out, etot_out ) USE ions_nose, ONLY : gkbt, kbt, ndega, nhpcl, nhpdim, qnp, & vnhp, xnhp0, xnhpm, xnhpp, atm2nhp, & ions_nosevel, ions_noseupd, & - ions_nose_allocate, ions_nose_deallocate,& - tempw, ions_nose_nrg, & - ions_nose_shiftvar, gkbt2nhp, ekin2nhp, & - anum2nhp + ions_nose_allocate, tempw, & + ions_nose_nrg, ions_nose_shiftvar, & + gkbt2nhp, ekin2nhp, anum2nhp USE electrons_nose, ONLY : qne, ekincw, xnhe0, xnhep, xnhem, & vnhe, electrons_nose_nrg, & electrons_nose_shiftvar, & @@ -1019,20 +1018,10 @@ SUBROUTINE cprmain( tau, fion_out, etot_out ) 1975 FORMAT( /1X,'Scaled coordinates '/1X,'species',' atom #' ) 1976 FORMAT( 1X,2I5,3F10.4 ) ! - IF( ionode ) WRITE( stdout, 1977 ) + IF ( ionode ) & + WRITE( stdout, '(5X,//,24("=")," end cp ",24("="),//)' ) ! CALL memory() - ! -1977 FORMAT(5X,//'====================== end cprvan ======================',//) - ! -! by Kostya -! Something is fishy here, when deallocate_modules_var is called -! IFC 8.0 and 8.1 spit out -!*** glibc detected *** free(): invalid next size (fast): 0x18b46af8 *** -!forrtl: error (76): IOT trap signal -! I could not find what is wrong ... - call ions_nose_deallocate() - CALL deallocate_modules_var() ! RETURN ! diff --git a/CPV/cprstart.f90 b/CPV/cprstart.f90 index 8506c7845..348650a1e 100644 --- a/CPV/cprstart.f90 +++ b/CPV/cprstart.f90 @@ -142,9 +142,7 @@ PROGRAM main ! END IF ! - CALL environment_end( ) - ! - CALL mp_end() + CALL stop_run( .TRUE. ) ! STOP ! diff --git a/CPV/stop_run.f90 b/CPV/stop_run.f90 new file mode 100644 index 000000000..f9e7dfba1 --- /dev/null +++ b/CPV/stop_run.f90 @@ -0,0 +1,74 @@ +! +! Copyright (C) 2001-2004 Quantum-ESPRESSO group +! This file is distributed under the terms of the +! GNU General Public License. See the file `License' +! in the root directory of the present distribution, +! or http://www.gnu.org/copyleft/gpl.txt . +! +! +!---------------------------------------------------------------------------- +SUBROUTINE stop_run( flag ) + !---------------------------------------------------------------------------- + ! + ! ... Close all files and synchronize processes before stopping. + ! + USE io_global, ONLY : stdout, ionode + USE control_flags, ONLY : lpath, lneb, lsmd, lconstrain + USE io_files, ONLY : prefix + USE environment, ONLY : environment_end + USE input_parameters, ONLY : deallocate_input_parameters + USE path_variables, ONLY : path_deallocation + USE path_io_routines, ONLY : io_path_stop + USE constraints_module, ONLY : deallocate_constraint + USE ions_nose, ONLY : ions_nose_deallocate + USE mp, ONLY : mp_barrier, mp_end + ! + IMPLICIT NONE + ! + LOGICAL, INTENT(IN) :: flag + LOGICAL :: exst + ! + ! + CALL environment_end() + ! + IF ( lpath ) CALL io_path_stop() + ! + CALL mp_barrier() + ! + CALL mp_end() + ! +#ifdef __T3E + ! + ! ... set streambuffers off + ! + CALL set_d_stream( 0 ) + ! +#endif + ! + CALL ions_nose_deallocate() + CALL deallocate_modules_var() + CALL deallocate_input_parameters() + ! + IF ( lconstrain ) CALL deallocate_constraint() + ! + IF ( lneb ) THEN + ! + CALL path_deallocation( 'neb' ) + ! + ELSE IF ( lsmd ) THEN + ! + CALL path_deallocation( 'smd' ) + ! + END IF + ! + IF ( flag ) THEN + ! + STOP + ! + ELSE + ! + STOP 1 + ! + END IF + ! +END SUBROUTINE stop_run diff --git a/CPV/wannier.f90 b/CPV/wannier.f90 index 71931aaf7..1250c6b98 100644 --- a/CPV/wannier.f90 +++ b/CPV/wannier.f90 @@ -355,7 +355,6 @@ MODULE wannier_subroutines SUBROUTINE write_charge_and_exit( rhog ) !-------------------------------------------------------------------------- ! - USE mp, ONLY : mp_end USE wannier_base, ONLY : writev ! IMPLICIT NONE @@ -368,9 +367,7 @@ MODULE wannier_subroutines ! CALL write_rho_g( rhog ) ! - CALL mp_end() - ! - STOP 'write_charge_and_exit' + CALL stop_run( .TRUE. ) ! END IF ! @@ -387,7 +384,6 @@ MODULE wannier_subroutines USE efcalc, ONLY : wf_efield USE wannier_base, ONLY : nwf, calwf, jwf, wffort, iplot, iwf USE wannier_module, ONLY : what1, wfc, utwf - USE mp, ONLY : mp_end USE control_flags, ONLY : iprsta ! IMPLICIT NONE @@ -418,28 +414,30 @@ MODULE wannier_subroutines j=wffort+i-1 CALL rhoiofr (nfi,cm, irb, eigrb,bec,rhovan,rhor,rhog,rhos,enl,ekin,j) END DO - CALL mp_end() - STOP 'wf_options 1' + ! + CALL stop_run( .TRUE. ) + ! END IF ! - IF (calwf.EQ.2) THEN - - ! calculate the overlap matrix + IF ( calwf == 2 ) THEN + ! + ! ... calculate the overlap matrix ! jwf=1 + ! CALL wf (calwf,cm(:,:,1,1),bec,eigr,eigrb,taub,irb,b1,b2,b3,utwf,becdr,what1,wfc,jwf,ibrav) - - CALL mp_end() - STOP 'wf_options 2' + ! + CALL stop_run( .TRUE. ) + ! END IF ! IF (calwf.EQ.5) THEN ! jwf=iplot(1) CALL wf (calwf,cm(:,:,1,1),bec,eigr,eigrb,taub,irb,b1,b2,b3,utwf,becdr,what1,wfc,jwf,ibrav) - - CALL mp_end() - STOP 'wf_options 5' + ! + CALL stop_run( .TRUE. ) + ! END IF ! ! ... End Wannier Function options - M.S @@ -652,7 +650,6 @@ MODULE wannier_subroutines USE efcalc, ONLY : wf_efield USE wannier_base, ONLY : nwf, calwf, jwf, wffort, iplot, iwf USE wannier_module, ONLY : what1, wfc, utwf - USE mp, ONLY : mp_end USE control_flags, ONLY : iprsta USE electrons_base, ONLY : nbsp USE gvecw, ONLY : ngw @@ -711,8 +708,7 @@ MODULE wannier_subroutines vnhh, velh, ecut, ecutw, delt, pmass, ibrav, celldm, & fion, tps, mat_z, occ_f ) ! - CALL mp_end() - STOP 'wf_closing_options 4' + CALL stop_run( .TRUE. ) ! END IF !