| [3] | 1 | SUBROUTINE PIAN2(NU,NT,XROT,XTRA,T) |
|---|
| 2 | C |
|---|
| 3 | C THIS ROUTINE WAS FIRST WRITTEN BY REGIS COURTIN IN 1980 : |
|---|
| 4 | C THE PARAMETERS WERE DETERMINED BY THE MEASUREMENTS OF |
|---|
| 5 | C BUONTEMPO ET AL (1975), JOURNAL OF CHEMICAL PHYSICS 63, 2570. |
|---|
| 6 | C LAST MODIFIED BY REGIS COURTIN (APRIL 23,1986) : |
|---|
| 7 | C THE QUADS1 PARAMETER WAS ADJUSTED TO FIT THE MEASUREMENTS OF |
|---|
| 8 | C DAGG ET AL (1985), CANADIAN JOURNAL OF PHYSICS 63, 625. |
|---|
| 9 | C |
|---|
| 10 | IMPLICIT REAL (A-H,O-Z) |
|---|
| 11 | REAL NU,I8,NSQR,K |
|---|
| 12 | real c |
|---|
| 13 | DIMENSION T(100) |
|---|
| 14 | DIMENSION XROT(100),XTRA(100) |
|---|
| 15 | DIMENSION XJ(32),G(32),E(32),WW(32),CG(32),RHO(100,32), |
|---|
| 16 | $I8(100),QUADS1(100),TAU1(100),TAU2(100),A2(100) |
|---|
| 17 | save ww,a2,pi,c,hck,tau1,tau2,cg,rho,c1,k,asqr,quads1,i8 |
|---|
| 18 | DATA JMAX1/30/,JMAX2/32/,PI/3.141592654/,H/1.05459E-27/, |
|---|
| 19 | $C/2.997925E10/,K/1.38054E-16/,HCK/1.43892/,XNLOS/2.687E19/, |
|---|
| 20 | $ASQR/3.3124/,EPSK/71.4/,PW1/.639/,PW2/.423/, |
|---|
| 21 | $DSDT/-.0204/ |
|---|
| 22 | DO 8 IT=1,NT |
|---|
| 23 | X=4.*EPSK/T(IT) |
|---|
| 24 | I8(IT)=FI8(X) |
|---|
| 25 | 8 CONTINUE |
|---|
| 26 | DO 10 J=1,JMAX2 |
|---|
| 27 | XJ(J)=FLOAT(J-1) |
|---|
| 28 | G(J)=6. |
|---|
| 29 | IF (MOD(J,2).EQ.0) G(J)=3. |
|---|
| 30 | E(J)=AZENER(0.,XJ(J)) |
|---|
| 31 | 10 CONTINUE |
|---|
| 32 | DO 20 J=1,JMAX1 |
|---|
| 33 | CG(J)=1.5*(XJ(J)+1.)*(XJ(J)+2.)/(2.*XJ(J)+3.) |
|---|
| 34 | WW(J)=2.*PI*C*(E(J+2)-E(J)) |
|---|
| 35 | 20 CONTINUE |
|---|
| 36 | NSQR=(XNLOS*1.0E-24)**2 |
|---|
| 37 | C1=4.*PI*PI*NSQR/H/C |
|---|
| 38 | DO 90 IT=1,NT |
|---|
| 39 | QUADS1(IT)=27.72+DSDT*T(IT) |
|---|
| 40 | TAU1(IT)=9.797E-12/(T(IT)**PW1) |
|---|
| 41 | TAU2(IT)=1.518E-12/(T(IT)**PW2) |
|---|
| 42 | SUM=0. |
|---|
| 43 | DO 50 J=1,JMAX2 |
|---|
| 44 | ARG=HCK*E(J)/T(IT) |
|---|
| 45 | RHO(IT,J)=EXP(-ARG) |
|---|
| 46 | SUM=SUM+(2.*XJ(J)+1.)*G(J)*RHO(IT,J) |
|---|
| 47 | 50 CONTINUE |
|---|
| 48 | DO 55 J=1,JMAX2 |
|---|
| 49 | RHO(IT,J)=G(J)*RHO(IT,J)/SUM |
|---|
| 50 | 55 CONTINUE |
|---|
| 51 | A2(IT)=0. |
|---|
| 52 | DO 60 J=1,JMAX1 |
|---|
| 53 | A2(IT)=A2(IT)+XJ(J)*(XJ(J)+1.)*(2.*XJ(J)+1.)*RHO(IT,J)/ |
|---|
| 54 | $ ((2.*XJ(J)-1.)*(2.*XJ(J)+3.)) |
|---|
| 55 | 60 CONTINUE |
|---|
| 56 | 90 CONTINUE |
|---|
| 57 | c print*,'A2 dans pia...',a2 |
|---|
| 58 | c print*,'var dans pia...', |
|---|
| 59 | c s pi,c,hck,tau1,tau2,cg,rho,c1,k,asqr,quads1,i8 |
|---|
| 60 | |
|---|
| 61 | RETURN |
|---|
| 62 | c!!!! ENTRY OPAN2(NU,NT,XROT,XTRA) |
|---|
| 63 | ENTRY OPAN2(NU,NT,XROT,XTRA,T) |
|---|
| 64 | c print*,'A2 dans opa...',a2 |
|---|
| 65 | c print*,'var dans opa...', |
|---|
| 66 | c s pi,c,hck,tau1,tau2,cg,rho,c1,k,asqr,quads1,i8 |
|---|
| 67 | W=2.*PI*C*NU |
|---|
| 68 | DO 200 IT=1,NT |
|---|
| 69 | CZ=HCK*NU/T(IT) |
|---|
| 70 | CW=W*(1.-EXP(-CZ)) |
|---|
| 71 | XTRA(IT)=A2(IT)*GAMMB(W,T(IT),TAU1(IT),TAU2(IT)) |
|---|
| 72 | XROT(IT)=0. |
|---|
| 73 | DO 125 J=1,JMAX1 |
|---|
| 74 | XROT(IT)=XROT(IT)+CG(J)* |
|---|
| 75 | $(RHO(IT,J )*GAMMB(W-WW(J),T(IT),TAU1(IT),TAU2(IT)) |
|---|
| 76 | $+RHO(IT,J+2)*GAMMB(W+WW(J),T(IT),TAU1(IT),TAU2(IT))) |
|---|
| 77 | 125 CONTINUE |
|---|
| 78 | COEF=CW*C1*K*ASQR*QUADS1(IT)*I8(IT) |
|---|
| 79 | XROT(IT)=XROT(IT)*COEF |
|---|
| 80 | XTRA(IT)=XTRA(IT)*COEF |
|---|
| 81 | 200 CONTINUE |
|---|
| 82 | RETURN |
|---|
| 83 | END |
|---|
