Three Solutions to MP1
1. A good solution:
c$omp PARALLEL DO
c$omp& PRIVATE(MRS,MQ,MI,MP,MRSPQ,VAL,XRSIQ,MJ,MRSIJ,XIJ)
C
DO 100 MRS=1,NRS
C
DO 10 MQ=1,NQ
DO 10 MI=1,MORB
10 XRSIQ(MI,MQ)=ZERO
DO 40 MP=1,NP
DO 30 MQ=1,MP
C MRSPQ=MRSPQ+1 -> CHANGE THIS INDUCTION VARIABLE
C-------------------------------------------------
C INDUCTION VARIABLE MODIFICATION
C-------------------------------------------------
MRSPQ=(MRS-1)*(NP*(NP+1))/2+(MP*(MP-1))/2+MQ
C
IF(VAL.EQ.ZERO) GO TO 30
DO 20 MI=1,MORB
XRSIQ(MI,MQ)=XRSIQ(MI,MQ)+VAL*V(MP,MI)
XRSIQ(MI,MP)=XRSIQ(MI,MP)+VAL*V(MQ,MI)
20 CONTINUE
30 CONTINUE
40 CONTINUE
C
C MRSIJ=MRSIJ0
DO 90 MI=1,MORB
DO 50 MJ=1,MI
50 XIJ(MJ)=ZERO
DO 70 MQ=1,NQ
VAL=XRSIQ(MI,MQ)
IF(VAL.EQ.ZERO) GO TO 70
DO 60 MJ=1,MI
60 XIJ(MJ)=XIJ(MJ)+VAL*V(MQ,MJ)
70 CONTINUE
DO 80 MJ=1,MI
C---------------------------------------
C INDUCTION VARIABLE MODIFICATION
C---------------------------------------
MRSIJ=(MRS-1)*NRS+(MI*(MI-1))/2+MJ
C
80 XRSIJ(MRSIJ)=XIJ(MJ)
90 CONTINUE
C
C MRSIJ0=MRSIJ0+NRS
100 CONTINUE
C
c$omp END PARALLEL DO
2. A better solution:
MRSPQ0=MRSPQ
C$OMP PARALLEL DO
C$OMP&PRIVATE (MRS,MQ,MI,MP,MJ,MRSPQ,
C$OMP& VAL,XRSIQ,XIJ)
C$OMP&LASTPRIVATE(MRSIJ)
C$OMP&SCHEDULE(DYNAMIC)
DO 100 MRS=1,NRS
C
DO 10 MQ=1,NQ
DO 10 MI=1,MORB
10 XRSIQ(MI,MQ)=ZERO
DO 40 MP=1,NP
DO 30 MQ=1,MP
MRSPQ=NP*(NP+1)/2*(MRS-1)+MP*(MP-1)/2+MQ
VAL=XRSPQ(MRSPQ)
IF(VAL.EQ.ZERO) GO TO 30
DO 20 MI=1,MORB
XRSIQ(MI,MQ)=XRSIQ(MI,MQ)+VAL*V(MP,MI)
XRSIQ(MI,MP)=XRSIQ(MI,MP)+VAL*V(MQ,MI)
20 CONTINUE
30 CONTINUE
40 CONTINUE
C
MRSIJ=MRSIJ0+(MRS-1)*NRS
DO 90 MI=1,MORB
DO 50 MJ=1,MI
50 XIJ(MJ)=ZERO
DO 70 MQ=1,NQ
VAL=XRSIQ(MI,MQ)
IF(VAL.EQ.ZERO) GO TO 70
DO 60 MJ=1,MI
60 XIJ(MJ)=XIJ(MJ)+VAL*V(MQ,MJ)
70 CONTINUE
DO 80 MJ=1,MI
MRSIJ=MRSIJ+1
80 XRSIJ(MRSIJ)=XIJ(MJ)
90 CONTINUE
C
100 CONTINUE
C$OMP END PARALLEL DO
MRSPQ=NP*(NP+1)/2*NRS
MRSIJ0=NRS*NRS+MRSIJ0
3. The best solution:
C$OMP PARALLEL DO
C$OMP& SHARED (XRSIJ)
C$OMP& PRIVATE(XRSIQ,XIJ,MI,MQ,MRS,MRSIJ,MRSPQ,VAL)
C$OMP& SCHEDULE(DYNAMIC)
DO 100 MRS=1,NRS
C
DO 10 MQ=1,NQ
DO 10 MI=1,MORB
10 XRSIQ(MI,MQ)=ZERO
C
C
MRSPQ = (MRS-1)*NRS
DO 40 MP=1,NP
DO 30 MQ=1,MP
MRSPQ=MRSPQ+1
VAL=XRSPQ(MRSPQ)
IF(VAL.EQ.ZERO) GO TO 30
DO 20 MI=1,MORB
XRSIQ(MI,MQ)=XRSIQ(MI,MQ)+VAL*V(MP,MI)
XRSIQ(MI,MP)=XRSIQ(MI,MP)+VAL*V(MQ,MI)
20 CONTINUE
30 CONTINUE
40 CONTINUE
C
MRSIJ=(MRS-1)*NRS
C
DO 90 MI=1,MORB
DO 50 MJ=1,MI
50 XIJ(MJ)=ZERO
C
DO 70 MQ=1,NQ
VAL=XRSIQ(MI,MQ)
IF(VAL.EQ.ZERO) GO TO 70
C
DO 60 MJ=1,MI
60 XIJ(MJ)=XIJ(MJ)+VAL*V(MQ,MJ)
C
70 CONTINUE
C
DO 80 MJ=1,MI
MRSIJ=MRSIJ+1
80 XRSIJ(MRSIJ)=XIJ(MJ)
C
90 CONTINUE
C
100 CONTINUE
C$OMP END PARALLEL DO