mirror of https://gitlab.com/QEF/q-e.git
Fixed some bugs in path_base. image-parallelisation of NEB and SMD modified in order
to be compatible with global filesystems exported via NFS (needed by N.Marzari's group). NEB and SMD still require a global filesystem. C.S. git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@1611 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
parent
d9a0d67234
commit
5f87767056
|
@ -345,13 +345,11 @@ MODULE path_base
|
|||
!
|
||||
inter_image_dist = path_length / DBLE( num_of_images - 1 )
|
||||
!
|
||||
! FORALL( i = 1: ( input_images - 1 ) )
|
||||
do i = 1, input_images - 1
|
||||
DO i = 1, input_images - 1
|
||||
!
|
||||
d_R(:,i) = d_R(:,i) / image_spacing(i)
|
||||
!
|
||||
end do
|
||||
! END FORALL
|
||||
END DO
|
||||
!
|
||||
pos_(:,1) = pos(1:dim,1)
|
||||
!
|
||||
|
@ -470,7 +468,7 @@ MODULE path_base
|
|||
!
|
||||
! ... tangent to the path ( normalised )
|
||||
!
|
||||
tangent(:,i) = path_tangent( i )
|
||||
tangent(:,i) = neb_tangent( i )
|
||||
!
|
||||
tangent(:,i) = tangent(:,i) / norm( tangent(:,i) )
|
||||
!
|
||||
|
@ -517,6 +515,78 @@ MODULE path_base
|
|||
!
|
||||
END SUBROUTINE neb_gradient
|
||||
!
|
||||
!-----------------------------------------------------------------------
|
||||
FUNCTION neb_tangent( index )
|
||||
!-----------------------------------------------------------------------
|
||||
!
|
||||
USE supercell, ONLY : pbc
|
||||
USE path_variables, ONLY : pos, dim, num_of_modes, num_of_images, &
|
||||
pes, path_length, path_length_av, ft_pos, &
|
||||
ft_pos_av, pos_av_in, pos_av_fin, Nft, &
|
||||
fixed_tan
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
! ... I/O variables
|
||||
!
|
||||
INTEGER, INTENT(IN) :: index
|
||||
REAL (KIND=DP) :: neb_tangent(dim)
|
||||
!
|
||||
! ... local variables
|
||||
!
|
||||
INTEGER :: n
|
||||
REAL (KIND=DP) :: x, pi_n
|
||||
REAL (KIND=DP) :: V_previous, V_actual, V_next
|
||||
REAL (KIND=DP) :: abs_next, abs_previous
|
||||
REAL (KIND=DP) :: delta_V_max, delta_V_min
|
||||
!
|
||||
!
|
||||
! ... NEB definition of the tangent
|
||||
!
|
||||
V_previous = pes( index - 1 )
|
||||
V_actual = pes( index )
|
||||
V_next = pes( index + 1 )
|
||||
!
|
||||
IF ( ( V_next > V_actual ) .AND. ( V_actual > V_previous ) ) THEN
|
||||
!
|
||||
neb_tangent = pbc( pos(:,( index + 1 )) - pos(:,index) )
|
||||
!
|
||||
ELSE IF ( ( V_next < V_actual ) .AND. ( V_actual < V_previous ) ) THEN
|
||||
!
|
||||
neb_tangent = pbc( pos(:,index) - pos(:,( index - 1 )) )
|
||||
!
|
||||
ELSE
|
||||
!
|
||||
abs_next = ABS( V_next - V_actual )
|
||||
abs_previous = ABS( V_previous - V_actual )
|
||||
!
|
||||
delta_V_max = MAX( abs_next , abs_previous )
|
||||
delta_V_min = MIN( abs_next , abs_previous )
|
||||
!
|
||||
IF ( V_next > V_previous ) THEN
|
||||
!
|
||||
neb_tangent = &
|
||||
pbc( pos(:,( index + 1 )) - pos(:,index) ) * delta_V_max + &
|
||||
pbc( pos(:,index) - pos(:,( index - 1 )) ) * delta_V_min
|
||||
!
|
||||
ELSE IF ( V_next < V_previous ) THEN
|
||||
!
|
||||
neb_tangent = &
|
||||
pbc( pos(:,( index + 1 )) - pos(:,index) ) * delta_V_min + &
|
||||
pbc( pos(:,index) - pos(:,( index - 1 )) ) * delta_V_max
|
||||
!
|
||||
ELSE
|
||||
!
|
||||
neb_tangent = pbc( pos(:,( index + 1 )) - pos(:,( index - 1 )) )
|
||||
!
|
||||
END IF
|
||||
!
|
||||
END IF
|
||||
!
|
||||
RETURN
|
||||
!
|
||||
END FUNCTION neb_tangent
|
||||
!
|
||||
! ... smd specific routines
|
||||
!
|
||||
!-----------------------------------------------------------------------
|
||||
|
@ -528,7 +598,7 @@ MODULE path_base
|
|||
path_thr, Nft, ft_coeff, pos, pes, &
|
||||
use_multistep, grad_pes, err_max, &
|
||||
frozen, vel, vel_zeroed
|
||||
|
||||
USE io_global, ONLY : meta_ionode
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
|
@ -551,9 +621,10 @@ MODULE path_base
|
|||
!
|
||||
! ... initialisation
|
||||
!
|
||||
WRITE( UNIT = iunpath, &
|
||||
FMT = '(5X,"initial number of images = ",I3,/)' ) &
|
||||
init_num_of_images
|
||||
IF ( meta_ionode ) &
|
||||
WRITE( UNIT = iunpath, &
|
||||
& FMT = '(5X,"initial number of images = ",I3,/)' ) &
|
||||
init_num_of_images
|
||||
!
|
||||
CALL redispose_last_image( init_num_of_images )
|
||||
!
|
||||
|
@ -567,9 +638,10 @@ MODULE path_base
|
|||
!
|
||||
IF ( new_num_of_images > num_of_images ) THEN
|
||||
!
|
||||
WRITE( UNIT = iunpath, &
|
||||
FMT = '(5X,"new number of images = ",I3,/)' ) &
|
||||
new_num_of_images
|
||||
IF ( meta_ionode ) &
|
||||
WRITE( UNIT = iunpath, &
|
||||
& FMT = '(5X,"new number of images = ",I3,/)' ) &
|
||||
new_num_of_images
|
||||
!
|
||||
CALL redispose_last_image( new_num_of_images )
|
||||
!
|
||||
|
@ -940,6 +1012,7 @@ MODULE path_base
|
|||
!
|
||||
USE path_variables, ONLY : num_of_images, grad, llangevin, &
|
||||
first_last_opt, path_thr, error, frozen
|
||||
USE mp_global, ONLY : nimage
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
|
@ -950,8 +1023,8 @@ MODULE path_base
|
|||
! ... local variables
|
||||
!
|
||||
INTEGER :: i, n
|
||||
INTEGER :: N_in, N_fin
|
||||
REAL (KIND=DP) :: err_max
|
||||
INTEGER :: N_in, N_fin, free_me, num_of_scf_images
|
||||
REAL (KIND=DP) :: err_max, val
|
||||
!
|
||||
!
|
||||
IF ( first_last_opt ) THEN
|
||||
|
@ -989,6 +1062,29 @@ MODULE path_base
|
|||
!
|
||||
END IF
|
||||
!
|
||||
IF ( nimage > 1 ) THEN
|
||||
!
|
||||
! ... in the case of image-parallelisation the number of images to
|
||||
! ... be optimised must be larger than nimage
|
||||
!
|
||||
IF ( nimage > ( N_fin - N_in ) ) &
|
||||
CALL errore( 'search_MEP', &
|
||||
& 'nimage is larger than the number of images ', 1 )
|
||||
!
|
||||
find_scf_images: DO
|
||||
!
|
||||
num_of_scf_images = COUNT( .NOT. frozen )
|
||||
!
|
||||
IF ( num_of_scf_images >= nimage ) EXIT find_scf_images
|
||||
!
|
||||
free_me = MAXLOC( error, 1, frozen(N_in:N_fin) )
|
||||
!
|
||||
frozen(free_me) = .FALSE.
|
||||
!
|
||||
END DO find_scf_images
|
||||
!
|
||||
END IF
|
||||
!
|
||||
#endif
|
||||
!
|
||||
IF ( PRESENT( err_out ) ) err_out = err_max
|
||||
|
@ -998,122 +1094,6 @@ MODULE path_base
|
|||
END SUBROUTINE compute_error
|
||||
!
|
||||
!-----------------------------------------------------------------------
|
||||
FUNCTION path_tangent( index )
|
||||
!-----------------------------------------------------------------------
|
||||
!
|
||||
USE supercell, ONLY : pbc
|
||||
USE control_flags, ONLY : lneb, lsmd
|
||||
USE path_variables, ONLY : pos, dim, num_of_modes, num_of_images, &
|
||||
pes, path_length, path_length_av, ft_pos, &
|
||||
ft_pos_av, pos_av_in, pos_av_fin, Nft, &
|
||||
fixed_tan
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
! ... I/O variables
|
||||
!
|
||||
INTEGER, INTENT(IN) :: index
|
||||
REAL (KIND=DP) :: path_tangent(dim)
|
||||
!
|
||||
! ... local variables
|
||||
!
|
||||
INTEGER :: n
|
||||
REAL (KIND=DP) :: x, pi_n
|
||||
REAL (KIND=DP) :: V_previous, V_actual, V_next
|
||||
REAL (KIND=DP) :: abs_next, abs_previous
|
||||
REAL (KIND=DP) :: delta_V_max, delta_V_min
|
||||
!
|
||||
!
|
||||
IF ( lneb ) THEN
|
||||
!
|
||||
! ... NEB definition of the tangent
|
||||
!
|
||||
V_previous = pes( index - 1 )
|
||||
V_actual = pes( index )
|
||||
V_next = pes( index + 1 )
|
||||
!
|
||||
IF ( ( V_next > V_actual ) .AND. ( V_actual > V_previous ) ) THEN
|
||||
!
|
||||
path_tangent = pbc( pos(:,( index + 1 )) - pos(:,index) )
|
||||
!
|
||||
ELSE IF ( ( V_next < V_actual ) .AND. ( V_actual < V_previous ) ) THEN
|
||||
!
|
||||
path_tangent = pbc( pos(:,index) - pos(:,( index - 1 )) )
|
||||
!
|
||||
ELSE
|
||||
!
|
||||
abs_next = ABS( V_next - V_actual )
|
||||
abs_previous = ABS( V_previous - V_actual )
|
||||
!
|
||||
delta_V_max = MAX( abs_next , abs_previous )
|
||||
delta_V_min = MIN( abs_next , abs_previous )
|
||||
!
|
||||
IF ( V_next > V_previous ) THEN
|
||||
!
|
||||
path_tangent = &
|
||||
pbc( pos(:,( index + 1 )) - pos(:,index) ) * delta_V_max + &
|
||||
pbc( pos(:,index) - pos(:,( index - 1 )) ) * delta_V_min
|
||||
!
|
||||
ELSE IF ( V_next < V_previous ) THEN
|
||||
!
|
||||
path_tangent = &
|
||||
pbc( pos(:,( index + 1 )) - pos(:,index) ) * delta_V_min + &
|
||||
pbc( pos(:,index) - pos(:,( index - 1 )) ) * delta_V_max
|
||||
!
|
||||
ELSE
|
||||
!
|
||||
path_tangent = &
|
||||
pbc( pos(:,( index + 1 )) - pos(:,( index - 1 )) )
|
||||
!
|
||||
END IF
|
||||
!
|
||||
END IF
|
||||
!
|
||||
ELSE IF ( lsmd ) THEN
|
||||
!
|
||||
! ... tangent from fourier interpolation
|
||||
!
|
||||
x = DBLE( index - 1 ) / DBLE( Nft )
|
||||
!
|
||||
IF ( fixed_tan ) THEN
|
||||
!
|
||||
path_tangent(:) = ( pos_av_fin(:) - pos_av_in(:) )
|
||||
!
|
||||
DO n = 1, num_of_modes
|
||||
!
|
||||
pi_n = pi * DBLE( n )
|
||||
!
|
||||
path_tangent(:) = path_tangent(:) + &
|
||||
ft_pos_av(:,n) * pi_n * COS( pi_n * x )
|
||||
!
|
||||
END DO
|
||||
!
|
||||
path_tangent(:) = path_tangent(:) / path_length_av
|
||||
!
|
||||
ELSE
|
||||
!
|
||||
path_tangent(:) = ( pos(:,num_of_images) - pos(:,1) )
|
||||
!
|
||||
DO n = 1, num_of_modes
|
||||
!
|
||||
pi_n = pi * DBLE( n )
|
||||
!
|
||||
path_tangent(:) = path_tangent(:) + &
|
||||
ft_pos(:,n) * pi_n * COS( pi_n * x )
|
||||
!
|
||||
END DO
|
||||
!
|
||||
path_tangent(:) = path_tangent(:) / path_length
|
||||
!
|
||||
END IF
|
||||
!
|
||||
END IF
|
||||
!
|
||||
RETURN
|
||||
!
|
||||
END FUNCTION path_tangent
|
||||
!
|
||||
!-----------------------------------------------------------------------
|
||||
FUNCTION gaussian_vect()
|
||||
!-----------------------------------------------------------------------
|
||||
!
|
||||
|
@ -1165,7 +1145,6 @@ MODULE path_base
|
|||
istep_path, pes, first_last_opt, &
|
||||
Emin , Emax, Emax_index, frozen, &
|
||||
error
|
||||
USE mp_global, ONLY : nimage
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
|
@ -1175,24 +1154,14 @@ MODULE path_base
|
|||
!
|
||||
! ... local variables
|
||||
!
|
||||
INTEGER :: N_in, N_fin, i, free_me, num_of_scf_images
|
||||
REAL (KIND=DP) :: val
|
||||
INTEGER :: N_in, N_fin, i
|
||||
!
|
||||
!
|
||||
IF ( istep_path == 0 ) THEN
|
||||
IF ( istep_path == 0 .OR. first_last_opt ) THEN
|
||||
!
|
||||
N_in = 1
|
||||
N_fin = num_of_images
|
||||
!
|
||||
ELSE IF ( first_last_opt ) THEN
|
||||
!
|
||||
N_in = 1
|
||||
N_fin = num_of_images
|
||||
!
|
||||
IF ( frozen(1) ) N_in = 2
|
||||
!
|
||||
IF ( frozen(num_of_images) ) N_fin = ( num_of_images - 1 )
|
||||
!
|
||||
ELSE
|
||||
!
|
||||
N_in = 2
|
||||
|
@ -1202,25 +1171,6 @@ MODULE path_base
|
|||
!
|
||||
IF ( suspended_image /= 0 ) N_in = suspended_image
|
||||
!
|
||||
IF ( nimage > 1 ) THEN
|
||||
!
|
||||
! ... in the case of image-parallelisation the number of images to
|
||||
! ... be optimised must be larger than nimage
|
||||
!
|
||||
find_scf_images: DO
|
||||
!
|
||||
num_of_scf_images = COUNT( .NOT. frozen )
|
||||
!
|
||||
IF ( num_of_scf_images > nimage ) EXIT find_scf_images
|
||||
!
|
||||
free_me = MAXLOC( error, 1, frozen )
|
||||
!
|
||||
frozen(free_me) = .FALSE.
|
||||
!
|
||||
END DO find_scf_images
|
||||
!
|
||||
END IF
|
||||
!
|
||||
CALL compute_scf( N_in, N_fin, stat )
|
||||
!
|
||||
IF ( .NOT. stat ) RETURN
|
||||
|
@ -1513,7 +1463,7 @@ MODULE path_base
|
|||
!
|
||||
USE input_parameters, ONLY : num_of_images_inp => num_of_images
|
||||
USE control_flags, ONLY : lneb, lsmd
|
||||
USE io_global, ONLY : ionode
|
||||
USE io_global, ONLY : meta_ionode
|
||||
USE path_variables, ONLY : path_thr, istep_path, nstep_path, &
|
||||
conv_path, suspended_image, &
|
||||
num_of_images, llangevin, lmol_dyn
|
||||
|
@ -1537,16 +1487,20 @@ MODULE path_base
|
|||
!
|
||||
IF ( exit_condition ) THEN
|
||||
!
|
||||
WRITE( UNIT = iunpath, FMT = final_fmt )
|
||||
!
|
||||
IF ( ionode .AND. lneb ) &
|
||||
WRITE( UNIT = iunpath, &
|
||||
FMT = '(/,5X,"neb: convergence achieved in ",I3, &
|
||||
& " iterations" )' ) istep_path
|
||||
IF ( ionode .AND. lsmd ) &
|
||||
WRITE( UNIT = iunpath, &
|
||||
FMT = '(/,5X,"smd: convergence achieved in ",I3, &
|
||||
& " iterations" )' ) istep_path
|
||||
IF ( meta_ionode ) THEN
|
||||
!
|
||||
WRITE( UNIT = iunpath, FMT = final_fmt )
|
||||
!
|
||||
IF ( lneb ) &
|
||||
WRITE( UNIT = iunpath, &
|
||||
FMT = '(/,5X,"neb: convergence achieved in ",I3, &
|
||||
& " iterations" )' ) istep_path
|
||||
IF ( lsmd ) &
|
||||
WRITE( UNIT = iunpath, &
|
||||
FMT = '(/,5X,"smd: convergence achieved in ",I3, &
|
||||
& " iterations" )' ) istep_path
|
||||
!
|
||||
END IF
|
||||
!
|
||||
suspended_image = 0
|
||||
!
|
||||
|
@ -1563,16 +1517,20 @@ MODULE path_base
|
|||
!
|
||||
IF ( istep_path >= nstep_path ) THEN
|
||||
!
|
||||
WRITE( UNIT = iunpath, FMT = final_fmt )
|
||||
!
|
||||
IF ( ionode .AND. lneb ) &
|
||||
WRITE( UNIT = iunpath, &
|
||||
FMT = '(/,5X,"neb: reached the maximum number of ", &
|
||||
& "steps")' )
|
||||
IF ( ionode .AND. lsmd ) &
|
||||
WRITE( UNIT = iunpath, &
|
||||
FMT = '(/,5X,"smd: reached the maximum number of ", &
|
||||
& "steps")' )
|
||||
IF ( meta_ionode ) THEN
|
||||
!
|
||||
WRITE( UNIT = iunpath, FMT = final_fmt )
|
||||
!
|
||||
IF ( lneb ) &
|
||||
WRITE( UNIT = iunpath, &
|
||||
FMT = '(/,5X,"neb: reached the maximum number of ", &
|
||||
& "steps")' )
|
||||
IF ( lsmd ) &
|
||||
WRITE( UNIT = iunpath, &
|
||||
FMT = '(/,5X,"smd: reached the maximum number of ", &
|
||||
& "steps")' )
|
||||
!
|
||||
END IF
|
||||
!
|
||||
suspended_image = 0
|
||||
!
|
||||
|
|
|
@ -58,6 +58,9 @@ MODULE path_variables
|
|||
lmol_dyn = .FALSE., &! .TRUE. if opt_scheme = "mol-dyn"
|
||||
lbroyden = .FALSE., &! .TRUE. if opt_scheme = "broyden"
|
||||
llangevin = .FALSE. ! .TRUE. if opt_scheme = "langevin"
|
||||
LOGICAL :: &
|
||||
tune_load_balance ! if .TRUE. the load balance for image
|
||||
! parallelisation is tuned at runtime
|
||||
INTEGER :: &
|
||||
istep_path, &! iteration in the optimization procedure
|
||||
nstep_path, &! maximum number of iterations
|
||||
|
|
|
@ -40,6 +40,7 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
|
|||
dim, suspended_image, istep_path, &
|
||||
first_last_opt, frozen, write_save
|
||||
USE parser, ONLY : int_to_char
|
||||
USE path_variables, ONLY : tune_load_balance
|
||||
USE io_global, ONLY : stdout, ionode, ionode_id, meta_ionode
|
||||
USE mp_global, ONLY : inter_image_comm, intra_image_comm, &
|
||||
my_image_id, nimage, root
|
||||
|
@ -61,14 +62,10 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
|
|||
REAL(KIND=DP), ALLOCATABLE :: tauold(:,:,:)
|
||||
! previous positions of atoms (needed for extrapolation)
|
||||
!
|
||||
! ... end of local variables definition
|
||||
!
|
||||
! ... external functions definition
|
||||
!
|
||||
REAL (KIND=DP), EXTERNAL :: get_clock
|
||||
!
|
||||
! ... end of external functions definition
|
||||
!
|
||||
tune_load_balance = .FALSE.
|
||||
!
|
||||
istep = istep_path + 1
|
||||
istat = 0
|
||||
|
@ -101,7 +98,7 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
|
|||
! ... only the first cpu initializes the file needed by parallelization
|
||||
! ... among images
|
||||
!
|
||||
IF ( ( nimage > 1 ) .AND. meta_ionode ) CALL new_image_init()
|
||||
IF ( meta_ionode ) CALL new_image_init()
|
||||
!
|
||||
image = N_in + my_image_id
|
||||
!
|
||||
|
@ -130,7 +127,7 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
|
|||
!
|
||||
END IF
|
||||
!
|
||||
! ... self-consistency ( for non-frozen images only, in neb case )
|
||||
! ... self-consistency ( for non-frozen images only )
|
||||
!
|
||||
IF ( .NOT. frozen(image) ) THEN
|
||||
!
|
||||
|
@ -384,11 +381,12 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
|
|||
! ... this subroutine initializes the file needed for the
|
||||
! ... parallelization among images
|
||||
!
|
||||
USE io_files, ONLY : iunnewimage
|
||||
USE mp_global, ONLY : nimage
|
||||
USE io_files, ONLY : iunnewimage
|
||||
USE path_variables, ONLY : tune_load_balance
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
IF ( nimage == 1 .OR. .NOT. tune_load_balance ) RETURN
|
||||
!
|
||||
OPEN( UNIT = iunnewimage, FILE = TRIM( tmp_dir_saved ) // &
|
||||
& TRIM( prefix ) // '.newimage' , STATUS = 'UNKNOWN' )
|
||||
|
@ -409,13 +407,15 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
|
|||
! ... the "prefix.BLOCK" file is needed to avoid (when present) that
|
||||
! ... other jobs try to read/write on file "prefix.newimage"
|
||||
!
|
||||
USE io_files, ONLY : iunnewimage, iunblock
|
||||
USE io_global, ONLY : ionode
|
||||
USE io_files, ONLY : iunnewimage, iunblock
|
||||
USE io_global, ONLY : ionode
|
||||
USE path_variables, ONLY : tune_load_balance
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
INTEGER, INTENT(INOUT) :: image
|
||||
INTEGER :: ioerr
|
||||
CHARACTER (LEN=256) :: filename
|
||||
LOGICAL :: opened, exists
|
||||
!
|
||||
!
|
||||
|
@ -423,38 +423,48 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
|
|||
!
|
||||
IF ( nimage > 1 ) THEN
|
||||
!
|
||||
open_loop: DO
|
||||
!
|
||||
OPEN( UNIT = iunblock, FILE = TRIM( tmp_dir_saved ) // &
|
||||
& TRIM( prefix ) // '.BLOCK' , IOSTAT = ioerr, STATUS = 'NEW' )
|
||||
IF ( tune_load_balance ) THEN
|
||||
!
|
||||
IF ( ioerr > 0 ) CYCLE open_loop
|
||||
filename = TRIM( tmp_dir_saved ) // TRIM( prefix ) // '.BLOCK'
|
||||
!
|
||||
INQUIRE( UNIT = iunnewimage, OPENED = opened )
|
||||
open_loop: DO
|
||||
!
|
||||
OPEN( UNIT = iunblock, FILE = TRIM( filename ), &
|
||||
& IOSTAT = ioerr, STATUS = 'NEW' )
|
||||
!
|
||||
IF ( ioerr > 0 ) CYCLE open_loop
|
||||
!
|
||||
INQUIRE( UNIT = iunnewimage, OPENED = opened )
|
||||
!
|
||||
IF ( .NOT. opened ) THEN
|
||||
!
|
||||
OPEN( UNIT = iunnewimage, FILE = TRIM( tmp_dir_saved ) // &
|
||||
& TRIM( prefix ) // '.newimage' , STATUS = 'OLD' )
|
||||
!
|
||||
READ( iunnewimage, * ) image
|
||||
!
|
||||
CLOSE( UNIT = iunnewimage, STATUS = 'DELETE' )
|
||||
!
|
||||
OPEN( UNIT = iunnewimage, FILE = TRIM( tmp_dir_saved ) // &
|
||||
& TRIM( prefix ) // '.newimage' , STATUS = 'NEW' )
|
||||
!
|
||||
WRITE( iunnewimage, * ) image + 1
|
||||
!
|
||||
CLOSE( UNIT = iunnewimage, STATUS = 'KEEP' )
|
||||
!
|
||||
EXIT open_loop
|
||||
!
|
||||
END IF
|
||||
!
|
||||
END DO open_loop
|
||||
!
|
||||
IF ( .NOT. opened ) THEN
|
||||
!
|
||||
OPEN( UNIT = iunnewimage, FILE = TRIM( tmp_dir_saved ) // &
|
||||
& TRIM( prefix ) // '.newimage' , STATUS = 'OLD' )
|
||||
!
|
||||
READ( iunnewimage, * ) image
|
||||
!
|
||||
CLOSE( UNIT = iunnewimage, STATUS = 'DELETE' )
|
||||
!
|
||||
OPEN( UNIT = iunnewimage, FILE = TRIM( tmp_dir_saved ) // &
|
||||
& TRIM( prefix ) // '.newimage' , STATUS = 'NEW' )
|
||||
!
|
||||
WRITE( iunnewimage, * ) image + 1
|
||||
!
|
||||
CLOSE( UNIT = iunnewimage, STATUS = 'KEEP' )
|
||||
!
|
||||
EXIT open_loop
|
||||
!
|
||||
END IF
|
||||
CLOSE( UNIT = iunblock, STATUS = 'DELETE' )
|
||||
!
|
||||
END DO open_loop
|
||||
!
|
||||
CLOSE( UNIT = iunblock, STATUS = 'DELETE' )
|
||||
ELSE
|
||||
!
|
||||
image = image + nimage
|
||||
!
|
||||
END IF
|
||||
!
|
||||
ELSE
|
||||
!
|
||||
|
|
Loading…
Reference in New Issue