From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001
From: upstream source tree <ports@midipix.org>
Date: Sun, 15 Mar 2015 20:14:05 -0400
Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; 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.
---
 .../gfortran.fortran-torture/compile/pr32663.f     | 147 +++++++++++++++++++++
 1 file changed, 147 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.fortran-torture/compile/pr32663.f

(limited to 'gcc/testsuite/gfortran.fortran-torture/compile/pr32663.f')

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
-- 
cgit v1.2.3