AMPTInterface/src/main.f

0001 c.....driver program for A Multi-Phase Transport model
0002       SUBROUTINE AMPT(FRAME0,BMIN,BMAX)
0003 c
0004       double precision xmp, xmu, alpha, rscut2, cutof2, dshadow
0005       double precision smearp,smearh,dpcoal,drcoal,ecritl
0006 cgsfs added following line to match C++ call
0007       double precision BMIN, BMAX
0008       integer K
0009 c     CHARACTER*(*) FRAME0
0010 c     CHARACTER FRAME0*8
0011       CHARACTER*(*) FRAME0
0012       CHARACTER FRAME*8
0013 cgsfs  added to match specification in AMPTSET
0014       character*25 amptvn
0015
0016       COMMON/HMAIN1/EATT,JATT,NATT,NT,NP,N0,N01,N10,N11
0017       COMMON /HPARNT/HIPR1(100), IHPR2(50), HINT1(100), IHNT2(50)
0018       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0019       COMMON /ARPRNT/ ARPAR1(100), IAPAR2(50),CARINT1(100), IAINT2(50)
0020       COMMON /AROUT/ IOUT
0021       COMMON /AREVT/ IAEVT, IARUN, MISS
0022       COMMON /smearz/smearp,smearh
0023       COMMON/RNDF77/NSEED
0024       common/anim/nevent,isoft,isflag,izpc
0025 c     parton coalescence radii in case of string melting:
0026       common/coal/dpcoal,drcoal,ecritl
0027       common/snn/efrm,npart1,npart2,epsiPz,epsiPt,PZPROJ,PZTARG
0028 c initialization value for parton cascade:
0029       common /para2/xmp,xmu,alpha,rscut2,cutof2
0030       common/para7/ioscar,nsmbbbar,nsmmeson
0031       common/para8/idpert,npertd,idxsec
0032       common/rndm3/iseedp
0033 c initialization value for hadron cascade:
0034       COMMON /RUN/ NUM
0035       common/input1/MASSPR,MASSTA,ISEED,IAVOID,DT
0036       COMMON/INPUT2/ILAB,MANYB,NTMAX,ICOLL,INSYS,IPOT,MODE,
0037      &   IMOMEN,NFREQ,ICFLOW,ICRHO,ICOU,KPOTEN,KMUL
0038       common/oscar1/iap,izp,iat,izt
0039       common/oscar2/FRAME,amptvn
0040       common/resdcy/NSAV,iksdcy
0041 clin-6/2009:
0042 c     common/phidcy/iphidcy
0043       common/phidcy/iphidcy,pttrig,ntrig,maxmiss,ipi0dcy
0044       common/embed/iembed,nsembd,pxqembd,pyqembd,xembd,yembd,
0045      1     psembd,tmaxembd,phidecomp
0046       common/cmsflag/dshadow,ishadow
0047 clin-2/2012 allow random orientation of reaction plane:
0048       common /phiHJ/iphirp,phiRP
0049
0050       EXTERNAL HIDATA,PYDATA,LUDATA,ARDATA,PPBDAT,zpcbdt
0051       SAVE
0052 c****************
0053
0054       FRAME=FRAME0
0055       imiss=0
0056 cgsfs This line should not be here, but the value needs to be set for ARINI2
0057 cgsfs      K=K+1
0058       K=1
0059
0060  100  CALL HIJING(FRAME, BMIN, BMAX)
0061       IAINT2(1) = NATT
0062
0063
0064 c     evaluate Npart (from primary NN collisions) for both proj and targ:
0065       call getnp
0066 c     switch for final parton fragmentation:
0067       IF (IHPR2(20) .EQ. 0) GOTO 2000
0068 c     In the unlikely case of no interaction (even after loop of 20 in HIJING),
0069 c     still repeat the event to get an interaction
0070 c     (this may have an additional "trigger" effect):
0071       if(NATT.eq.0) then
0072           imiss=imiss+1
0073           if(imiss.le.20) then
0074             write(6,*) 'repeated event: natt=0,j,imiss=',j,imiss
0075           goto 100
0076           else
0077             write(6,*) 'missed event: natt=0,j=',j
0078             goto 2000
0079           endif
0080       endif
0081 c.....ART initialization and run
0082       CALL ARINI
0083       CALL ARINI2(K)
0084       CALL ARTAN1
0085       CALL HJANA3
0086       CALL ARTMN
0087       CALL HJANA4
0088       CALL ARTAN2
0089
0090  2000 CONTINUE
0091 c
0092 c       CALL ARTOUT(NEVNT)
0093 clin-5/2009 ctest off:
0094 c       call flowh0(NEVNT,2)
0095 c       call flowp(2)
0096 c       call iniflw(NEVNT,2)
0097 c       call frztm(NEVNT,2)
0098 c
0099       RETURN
0100       END
0101
0102       SUBROUTINE AMPTSET(EFRM0,FRAME0,PROJ0,TARG0,IAP0,IZP0,IAT0,IZT0)
0103 c cgsfs added following line to match C++ call
0104       double precision EFRM0
0105       double precision xmp, xmu, alpha, rscut2, cutof2
0106       double precision smearp,smearh,dpcoal,drcoal,ecritl
0107       CHARACTER*(*) FRAME0,PROJ0,TARG0
0108       CHARACTER FRAME*8,PROJ*8,TARG*8
0109       character*25 amptvn
0110       COMMON/HMAIN1/EATT,JATT,NATT,NT,NP,N0,N01,N10,N11
0111       COMMON /HPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
0112       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0113       COMMON/ARPRNT/ARPAR1(100),IAPAR2(50),ARINT1(100),IAINT2(50)
0114       COMMON/AROUT/IOUT
0115       COMMON/AREVT/IAEVT,IARUN,MISS
0116       COMMON/smearz/smearp,smearh
0117       COMMON/RNDF77/NSEED
0118       common/anim/nevent,isoft,isflag,izpc
0119 c parton coalescence radii in case of string melting:
0120       common/coal/dpcoal,drcoal,ecritl
0121       common/snn/efrm,npart1,npart2,epsiPz,epsiPt,PZPROJ,PZTARG
0122 c initialization value for parton cascade:
0123       common/para2/xmp,xmu,alpha,rscut2,cutof2
0124       common/para7/ioscar,nsmbbbar,nsmmeson
0125       common/para8/idpert,npertd,idxsec
0126       common/rndm3/iseedp
0127 c initialization value for hadron cascade:
0128       COMMON/RUN/NUM
0129       common/input1/MASSPR,MASSTA,ISEED,IAVOID,DT
0130       COMMON/INPUT2/ILAB,MANYB,NTMAX,ICOLL,INSYS,IPOT,MODE,
0131      & IMOMEN,NFREQ,ICFLOW,ICRHO,ICOU,KPOTEN,KMUL
0132       common/oscar1/iap,izp,iat,izt
0133       common/oscar2/FRAME,amptvn
0134       common/resdcy/NSAV,iksdcy
0135 clin-6/2009:
0136 c      common/phidcy/iphidcy
0137       common/phidcy/iphidcy,pttrig,ntrig,maxmiss,ipi0dcy
0138       common/embed/iembed,nsembd,pxqembd,pyqembd,xembd,yembd,
0139      1     psembd,tmaxembd,phidecomp
0140       common/popcorn/ipop
0141
0142       EXTERNAL HIDATA,PYDATA, LUDATA,ARDATA,PPBDAT,zpcbdt
0143       SAVE
0144 c****************
0145
0146       EFRM=EFRM0
0147       FRAME=FRAME0
0148       PROJ=PROJ0
0149       TARG=TARG0
0150       IAP=IAP0
0151       IZP=IZP0
0152       IAT=IAT0
0153       IZT=IZT0
0154
0155       if(ipop.eq.1) IHPR2(11)=3
0156
0157 clin-6/2009 ctest off turn on jet triggering:
0158 c      IHPR2(3)=1
0159 c     Trigger Pt of high-pt jets in HIJING:
0160 c      HIPR1(10)=7.
0161 c
0162       if(isoft.eq.1) then
0163          amptvn = '1.26t5 (Default)'
0164       elseif(isoft.eq.4) then
0165          amptvn = '2.26t5 (StringMelting)'
0166       else
0167          amptvn = 'Test-Only'
0168       endif
0169       WRITE(6,50) amptvn
0170       WRITE(12,50) amptvn
0171  50   FORMAT(' '/
0172      &11X,'##################################################'/1X,
0173      &10X,'#      AMPT (A Multi-Phase Transport) model      #'/1X,
0174      &10X,'#          Version ',a25,                  '     #'/1X,
0175      &10X,'#                4/06/2015                       #'/1X,
0176      &10X,'##################################################'/1X,
0177      &10X,' ')
0178
0179 clin-5/2015 an odd number is needed for the random number generator:
0180 c      if(mod(NSEED,2).eq.0) NSEED=NSEED+1
0181       NSEED=2*NSEED+1
0182 c     9/26/03 random number generator for f77 compiler:
0183       CALL SRAND(NSEED)
0184 c
0185 c.....turn on warning messages in nohup.out when an event is repeated:
0186       IHPR2(10) = 1
0187 c     string formation time:
0188       ARPAR1(1) = 0.7
0189 c     smearp is the smearing halfwidth on parton z0,
0190 c     set to 0 for now to avoid overflow in eta.
0191 c     smearh is the smearing halfwidth on string production point z0.
0192       smearp=0d0
0193       IAmax=max(iap,iat)
0194       smearh=1.2d0*IAmax**0.3333d0/(dble(EFRM)/2/0.938d0)
0195       nevent=NEVNT
0196 c
0197       CALL HIJSET(EFRM, FRAME, PROJ, TARG, IAP, IZP, IAT, IZT)
0198       CALL ARTSET
0199       CALL INIZPC
0200
0201       RETURN
0202       END