[CPMD-list] crash of parallel CP slab calculations with Vanderbilt PPs

Juerg Hutter hutter at pci.unizh.ch
Sat Aug 24 15:07:05 CEST 2002


Dear Martin

I'm not sure that this will help, but attached is a
new version of the file noforce.F that fixes a
scratch space bug.
After changing this file I was able to run an input
similar to yours.

Juerg

----------------------------------------------------------
Juerg Hutter                   Phone : ++41 1 635 4491
Physical Chemistry Institute   FAX   : ++41 1 635 6838
University of Zurich           E-mail: hutter at pci.unizh.ch
Winterthurerstrasse 190
CH-8057 Zurich, Switzerland
----------------------------------------------------------


-------------- next part --------------
C     ==================================================================
      SUBROUTINE NOFORCE(C0,C2,SC0,TAU0,FION,EIGV,
     &                   RHOE,PSI,XMAT1,XMAT2,SCR,LSCR,NSTATE,TFOR)
C     ==--------------------------------------------------------------==
C     ==          COMPUTES FOR  A SET OF NONORTHOGONAL ORBITALS       ==
C     ==                     THE TOTAL ENERGY                         ==
C     ==                  THE ELECTRONIC FORCES                       ==
C     ==                  THE FORCES ON THE IONS                      ==
C     ==--------------------------------------------------------------==
      IMPLICIT NONE
      INCLUDE 'system.h'
      INCLUDE 'elct.inc'
      INCLUDE 'norm.inc'
      INCLUDE 'pslo.inc'
      INCLUDE 'ropt.inc'
      INCLUDE 'cppt.inc'
      INCLUDE 'nlps.inc'
      INCLUDE 'sfac.inc'
      INCLUDE 'ions.inc'
      INCLUDE 'nort.inc'
      INCLUDE 'cvan.inc'
      INCLUDE 'spin.inc'
      INCLUDE 'geq0.inc'
C     Arguments
      INTEGER    NSTATE,LSCR
      COMPLEX*16 C0(NGW,*),C2(NGW,*),SC0(NGW,*),PSI(NNR1)
      REAL*8     TAU0(*),FION(*),EIGV(*),RHOE(NNR1),SCR(LSCR)
      LOGICAL    TFOR
      REAL*8  XMAT1(NSTATE,NSTATE),XMAT2(NSTATE,NSTATE)
C     Variables
      REAL*8     GAM(NSTATE,NSTATE),AUXC(*),SMAT(NSTATE*NSTATE)
      REAL*8     DDIA(*)
      POINTER    (IP_GAM,GAM),(IP_AUXC,AUXC),(IP_SMAT,SMAT)
      POINTER    (IP_DDIA,DDIA)
      DIMENSION  F(NSTATE)
      CHARACTER  TAG*30
      REAL*8     FNL(NAT,NHXS,NSTATE),DFNL(*),
     &           DOTP
      INTEGER    ISUB,I,IJ,J,IABS,IERR,
     &           IL_GAM,IL_AUXC,IL_SMAT,IL_DDIA,LNOFORCE,
     &           IZAMAX,
     &           ICON
      DATA       ICON /0/
      SAVE       ICON
#ifdef PARALLEL
      INTEGER    MSGLEN
#endif
#ifdef POINTER8
      INTEGER*8  GET_ADDR
#else
      INTEGER    GET_ADDR
#endif
C     ==--------------------------------------------------------------==
      CALL TISET('   NOFORCE',ISUB)
      IF(IMAGP.EQ.2) CALL STOPGM('NOFORCE','K-POINT NOT IMPLEMENTED')
C     ==--------------------------------------------------------------==
C     SCR partition
      CALL GIVE_SCR_NLFORCE(IL_GAM,IL_AUXC,IL_SMAT,NSTATE)
      IF(PRTEIG.AND.PARENT) THEN
        IL_AUXC=MAX(IL_AUXC,NSTATE*(NSTATE+1)/2+3*NSTATE) !REIGS
      ENDIF
      IL_AUXC=MAX(IL_AUXC,NSTATE*NSTATE) !NOFORCE
      IL_SMAT=MAX(IL_SMAT,NSTATE*NSTATE) !NOFORCE
      IL_DDIA=2*NAX
      CALL GIVE_SCR_NOFORCE(LNOFORCE,TAG,NSTATE,TFOR)
      LNOFORCE=MAX(LNOFORCE,IL_GAM+IL_AUXC+IL_SMAT+IL_DDIA)
      CALL TEST_SCR('NOFORCE','LENGTH',LSCR,LNOFORCE)
      IP_GAM =GET_ADDR(SCR(1))
      IP_AUXC=GET_ADDR(SCR(1+IL_GAM))
      IP_SMAT=GET_ADDR(SCR(1+IL_GAM+IL_AUXC))
      IP_DDIA=GET_ADDR(SCR(1+IL_GAM+IL_AUXC+IL_SMAT))
C     ==--------------------------------------------------------------==
      IF(GEQ0) CALL ZCLEAN(C0,NSTATE,NGW)
      GNMAX=0.0D0
      GNORM=0.0D0
      IF(TIVAN) CALL RNLSM(C0,NSTATE,PSI,SCR,LSCR,1,1,.FALSE.)
C     ==--------------------------------------------------------------==
C     ==   OVERLAP MATRIX                                             ==
C     ==--------------------------------------------------------------==
      CALL CSMAT(GAM,C0,FNL,NSTATE,1)
#ifdef PARALLEL
      CALL SUMMAT(GAM,NSTATE,AUXC,IL_AUXC)
#endif
C     ==--------------------------------------------------------------==
C     ==   CALCULATE S**(-1/2)                                        ==
C     ==--------------------------------------------------------------==
      IF(PARENT) THEN
        CALL DGEMM('N','N',NSTATE,NSTATE,NSTATE,1.0D0,GAM(1,1),NSTATE,
     *             XMAT1(1,1),NSTATE,0.0D0,XMAT2(1,1),NSTATE)
        CALL DGEMM('T','N',NSTATE,NSTATE,NSTATE,1.0D0,XMAT1(1,1),NSTATE,
     *             XMAT2(1,1),NSTATE,0.0D0,GAM(1,1),NSTATE)
        CALL JACOBI(NSTATE,NSTATE,GAM,EIGV,XMAT2,IERR)
        CALL DGEMM('N','N',NSTATE,NSTATE,NSTATE,1.0D0,XMAT1(1,1),NSTATE,
     *             XMAT2(1,1),NSTATE,0.0D0,SMAT(1),NSTATE)
        CALL DCOPY(NSTATE*NSTATE,SMAT(1),1,XMAT1(1,1),1)
        ICON=ICON+1
        DO I=1,NSTATE
          EIGV(I)=1.0D0/DSQRT(EIGV(I))
        ENDDO
        IJ=0
        DO I=1,NSTATE
          DO J=1,NSTATE
            IJ=IJ+1
            AUXC(IJ)=EIGV(I)*SMAT(IJ)
          ENDDO
        ENDDO
        CALL DGEMM('N','T',NSTATE,NSTATE,NSTATE,1.0D0,AUXC(1),NSTATE,
     *             SMAT(1),NSTATE,0.0D0,GAM(1,1),NSTATE)
        CALL DCOPY(NSTATE*NSTATE,GAM(1,1),1,SMAT(1),1)
        CALL DCOPY(NSTATE*NSTATE,SMAT(1),1,XMAT2(1,1),1)
      ENDIF
#ifdef PARALLEL
      MSGLEN = NSTATE*NSTATE * 8
      CALL MY_BCAST(SMAT,MSGLEN,SOURCE,ALLGRP)
#endif
C     ==--------------------------------------------------------------==
C     ==   SYMMETRIC ORTHOGONALIZATION  SC0 = S**(-1/2)*C0            ==
C     ==--------------------------------------------------------------==
      CALL ROTATE(1.0D0,C0,0.0D0,SC0,SMAT,NSTATE,2*NGW,TLSD,NSUP,NSDOWN)
C     ==--------------------------------------------------------------==
C     ==   CALCULATE THE POTENTIAL AND THE FORCE ON THE IONS          ==
C     ==--------------------------------------------------------------==
      CALL RNLSM(SC0,NSTATE,PSI,SCR,LSCR,1,1,TFOR)
      CALL RSCPOT(SC0,TAU0,FION,RHOE,PSI,SCR,LSCR,
     &            TFOR,CALSTE,NSTATE,1)
C     ==--------------------------------------------------------------==
C     ==   CALCULATE THE ELECTRONIC FORCE                             ==
C     ==--------------------------------------------------------------==
      CALL AZZERO(C2,2*NGW*NSTATE)
C     ==--------------------------------------------------------------==
C     == Compute the force on the electronic degrees of freedom due   ==
C     == to the local potential (stored in RHOE)                      ==
C     ==--------------------------------------------------------------==
      CALL VPSI(SC0,C2,F,RHOE,PSI,NSTATE,1,NLSD)
      IF(TIVAN) THEN
        CALL OVLAP(NSTATE,GAM,C2,SC0)
        CALL HNLMAT(GAM,F,NSTATE)
#ifdef PARALLEL
        CALL SUMMAT(GAM,NSTATE,AUXC,IL_AUXC)
#endif
        CALL ROTATE(-1.0D0,SC0,1.0D0,C2,GAM,NSTATE,2*NGW,
     *              TLSD,NSUP,NSDOWN)
        IF(TFOR) CALL RNLFL(FION,GAM,NSTATE,1)
        IF(CALSTE) CALL NLSL(GAM,NSTATE)
        CALL NLFORCE(C2,F,GAM,AUXC,SMAT,NSTATE)
      ELSE
C     ==--------------------------------------------------------------==
C     == Compute the force on the electronic degrees of freedom due   ==
C     == to the non-local part of the potential, and add it to the    ==
C     == other piece, coming from the local contribution.             ==
C     ==--------------------------------------------------------------==
        CALL FNONLOC(C2,F,NSTATE,AUXC,DDIA,1,NLSD)
        CALL OVLAP(NSTATE,GAM,C2,SC0)
#ifdef PARALLEL
        CALL SUMMAT(GAM,NSTATE,AUXC,IL_AUXC)
#endif
C     ==--------------------------------------------------------------==
C     ==   C2(I) = C2(I) - SUM(J) <SC(I) | H | SC(J)> SC(J)           ==
C     ==--------------------------------------------------------------==
        CALL ROTATE(-1.0D0,SC0,1.0D0,C2,GAM,NSTATE,2*NGW,
     *              TLSD,NSUP,NSDOWN)
      ENDIF
      IF(PRTEIG.AND.PARENT) THEN
        CALL DSCAL(NSTATE*NSTATE,-1.0D0,GAM(1,1),1)
        CALL REIGS(NSTATE,GAM,F,AUXC,EIGV,AUXC(3*N+1))
        CALL DSCAL(NSTATE*NSTATE,-1.0D0,GAM(1,1),1)
      ENDIF
C     ==--------------------------------------------------------------==
C     ==   ROTATE ELECTRONIC FORCE BACK INTO NONORTHOGONAL BASIS      ==
C     ==--------------------------------------------------------------==
      IF(PARENT) CALL DCOPY(NSTATE*NSTATE,XMAT2(1,1),1,SMAT(1),1)
#ifdef PARALLEL
      MSGLEN = NSTATE*NSTATE * 8
      CALL MY_BCAST(SMAT,MSGLEN,SOURCE,ALLGRP)
#endif
      CALL ROTATE(1.0D0,C2,0.0D0,SC0,SMAT,NSTATE,2*NGW,TLSD,NSUP,NSDOWN)
      CALL DCOPY(2*NGW*NSTATE,SC0(1,1),1,C2(1,1),1)
C     ==--------------------------------------------------------------==
      GEMAX=0.0D0
      CNORM=0.0D0
      DO I=1,NSTATE
        IABS=IZAMAX(NGW,C2(1,I),1)
        GEMAX=DMAX1(F(I)*CDABS(C2(IABS,I)),GEMAX)
        CNORM=CNORM+F(I)*DOTP(NGW,C2(1,I),C2(1,I))
      ENDDO
#ifdef PARALLEL
      CALL GLOSUM(1,CNORM)
      CALL GLOMAX(1,GEMAX)
#endif
      CNORM=DSQRT(CNORM/(NSTATE*NGWS))
C     ==--------------------------------------------------------------==
      IF(TFOR) THEN
#ifdef PARALLEL
        CALL GLOSUM(3*NAX*NSX,FION)
#endif
        IF(PARENT) THEN
          CALL SYMVEC(FION,SMAT,IL_SMAT)
          CALL TAUCL(FION)
          CALL GSIZE(FION,GNMAX,GNORM)
        ENDIF
      ENDIF
      CALL TIHALT('   NOFORCE',ISUB)
C     ==--------------------------------------------------------------==
      RETURN
      END
C     ==================================================================
      SUBROUTINE GIVE_SCR_NOFORCE(LNOFORCE,TAG,NSTATE,TFOR)
C     ==--------------------------------------------------------------==
      IMPLICIT NONE
      INCLUDE 'system.h'        !PARENT
      INCLUDE 'ropt.inc'        !PRTEIG
C     Arguments
      INTEGER   LNOFORCE,NSTATE
      CHARACTER TAG*30
      LOGICAL   TFOR
C     Variables
      INTEGER   IL_GAM,IL_AUXC,IL_SMAT,IL_DDIA,LRNLSM,LRSCPOT
C     ==--------------------------------------------------------------==
      CALL GIVE_SCR_NLFORCE(IL_GAM,IL_AUXC,IL_SMAT,NSTATE)
      IF(PRTEIG.AND.PARENT) THEN
        IL_AUXC=MAX(IL_AUXC,NSTATE*(NSTATE+1)/2+3*NSTATE) !REIGS
      ENDIF
      IL_AUXC=MAX(IL_AUXC,NSTATE*NSTATE) !NOFORCE
      IL_SMAT=MAX(IL_SMAT,NSTATE*NSTATE) !NOFORCE
      IL_DDIA=2*NAX
      CALL GIVE_SCR_RNLSM(LRNLSM,TAG,NSTATE,TFOR)
      CALL GIVE_SCR_RSCPOT(LRSCPOT,TAG,CALSTE)
      LNOFORCE=MAX(IL_GAM+IL_AUXC+IL_SMAT+IL_DDIA,LRNLSM,LRSCPOT)
C     ==--------------------------------------------------------------==
      RETURN
      END
C     ==================================================================


More information about the CPMD-list mailing list