Conference turris::fortran

1202.0. "another critical routine" by RTOMS::PARETIJ () Wed Feb 26 1997 12:51

it seems the routine below is the critical spot :
it has 7 nested do-loops with the instruction
eden()=eden()+xleft...

being executed 20*20*20*20*64*160*160 times
(or 262.144 billions )

any change from trivial (e.g. get rid of /2.d0 )
to loop-swap should have a large pay-off.

Suggestions are most welcome,

cheers
/Joseph
---------------------------------------------

      SUBROUTINE  CALINT(NLEV,KK,IPAR,JMODE,NRPA)
C
      IMPLICIT REAL*8(A-H,O-Z)
C
      COMMON /SENG/EDEN(325,325,64)
      COMMON /SCIS/ABSCIS(64),WEIGHT(64)
C
      COMMON /XYWINI/XRPA(325,325,30),YRPA(325,325,30),WRPA(325,30)
      COMMON /XYWFIN/XPRPA(325,325,30),YPRPA(325,325,30),WPRPA(325,30)
      COMMON /AMGT/OES(325,325,30),
     &             XLEFT(25,25,325,30),XRIGHT(25,25,325,30)
C
      COMMON /SPNI/NONI(50),LNI(50),JNI(50)
      COMMON /SPNF/NONF(50),LNF(50),JNF(50)
      COMMON /CONF/JM(30),IP(30),IIN1(325,30),IIN2(325,30),NMAX(30),
     &             NM11(30),NM22(30),NM12(30)
      COMMON /OUT/IOUT
C
      DATA PI/3.141592654D0/,XLAMB/850.D0/
C
      JMODE2=2*JMODE
C
      IAB=0
      DO 1 IIA=1,NLEV
      NA=NONI(IIA)
      LA=LNI(IIA)
      JA=JNI(IIA)
C
      DO 2 IIC=1,NLEV
      NC=NONI(IIC)
      LC=LNI(IIC)
      JC=JNI(IIC)
      XPAR=(-1.D0)**(LA+LC)*DFLOAT(IPAR)
      IF(XPAR.LT.0.D0) GOTO 2
      IF(IABS(JA-JC).GT.JMODE2) GOTO 2
      IF(    (JA+JC).LT.JMODE2) GOTO 2
      IAB=IAB+1
C
      ICD=0
            DO 3 IIB=1,NLEV
      NB=NONI(IIB)
      LB=LNI(IIB)
      JB=JNI(IIB)
C
             DO 4 IID=1,NLEV
      ND=NONI(IID)
      LD=LNI(IID)
      JD=JNI(IID)
      XPAR=(-1.D0)**(LB+LD)*DFLOAT(IPAR)
      IF(XPAR.LT.0.D0) GOTO 4
      IF(IABS(JB-JD).GT.JMODE2) GOTO 4
      IF(    (JB+JD).LT.JMODE2) GOTO 4
      ICD=ICD+1
C
C--------   energy loop initial+final -----------
C           containing denominator
C
C
                DO IQ=1,64
      QQ=ABSCIS(IQ)/XLAMB
      FQQ=1.D0/(1.D0+QQ*QQ)**2
      FQQ=FQQ*FQQ*ABSCIS(IQ)*WEIGHT(IQ)
C
      EDEN(IAB,ICD,IQ)=0.D0
      DO IE=1,NRPA
      EINIT=WRPA(IE,KK)
                        DO IEP=1,NRPA
      EFINL=WPRPA(IEP,KK)
      EAVER=(EINIT+EFINL)/2.D0
      EDEN(IAB,ICD,IQ)=EDEN(IAB,ICD,IQ)+
     & XLEFT(IIA,IIC,IEP,KK)*XRIGHT(IIB,IID,IE,KK)*OES(IEP,IE,KK)*
     &                   FQQ/(ABSCIS(IQ)+EAVER)
                        ENDDO
                ENDDO
      EDEN(IAB,ICD,IQ)=EDEN(IAB,ICD,IQ)*2.D0/(197.328*PI)
             ENDDO
C
C----------- end of energy loop ---------------
C
 4    CONTINUE
 3    CONTINUE
 2    CONTINUE
 1    CONTINUE
C
C------------ end loop of ia, ic, ib, id ----------
C
      RETURN
      END