From e156da237d90dec92c4d948f55814f80495d855e Mon Sep 17 00:00:00 2001 From: scott snyder Date: Mon, 21 Mar 2022 15:39:40 +0100 Subject: [PATCH] Hijing_i: Fix fortran compilation warnings. Fix warnings related to deprecated do-loop constructions. --- .../Hijing_i/src/Hijing_modified/aran9.f | 5 +- .../Hijing_i/src/Hijing_modified/attrad.f | 13 ++-- .../Hijing_i/src/Hijing_modified/hijfrg.f | 6 +- .../Hijing_i/src/Hijing_modified/hijing.f | 25 +++--- .../Hijing_i/src/Hijing_modified/quench.f | 30 ++++--- .../Hijing_i/src/Hijing_modified/vegas.f | 78 +++++++++++-------- 6 files changed, 93 insertions(+), 64 deletions(-) diff --git a/Generators/Hijing_i/src/Hijing_modified/aran9.f b/Generators/Hijing_i/src/Hijing_modified/aran9.f index 6be705e0388..b53a0e6e67d 100644 --- a/Generators/Hijing_i/src/Hijing_modified/aran9.f +++ b/Generators/Hijing_i/src/Hijing_modified/aran9.f @@ -3,7 +3,8 @@ C SUBROUTINE ARAN9(QRAN,NDIM) DIMENSION QRAN(10) COMMON/SEEDVAX/NUM1 - DO 1 I=1,NDIM - 1 QRAN(I)=ATL_RAN(NUM1) + DO I=1,NDIM + QRAN(I)=ATL_RAN(NUM1) + enddo RETURN END diff --git a/Generators/Hijing_i/src/Hijing_modified/attrad.f b/Generators/Hijing_i/src/Hijing_modified/attrad.f index 65f1a9bd00e..70dbdcf05ef 100644 --- a/Generators/Hijing_i/src/Hijing_modified/attrad.f +++ b/Generators/Hijing_i/src/Hijing_modified/attrad.f @@ -43,15 +43,16 @@ C.....SM IS THE LARGEST MASS-SQUARED.... C.....MAKE PLACE FOR ONE GLUON..... IF(JL+1.EQ.N) GOTO 190 - DO 160 J=N,JL+2,-1 + DO J=N,JL+2,-1 K(J+1,1)=K(J,1) - K(J+1,2)=K(J,2) - DO 150 M=1,5 + K(J+1,2)=K(J,2) + DO M=1,5 C+++BAC - V(J+1,M) = V(J,M) + V(J+1,M) = V(J,M) C---BAC -150 P(J+1,M)=P(J,M) -160 CONTINUE + P(J+1,M)=P(J,M) + enddo + enddo 190 N=N+1 C.....BOOST TO REST SYSTEM FOR PARTICLES JL AND JL+1..... diff --git a/Generators/Hijing_i/src/Hijing_modified/hijfrg.f b/Generators/Hijing_i/src/Hijing_modified/hijfrg.f index 6b88bd7847a..4f06b9bf12b 100644 --- a/Generators/Hijing_i/src/Hijing_modified/hijfrg.f +++ b/Generators/Hijing_i/src/Hijing_modified/hijfrg.f @@ -212,11 +212,12 @@ C ********sort jets in order of y IF((ABS(KF1).GT.1000.AND.KF1.LT.0) & .OR.(ABS(KF1).LT.1000.AND.KF1.GT.0)) IEX=1 DO 520 I=N,2,-1 - DO 520 J=1,5 + DO J=1,5 II=NPJ(JTP)+I K(II,J)=K(I,J) P(II,J)=P(I,J) V(II,J)=V(I,J) + enddo 520 CONTINUE DO 540 I=1,NPJ(JTP) DO 542 J=1,5 @@ -246,11 +247,12 @@ C ********sort jets in order of y IF((ABS(KF2).GT.1000.AND.KF2.LT.0) & .OR.(ABS(KF2).LT.1000.AND.KF2.GT.0)) IEX=0 DO 560 I=N,2,-1 - DO 560 J=1,5 + DO J=1,5 II=NTJ(JTP)+I K(II,J)=K(I,J) P(II,J)=P(I,J) V(II,J)=V(I,J) + enddo 560 CONTINUE DO 580 I=1,NTJ(JTP) DO 582 J=1,5 diff --git a/Generators/Hijing_i/src/Hijing_modified/hijing.f b/Generators/Hijing_i/src/Hijing_modified/hijing.f index e553d90014e..824eb2e5ed7 100644 --- a/Generators/Hijing_i/src/Hijing_modified/hijing.f +++ b/Generators/Hijing_i/src/Hijing_modified/hijing.f @@ -309,8 +309,8 @@ c******************************* endif c******************************** DO 12 I=1,IHNT2(1)-1 - DO 12 J=I+1,IHNT2(1) - IF(YP(3,I).GT.YP(3,J)) GO TO 12 + DO 13 J=I+1,IHNT2(1) + IF(YP(3,I).GT.YP(3,J)) GO TO 13 Y1=YP(1,I) Y2=YP(2,I) Y3=YP(3,I) @@ -320,6 +320,7 @@ c******************************** YP(1,J)=Y1 YP(2,J)=Y2 YP(3,J)=Y3 +13 continue 12 CONTINUE C C****************************** @@ -366,8 +367,8 @@ c********************************** endif c********************************* DO 22 I=1,IHNT2(3)-1 - DO 22 J=I+1,IHNT2(3) - IF(YT(3,I).LT.YT(3,J)) GO TO 22 + DO 23 J=I+1,IHNT2(3) + IF(YT(3,I).LT.YT(3,J)) GO TO 23 Y1=YT(1,I) Y2=YT(2,I) Y3=YT(3,I) @@ -377,6 +378,7 @@ c********************************* YT(1,J)=Y1 YT(2,J)=Y2 YT(3,J)=Y3 +23 continue 22 CONTINUE C******************** 24 MISS=-1 @@ -418,7 +420,7 @@ C HINT1(20)=PHI C DO 70 JP=1,IHNT2(1) - DO 70 JT=1,IHNT2(3) + DO 71 JT=1,IHNT2(3) SCIP(JP,JT)=-1.0 B2=(YP(1,JP)+BBX-YT(1,JT))**2+(YP(2,JP)+BBY-YT(2,JT))**2 R2=B2*HIPR1(40)/HIPR1(31)/0.1 @@ -437,7 +439,7 @@ C ********mb=0.1*fm, YP is in fm,HIPR1(31) is in mb & (IHNT2(1).EQ.1.AND.IHNT2(3).EQ.1)) THEN GS=1.0-EXP(-(HIPR1(30)+HINT1(18))*ROMG(R2)/HIPR1(31)) RANTOT=ATL_RAN(NSEED) - IF(RANTOT.GT.GS) GO TO 70 + IF(RANTOT.GT.GS) GO TO 71 GO TO 65 ENDIF GSTOT_0=2.0*(1.0-EXP(-(HIPR1(30)+HINT1(18)) @@ -446,7 +448,7 @@ C ********mb=0.1*fm, YP is in fm,HIPR1(31) is in mb GS=1.0-EXP(-(HIPR1(30)+HINT1(18))/HIPR1(31)*ROMG(R2)) GSTOT=2.0*(1.0-SQRT(1.0-GS)) RANTOT=ATL_RAN(NSEED)*GSTOT_0 - IF(RANTOT.GT.GSTOT) GO TO 70 + IF(RANTOT.GT.GSTOT) GO TO 71 IF(RANTOT.GT.GS) THEN CALL HIJCSC(JP,JT) GO TO 70 @@ -458,6 +460,7 @@ C ********perform elastic collisions NCOLT=NCOLT+1 IPCOL(NCOLT)=JP ITCOL(NCOLT)=JT +71 continue 70 CONTINUE C ********total number interactions proj and targ has C suffered @@ -488,8 +491,8 @@ C ********Specifying the location of the hard and C minijet if they are enforced by user C DO 200 JP=1,IHNT2(1) - DO 200 JT=1,IHNT2(3) - IF(SCIP(JP,JT).EQ.-1.0) GO TO 200 + DO 205 JT=1,IHNT2(3) + IF(SCIP(JP,JT).EQ.-1.0) GO TO 205 NFP(JP,11)=NFP(JP,11)+1 NFT(JT,11)=NFT(JT,11)+1 IF(NFP(JP,5).LE.1 .AND. NFT(JT,5).GT.1) THEN @@ -619,6 +622,7 @@ C C ********conduct soft scattering between JP and JT JATT=JATT+JOUT +205 continue 200 CONTINUE c c************************** @@ -789,7 +793,7 @@ C JTP(1)=IHNT2(1) JTP(2)=IHNT2(3) DO 400 NTP=1,2 - DO 400 J_JTP=1,JTP(NTP) + DO 401 J_JTP=1,JTP(NTP) CALL HIJFRG(J_JTP,NTP,IERROR) IF(MSTU(24).NE.0 .OR. IERROR.GT.0) THEN MSTU(24)=0 @@ -910,6 +914,7 @@ C---BAC VATT(NATT,4)=V(I,4) 390 CONTINUE +401 continue 400 CONTINUE C ********Fragment the q-qq related string systems ENDIF diff --git a/Generators/Hijing_i/src/Hijing_modified/quench.f b/Generators/Hijing_i/src/Hijing_modified/quench.f index 0376fef64ec..789a9e42ee6 100644 --- a/Generators/Hijing_i/src/Hijing_modified/quench.f +++ b/Generators/Hijing_i/src/Hijing_modified/quench.f @@ -62,14 +62,15 @@ C******* find the wounded proj which can interact with jet*** 100 CONTINUE C******* rearrange according decending rd************ DO 110 I2=1,KP-1 - DO 110 J2=I2+1,KP - IF(RDP(I2).LT.RDP(J2)) GO TO 110 + DO 111 J2=I2+1,KP + IF(RDP(I2).LT.RDP(J2)) GO TO 111 RD=RDP(I2) LQ=LQP(I2) RDP(I2)=RDP(J2) LQP(I2)=LQP(J2) RDP(J2)=RD LQP(J2)=LQ + 111 continue 110 CONTINUE C****** find wounded targ which can interact with jet******** KT=0 @@ -89,14 +90,15 @@ C****** find wounded targ which can interact with jet******** 120 CONTINUE C******* rearrange according decending rd************ DO 130 I2=1,KT-1 - DO 130 J2=I2+1,KT - IF(RDT(I2).LT.RDT(J2)) GO TO 130 + DO 131 J2=I2+1,KT + IF(RDT(I2).LT.RDT(J2)) GO TO 131 RD=RDT(I2) LQ=LQT(I2) RDT(I2)=RDT(J2) LQT(I2)=LQT(J2) RDT(J2)=RD LQT(J2)=LQ + 131 continue 130 CONTINUE MP=0 @@ -230,14 +232,15 @@ C******* find the wounded proj which can interact with jet*** 500 CONTINUE C******* rearrange according to decending rd************ DO 510 I2=1,KP-1 - DO 510 J2=I2+1,KP - IF(RDP(I2).LT.RDP(J2)) GO TO 510 + DO 511 J2=I2+1,KP + IF(RDP(I2).LT.RDP(J2)) GO TO 511 RD=RDP(I2) LQ=LQP(I2) RDP(I2)=RDP(J2) LQP(I2)=LQP(J2) RDP(J2)=RD LQP(J2)=LQ + 511 continue 510 CONTINUE C****** find wounded targ which can interact with jet******** KT=0 @@ -257,14 +260,15 @@ C****** find wounded targ which can interact with jet******** 520 CONTINUE C******* rearrange according to decending rd************ DO 530 I2=1,KT-1 - DO 530 J2=I2+1,KT - IF(RDT(I2).LT.RDT(J2)) GO TO 530 + DO 531 J2=I2+1,KT + IF(RDT(I2).LT.RDT(J2)) GO TO 531 RD=RDT(I2) LQ=LQT(I2) RDT(I2)=RDT(J2) LQT(I2)=LQT(J2) RDT(J2)=RD LQT(J2)=LQ + 531 continue 530 CONTINUE MP=0 @@ -400,14 +404,15 @@ C 2500 CONTINUE C******* rearrange according to decending rd************ DO 2510 I2=1,KP-1 - DO 2510 J2=I2+1,KP - IF(RDP(I2).LT.RDP(J2)) GO TO 2510 + DO 2511 J2=I2+1,KP + IF(RDP(I2).LT.RDP(J2)) GO TO 2511 RD=RDP(I2) LQ=LQP(I2) RDP(I2)=RDP(J2) LQP(I2)=LQP(J2) RDP(J2)=RD LQP(J2)=LQ + 2511 continue 2510 CONTINUE C****** find wounded targ which can interact with jet******** KT=0 @@ -427,14 +432,15 @@ C****** find wounded targ which can interact with jet******** 2520 CONTINUE C******* rearrange according to decending rd************ DO 2530 I2=1,KT-1 - DO 2530 J2=I2+1,KT - IF(RDT(I2).LT.RDT(J2)) GO TO 2530 + DO 2531 J2=I2+1,KT + IF(RDT(I2).LT.RDT(J2)) GO TO 2531 RD=RDT(I2) LQ=LQT(I2) RDT(I2)=RDT(J2) LQT(I2)=LQT(J2) RDT(J2)=RD LQT(J2)=LQ + 2531 continue 2530 CONTINUE MP=0 diff --git a/Generators/Hijing_i/src/Hijing_modified/vegas.f b/Generators/Hijing_i/src/Hijing_modified/vegas.f index 1ecb0463738..2938aca1ff5 100644 --- a/Generators/Hijing_i/src/Hijing_modified/vegas.f +++ b/Generators/Hijing_i/src/Hijing_modified/vegas.f @@ -27,8 +27,9 @@ C C NDO=1 - DO 1 J=1,NDIM -1 XI(1,J)=ONE + DO J=1,NDIM + XI(1,J)=ONE + enddo C ENTRY VEGAS1(FXN,AVGI,SD,CHI2A) C - INITIALIZES CUMMULATIVE VARIABLES, BUT NOT GRID @@ -60,10 +61,11 @@ C - NO INITIALIZATION NDM=ND-1 DXG=DXG*XND XJAC=ONE/CALLS - DO 3 J=1,NDIM + DO J=1,NDIM c***this is the line 50 - DX(J)=XU(J)-XL(J) -3 XJAC=XJAC*DX(J) + DX(J)=XU(J)-XL(J) + XJAC=XJAC*DX(J) + enddo C C REBIN PRESERVING BIN DENSITY C @@ -83,9 +85,11 @@ C DR=DR-RC XIN(I)=XN-(XN-XO)*DR IF(I.LT.NDM) GO TO 5 - DO 6 I=1,NDM -6 XI(I,J)=XIN(I) -7 XI(ND,J)=ONE + DO I=1,NDM + XI(I,J)=XIN(I) + enddo + XI(ND,J)=ONE +7 continue NDO=ND C 8 CONTINUE @@ -97,11 +101,13 @@ C - MAIN INTEGRATION LOOP 9 IT=IT+1 TI=0. TSI=TI - DO 10 J=1,NDIM - KG(J)=1 - DO 10 I=1,ND - D(I,J)=TI -10 DI(I,J)=TI + DO J=1,NDIM + KG(J)=1 + DO I=1,ND + D(I,J)=TI + DI(I,J)=TI + enddo + enddo C 11 FB=0. F2B=FB @@ -128,18 +134,20 @@ C F2=F*F FB=FB+F F2B=F2B+F2 - DO 16 J=1,NDIM - DI(IA(J),J)=DI(IA(J),J)+F -16 IF(MDS.GE.0) D(IA(J),J)=D(IA(J),J)+F2 + DO J=1,NDIM + DI(IA(J),J)=DI(IA(J),J)+F + IF(MDS.GE.0) D(IA(J),J)=D(IA(J),J)+F2 + enddo IF(K.LT.NPG) GO TO 12 C F2B=DSQRT(F2B*NPG) F2B=(F2B-FB)*(F2B+FB) TI=TI+FB TSI=TSI+F2B - IF(MDS.GE.0) GO TO 18 - DO 17 J=1,NDIM -17 D(IA(J),J)=D(IA(J),J)+F2B + IF(MS.GE.0) GO TO 18 + DO J=1,NDIM + D(IA(J),J)=D(IA(J),J)+F2B + enddo 18 K=NDIM 19 KG(K)=MOD(KG(K),NG)+1 IF(KG(K).NE.1) GO TO 11 @@ -166,8 +174,9 @@ C****this is the line 150 TSI=DSQRT(TSI) WRITE(16,201) IT,TI,TSI,AVGI,SD,CHI2A IF(NPRN.GE.0) GO TO 21 - DO 20 J=1,NDIM -20 WRITE(16,202) J,(XI(I,J),DI(I,J),D(I,J),I=1,ND) + DO J=1,NDIM + WRITE(16,202) J,(XI(I,J),DI(I,J),D(I,J),I=1,ND) + enddo C C REFINE GRID C @@ -176,14 +185,16 @@ C XN=D(2,J) D(1,J)=(XO+XN)/2. DT(J)=D(1,J) - DO 22 I=2,NDM - D(I,J)=XO+XN - XO=XN - XN=D(I+1,J) - D(I,J)=(D(I,J)+XN)/3. -22 DT(J)=DT(J)+D(I,J) + DO I=2,NDM + D(I,J)=XO+XN + XO=XN + XN=D(I+1,J) + D(I,J)=(D(I,J)+XN)/3. + DT(J)=DT(J)+D(I,J) + enddo D(ND,J)=(XN+XO)/2. -23 DT(J)=DT(J)+D(ND,J) + DT(J)=DT(J)+D(ND,J) +23 continue C DO 28 J=1,NDIM RC=0. @@ -203,7 +214,8 @@ C1114 FORMAT(1X,'**************END NOTICE*************') IF(D(I,J).LE.1.0D-18) GO TO 24 XO=DT(J)/D(I,J) R(I)=((XO-ONE)/XO/DLOG(XO))**ALPH -24 RC=RC+R(I) + RC=RC+R(I) +24 continue RC=RC/XND K=0 XN=0. @@ -219,9 +231,11 @@ c****this is the line 200 DR=DR-RC XIN(I)=XN-(XN-XO)*DR/(R(K)+1.0d-30) IF(I.LT.NDM) GO TO 26 - DO 27 I=1,NDM -27 XI(I,J)=XIN(I) -28 XI(ND,J)=ONE + DO I=1,NDM + XI(I,J)=XIN(I) + enddo + XI(ND,J)=ONE +28 continue C IF(IT.LT.ITMX.AND.ACC*DABS(AVGI).LT.SD) GO TO 9 200 FORMAT('0INPUT PARAMETERS FOR VEGAS: NDIM=',I3,' NCALL=',F8.0 -- GitLab