Deallocation of constraints arrays made independent from clean_pw to reduce modules dependencies.

C.S.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@1839 c92efa57-630b-4861-b058-cf58834340f0

Modules/constraints_module.f90

@@ -39,7 +39,8 @@ MODULE constraints_module
   !
   PUBLIC :: init_constraint, &
             check_constrain, &
-            remove_constraint_force
+            remove_constraint_force, &
+            deallocate_constraint
   !
   ! ... public variables (assigned in the CONSTRAINTS input card)
   !
@@ -449,4 +450,19 @@ MODULE constraints_module
        !
      END SUBROUTINE remove_constraint_force
      !
+     !-----------------------------------------------------------------------
+     SUBROUTINE deallocate_constraint()
+       !-----------------------------------------------------------------------
+       !
+       IMPLICIT NONE
+       !
+       !
+       IF ( ALLOCATED( constr ) )      DEALLOCATE( constr )
+       IF ( ALLOCATED( constr_type ) ) DEALLOCATE( constr_type )
+       IF ( ALLOCATED( target ) )      DEALLOCATE( target )       
+       !
+       RETURN
+       !
+     END SUBROUTINE deallocate_constraint
+     !
 END MODULE constraints_module

PW/clean_pw.f90

@@ -35,18 +35,17 @@ SUBROUTINE clean_pw(lflag)
 #endif  
   USE fft_types,            ONLY : fft_dlay_deallocate
   USE spin_orb,             ONLY : lspinorb, fcoef
-  USE constraints_module,   ONLY : constr, target
   USE noncollin_module,     ONLY : deallocate_noncol
   !
   IMPLICIT NONE
   !
-  logical :: lflag
-  !          if .true. deallocate_ions_base is called
+  LOGICAL :: lflag
+    ! if .true. deallocate_ions_base is called
   !
   !
   ! ... arrays allocated in input.f90, read_file.f90 or setup.f90
   !
-  if (lflag) CALL deallocate_ions_base( )
+  IF ( lflag ) CALL deallocate_ions_base()
   !
   IF ( ALLOCATED( force ) )      DEALLOCATE( force )
   IF ( ALLOCATED( tetra ) )      DEALLOCATE( tetra )
@@ -76,7 +75,7 @@ SUBROUTINE clean_pw(lflag)
   IF ( ALLOCATED( vnew ) )       DEALLOCATE( vnew )
   IF ( ALLOCATED( rho_core ) )   DEALLOCATE( rho_core )
   IF ( ALLOCATED( psic ) )       DEALLOCATE( psic )
-  IF ( ALLOCATED( psic_nc ) )       DEALLOCATE( psic_nc )
+  IF ( ALLOCATED( psic_nc ) )    DEALLOCATE( psic_nc )
   IF ( ALLOCATED( vrs ) )        DEALLOCATE( vrs )
   IF ( doublegrid ) THEN
     IF ( ASSOCIATED( nls ) )     DEALLOCATE( nls )
@@ -103,13 +102,13 @@ SUBROUTINE clean_pw(lflag)
   IF ( ALLOCATED( nsnew ) )      DEALLOCATE( nsnew )
   IF ( ALLOCATED( tab ) )        DEALLOCATE( tab )
   IF ( ALLOCATED( tab_at ) )     DEALLOCATE( tab_at )
-  IF (lspinorb) then
-     IF ( ALLOCATED( fcoef ) )      DEALLOCATE( fcoef )
+  IF ( lspinorb ) THEN
+     IF ( ALLOCATED( fcoef ) )   DEALLOCATE( fcoef )
   END IF
   !
-  call deallocate_uspp () 
+  CALL deallocate_uspp() 
   !
-  call deallocate_noncol () 
+  CALL deallocate_noncol() 
   !
   ! ... arrays allocated in allocate_wfc.f90 ( and never deallocated )
   !
@@ -117,14 +116,15 @@ SUBROUTINE clean_pw(lflag)
   IF ( ALLOCATED( wg ) )         DEALLOCATE( wg )
   IF ( ALLOCATED( evc ) )        DEALLOCATE( evc )
   IF ( ALLOCATED( swfcatom ) )   DEALLOCATE( swfcatom )
-  IF ( ALLOCATED( evc_nc ) )        DEALLOCATE( evc_nc )
+  IF ( ALLOCATED( evc_nc ) )     DEALLOCATE( evc_nc )
   !
 #ifdef __SX6
   !
   ! ... arrays allocated in cft_3.f90 ( and never deallocated )
   !
   IF ( ALLOCATED( auxp ) )       DEALLOCATE( auxp )
-  first(:)=.true.
+  !
+  first(:) = .TRUE.
   !
 #endif 
   !
@@ -135,16 +135,11 @@ SUBROUTINE clean_pw(lflag)
   !
   ! ... stick-owner matrix allocated in sticks_base
   !
-  CALL sticks_deallocate( )
+  CALL sticks_deallocate()
   !
   ! ... deallocate indices used in calculation of polarizability at gamma
   !
-  CALL berry_closeup( )
-  !
-  ! ... vectors for ionic constrains
-  !
-  IF ( ALLOCATED( constr ) )     DEALLOCATE( constr )
-  IF ( ALLOCATED( target ) )     DEALLOCATE( target )
+  CALL berry_closeup()
   !
   RETURN
   !

PW/stop_pw.f90

@@ -14,13 +14,14 @@ SUBROUTINE stop_pw( flag )
   ! ... Called at the end of the run with flag = .TRUE. (removes 'restart')
   ! ... or during execution with flag = .FALSE. (does not remove 'restart')
   !
-  USE io_global,        ONLY : stdout, ionode
-  USE control_flags,    ONLY : lpath, lneb, lsmd, twfcollect
-  USE io_files,         ONLY : prefix, iunwfc, iunigk, iunres
-  USE input_parameters, ONLY : deallocate_input_parameters
-  USE path_variables,   ONLY : path_deallocation
-  USE path_io_routines, ONLY : io_path_stop
-  USE mp,               ONLY : mp_barrier, mp_end
+  USE io_global,          ONLY : stdout, ionode
+  USE control_flags,      ONLY : lpath, lneb, lsmd, twfcollect, lconstrain
+  USE io_files,           ONLY : prefix, iunwfc, iunigk, iunres
+  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 mp,                 ONLY : mp_barrier, mp_end
   !
   IMPLICIT NONE
   !
@@ -82,11 +83,11 @@ SUBROUTINE stop_pw( flag )
   CALL set_d_stream( 0 )
 #endif
   !
-  CALL clean_pw(.true.)
+  CALL clean_pw( .TRUE. )
   !
   CALL deallocate_input_parameters()
   !
-  ! ... deallocation of variables specific of "path" optimizations
+  IF ( lconstrain ) CALL deallocate_constraint()
   !
   IF ( lneb ) THEN
      !