summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.fortran-torture/compile/pr32663.f
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.fortran-torture/compile/pr32663.f
downloadcbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2
cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.xz
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository.
Diffstat (limited to 'gcc/testsuite/gfortran.fortran-torture/compile/pr32663.f')
-rw-r--r--gcc/testsuite/gfortran.fortran-torture/compile/pr32663.f147
1 files changed, 147 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/pr32663.f b/gcc/testsuite/gfortran.fortran-torture/compile/pr32663.f
new file mode 100644
index 000000000..03896adab
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/compile/pr32663.f
@@ -0,0 +1,147 @@
+ SUBROUTINE DIMOID(DEN,RLMO,SSQU,STRI,ATMU,IATM,IWHI,MAPT,INAT,
+ * IATB,L1,L2,M1,M2,NATS,NOSI,NCAT,NSWE)
+C
+ IMPLICIT DOUBLE PRECISION(A-H,O-Z)
+C
+ DIMENSION RLMO(L1,L1),SSQU(L1,L1),STRI(L2),ATMU(NATS),DEN(M2)
+ DIMENSION IATM(NATS,M1),IWHI(M1+NATS),MAPT(M1),INAT(M1+NATS)
+ DIMENSION IATB(NATS,M1)
+C
+ PARAMETER (MXATM=500, MXSH=1000, MXGTOT=5000, MXAO=2047)
+C
+ LOGICAL GOPARR,DSKWRK,MASWRK
+C
+ COMMON /INFOA / NAT,ICH,MUL,NUM,NQMT,NE,NA,NB,
+ * ZAN(MXATM),C(3,MXATM)
+ COMMON /IOFILE/ IR,IW,IP,IJKO,IJKT,IDAF,NAV,IODA(400)
+ COMMON /NSHEL / EX(MXGTOT),CS(MXGTOT),CP(MXGTOT),CD(MXGTOT),
+ * CF(MXGTOT),CG(MXGTOT),
+ * KSTART(MXSH),KATOM(MXSH),KTYPE(MXSH),
+ * KNG(MXSH),KLOC(MXSH),KMIN(MXSH),
+ * KMAX(MXSH),NSHELL
+ COMMON /OPTLOC/ CVGLOC,MAXLOC,IPRTLO,ISYMLO,IFCORE,NOUTA,NOUTB,
+ * MOOUTA(MXAO),MOOUTB(MXAO)
+ COMMON /PAR / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
+ COMMON /RUNLAB/ TITLE(10),A(MXATM),B(MXATM),BFLAB(MXAO)
+C
+C
+ DO 920 II=1,M1
+ INAT(II) = 0
+ 920 CONTINUE
+C
+
+ DO 900 IO = NOUTA+1,NUMLOC
+ IZ = IO - NOUTA
+ DO 895 II=NST,NEND
+ ATMU(II) = 0.0D+00
+ IATM(II,IZ) = 0
+ 895 CONTINUE
+ IFUNC = 0
+ DO 890 ISHELL = 1,NSHELL
+ IAT = KATOM(ISHELL)
+ IST = KMIN(ISHELL)
+ IEN = KMAX(ISHELL)
+ DO 880 INO = IST,IEN
+ IFUNC = IFUNC + 1
+ IF (IAT.LT.NST.OR.IAT.GT.NEND) GOTO 880
+ ZINT = 0.0D+00
+ DO 870 II = 1,L1
+ ZINT = ZINT + RLMO(II,IO)*SSQU(II,IFUNC)
+ 870 CONTINUE
+ ATMU(IAT) = ATMU(IAT) + RLMO(IFUNC,IO)*ZINT
+ 880 CONTINUE
+ 890 CONTINUE
+ IF (MASWRK) WRITE(IW,9010) IZ,(ATMU(II),II=NST,NEND)
+ 900 CONTINUE
+C
+ NOSI = 0
+ DO 700 II=1,M1
+ NO=0
+ DO 720 JJ=1,NAT
+ NO = NO + 1
+ 720 CONTINUE
+ 740 CONTINUE
+ IF (NO.GT.1.OR.NO.EQ.0) THEN
+ NOSI = NOSI + 1
+ IWHI(NOSI) = II
+ ENDIF
+ IF (MASWRK)
+ * WRITE(IW,9030) II,(IATM(J,II),A(IATM(J,II)),J=1,NO)
+ 700 CONTINUE
+C
+ IF (MASWRK) THEN
+ WRITE(IW,9035) NOSI
+ IF (NOSI.GT.0) THEN
+ WRITE(IW,9040) (IWHI(I),I=1,NOSI)
+ WRITE(IW,9040)
+ ELSE
+ WRITE(IW,9040)
+ ENDIF
+ ENDIF
+C
+ CALL DCOPY(L1*L1,RLMO,1,SSQU,1)
+ CALL DCOPY(M2,DEN,1,STRI,1)
+C
+ IP2 = NOUTA
+ IS2 = M1+NOUTA-NOSI
+ DO 695 II=1,NAT
+ INAT(II) = 0
+ 695 CONTINUE
+C
+ DO 690 IAT=1,NAT
+ DO 680 IORB=1,M1
+ IP1 = IORB + NOUTA
+ IF (IATM(1,IORB).NE.IAT) GOTO 680
+ IF (IATM(2,IORB).NE.0) GOTO 680
+ INAT(IAT) = INAT(IAT) + 1
+ IP2 = IP2 + 1
+ CALL DCOPY(L1,SSQU(1,IP1),1,RLMO(1,IP2),1)
+ CALL ICOPY(NAT,IATM(1,IORB),1,IATB(1,IP2-NOUTA),1)
+ MAPT(IORB) = IP2-NOUTA
+ 680 CONTINUE
+ DO 670 IORB=1,NOSI
+ IS1 = IWHI(IORB) + NOUTA
+ IF (IAT.EQ.NAT.AND.IATM(1,IWHI(IORB)).EQ.0) GOTO 675
+ IF (IATM(1,IWHI(IORB)).NE.IAT) GOTO 670
+ 675 CONTINUE
+ IS2 = IS2 + 1
+ MAPT(IWHI(IORB)) = IS2-NOUTA
+ 670 CONTINUE
+ 690 CONTINUE
+C
+ NSWE = 0
+ NCAT = 0
+ LASP = 1
+ NLAST = 0
+ DO 620 II=1,NAT
+ NSWE = NSWE + (IWHI(II)*(IWHI(II)-1))/2
+ NCAT = NCAT + 1
+ INAT(NCAT) = LASP + NLAST
+ LASP = INAT(NCAT)
+ NLAST = IWHI(II)
+ IWHI(NCAT) = II
+ 620 CONTINUE
+C
+ DO 610 II=1,NOSI
+ NCAT = NCAT + 1
+ INAT(NCAT) = LASP + NLAST
+ LASP = INAT(NCAT)
+ NLAST = 1
+ IWHI(NCAT) = 0
+ 610 CONTINUE
+C
+ RETURN
+C
+ 8000 FORMAT(/1X,'** MULLIKEN ATOMIC POPULATIONS FOR EACH NON-FROZEN ',
+ * 'LOCALIZED ORBITAL **')
+ 9000 FORMAT(/3X,'ATOM',2X,100(I2,1X,A4))
+ 9005 FORMAT(1X,'LMO')
+ 9010 FORMAT(1X,I3,3X,100F7.3)
+ 9015 FORMAT(/1X,'** ATOMIC POPULATIONS GREATER THAN ',F4.2,
+ * ' ARE CONSIDERED MAJOR **')
+ 9020 FORMAT(/2X,'LMO',3X,'MAJOR CONTRIBUTIONS FROM ATOM(S)')
+ 9030 FORMAT(2X,I3,2X,100(I2,1X,A2,2X))
+ 9035 FORMAT(/1X,'NO OF LMOS INVOLVING MORE THAN ONE ATOM =',I3)
+ 9040 FORMAT(1X,'THESE ARE LMOS :',100I3)
+C
+ END