SUBROUTINE Read_Overlap(distance, overlap, n) !------------------------------------------------------------------- ! SUBROUTINE: read_overlap ! ! package : CID ! ! Language : Fortran 90 ! ! author : F. Colavecchia (flavioc@lanl.gov) ! ! date : Apr-02 version: 0.1 ! revision : version: ! ! purpose : Read overlap matrices ! ! input : distance -> rho value for which the overlap matrix is needed ! n -> size of the overlap matrix ! ! output : overlap -> overlap matrix ! ! modules : time_Module -> timing ! FileNames_Module-> file names ! nrho_Module -> nrho value ! jtot_Module -> Jtotal propagation value ! common : ! ! ! notes : ! !------------------------------------------------------------------- USE Time_Conv_Module USE FileNames_Module USE jtot_Module USE nrho_Module IMPLICIT NONE REAL(Kind=WP_Kind) distance REAL(Kind=WP_Kind) overlap(n,n) INTEGER n ! CHARACTER(LEN=11) :: Blank CHARACTER(LEN=50), PARAMETER:: Overlap_File='Overlap.bin' CHARACTER(LEN=21), PARAMETER:: procname='read_overlap' LOGICAL, save :: debug LOGICAL firstcall,isthere,opn data firstcall /.true./ SAVE firstcall ! REAL(Kind=WP_Kind) rho2,rholast INTEGER nsfunc2,nrho2 INTEGER Jtot2 CHARACTER(LEN=3) Parity2,symm2 LOGICAL fGP2 REAL(Kind=WP_Kind) phi02,theta02 INTEGER mvec2,i,j ! ! Initialize ! overlap = 0d0 ! ! Open file in first CALL if not already opened ! IF(firstcall)THEN CALL get_debug(procname,debug) INQUIRE(file=OutDIR(1:LEN(TRIM(OutDIR)))//overlap_file,EXIST=isthere,OPENED=opn) IF(isthere)THEN IF(.NOT.opn)THEN OPEN(Unit= overlap_unit,File=OutDIR(1:LEN(TRIM(OutDIR)))//overlap_file, status='old',form='unformatted') ENDIF ELSE WRITE(msg_unit,*) 'overlap_file = ',overlap_file CALL errormsg(msg_unit,procname,' Overlap file does not exist') ENDIF firstcall = .false. ENDIF ! ! Read Header ! READ(overlap_unit) rho2,rholast,nrho2,nsfunc2 READ(overlap_unit) Jtot2,Parity2,symm2 READ(overlap_unit) fGP2,phi02,theta02,mvec2 ! ! Debug ! IF(debug)THEN WRITE(Out_Unit,*) 'rho2 =',rho2,' rholast=', rholast WRITE(Out_Unit,*) 'nrho2=',nrho2,'nsfunc2=',nsfunc2 WRITE(Out_Unit,*) 'Jtot2=',Jtot2 WRITE(Out_Unit,*) 'Par. =',Parity2 WRITE(Out_Unit,*) 'Symm.=',symm2 IF(fGP2)THEN WRITE(Out_Unit,*) 'phi02 =',phi02 WRITE(Out_Unit,*) 'theta02=',theta02 WRITE(Out_Unit,*) 'mvec =',mvec2 ENDIF ENDIF ! ! Check header ! IF(nsfunc2 > n)THEN WRITE(msg_unit,*) 'nsfunc2= ',nsfunc2 WRITE(msg_unit,*) 'n = ',n CALL errormsg(msg_unit,procname, 'nsfunc2 gt n') ENDIF IF(Jtot2 /= Jtot)THEN WRITE(msg_unit,*) 'Jtot2 = ',Jtot2 WRITE(msg_unit,*) 'Jtot = ',Jtot CALL errormsg(msg_unit,procname, 'Jtot2 ne Jtot') ENDIF IF(ABS(rho2-distance) > 1.0E-9)THEN WRITE(msg_unit,*) 'rho2 = ',rho2 WRITE(msg_unit,*) 'distance = ',distance CALL errormsg(msg_unit,procname, 'rho2 ne distance') ENDIF DO i=1,nsfunc2 READ(overlap_unit) (overlap(i,j),j=1,nsfunc2) ENDDO ! ! Debug ! IF(debug)THEN CALL MatrixOut(overlap,nsfunc2,nsfunc2,'Overlap-read', 'overlap',Blank, Blank,.false., Blank, .false.) ENDIF ! ! Complete the overlap ! IF(nsfunc2<n)THEN DO i=nsfunc2+1,n DO j=nsfunc2+1,n overlap(i,j) = 0d0 IF(i==j) overlap(i,j) = 1d0 ENDDO ENDDO ENDIF ! ! Close file for last CALL ! IF(nrho2==nrho) CLOSE(overlap_unit) RETURN ENDSUBROUTINE Read_Overlap