Computer Determinant Code
in [Math]
|
Prev: Riemann-Siegel Z function and Lehmer's phenomenon
Next: 【 P = NP Quod Erat Demonstrandum 】の検索結果
From: http://alexslemonade.org on 21 Oct 2009 03:03 n = 200819. 2. 782 therefore increment t s = a * sp + b * sq mod N. where. sp=mdp mod (p) and sq=mdq mod (q) a/b = (rp. m+1. ± sp. m )/(rq. m+1. ± sq. m ) [a, b, s:1] presents a plot of the mod-4 prime race over the interval [a, b] Let it ride: http://meami.org (C) All Rights Reserved. + http://buildasearch.com/meami c=Copywrite(C) 2009. [at] (c) Copyright: http://MEAMI[dot]ORG ! Programma FINALE ! versione risc1 IBM ! versione FINALE nel caso assiale ! versione FINALE nel caso rombico (non funziona in assenza di ZFS) C PARAMAGNETIC ENHANCEMENT IN NMRD PROFILE C C THIS PROGRAM REQUIRES THE INPUT FILE PAR.DAT C 0 BEFORE A PARAMETER MEANS IT HAS TO BE ASSUMED AS CONSTANT C 1 BEFORE A PARAMATER MEANS IT HAS TO BE CHANGED IN THE FITTING C C C INTERNAL FITTING IS PERFORMED IN THE PARAMETERS: C d , Ddiff , RK , A/h , MOLAR FRACTION , TAUM C C SUBROUTINES: C FUNCZFS: SET PARAMETERS IN FITTING PROCEDUREC C FUNCINT: SET PARAMETERS IN INTERNAL FITTING PROCEDURE C DIAG: WRITE ENERGY MATRIX AND CALCULATE EXPECTATION VALUES C POWELL: FITTING PROCEDURE C CONNECTED SUBROUTINES: C LINMIN C F1DIM C MNBRAK C MRENT C XISTEP C POWELLINT: INTERNAL FITTING PROCEDURE C F01BCF....X04BAF: CALCULATE EIGENVALUES AND EIGENFUNCTIONS C GAUINT: PERFORME INTEGRATION ON ANGLES C TUNO: PERFORME CALCULATION OF T1M C TDUE: PERFORME CALCULATION OF T2M C TUNOISO: PERFORME CALCULATION OF T1M IN AXIAL CASE C C THETA AND PHI ARE THE POLAR ANGLES DEFINING THE WATER PROTON DIRECTION C IN THE MOLECULAR FRAME C C BETA AND GAMMA ARE THE EULER ANGLES DEFINING THE MOLECULAR FRAME WITH C RESPECT TO THE HTTP://MEAMI.ORG/ FRAME IMPLICIT REAL*8(A-H,O-Z) PARAMETER(PI2 = 6.2831853, VL = 2.9979D+10) COMMON /SET/SET COMMON /RK10/ SPIN, SI COMMON /GAMMAH/ GAMMAI COMMON /B31/ TPUNO(500) COMMON /B32/ PP(500),Z(500) COMMON /TAUDELTA/ TAUDELTA COMMON /B4/ NVMEM,NPT(10),NPTOT COMMON /WATER/ ACQ COMMON /T1T2/ IREL COMMON /INDEX/ INDEX COMMON /ALFASTEP/ ALFASTEP COMMON /STAMPA/INDEXSTAMPA COMMON /TOT/ DPARATOT,EPARATOT,APARTOT,APERTOT,APERTOT2,ACONIND COMMON/INDA/ INDDPARA(10),INDAPAR(10),INDAPER(10),INDEPARA(10) & ,INDED(10),INDAMOLFRA(10),INDS4(10),INDAPER2(10) COMMON /C1M/DM(10),DDM(10),CONCM(10) COMMON /IPERFM/AZM(10),AYM(10),AXM(10),THETAM(10),RKM(10), & TAUCM(10),DPARAM(10),EPARAM(10),PHIM(10),S4M(10), & GXM(10),GYM(10),GZM(10) COMMON /TAU1M/ TAUS0M(10,10),TAURM(10,10),TAUVM(10,10), & TAUMM(10,10) COMMON /MOLFRAZM/ AMOLFRAM(10) COMMON /CONTATM/ ACONTM(10) COMMON /CICLE/ NVEST COMMON /BPARA/B1(10),B2(10),B3(10),B4(10),B5(10),B6(10),B7(10), & B8(10),B9(10),B10(10),B11(10),B12(10),B13(10),B14(10),B15(10), & B16(10),B17(10),B18(10),B19(10),B20(10),B21(10) CHARACTER*20 FILENAME COMMON/TEMPERATURE/ TEMP(10) COMMON /TMSTART/ TM11(10),TM21(10) C DIMENSION=MAX NUMBER OF PARAMETERS (21) DIMENSION P(21) DIMENSION P1(21) COMMON /PPAR/ P2(21) DIMENSION XI(21,21) INDEX=1 INDEXSTAMPA=0 C CONSTANTS READ IN FILE PAR.DAT OPEN (1, STATUS = 'OLD', FILE = 'PARC.DAT') OPEN (4, FILE="PAR.OUT") C OUTPUT FILE READ(1,'(A)')FILENAME C NUCLEAR MOLECULAR SPIN READ(1,*)SI C GAMMA OF THE INVESTIGATED PARTICLE READ(1,*)GAMMAI C ELECTRON SPIN READ(1,*)SPIN C T1 OR T2 CALCULATION READ(1,*)IREL C LIMITS OF THE FIELD READ(1,*)X1,X2,X3 IF(X3.EQ.1)THEN XMIN=X1 XMAX=X2 ELSE XMIN=LOG10(GAMMAI*X1/6.283) XMAX=LOG10(GAMMAI*X2/6.283) ENDIF C NUMBER OF POINTS TO BE CALCULATED READ(1,*)NUMPUN IF(XMIN.EQ.XMAX)NUMPUN=1 C NUMBER OF SETS OF DATA FOR FITTING READ(1,*)SET IF(SET.EQ.0) SET=1 C TEMPERATURE READ(1,*)(TEMP(K),K=1,SET) J=1 IND=1 IND1=1 IND2=1 NV=0 NVEST=0 NPLUS=0 NPLUS2=0 C CORRELATION TIMES READ(1,*)B1(J), (TAUS0M(J,K),K=1,2),TAUDELTA IF(B1(J).GE.2)THEN TS1=TAUS0M(J,1) TS2=TAUS0M(J,2) DO K=1,SET TAUS0M(J,K)=TS1*EXP(TS2/TEMP(K)) END DO IF(B1(J).EQ.3)NPLUS=NPLUS+1 ENDIF IF(B1(J).EQ.1)THEN P(IND)=TAUS0M(J,1) P1(IND1)=TAUS0M(J,1) WRITE(4,'(2X,4(E10.4,2X))') P(IND) IND=IND+1 IND1=IND1+1 ENDIF IF(B1(J).EQ.2)THEN P(IND)=TS1 P1(IND1)=TS1 P(IND+1)=TS2 P1(IND1+1)=TS2 WRITE(4,'(2X,4(E10.4,2X))') TS1,TS2 IND=IND+2 IND1=IND1+2 ENDIF READ(1,*)B2(J), (TAURM(J,K),K=1,2) IF(B2(J).GE.2)THEN TR1=TAURM(J,1) TR2=TAURM(J,2) DO K=1,SET TAURM(J,K)=TR1*EXP(TR2/TEMP(K)) !Stokes END DO IF(B2(J).EQ.3) NPLUS=NPLUS+1 ENDIF IF(B2(J).EQ.1)THEN P(IND)=TAURM(J,1) P1(IND1)=TAURM(J,1) WRITE(4,'(2X,4(E10.4,2X))') P(IND) IND=IND+1 IND1=IND1+1 ENDIF IF(B2(J).EQ.2)THEN P(IND)=TR1 P1(IND1)=TR1 P(IND+1)=TR2 P1(IND1+1)=TR2 WRITE(4,'(2X,4(E10.4,2X))') TR1,TR2 IND=IND+2 IND1=IND1+2 ENDIF READ(1,*)B3(J), (TAUVM(J,K),K=1,2) IF(B3(J).GE.2)THEN TV1=TAUVM(J,1) TV2=TAUVM(J,2) DO K=1,SET TAUVM(J,K)=TV1*EXP(TV2/TEMP(K)) END DO IF(B3(J).EQ.3) NPLUS=NPLUS+1 ENDIF IF(B3(J).EQ.1)THEN P(IND)=TAUVM(J,1) P1(IND1)=TAUVM(J,1) WRITE(4,'(2X,4(E10.4,2X))') P(IND) IND=IND+1 IND1=IND1+1 ENDIF IF(B3(J).EQ.2)THEN P(IND)=TV1 P1(IND1)=TV1 P(IND+1)=TV2 P1(IND1+1)=TV2 WRITE(4,'(2X,4(E10.4,2X))') TV1,TV2 IND=IND+2 IND1=IND1+2 ENDIF IF (TAURM(J,1).EQ.0.AND.TAUVM(J,1).EQ.0)THEN TAUCM(J)=TAUS0M(J,1) IF(B1(J).EQ.1) P(IND-1)=TAUS0M(J,K) IF(B1(J).EQ.1) P1(IND1-1)=TAUS0M(J,K) ENDIF C PARAMETERS OF ZERO FIELD SPLITTING READ(1,*)B11(J), DPARAM(J) DPARAM(J) = PI2*VL*DPARAM(J) IF(B11(J).EQ.1)THEN P(IND)=DPARAM(J) P1(IND1)=DPARAM(J) WRITE(4,'(2X,4(E10.4,2X))') P(IND)/VL/PI2 INDDPARA(J)=IND IND=IND+1 IND1=IND1+1 ENDIF READ(1,*)B12(J), EPARAM(J) EPARAM(J) = PI2*VL*EPARAM(J) IF(B12(J).EQ.1)THEN P(IND)=EPARAM(J) P1(IND1)=EPARAM(J) WRITE(4,'(2X,4(E10.4,2X))') P(IND)/VL/PI2 INDEPARA(J)=IND IND=IND+1 IND1=IND1+1 ENDIF READ(1,*)B19(J), S4M(J) S4M(J) = PI2*VL*S4M(J) IF(B19(J).EQ.1)THEN P(IND)=S4M(J) P1(IND1)=S4M(J) WRITE(4,'(2X,4(E10.4,2X))') P(IND)/VL/PI2 INDS4(J)=IND IND=IND+1 IND1=IND1+1 ENDIF C PARAMETER OF G-TENSOR READ(1,*)B17(J), GSER GXM(J)=GSER/2.003 IF(B17(J).EQ.1)THEN P(IND)=GXM(J) P1(IND1)=GXM(J) WRITE(4,'(2X,4(E10.4,2X))') P(IND) IND=IND+1 IND1=IND1+1 ENDIF READ(1,*)B18(J), GSER GYM(J)=GSER/2.003 IF(B18(J).EQ.1)THEN P(IND)=GYM(J) P1(IND1)=GYM(J) WRITE(4,'(2X,4(E10.4,2X))') P(IND) IND=IND+1 IND1=IND1+1 ENDIF READ(1,*)B20(J), GSER GZM(J)=GSER/2.003 IF(B20(J).EQ.1)THEN P(IND)=GZM(J) P1(IND1)=GZM(J) WRITE(4,'(2X,4(E10.4,2X))') P(IND) IND=IND+1 IND1=IND1+1 ENDIF C PARAMETERS OF HYPERFINE COUPLING READ(1,*)B9(J), AXM(J) C CONVERTION FROM CM-1 TO S-1.RAD AXM(J)=PI2*VL*AXM(J) IF(B9(J).EQ.1)THEN P(IND)=AXM(J) P1(IND1)=AXM(J) WRITE(4,'(2X,4(E10.4,2X))') P(IND)/VL/PI2 INDAPAR(J)=IND IND=IND+1 IND1=IND1+1 ENDIF READ(1,*)B10(J), AYM(J) AYM(J)=PI2*VL*AYM(J) IF(B10(J).EQ.1)THEN P(IND)=AYM(J) P1(IND1)=AYM(J) WRITE(4,'(2X,4(E10.4,2X))') P(IND)/VL/PI2 INDAPER(J)=IND IND=IND+1 IND1=IND1+1 ENDIF READ(1,*)B21(J), AZM(J) AZM(J)=PI2*VL*AZM(J) IF(B21(J).EQ.1)THEN P(IND)=AZM(J) P1(IND1)=AZM(J) WRITE(4,'(2X,4(E10.4,2X))') P(IND)/VL/PI2 INDAPER2(J)=IND IND=IND+1 IND1=IND1+1 ENDIF C PARAMETERS OF OUTER-SPHERE READ(1,*)B13(J), DM(J) DM(J)=DM(J)*1.E-8 IF(B13(J).EQ.1)THEN P(IND)=DM(J) P2(IND2)=DM(J) WRITE(4,'(2X,4(E10.4,2X))') P(IND)/1.E-8 INDED(J)=IND IND=IND+1 IND2=IND2+1 ENDIF READ(1,*)B14(J), DDM(J) IF(B14(J).EQ.1)THEN P(IND)=DDM(J) P2(IND2)=DDM(J) WRITE(4,'(2X,4(E10.4,2X))') P(IND) IND=IND+1 IND2=IND2+1 ENDIF READ(1,*)B15(J), CONCM(J) IF(B15(J).EQ.1)THEN P(IND)=CONCM(J) P2(IND2)=CONCM(J) WRITE(4,'(2X,4(E10.4,2X))') P(IND) IND=IND+1 IND2=IND2+1 ENDIF C NUMBER OF DIFFERENT SITES READ(1,*) ACQ C PARAMETERS FOR DIFFERENT SITES DO J=1,ACQ READ(1,*)B4(J), (TAUMM(J,K),K=1,2) IF(B4(J).GE.2)THEN TM1=TAUMM(J,1) TM2=TAUMM(J,2) TM11(J)=TAUMM(J,1) TM21(J)=TAUMM(J,2) DO K=1,SET TAUMM(J,K)=TM1*EXP(TM2/TEMP(K)) END DO IF(B4(J).EQ.3) NPLUS2=1 ENDIF IF(B4(J).EQ.1)THEN P(IND)=TAUMM(J,1) P2(IND2)=TAUMM(J,1) WRITE(4,'(2X,4(E10.4,2X))') P(IND) IND=IND+1 IND2=IND2+1 ENDIF IF(B4(J).EQ.2)THEN P(IND)=TM1 P2(IND2)=TM1 P(IND+1)=TM2 P2(IND2+1)=TM2 WRITE(4,'(2X,4(E10.4,2X))') TM1,TM2 IND=IND+2 IND2=IND2+2 ENDIF READ(1,*)B5(J), AMOLFRAM(J) AMOLFRAM(J)=AMOLFRAM(J)*1.E-3/111. IF(B5(J).EQ.1)THEN P(IND)=AMOLFRAM(J) P2(IND2)=AMOLFRAM(J) WRITE(4,'(2X,4(E10.4,2X))') P(IND)*111./1.E-3 INDAMOLFRA(J)=IND IND=IND+1 IND2=IND2+1 ENDIF READ(1,*)B6(J), RKM(J) IF(B6(J).EQ.1)THEN P(IND)=RKM(J) P2(IND2)=RKM(J) WRITE(4,'(2X,4(E10.4,2X))') P(IND) IND=IND+1 IND2=IND2+1 ENDIF READ(1,*)B16(J), ACONTM(J) IF(B16(J).EQ.1)THEN P(IND)=ACONTM(J) P2(IND2)=ACONTM(J) WRITE(4,'(2X,4(E10.4,2X))') P(IND) IND=IND+1 IND2=IND2+1 ENDIF READ(1,*)B7(J), THETAM(J) IF(B7(J).EQ.1)THEN P(IND)=THETAM(J) P1(IND1)=THETAM(J) WRITE(4,'(2X,4(E10.4,2X))') P(IND) IND=IND+1 IND1=IND1+1 ENDIF READ(1,*)B8(J), PHIM(J) IF(B8(J).EQ.1)THEN P(IND)=PHIM(J) P1(IND1)=PHIM(J) WRITE(4,'(2X,4(E10.4,2X))') P(IND) IND=IND+1 IND1=IND1+1 ENDIF C NUMBER OF FITTING PARAMETERS NV=NV+B1(J)+B2(J)+B3(J)+B4(J)+B5(J)+B6(J)+B7(J)+B8(J)+B9(J)+ & B10(J)+B11(J)+B12(J)+B13(J)+B14(J)+B15(J)+B16(J)+B17(J) & +B18(J)+B19(J)+B20(J)+B21(J)-NPLUS*3-NPLUS2*3 C NUMBER OF FITTING PARAMETERS IN EXTERNAL CICLE NVEST=NVEST+B1(J)+B2(J)+B3(J)+B7(J)+B8(J)+B9(J)+ & B10(J)+B11(J)+B12(J)+B17(J) & +B18(J)+B19(J)+B20(J)+B21(J)-NPLUS*3 NPLUS=0 NPLUS2=0 END DO NVMEM=NV DPARATOT=0. EPARATOT=0. APERTOT=0. APERTOT2=0. APARTOT=0. ACONTOT=0. ACONIND=0. DO J=1,ACQ DPARATOT=DPARAM(J)+DPARATOT EPARATOT=EPARAM(J)+EPARATOT APERTOT=AZM(J)+APERTOT APERTOT2=AXM(J)+APERTOT2 APARTOT=AYM(J)+APARTOT ACONTOT=ACONTM(J)+ACONTOT END DO C DEFINITION OF NMX: DIMENSION OF ENERGY MATRIX IF(DPARATOT.EQ.0..AND.EPARATOT.EQ.0. & AND.GX.EQ.GZ.AND.GX.EQ.GY.AND.SPIN.EQ.0.5)THEN NMX=2.*(2*SI+1.) ELSE IF(APERTOT.EQ.0.AND.APARTOT.EQ.0.AND.APERTOT2.EQ.0.AND. & GX.EQ.GZ.AND.GX.EQ.GY.AND.EPARATOT.EQ.0)THEN SI=0.5 NMX=2*SPIN+1. ELSE NMX = (2*SI + 1)*(2*SPIN+1) ENDIF ENDIF IF(IREL.NE.1) NMX = (2*SI + 1)*(2*SPIN+1) IF(ACONTOT.NE.0) THEN IF(APERTOT.NE.0.OR.APARTOT.NE.0.OR.APERTOT2.NE.0.OR. & GX.NE.GZ.OR.GX.NE.GY.OR.EPARATOT.NE.0.OR.DPARATOT.NE.0)THEN NMX = (2*SI + 1)*(2*SPIN+1) ACONIND=1. ENDIF ENDIF READ(1,*) (NPT(K),K=1, SET) READ(1,*) FTOL READ(1,*) ALFASTEP C Z: FREQUENCIES, PP: RATE NPTOT=0 DO K=1,SET NPTOT=NPTOT+NPT(K) END DO DO 11 I=1,NPTOT READ(1,*) Z(I),PP(I) 11 CONTINUE CLOSE(1) OO=10 IF (NPT(1).EQ.0)GOTO 250 C STARTING FITTING PROCEDURE IF(NVEST.EQ.0)THEN CALL FUNCZFS(P2,FUNC,NMX,NV) NP=NV N=NV ITER=1000 CALL POWELLINT(P2,XI,N,NP,FTOL,ITER,FRET,NMX) DO J=1,NP WRITE(6,'(2X,4(E10.4,2X))') P2(J),2 END DO ELSE NP=NVEST N=NVEST ITER=1000 CALL POWELL(P1,XI,N,NP,FTOL,ITER,FRET,NMX) ENDIF WRITE(4,*) 'ERROR=', FRET/(NPTOT-NV) DO J=1,ACQ IF(B5(J).EQ.1)P2(INDAMOLFRA(J))=P2(INDAMOLFRA(J))*111/1.E-3 IF(B9(J).EQ.1)P1(INDAPAR(J))=P1(INDAPAR(J))/PI2/VL IF(B10(J).EQ.1)P1(INDAPER(J))=P1(INDAPER(J))/PI2/VL IF(B21(J).EQ.1)P1(INDAPER2(J))=P1(INDAPER2(J))/PI2/VL IF(B11(J).EQ.1)P1(INDDPARA(J))=P1(INDDPARA(J))/PI2/VL IF(B12(J).EQ.1)P1(INDEPARA(J))=P1(INDEPARA(J))/PI2/VL IF(B13(J).EQ.1)P2(INDED(J))=P2(INDED(J))/1.E-8 IF(B19(J).EQ.1)P1(INDS4(J))=P1(INDS4(J))/PI2/VL END DO C WRITE RESULTS OF FITTING PROCEDURE IF(NVEST.NE.0)THEN JI=1 IF(B1(1).EQ.2)THEN DO K=1,SET WRITE(4,'(2X,4(E10.4,2X))')P1(JI)*EXP(P1(JI+1)/TEMP(K)) END DO JI=JI+2 ENDIF IF(B2(1).EQ.2)THEN DO K=1,SET WRITE(4,'(2X,4(E10.4,2X))')P1(JI)*EXP(P1(JI+1)/TEMP(K)) END DO JI=JI+2 ENDIF IF(B3(1).EQ.2)THEN DO K=1,SET WRITE(4,'(2X,4(E10.4,2X))')P1(JI)*EXP(P1(JI+1)/TEMP(K)) END DO JI=JI+2 ENDIF DO J=JI,NVEST WRITE(4,'(2X,4(E10.4,2X))') P1(J) END DO ENDIF DO JJ=1,ACQ IF(NV-NVEST.NE.0)THEN JI=1 IF(B4(JJ).EQ.2)THEN DO K=1,SET WRITE(4,'(2X,4(E10.4,2X))')P2(JI)*EXP(P2(JI+1)/TEMP(K)) END DO JI=JI+2 ENDIF DO J=JI,NV-NVEST WRITE(4,'(2X,4(E10.4,2X))') P2(J) END DO ENDIF END DO WRITE(4,*) 'MAGN. FIELD, OBSED., CAL. ' DO 1 I=1,NPTOT WRITE(4,'(2X,3(F8.3,2X))') Z(I),PP(I)/CONCM(1)*0.001, & TPUNO(I)/CONCM(1)*0.001 1 CONTINUE CLOSE(4) DO J=1,ACQ IF(B5(J).EQ.1)P2(INDAMOLFRA(J))=P2(INDAMOLFRA(J))/111*1.E-3 IF(B9(J).EQ.1)P1(INDAPAR(J))=P1(INDAPAR(J))*PI2*VL IF(B10(J).EQ.1)P1(INDAPER(J))=P1(INDAPER(J))*PI2*VL IF(B21(J).EQ.1)P1(INDAPER2(J))=P1(INDAPER2(J))*PI2*VL IF(B11(J).EQ.1)P1(INDDPARA(J))=P1(INDDPARA(J))*PI2*VL IF(B12(J).EQ.1)P1(INDEPARA(J))=P1(INDEPARA(J))*PI2*VL IF(B13(J).EQ.1)P2(INDED(J))=P2(INDED(J))*1.E-8 IF(B19(J).EQ.1)P1(INDS4(J))=P1(INDS4(J))*PI2*VL END DO OO=0 250 CONTINUE C CALCULATION OF THE CURVE OPEN (44, FILE=FILENAME) DO K=1,SET NPT(K)=NUMPUN END DO INDEXSTAMPA=1 DO K=1,SET DO I=1,NPT(K) ZE = XMIN + (XMAX - XMIN)*FLOAT(I)/FLOAT(NPT(K)) ADD=0 DO IJK=1,K-1 ADD=ADD+NPT(IJK) END DO PP(I+1+ADD)=PP(I+ADD) Z(I+ADD) = 10.**ZE/1000000. END DO END DO NVEST=30+OO CALL FUNCZFS(P1,FUNC,NMX,NV) CLOSE(44) STOP END SUBROUTINE FUNCZFS(P,FUNC,NMX,NV) IMPLICIT REAL*8(A-H,O-Z) DIMENSION P(NV) DIMENSION XI2(21,21) PARAMETER(PI2 = 6.2831853, VL = 2.9979D+10) COMMON /SET/SET COMMON /PPAR/ P2(21) COMMON /RK10/ SPIN, SI COMMON /WATER/ ACQ COMMON /STAMPA/INDEXSTAMPA COMMON /STEPGAMMA/ STEPGAMMA COMMON /B4/ NVMEM,NPT(10),NPTOT COMMON /B31/ TPUNO(500) COMMON /B32/ PP(500),Z(500) COMMON /C1M/DM(10),DDM(10),CONCM(10) COMMON /IPERFM/AZM(10),AYM(10),AXM(10),THETAM(10),RKM(10), & TAUCM(10),DPARAM(10),EPARAM(10),PHIM(10),S4M(10),GXM(10), & GYM(10),GZM(10) COMMON /TAU1M/ TAUS0M(10,10),TAURM(10,10),TAUVM(10,10), & TAUMM(10,10) COMMON /MOLFRAZM/ AMOLFRAM(10) COMMON /CONTATM/ ACONTM(10) COMMON /INDA/ INDDPARA(10),INDAPAR(10),INDAPER(10),INDEPARA(10) & ,INDED(10),INDAMOLFRA(10),INDS4(10),INDAPER2(10) COMMON /C1/D,DD,CONC COMMON /IPERF/AZ,AY,AX,THETA,RK,TAUC,DPARA,EPARA,PHI,S4 COMMON /GTENSOR/ GX,GY,GZ COMMON /TAU1/ TAUS0 COMMON /TAU/ TAUR,TAUV,TAUM COMMON /MOLFRAZ/ AMOLFRA COMMON /CONTAT/ ACONT COMMON /GAMMAH/ GAMMAI COMMON /TM/ TMUNO,TMUNOCONT,TMUNOCROSS COMMON /CICLE/ NVEST COMMON /TMAT/ TMAT(500,10),TMATCONT(500,10),TMATCROSS(500,10) COMMON /BPARA/B1(10),B2(10),B3(10),B4(10),B5(10),B6(10),B7(10), & B8(10),B9(10),B10(10),B11(10),B12(10),B13(10),B14(10),B15(10), & B16(10),B17(10),B18(10),B19(10),B20(10),B21(10) COMMON/TEMPERATURE/ TEMP(10) DIMENSION TS1(10),TS2(10),TR1(10),TR2(10),TV1(10),TV2(10) COMMON /TMSTART/ TM11(10),TM21(10) C SET PARAMETERS FB=0. FBW=0. IF(NVEST.LT.30)THEN WRITE(6,*)'PARAMETERS: ' DO J=1,ACQ IF(B5(J).EQ.1)P(INDAMOLFRA(J))=P(INDAMOLFRA(J))*111/1.E-3 IF(B9(J).EQ.1)P(INDAPAR(J))=P(INDAPAR(J))/PI2/VL IF(B10(J).EQ.1)P(INDAPER(J))=P(INDAPER(J))/PI2/VL IF(B21(J).EQ.1)P(INDAPER2(J))=P(INDAPER2(J))/PI2/VL IF(B11(J).EQ.1)P(INDDPARA(J))=P(INDDPARA(J))/PI2/VL IF(B12(J).EQ.1)P(INDEPARA(J))=P(INDEPARA(J))/PI2/VL IF(B13(J).EQ.1)P(INDED(J))=P(INDED(J))/1.E-8 IF(B19(J).EQ.1)P(INDS4(J))=P(INDS4(J))/PI2/VL END DO DO I=1,NV WRITE(6,'(2X,E10.4)')P(I) END DO DO J=1,ACQ IF(B5(J).EQ.1)P(INDAMOLFRA(J))=P(INDAMOLFRA(J))/111*1.E-3 IF(B9(J).EQ.1)P(INDAPAR(J))=P(INDAPAR(J))*PI2*VL IF(B10(J).EQ.1)P(INDAPER(J))=P(INDAPER(J))*PI2*VL IF(B21(J).EQ.1)P(INDAPER2(J))=P(INDAPER2(J))*PI2*VL IF(B11(J).EQ.1)P(INDDPARA(J))=P(INDDPARA(J))*PI2*VL IF(B12(J).EQ.1)P(INDEPARA(J))=P(INDEPARA(J))*PI2*VL IF(B13(J).EQ.1)P(INDED(J))=P(INDED(J))*1.E-8 IF(B19(J).EQ.1)P(INDS4(J))=P(INDS4(J))*PI2*VL END DO ENDIF DO 223 K=1,SET DO I=1, NPT(K) IND=1 TPUNOTOT=0 J=1 TAUS0=TAUS0M(J,1) TAUR=TAURM(J,1) TAUV=TAUVM(J,1) IF(TAUR.EQ.0.AND.TAUV.EQ.0.)TAUC=TAUCM(J) AX=AXM(J) AY=AYM(J) AZ=AZM(J) DPARA=DPARAM(J) EPARA=EPARAM(J) GX=GXM(J) GY=GYM(J) GZ=GZM(J) S4=S4M(J) IF(INDEXSTAMPA.EQ.0.OR.NVEST.EQ.40)THEN D=DM(J) DD=DDM(J) CONC=CONCM(J) ENDIF C PARAMETERS************************************************************** IF(B1(J).EQ.1)THEN TAUS0=P(IND) IND=IND+1 ENDIF IF(B1(J).EQ.2)THEN TS1(K)=P(IND) TS2(K)=P(IND+1) IND=IND+2 ENDIF IF(B2(J).EQ.1)THEN TAUR=P(IND) IND=IND+1 ENDIF IF(B2(J).EQ.2)THEN TR1(K)=P(IND) TR2(K)=P(IND+1) IND=IND+2 ENDIF IF(B3(J).EQ.1)THEN TAUV=P(IND) IND=IND+1 ENDIF IF(B3(J).EQ.2)THEN TV1(K)=P(IND) TV2(K)=P(IND+1) IND=IND+2 ENDIF IF(B1(J).EQ.1.AND.TAUR.EQ.0.AND.TAUV.EQ.0)THEN TAUC=P(IND-1) ENDIF IF(B11(J).EQ.1)THEN DPARA=P(IND) IND=IND+1 ENDIF IF(B12(J).EQ.1)THEN EPARA=P(IND) IND=IND+1 ENDIF IF(B19(J).EQ.1)THEN S4=P(IND) IND=IND+1 ENDIF IF(B17(J).EQ.1)THEN GX=P(IND) IND=IND+1 ENDIF IF(B18(J).EQ.1)THEN GY=P(IND) IND=IND+1 ENDIF IF(B20(J).EQ.1)THEN GZ=P(IND) IND=IND+1 ENDIF IF(B9(J).EQ.1)THEN AX=P(IND) IND=IND+1 ENDIF IF(B10(J).EQ.1)THEN AY=P(IND) IND=IND+1 ENDIF IF(B21(J).EQ.1)THEN AZ=P(IND) IND=IND+1 ENDIF IND2=1 !!!!!!!!!!!!!!!!!!!!!!!!! IF(B13(J).EQ.1) IND2=IND2+1 IF(B14(J).EQ.1) IND2=IND2+1 IF(B15(J).EQ.1) IND2=IND2+1 !!!!!!!!!!!!!!!!! DO J=1,ACQ IF(INDEXSTAMPA.EQ.0.OR.NVEST.EQ.40)THEN TAUM=TAUMM(J,1) AMOLFRA=AMOLFRAM(J) RK=RKM(J) ACONT=ACONTM(J) ENDIF IF(INDEXSTAMPA.EQ.1)THEN !!!!!!!!!!!!!!!!!!!!!!!!!!!!! IF(B4(J).EQ.0)TAUM=TAUMM(J,1) IF(B4(J).EQ.1)THEN TAUM=P2(IND2) IND2=IND2+1 ENDIF IF(B4(J).EQ.2)THEN TM11(J)=P2(IND2) TM21(J)=P2(IND2+1) IND2=IND2+2 ENDIF IF(B5(J).EQ.0)AMOLFRA=AMOLFRAM(J) IF(B5(J).EQ.1)THEN AMOLFRA=P2(IND2) IND2=IND2+1 ENDIF IF(B6(J).EQ.0)RK=RKM(J) IF(B6(J).EQ.1)THEN RK=P2(IND2) IND2=IND2+1 ENDIF IF(B16(J).EQ.0)ACONT=ACONTM(J) IF(B16(J).EQ.1)THEN ACONT=P2(IND2) IND2=IND2+1 ENDIF ENDIF !!!!!!!!!!!!!!!!!!!!!!!!!!!! THETA=THETAM(J) PHI=PHIM(J) IF(B7(J).EQ.1)THEN THETA=P(IND) IND=IND+1 ENDIF IF(B8(J).EQ.1)THEN PHI=P(IND) IND=IND+1 ENDIF IF(B1(J).EQ.2)TAUS0=TS1(1)*EXP(TS2(1)/TEMP(K)) IF(B2(J).EQ.2)TAUR=TR1(1)*EXP(TR2(1)/TEMP(K)) !stokes IF(B3(J).EQ.2)TAUV=TV1(1)*EXP(TV2(1)/TEMP(K)) IF(B4(J).EQ.2)TAUM=TM11(J)*EXP(TM21(J)/TEMP(K)) IF(B1(J).EQ.3)TAUS0=TAUS0M(J,K) IF(B2(J).EQ.3)TAUR=TAURM(J,K) IF(B3(J).EQ.3)TAUV=TAUVM(J,K) IF(B4(J).EQ.3)TAUM=TAUMM(J,K) C******************************************************************************* ADD=0 DO IJK=1,K-1 ADD=ADD+NPT(IJK) END DO IPLUS=I+ADD C PROTON LARMOR FREQUENCY BZ=Z(IPLUS)*1000000 C CONSTANTS IN DIPOLAR RELAXATION RK1=10.*2.46502D-52/(2.6752D8)**2*GAMMAI**2*(RK*1.E-10)**(-6) IF (AMOLFRA.EQ.0.)RK1=10./(SPIN*(SPIN+1.)*2./15.)/TAUS0*1.E-9 IF(RK.EQ.0) RK1=0. C CONSTANT OF CONTACT RELAXATION CONA=(ACONT*6.28*1.E6*1.0546E-34) IF(TAUC.EQ.0.AND.TAUS0.EQ.0) GOTO 56 CALL GAUINT (BZ,TAUM,NMX) C STORE CONTRIBUTIONS FOR TUNO TMAT(IPLUS,J)=TMUNO TMATCONT(IPLUS,J)=TMUNOCONT TMATCROSS(IPLUS,J)=TMUNOCROSS C CALCULATION OF TPUNO TMUNO=TMUNO*RK1+CONA*CONA*TMUNOCONT+SQRT(RK1)*CONA*TMUNOCROSS TPUNO1=1./(1./TMUNO+TAUM)*AMOLFRA IF(AMOLFRA.EQ.0.)TPUNO1=1./(1./TMUNO+TAUM) TPUNO(IPLUS)=TPUNO1/CONC*0.001 TPUNOTOT=TPUNOTOT+TPUNO(IPLUS) END DO 56 CONTINUE C CALCULATION OF OUTER-SPHERE CONTRIBUTION TERM=0 IF(DD.NE.0)THEN V=BZ*2.*3.14 TAUD=D**2/DD CZ=SQRT(2*V*TAUD) ZZ=SQRT(2*V*TAUD*658.) GEI=(1.+5.*CZ/8.+CZ**2/8.)/(1.+CZ+CZ**2/2.+CZ**3/6.+4.* & CZ**4/81.+CZ**5/81.+CZ**6/648.) GES=(1.+5.*ZZ/8.+ZZ**2/8.)/(1.+ZZ+ZZ**2/2.+ZZ**3/6.+4.* & ZZ**4/81.+ZZ**5/81.+ZZ**6/648.) PRIMO=32.*3.14/405.*(2.6752E4*1.7608E7*1.0546E-27)**2*6.022E20 SECONDO=SPIN*(SPIN+1)*CONC/(D*DD) TERZO=(3.*GEI+7.*GES) TERM=(PRIMO*SECONDO*TERZO) ENDIF TPUNOTOT=TPUNOTOT+TERM TPUNO(IPLUS)=TPUNOTOT C DIFFERENCE BETWEEN EXPERIMENTAL AND FITTING VALUES FB=((PP(IPLUS)-TPUNO(IPLUS))**2)/PP(IPLUS)+FB FBW=SQRT((PP(IPLUS)-TPUNO(IPLUS))**2)/PP(IPLUS)+FBW IF (STEPGAMMA.NE.1) WRITE(6,'(2X,2(E10.4))')Z(IPLUS),TPUNO (IPLUS) IF(INDEXSTAMPA.EQ.1)WRITE(44,'(2X,2(E10.4))')6.283d+6*Z(IPLUS)/ & (GAMMAI) ,TPUNO(IPLUS) END DO 223 CONTINUE FUNC=FBW IF(INDEXSTAMPA.EQ.0)WRITE(6,*)' ERROR', & '=',FBW/(NPTOT-NVMEM),'**********' IF(NV.NE.NVMEM)THEN C INTERNAL FITTING PROCEDURE NP2=NVMEM-NV N2=NVMEM-NV ITER2=1000 FRET2=0. CALL POWELLINT(P2,XI2,N2,NP2,FTOL,ITER2,FRET2,NMX) WRITE(6,*)' ERROR', & '=', FRET2/(NPTOT-NVMEM) DO J=1,NP2 WRITE(6,'(2X,E10.4)')P2(J) END DO FUNC=FRET2 ENDIF RETURN END SUBROUTINE FUNCINT(P,FUNC,NMX,NV) IMPLICIT REAL*8(A-H,O-Z) DIMENSION P(NV) PARAMETER(PI2 = 6.2831853, VL = 2.9979D+10) COMMON /SET/SET COMMON /RK10/ SPIN, SI COMMON /WATER/ ACQ COMMON /STAMPA/INDEXSTAMPA COMMON /STEPGAMMA/ STEPGAMMA COMMON /B4/ NVMEM,NPT(10),NPTOT COMMON /B31/ TPUNO(500) COMMON /B32/ PP(500),Z(500) COMMON /C1M/DM(10),DDM(10),CONCM(10) COMMON /IPERFM/AZM(10),AYM(10),AXM(10),THETAM(10),RKM(10), & TAUCM(10),DPARAM(10),EPARAM(10),PHIM(10),S4M(10),GXM(10), & GYM(10),GZM(10) COMMON /TAU1M/ TAUS0M(10,10),TAURM(10,10),TAUVM(10,10), & TAUMM(10,10) COMMON /MOLFRAZM/ AMOLFRAM(10) COMMON /CONTATM/ ACONTM(10) COMMON/INDA/ INDDPARA(10),INDAPAR(10),INDAPER(10),INDEPARA(10) & ,INDED(10),INDAMOLFRA(10),INDS4(10),INDAPER2(10) COMMON /C1/D,DD,CONC COMMON /IPERF/AZ,AY,AX,THETA,RK,TAUC,DPARA,EPARA,PHI,S4 COMMON /GTENSOR/ GX,GY,GZ COMMON /TAU1/ TAUS0 COMMON /TAU/ TAUR,TAUV,TAUM COMMON /MOLFRAZ/ AMOLFRA COMMON /CONTAT/ ACONT COMMON /GAMMAH/ GAMMAI COMMON /TM/ TMUNO,TMUNOCONT,TMUNOCROSS COMMON /CICLE/ NVEST COMMON /TMAT/ TMAT(500,10),TMATCONT(500,10),TMATCROSS(500,10) COMMON /BPARA/B1(10),B2(10),B3(10),B4(10),B5(10),B6(10),B7(10), & B8(10),B9(10),B10(10),B11(10),B12(10),B13(10),B14(10),B15(10), & B16(10),B17(10),B18(10),B19(10),B20(10),B21(10) COMMON/TEMPERATURE/ TEMP(10) DIMENSION TM1(10),TM2(10) C SET PARAMETERS FB=0. FBW=0. DO 223 K=1,SET DO I=1, NPT(K) IND=1 TPUNOTOT=0 J=1 C PARAMETERS OF INTERNAL FITTING********************************************* IF(B13(J).EQ.1)THEN D=P(IND) IND=IND+1 ELSE D=DM(J) ENDIF IF(B14(J).EQ.1)THEN DD=P(IND) IND=IND+1 ELSE DD=DDM(J) ENDIF IF(B15(J).EQ.1)THEN CONC=P(IND) IND=IND+1 ELSE CONC=CONCM(J) ENDIF DO J=1,ACQ IF(B4(J).EQ.1)THEN TAUM=P(IND) IND=IND+1 ENDIF IF(B4(J).EQ.2)THEN TM1(1)=P(IND) TM2(1)=P(IND+1) IND=IND+2 ENDIF IF(B4(J).EQ.0) TAUM=TAUMM(J,1) IF(B5(J).EQ.1)THEN AMOLFRA=P(IND) IND=IND+1 ELSE AMOLFRA=AMOLFRAM(J) ENDIF IF(B6(J).EQ.1)THEN RK=P(IND) IND=IND+1 ELSE RK=RKM(J) ENDIF IF(B16(J).EQ.1)THEN ACONT=P(IND) IND=IND+1 ELSE ACONT=ACONTM(J) ENDIF IF(B4(J).EQ.2)TAUM=TM1(1)*EXP(TM2(1)/TEMP(K)) IF(B4(J).EQ.3)TAUM=TAUMM(J,K) C******************************************************************************* ADD=0 DO IJK=1,K-1 ADD=ADD+NPT(IJK) END DO IPLUS=I+ADD BZ=Z(IPLUS)*1000000. RK1=10.*2.46502D-52/(2.6752D8)**2*GAMMAI**2*(RK*1.E-10)**(-6) IF (AMOLFRA.EQ.0.)RK1=10./(SPIN*(SPIN+1.)*2./15.)/TAUS0*1.E-9 IF(RK.EQ.0) RK1=0. CONA=(ACONT*6.28*1.E6*1.0546E-34) C READ CALCULATED CONTRIBUTIONS TO TMUNO TMUNO=TMAT(IPLUS,J) TMUNOCONT=TMATCONT(IPLUS,J) TMUNOCROSS=TMATCROSS(IPLUS,J) C CALCULATION OF TMUNO TMUNO=TMUNO*RK1+CONA*CONA*TMUNOCONT+SQRT(RK1)*CONA*TMUNOCROSS TPUNO1=1./(1./TMUNO+TAUM)*AMOLFRA IF(AMOLFRA.EQ.0.)TPUNO1=1./(1./TMUNO+TAUM) TPUNO(IPLUS)=TPUNO1/CONC*0.001 TPUNOTOT=TPUNOTOT+TPUNO(IPLUS) END DO 56 CONTINUE C CALCULATION OF OUTER-SPHERE CONTRIBUTION TERM=0 IF(DD.NE.0)THEN V=BZ*2.*3.14 TAUD=D**2/DD CZ=SQRT(2*V*TAUD) ZZ=SQRT(2*V*TAUD*658.) GEI=(1.+5.*CZ/8.+CZ**2/8.)/(1.+CZ+CZ**2/2.+CZ**3/6.+4.* & CZ**4/81.+CZ**5/81.+CZ**6/648.) GES=(1.+5.*ZZ/8.+ZZ**2/8.)/(1.+ZZ+ZZ**2/2.+ZZ**3/6.+4.* & ZZ**4/81.+ZZ**5/81.+ZZ**6/648.) PRIMO=32.*3.14/405.*(2.6752E4*1.7608E7*1.0546E-27)**2*6.022E20 SECONDO=SPIN*(SPIN+1)*CONC/(D*DD) TERZO=(3.*GEI+7.*GES) TERM=(PRIMO*SECONDO*TERZO) ENDIF TPUNOTOT=TPUNOTOT+TERM C DIFFERENCES BETWEEN EXPERIMENTAL AND FITTED VALUES TPUNO(IPLUS)=TPUNOTOT FB=((PP(IPLUS)-TPUNO(IPLUS))**2)/PP(IPLUS)+FB FBW=SQRT((PP(IPLUS)-TPUNO(IPLUS))**2)/PP(IPLUS)+FBW !IF (STEPGAMMA.NE.1) WRITE(6,'(2X,2(E10.4))')Z(IPLUS),TPUNO (IPLUS) IF(INDEXSTAMPA.EQ.1) WRITE(44,'(2X,2(E10.4))') 6.283d+6*Z (IPLUS)/ & (GAMMAI), TPUNO(IPLUS) END DO 223 CONTINUE FUNC=FBW RETURN END FUNCTION E(BZ,BETA,THETA,TAUC,NMX,PHI,GAMMA) IMPLICIT REAL*8(A-H,O-Z) COMMON /A3/ T11,T12,T13 COMMON /T1T2/ IREL COMMON /ECOM/ ECONT,ECROSS COMMON /STEPGAMMA/ STEPGAMMA COMMON /TOT/ DPARATOT,EPARATOT OMI=BZ*6.2831853 CALL DIAG(BETA,GAMMA,BZ,NMX) CCCCCCCCCCCCCCCCCCCCCCCC modificare CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC IF(IREL.EQ.1.AND.STEPGAMMA.GT.1)CALL TUNO(BETA,OMI,THETA, & TAUC,NMX,PHI,GAMMA) IF(IREL.EQ.1.AND.STEPGAMMA.EQ.1)CALL TUNOISO(BETA,OMI,THETA, & TAUC,NMX) ! IF(IREL.EQ.1)CALL TUNO(BETA,OMI,THETA,TAUC,NMX,PHI,GAMMA) IF(IREL.EQ.2)CALL TDUE(BETA,OMI,THETA,TAUC,NMX,PHI,GAMMA) E=T11*SIN(BETA) ECONT=T12*SIN(BETA) ECROSS=T13*SIN(BETA) RETURN END SUBROUTINE DIAG(BETA,GAMMA,BZ,NMX) IMPLICIT REAL*8(A-H,O-Z) PARAMETER(PI2 = 6.2831853, VL = 2.9979D+10) common /butto/ taurb,tausb COMMON /RK10/ SPIN, SI COMMON /T1T2/ IREL COMMON /INDEX/ INDEX COMMON /STEPGAMMA/ STEPGAMMA COMMON /TAUDELTA/ TAUDELTA COMMON /TAUE/ TAUE COMMON /CONTAT/ ACONT COMMON /TOT/ DPARATOT,EPARATOT,APARTOT,APERTOT,APERTOT2,ACONIND COMMON /IPERF/AZ,AY,AX,THETA,RK,TAUC,DPARA,EPARA,PHI,S4 COMMON /GTENSOR/ GX,GY,GZ COMMON /TAU/ TAUR,TAUV,TAUM COMMON /TAU1/ TAUS0 COMMON /AOLD/ OMOLD(10000),COLD(10000,4) dimension cold1(10000,4),cold2(10000,4) COMPLEX*16 C(100,100,19) COMPLEX*16 Cn1(100,100,19) COMPLEX*16 Cn2(100,100,19) COMMON /A1/ OM(1000,1000),C PARAMETER(MBRANC=90) COMPLEX*16 SZ(MBRANC,MBRANC),SP(MBRANC,MBRANC),SM(MBRANC,MBRANC) DIMENSION CO1(MBRANC),CO2(MBRANC), CO3(MBRANC) COMPLEX*16 SZT(MBRANC,MBRANC),SPT(MBRANC,MBRANC) COMPLEX*16 SMT(MBRANC,MBRANC) COMPLEX*16 TZ,TP,TM COMPLEX*16 cpp,cpm,cpz,cmp,cmm,cmz,czz,czp,czm COMPLEX*16 ammcp1,ammcp2,ammcp3,ammcp4,ammcp5,ammcp6,ammcp7, & ammcp8,ammcp9 COMPLEX*16 ammcm1,ammcm2,ammcm3,ammcm4,ammcm5,ammcm6,ammcm7, & ammcm8,ammcm9 COMPLEX*16 ammcz1,ammcz2,ammcz3,ammcz4,ammcz5,ammcz6,ammcz7, & ammcz8,ammcz9 COMPLEX*16 primo,secondo,terzo,quarto,quinto,sesto,settimo, & ottavo,onono COMPLEX*16 a1,b1,c1,d1,e1,f1,g1,h1,ai1,al1,trhoa,trhob,trhoc COMPLEX*16 a,b,cp,a11,a12,a13,a21,a22,a23,a31,a32,a33 COMPLEX*16 a44,a55,a66,a77,a88,a99,a45,a54,a78,a87 COMPLEX*16 t10,t21,t3,t4,t5,t6,t78,t8,t11,t12 COMPLEX*16 rpzpz,rzmzm,r1223,rpmpm complex*16 ak11,ak12,ak13,ak21,ak22,ak23,ak31,ak32,ak33 complex*16 cz1,cz2,cz3,cz4,cz5,cz6,cz7,cz8,cz9 complex*16 cp1,cp2,cp3,cp4,cp5,cp6,cp7,cp8,cp9 complex*16 cm1,cm2,cm3,cm4,cm5,cm6,cm7,cm8,cm9 COMPLEX*16 rhoa,rhob,rhoc,rt1 common /stoccolma/ disp DIMENSION WR( MBRANC ) COMPLEX*16 AR(MBRANC,MBRANC),ZR(MBRANC,MBRANC ) COMPLEX*16 aaa(3,3) DIMENSION ARR(MBRANC,MBRANC),ARI(MBRANC,MBRANC) DIMENSION ZRR(MBRANC,MBRANC),ZRI(MBRANC,MBRANC) DIMENSION WK1(MBRANC),WK2(MBRANC),WK3(MBRANC) integer lda,num,ipvt(3),info,job complex*16 det(2),work(3),zrn(3,3) COMMON /GAMMAH/GAMMAI complex a44zfs,a55zfs,a44zee,a55zee CT=COS(BETA) ST=SIN(BETA) C CALCULATION OF CORRELATION TIME WI=2*3.1416*BZ WS=658.2*WI IF(TAUV.EQ.0.AND.TAUR.EQ.0)THEN TAUC=TAUS0 IF(TAUM.EQ.0)THEN TAUE=TAUS0 ELSE TAUE=1./(1./TAUS0+1./TAUM) ENDIF ELSE STI=WS**2*TAUV**2 IF (TAUDELTA.EQ.2)THEN delta=taus0*VL*PI2 RTAUS=2.*(TAUS0*VL*PI2)**2*(4.*SPIN*(SPIN+1)-3)/50.* & (TAUV/(1+STI)+4*TAUV/(1+4*STI)) ! write(6,*)rtaus ! stop !cance ELSE delta=0 RTAUS=(0.2/TAUS0)*(1./(1.+STI)+4./(1.+4.*STI)) ENDIF IF(TAUR.EQ.0)THEN RTAUC=RTAUS ELSE RTAUC=RTAUS+1./TAUR ENDIF IF(TAUM.NE.0)THEN RTAUC=RTAUC+1./TAUM ENDIF TAUC=1./RTAUC IF (ACONT.NE.0)THEN IF (TAUM.EQ.0)THEN RTAUE=RTAUS ELSE RTAUE=RTAUS+1./TAUM ENDIF TAUE=1./RTAUE ENDIF ENDIF IF (STEPGAMMA.GT.1)THEN COEFFH=-1. ELSE COEFFH=1. ENDIF IF(ACONIND.EQ.1.)GO TO 456 IF (DPARATOT.EQ.0..AND.EPARATOT.EQ.0..AND.SPIN.EQ.0.5.AND. & GX.EQ.GY.AND.GX.EQ.GZ.AND.IREL.EQ.1)THEN C MATRIX OF ENERGY FOR HYPERFINE COUPLING X=BZ*3.1415927*658.2 ZC=X*CT ZS=X*ST DO 200 I=1,(2.*SI+1.)*2. DO 200 J=1,(2.*SI+1.) *2. 200 AR(I,J) =0. SSI = SI*(SI + 1.) DO I = 1, (2.*SI+1.)*2., 2 COEF = SI - (I - 1)/2 AR(I,I) = ZC*GZ + (SI-I/2)*AZ/2. AR(I+1,I+1) = -(ZC*GZ + (SI-I/2)*AZ/2.) AR(I,I+1) = COEFFH*ZS*GY AR(I+1,I) = COEFFH*ZS*GY AR(I+1,I+2) = 0.5*(AX+AY)/2.*SQRT(SSI-(COEF-1.)*COEF) AR(I+2,I+1) = 0.5*(AX+AY)/2.*SQRT(SSI-(COEF-1.)*COEF) END DO IF (INDEX.EQ.1)THEN WRITE(6,*)'DIM. MATRIX', NMX OPEN(UNIT=17,FILE='MAT') DO I=1,(2.*SI+1)*(2.*SPIN+1) DO J=1,(2.*SI+1)*(2.*SPIN+1) WRITE(17,*)AR(I,J) END DO WRITE(17,*)' ' END DO CLOSE(17) ENDIF INDEX=INDEX+1 C DIAGONALISATION OF THE MATRIX OF ENERGY DO 45 I=1,NMX DO 45 J=1,NMX ARR(I,J)=REAL(AR(I,J)) ARI(I,J)=IMAG(AR(I,J)) 45 CONTINUE CALL F02AXF(ARR,MBRANC,ARI,MBRANC,NMX,WR,ZRR,MBRANC,ZRI,MBRANC $ ,WK1,WK2,WK3,0) DO 46 I=1,NMX DO 46 J=1,NMX ZR(I,J)=CMPLX(ZRR(I,J),ZRI(I,J)) 46 CONTINUE I=1 OM(1,1)=0. OMOLD(1)=0. DO 700 K=1,NMX DO 700 L=1,NMX IF (K.EQ.L)GO TO 700 I=I+1 OM(K,L)=WR(K)-WR(L) C DIFFERENCES IN ENERGY LEVELS OMOLD(I)=WR(K)-WR(L) 700 CONTINUE C CALCULATION OF CORRELATION FUNCTIONS DO 400 K=1,NMX DO 400 L=1,NMX TZ=0 DO 1500 J=1,NMX TZ=-((-1.)**J)*ZR(J,K)*CONJG(ZR(J,L)) +TZ 1500 CONTINUE SZ(K,L)=TZ/ 2. SZT(K,L)=SZ (K,L) TP=0 DO J=1,NMX,2 TP=ZR(J,K)*CONJG(ZR(J+1,L))+TP END DO SP(K,L) =TP SPT(K,L)=SP (K,L) TM=0 DO J=2,NMX,2 TM=ZR(J,K)*CONJG(ZR(J-1,L)) +TM END DO SM(K,L) =TM SMT(K,L)=SM (K,L) 400 CONTINUE GO TO 567 ENDIF IF (APARTOT.EQ.0.AND.APERTOT.EQ.0.AND.APERTOT2.EQ.0. & AND.EPARATOT.EQ.0.AND.GX.EQ.GY.AND.GX.EQ.GZ.AND.IREL.EQ.1)THEN IF (INDEX.EQ.1)THEN WRITE(6,*)'DIM. MATRIX', NMX ENDIF INDEX=INDEX+1 C MATRIX OF ENERGY IN ZERO FIELD SPLITTING X=BZ*2*3.1415927*658.2 ZC=X*CT ZS=X*ST DO 5200 I=1,NMX DO 5200 J=1,NMX 5200 AR(I,J)=0. S = FLOAT(NMX - 1)/2. SS = S*(S + 1.) DO I = 1, NMX COEF = S - DFLOAT(I - 1) AR(I,I) = COEF*ZC*GZ + DPARA*(COEF**2 - SS/3.) IF(I.LT.NMX) THEN AR(I,I+1) = COEFFH*0.5*ZS*GY*SQRT(SS-(COEF-1.)*COEF) AR(I+1,I) = AR(I,I+1) END IF END DO IF (INDEX.EQ.2)THEN OPEN(UNIT=17,FILE='MAT') DO I=1,(2.*SI+1)*(2.*SPIN+1) DO J=1,(2.*SI+1)*(2.*SPIN+1) WRITE(17,*)AR(I,J) END DO WRITE(17,*)' ' END DO CLOSE(17) ENDIF INDEX=INDEX+1 DO 145 I=1,NMX DO 145 J=1,NMX ARR(I,J)=REAL(AR(I,J)) ARI(I,J)=IMAG(AR(I,J)) 145 CONTINUE CALL F02AXF(ARR,MBRANC,ARI,MBRANC,NMX,WR,ZRR,MBRANC,ZRI,MBRANC $ ,WK1,WK2,WK3,0) DO 146 I=1,NMX DO 146 J=1,NMX ZR(I,J)=CMPLX(ZRR(I,J),ZRI(I,J)) 146 CONTINUE I=1 OM(1,1)=0. OMOLD(1)=0. DO 570 K=1,NMX DO 570 L=1,NMX IF (K.EQ.L)GO TO 570 I=I+1 OM(K,L)=WR(K)-WR(L) OMOLD(I)=WR(K)-WR(L) 570 CONTINUE C PER SPIN (SZ) DIVERSI DA 1/2 DO J=1,NMX CO1(J)=(NMX-(2*J-1))/2. END DO DO J=1,NMX-1 CO2(J)=SQRT(SS-CO1(J+1)*(CO1(J+1)+1.)) END DO DO J=2,NMX CO3(J)=SQRT(SS-CO1(J-1)*(CO1(J-1)-1.)) END DO omega1=abs(wr(2)-wr(3)) !omold(5)) !ZFS omega2=abs(wr(1)-wr(2)) !omold(3)) !ZFS omega3=abs(wr(3)-wr(1)) !omold(2)) !ZFS cmp=zrr(3,3) czp=zrr(2,3) cpp=zrr(1,3) cmm=zrr(3,1) !solo Zeeman czm=zrr(2,1) cpm=zrr(1,1) cmz=zrr(3,2) czz=zrr(2,2) cpz=zrr(1,2) bfield=bz*6.283/GAMMAI C***************************************************************************** C*********** CACLULATION OF ELECTRONIC R2 ************************************ C*********** IN AXIAL ROUTINE ************************************ C***************************************************************************** !nuovo calcolo R2 !++00 a1=cpp*conjg(cpp)-2*czp*conjg(czp)+cmp*conjg(cmp) b1=cpp*conjg(czp)-czp*conjg(cmp) c1=conjg(czp)*cmp-czp*conjg(cpp) d1=cpp*conjg(cmp) e1=cmp*conjg(cpp) f1=cpz*conjg(cpz)-2*czz*conjg(czz)+cmz*conjg(cmz) g1=cpz*conjg(czz)-czz*conjg(cmz) h1=cmz*conjg(czz)-czz*conjg(cpz) ai1=cmz*conjg(cpz) al1=cpz*conjg(cmz) t10=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 !0++0 a1=cpz*conjg(cpp)-2*czz*conjg(czp)+cmz*conjg(cmp) b1=cpz*conjg(czp)-czz*conjg(cmp) c1=cmz*conjg(czp)-czz*conjg(cpp) d1=cpz*conjg(cmp) e1=cmz*conjg(cpp) f1=cpp*conjg(cpz)-2*czp*conjg(czz)+cmp*conjg(cmz) g1=cpp*conjg(czz)-czp*conjg(cmz) h1=cmp*conjg(czz)-czp*conjg(cpz) ai1=cpp*conjg(cmz) al1=cmp*conjg(cpz) t3=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 !0000 a1=cpz*conjg(cpz)-2*czz*conjg(czz)+cmz*conjg(cmz) b1=cpz*conjg(czz)-czz*conjg(cmz) c1=cmz*conjg(czz)-czz*conjg(cpz) d1=cmz*conjg(cpz) e1=cpz*conjg(cmz) f1=cpz*conjg(cpz)-2*czz*conjg(czz)+cmz*conjg(cmz) g1=cpz*conjg(czz)-czz*conjg(cmz) h1=cmz*conjg(czz)-czz*conjg(cpz) ai1=cmz*conjg(cpz) al1=cpz*conjg(cmz) t4=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 !0--0 a1=cpz*conjg(cpm)-2*czz*conjg(czm)+cmz*conjg(cmm) b1=cpz*conjg(czm)-czz*conjg(cmm) c1=cmz*conjg(czm)-czz*conjg(cpm) d1=cpz*conjg(cmm) e1=cmz*conjg(cpm) f1=cpm*conjg(cpz)-2*czm*conjg(czz)+cmm*conjg(cmz) g1=cpm*conjg(czz)-czm*conjg(cmz) h1=cmm*conjg(czz)-czm*conjg(cpz) ai1=cpm*conjg(cmz) al1=cmm*conjg(cpz) t5=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 !++++ a1=cpp*conjg(cpp)-2*czp*conjg(czp)+cmp*conjg(cmp) b1=cpp*conjg(czp)-czp*conjg(cmp) c1=conjg(czp)*cmp-czp*conjg(cpp) d1=cpp*conjg(cmp) e1=cmp*conjg(cpp) f1=cpp*conjg(cpp)-2*czp*conjg(czp)+cmp*conjg(cmp) g1=cpp*conjg(czp)-czp*conjg(cmp) h1=conjg(czp)*cmp-czp*conjg(cpp) ai1=cpp*conjg(cmp) al1=cmp*conjg(cpp) t6=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 !-++- a1=cpp*conjg(cpm)-2*czp*conjg(czm)+cmp*conjg(cmm) b1=cpp*conjg(czm)-czp*conjg(cmm) c1=cmp*conjg(czm)-czp*conjg(cpm) d1=cpp*conjg(cmm) e1=cmp*conjg(cpm) f1=cpm*conjg(cpp)-2*czm*conjg(czp)+cmm*conjg(cmp) g1=cpm*conjg(czp)-czm*conjg(cmp) h1=cmm*conjg(czp)-czm*conjg(cpp) ai1=cpm*conjg(cmp) al1=cmm*conjg(cpp) t78=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 rpzpz=-(2*t10*tauv & -t6*tauv & -2*t3* & tauv/(1+omega1**2*tauv**2) & -t78* & tauv/(1+omega3**2*tauv**2) & -t4*tauv & -t5* & tauv/(1+omega2**2*tauv**2)) !---- a1=cpm*conjg(cpm)-2*czm*conjg(czm)+cmm*conjg(cmm) b1=cpm*conjg(czm)-czm*conjg(cmm) c1=cmm*conjg(czm)-czm*conjg(cpm) d1=cpm*conjg(cmm) e1=cmm*conjg(cpm) f1=cpm*conjg(cpm)-2*czm*conjg(czm)+cmm*conjg(cmm) g1=cpm*conjg(czm)-czm*conjg(cmm) h1=cmm*conjg(czm)-czm*conjg(cpm) ai1=cpm*conjg(cmm) al1=cmm*conjg(cpm) t12=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 !00-- a1=cpz*conjg(cpz)-2*czz*conjg(czz)+cmz*conjg(cmz) b1=cpz*conjg(czz)-czz*conjg(cmz) c1=cmz*conjg(czz)-czz*conjg(cpz) d1=cmz*conjg(cpz) e1=cpz*conjg(cmz) f1=cpm*conjg(cpm)-2*czm*conjg(czm)+cmm*conjg(cmm) g1=cpm*conjg(czm)-czm*conjg(cmm) h1=cmm*conjg(czm)-czm*conjg(cpm) ai1=cpm*conjg(cmm) al1=cmm*conjg(cpm) t11=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 rzmzm=-(2*t11*tauv & -t3* & tauv/(1+omega1**2*tauv**2) & -t4*tauv & -2*t5* & tauv/(1+omega2**2*tauv**2) & -t78* & tauv/(1+omega3**2*tauv**2) & -t12*tauv) a1=cpp*conjg(cpz)-2*czp*conjg(czz)+cmp*conjg(cmz) b1=cpp*conjg(czz)-czp*conjg(cmz) c1=cmp*conjg(czz)-czp*conjg(cpz) d1=cpp*conjg(cmz) e1=cmp*conjg(cpz) f1=cpm*conjg(cpz)-2*czm*conjg(czz)+cmm*conjg(cmz) g1=cpm*conjg(czz)-czm*conjg(cmz) h1=cmm*conjg(czz)-czm*conjg(cpz) ai1=cpm*conjg(cmz) al1=cmm*conjg(cpz) t8=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 r1223zee=-t8* & (tauv/(1+omega1**2*tauv**2)+ & tauv/(1+omega2**2*tauv**2)) c****************************************************************************** c******************** R1223zfs ************************************************ if ((dpara.gt.ws).or.(beta.gt.0.07)) then cmp=zrr(3,3) !ZFS czp=zrr(2,3) cpp=zrr(1,3) cmm=zrr(3,2) czm=zrr(2,2) cpm=zrr(1,2) cmz=zrr(3,1) czz=zrr(2,1) cpz=zrr(1,1) omega1=abs(wr(1)-wr(3)) !omold(5)) !ZFS omega2=abs(wr(1)-wr(2)) !omold(3)) !ZFS omega3=abs(wr(3)-wr(2)) !omold(2)) !ZFS a1=cpp*conjg(cpz)-2*czp*conjg(czz)+cmp*conjg(cmz) b1=cpp*conjg(czz)-czp*conjg(cmz) c1=cmp*conjg(czz)-czp*conjg(cpz) d1=cpp*conjg(cmz) e1=cmp*conjg(cpz) f1=cpm*conjg(cpz)-2*czm*conjg(czz)+cmm*conjg(cmz) g1=cpm*conjg(czz)-czm*conjg(cmz) h1=cmm*conjg(czz)-czm*conjg(cpz) ai1=cpm*conjg(cmz) al1=cmm*conjg(cpz) t8=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 r1223zfs=-t8* & (tauv/(1+omega1**2*tauv**2)+ & tauv/(1+omega2**2*tauv**2)) endif omega1=abs(wr(2)-wr(3)) !omold(5)) !ZFS omega2=abs(wr(1)-wr(2)) !omold(3)) !ZFS omega3=abs(wr(3)-wr(1)) !omold(2)) !ZFS cmp=zrr(3,3) czp=zrr(2,3) cpp=zrr(1,3) cmm=zrr(3,1) !solo Zeeman czm=zrr(2,1) cpm=zrr(1,1) cmz=zrr(3,2) czz=zrr(2,2) cpz=zrr(1,2) c****************************************************************************** ! ++-0 a1=cpp*conjg(cpp)-2*czp*conjg(czp)+cmp*conjg(cmp) b1=cpp*conjg(czp)-czp*conjg(cmp) c1=conjg(czp)*cmp-czp*conjg(cpp) d1=cpp*conjg(cmp) e1=cmp*conjg(cpp) f1=cpm*conjg(cpz)-2*czm*conjg(czz)+cmm*conjg(cmz) g1=cpm*conjg(czz)-czm*conjg(cmz) h1=cmm*conjg(czz)-czm*conjg(cpz) ai1=cpm*conjg(cmz) al1=cmm*conjg(cpz) t51=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 ! +0-+ a1=cpp*conjg(cpz)-2*czp*conjg(czz)+cmp*conjg(cmz) b1=cpp*conjg(czz)-czp*conjg(cmz) c1=cmp*conjg(czz)-czp*conjg(cpz) d1=cpp*conjg(cmz) e1=cmp*conjg(cpz) f1=cpp*conjg(cpm)-2*czp*conjg(czm)+cmp*conjg(cmm) g1=cpp*conjg(czm)-czp*conjg(cmm) h1=cmp*conjg(czm)-czp*conjg(cpm) ai1=cpp*conjg(cmm) al1=cmp*conjg(cpm) t52=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 ! 00-0 a1=cpz*conjg(cpz)-2*czz*conjg(czz)+cmz*conjg(cmz) b1=cpz*conjg(czz)-czz*conjg(cmz) c1=cmz*conjg(czz)-czz*conjg(cpz) d1=cmz*conjg(cpz) e1=cpz*conjg(cmz) f1=cpm*conjg(cpz)-2*czm*conjg(czz)+cmm*conjg(cmz) g1=cpm*conjg(czz)-czm*conjg(cmz) h1=cmm*conjg(czz)-czm*conjg(cpz) ai1=cpm*conjg(cmz) al1=cmm*conjg(cpz) t53=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 ! -0-- a1=cpm*conjg(cpz)-2*czm*conjg(czz)+cmm*conjg(cmz) b1=cpm*conjg(czz)-czm*conjg(cmz) c1=cmm*conjg(czz)-czm*conjg(cpz) d1=cpm*conjg(cmz) e1=cmm*conjg(cpz) f1=cpm*conjg(cpm)-2*czm*conjg(czm)+cmm*conjg(cmm) g1=cpm*conjg(czm)-czm*conjg(cmm) h1=cmm*conjg(czm)-czm*conjg(cpm) ai1=cpm*conjg(cmm) al1=cmm*conjg(cpm) t54=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 r1213=-(t51*tauv+t51* & tauv/(1+omega2**2*tauv**2) & -t52* & tauv/(1+omega3**2*tauv**2) & -t53* & tauv/(1+omega2**2*tauv**2) & -t54*tauv) ! 0-+- a1=cpz*conjg(cpm)-2*czz*conjg(czm)+cmz*conjg(cmm) b1=cpz*conjg(czm)-czz*conjg(cmm) c1=cmz*conjg(czm)-czz*conjg(cpm) d1=cpz*conjg(cmm) e1=cmz*conjg(cpm) f1=cpm*conjg(cpp)-2*czm*conjg(czp)+cmm*conjg(cmp) g1=cpm*conjg(czp)-czm*conjg(cmp) h1=cmm*conjg(czp)-czm*conjg(cpp) ai1=cpm*conjg(cmp) al1=cmm*conjg(cpp) t41=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 r2331=-t41* & (tauv/(1+omega3**2*tauv**2)+ & tauv/(1+omega2**2*tauv**2)) rt2a=(rpzpz+rzmzm+sqrt((rpzpz-rzmzm)**2+4*r1223**2))/2 rt2b=(rpzpz+rzmzm-sqrt((rpzpz-rzmzm)**2+4*r1223**2))/2 !++-- a1=cpp*conjg(cpp)-2*czp*conjg(czp)+cmp*conjg(cmp) b1=cpp*conjg(czp)-czp*conjg(cmp) c1=conjg(czp)*cmp-czp*conjg(cpp) d1=cpp*conjg(cmp) e1=cmp*conjg(cpp) f1=cpm*conjg(cpm)-2*czm*conjg(czm)+cmm*conjg(cmm) g1=cpm*conjg(czm)-czm*conjg(cmm) h1=cmm*conjg(czm)-czm*conjg(cpm) ai1=cpm*conjg(cmm) al1=cmm*conjg(cpm) t21=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 rpmpm=-(2*t21*tauv & -t6*tauv & -t3* & tauv/(1+omega1**2*tauv**2) & -2*t78* & tauv/(1+omega3**2*tauv**2) & -t5* & tauv/(1+omega2**2*tauv**2) & -t12*tauv) C***************************************************************************** C*********** CALCULATION OF ELECTRONIC R1 ************************************ C*********** IN AXIAL ROUTINE ************************************ C***************************************************************************** ! originali a1=cpz*cpp-2*czz*czp+cmz*cmp b1=cpz*czp-czz*cmp c1=cmz*czp-czz*cpp d1=cpz*cmp e1=cmz*cpp f1=cpp*cpz-2*czp*czz+cmp*cmz g1=cpp*czz-czp*cmz h1=cmp*czz-czp*cpz ai1=cpp*cmz al1=cmp*cpz trhoa=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 rhoa=2*trhoa* & tauv/(1+omega1**2*tauv**2) a1=cpp*cpm-2*czp*czm+cmp*cmm b1=cpp*czm-czp*cmm c1=cmp*czm-czp*cpm d1=cpp*cmm e1=cmp*cpm f1=cpm*cpp-2*czm*czp+cmm*cmp g1=cpm*czp-czm*cmp h1=cmm*czp-czm*cpp ai1=cpm*cmp al1=cmm*cpp trhob=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 rhob=2*trhob* & tauv/(1+omega3**2*tauv**2) a1=cpz*cpm-2*czz*czm+cmz*cmm b1=cpz*czm-czz*cmm c1=cmz*czm-czz*cpm d1=cpz*cmm e1=cmz*cpm f1=cpm*cpz-2*czm*czz+cmm*cmz g1=cpm*czz-czm*cmz h1=cmm*czz-czm*cpz ai1=cpm*cmz al1=cmm*cpz trhoc=a1*f1/6.-(c1*g1+b1*h1)/2.+e1*ai1+d1*al1 rhoc=2*trhoc* & tauv/(1+omega2**2*tauv**2) C****************************************************************************** C********** WRITING RELAXATION RATES IN AXIAL TOUTINE ************************* C****************************************************************************** part=(rhoa+rhob+rhoc) if(abs(rhoa/2.+rhoc/2.).gt.abs(rhob))then rt1=(part-sqrt(part**2-3.*(rhoa*rhob+rhoa*rhoc+rhob*rhoc))) else rt1=(part+sqrt(part**2-3.*(rhoa*rhob+rhoa*rhoc+rhob*rhoc))) endif rt11=(part-sqrt(part**2-3.*(rhoa*rhob+rhoa*rhoc+rhob*rhoc))) rt12=(part+sqrt(part**2-3.*(rhoa*rhob+rhoa*rhoc+rhob*rhoc))) rt1=rt1*sqrt(abs(dpara-ws)/(dpara+ws))+(rt11+rt12)/2* ^ (1-sqrt(abs(dpara-ws)/(dpara+ws))) bfield=bz*6.283/GAMMAI if (beta.gt.1.55) then endif !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C***************************************************************************** C*************** DEFINITION OF SUPERMATRIX *********************************** C*************** IN AXIAL ROUTINE *********************************** C***************************************************************************** a=delta**2/5.*rhoa b=delta**2/5.*rhoc cp=delta**2/5.*rhob d=1./taur e=wi ! write(6,*)a,b,cp,d,e a11=(d*(3*b*cp+3*a*(b+cp)+2*(a+b+cp)*d+d*d)*(d*(cp+d)+a* & (b+cp+d)+b*(cp+2*d))+(4*b*b*(cp+d)+2*d*(cp+d)**2+ & a*a*(b+cp+2*d)+b*(cp*cp+6*cp*d+4*d*d)+a*(4*b*b+6*b* & (cp+d)+(cp+2*d)**2))*e*e+(a+cp+d)*e**4)/ & ((d**2+e**2)*((3*b*cp+3*a*(b+cp)+2*(a+b+cp)*d+d*d)**2+ & 2*(2*a*a+a*b+2*b*b+a*cp+b*cp+2*cp*cp+2*(a+b+cp)*d+d*d)* & e*e+e**4)) a12=(d*(3*b*cp+3*a*(b+cp)+2*(a+b+cp)*d+d*d)*(b*cp+a* & (b+cp+d))+(a*a*(b+cp+2*d)-b*cp*(2*(b+cp)+3*d)- & a*(2*b*b+cp*(2*cp+d)+b*(3*cp+d)))*e*e-a*e**4)/ & ((d**2+e**2)*((3*b*cp+3*a*(b+cp)+2*(a+b+cp)*d+d*d)**2+ & 2*(2*a*a+a*b+2*b*b+a*cp+b*cp+2*cp*cp+2*(a+b+cp)*d+d*d)* & e*e+e**4)) a13=(d*(3*b*cp+3*a*(b+cp)+2*(a+b+cp)*d+d*d)*(a*(b+cp)+cp*(b+d))- & (2*a*a*(b+cp)+cp*(2*b*b-2*cp*d+b*(-cp+d))+a*(2*b*b+cp* & (-cp+d)+3*b*(cp+d)))*e*e-cp*e**4)/ & ((d**2+e**2)*((3*b*cp+3*a*(b+cp)+2*(a+b+cp)*d+d*d)**2+ & 2*(2*a*a+a*b+2*b*b+a*cp+b*cp+2*cp*cp+2*(a+b+cp)*d+d*d)* & e*e+e**4)) a21=(d*(3*b*cp+3*a*(b+cp)+2*(a+b+cp)*d+d*d)*(b*cp+a* & (b+cp+d))+(a*a*(b+cp+2*d)-b*cp*(2*(b+cp)+3*d)- & a*(2*b*b+cp*(2*cp+d)+b*(3*cp+d)))*e*e-a*e**4)/ & ((d**2+e**2)*((3*b*cp+3*a*(b+cp)+2*(a+b+cp)*d+d*d)**2+ & 2*(2*a*a+a*b+2*b*b+a*cp+b*cp+2*cp*cp+2*(a+b+cp)*d+d*d)* & e*e+e**4)) a22=(d*(3*b*cp+3*a*(b+cp)+2*(a+b+cp)*d+d*d)*(b*(cp+d)+a* & (b+cp+d)+d*(2*cp+d))+(a*a*b+a*b*b+a*a*cp+6*a*b*cp+b*b*cp+ & 4*a*cp*cp+4*b*cp*cp+2*(a+b+cp)*(a+b+2*cp)*d+4*(a+b+cp)* & d*d+2*d**3)*e*e+(a+b+d)*e**4)/ & ((d**2+e**2)*((3*b*cp+3*a*(b+cp)+2*(a+b+cp)*d+d*d)**2+ & 2*(2*a*a+a*b+2*b*b+a*cp+b*cp+2*cp*cp+2*(a+b+cp)*d+d*d)* & e*e+e**4)) a23=(d*(3*b*cp+3*a*(b+cp)+2*(a+b+cp)*d+d*d)*(a*(b+cp)+b*(cp+d))- & (2*a*a*(b+cp)+b*(cp*(2*cp+d)-b*(cp+2*d))+a*(-b*b+b*(3*cp+d) + & cp*(2*cp+3*d)))*e*e-b*e**4)/ & ((d**2+e**2)*((3*b*cp+3*a*(b+cp)+2*(a+b+cp)*d+d*d)**2+ & 2*(2*a*a+a*b+2*b*b+a*cp+b*cp+2*cp*cp+2*(a+b+cp)*d+d*d)* & e*e+e**4)) a31=(d*(3*b*cp+3*a*(b+cp)+2*(a+b+cp)*d+d*d)*(a*(b+cp)+cp*(b+d))- & (2*a*a*(b+cp)+cp*(2*b*b-2*cp*d+b*(-cp+d))+a*(2*b*b+cp* & (-cp+d)+3*b*(cp+d)))*e*e-cp*e**4)/ & ((d**2+e**2)*((3*b*cp+3*a*(b+cp)+2*(a+b+cp)*d+d*d)**2+ & 2*(2*a*a+a*b+2*b*b+a*cp+b*cp+2*cp*cp+2*(a+b+cp)*d+d*d)* & e*e+e**4)) a32=(d*(3*b*cp+3*a*(b+cp)+2*(a+b+cp)*d+d*d)*(a*(b+cp)+b*(cp+d))- & (2*a*a*(b+cp)+b*(cp*(2*cp+d)-b*(cp+2*d))+a*(-b*b+b*(3*cp+d) + & cp*(2*cp+3*d)))*e*e-b*e**4)/ & ((d**2+e**2)*((3*b*cp+3*a*(b+cp)+2*(a+b+cp)*d+d*d)**2+ & 2*(2*a*a+a*b+2*b*b+a*cp+b*cp+2*cp*cp+2*(a+b+cp)*d+d*d)* & e*e+e**4)) a33=(d*(3*b*cp+3*a*(b+cp)+2*(a+b+cp)*d+d*d)*((b+d)*(cp+d)+a* & (b+cp+2*d))+(2*d*(cp+d)**2+4*a*a*(b+cp+d)+b*b*(cp+2*d)+b & *(cp+2*d)**2+a*(b**2+cp**2+6*cp*d+4*d**2+6*b*(cp+d)))* & e*e+(b+cp+d)*e**4)/ & ((d**2+e**2)*((3*b*cp+3*a*(b+cp)+2*(a+b+cp)*d+d*d)**2+ & 2*(2*a*a+a*b+2*b*b+a*cp+b*cp+2*cp*cp+2*(a+b+cp)*d+d*d)* & e*e+e**4)) c*************** defined in Zeeman limit *********************************** a=(delta**2/5.)*rpzpz b=(delta**2/5.)*rzmzm f=(delta**2/5.)*rpmpm cp=(delta**2/5.)*r1223 d=1.0/taur e=wi ea=omega1 eb=omega2 cpzfs=(delta**2/5.)*r1223zfs cpzee=(delta**2/5.)*r1223zee c****************************************************************************** c**************** Check secular approximation for R1223 *********************** c****************************************************************************** if (dpara.gt.ws) then w1zfs=omega3+e w2zfs=omega2+e w3zfs=omega1+e a44r1=real(f)+d a55r1=real(b)+d a44zfs=dcmplx(a44r1,w1zfs) a55zfs=dcmplx(a55r1,w2zfs) cpzfs1=cdabs(cpzfs/(a44zfs-a55zfs)) else w1zee=omega1 w2zee=omega2 w3zee=omega3 a44r2=real(a)+d a55r2=real(b)+d a44zee=dcmplx(a44r2,w1zee) a55zee=dcmplx(a55r2,w2zee) cpzee1=cdabs(cpzee/(a44zee-a55zee)) endif c*********** COMMENT: I FOUND THE DC APPROXIMATION UNNECESSARY, MEAMI.********* c****************************************************************************** c****************************************************************************** C************ defined in zfs or Zeeman **************************************** C****************************************************************************** if ((dpara.gt.ws).or.(beta.gt.0.07)) then a=(delta**2/5.)*rpmpm b=(delta**2/5.)*rzmzm f=(delta**2/5.)*rpzpz cp=cpzfs d=1.0/taur e=wi ea=omega3 eb=omega2 ec=omega1 else a=(delta**2/5.)*rpzpz b=(delta**2/5.)*rzmzm f=(delta**2/5.)*rpmpm cp=cpzee d=1.0/taur e=wi ea=omega1 eb=omega2 ec=omega3 endif c*************************** writing out eigenvalues for R2e ***************** rt2a=(a+b+sqrt((a-b)**2+4*cp**2))/2 rt2b=(a+b-sqrt((a-b)**2+4*cp**2))/2 rt2c=f if (beta.lt.0.06) then c WRITE(6,*)bfield,rt2a c WRITE(6,*)bfield,rt2b c WRITE(6,*)bfield,rt2c endif c****************************************************************************** a44=(b**2*d-b*(cp**2-2*d**2)+d*(-(cp**2)+d**2+(e+eb)**2)+ & a*((b+d)**2+(e+eb)**2))/(cp**4+2*cp**2*(-d*(b+d)+ & (e+ea)*(e+eb))+a**2*((b+d)**2+(e+eb)**2)+(d**2+(e+ea)**2)* & ((b+d)**2+(e+eb)**2)+2*a*(b**2*d-b*(cp**2-2*d**2)+ & d*(-(cp**2)+d**2+(e+eb)**2))) a55=(-(cp**2)*d+a**2*(b+d)+a*(-(cp**2)+2*d*(b+d))+(b+d)* & (d**2+(e+ea)**2))/(cp**4+2*cp**2*(-d*(b+d)+ & (e+ea)*(e+eb))+a**2*((b+d)**2+(e+eb)**2)+(d**2+(e+ea)**2)* & ((b+d)**2+(e+eb)**2)+2*a*(b**2*d-b*(cp**2-2*d**2)+ & d*(-(cp**2)+d**2+(e+eb)**2))) a45=-(cp*(-(cp**2)+(a+d)*(b+d)-(e+ea)*(e+eb)))/ & ((cp**2-(a+d)*(b+d)+(e+ea)*(e+eb))**2+ & (b*(e+ea)+a*(e+eb)+d*(2*e+ea+eb))**2) a54=a45 taus3=1./(d+f) a66=taus3/(1+(wi+ec)**2*taus3**2) a77=a44 a88=a55 a78=a45 a87=a78 a99=a66 a65=0.0d0 a56=0.0d0 a89=0.0d0 a98=0.0d0 if (dpara.gt.ws) then astore1=a44 astore2=a66 a44=a99 a66=a77 a99=astore1 a77=astore2 a65=a45 a56=a65 a89=a65 a98=a65 a45=0.0d0 a54=0.0d0 a78=0.0d0 a87=0.0d0 endif C****************************************************************************** C******** DEFINITION OF COEFF. MATRIX FOR DIAGONALIZED H0 ********************* C******** IN AXIAL ROUTINE ********************* C****************************************************************************** zrn(1,1)=zr(1,3) !Zeeman zrn(1,2)=zr(2,3) zrn(1,3)=zr(3,3) zrn(2,1)=zr(1,2) zrn(2,2)=zr(2,2) zrn(2,3)=zr(3,2) zrn(3,1)=zr(1,1) zrn(3,2)=zr(2,1) zrn(3,3)=zr(3,1) C****************************************************************************** C************** DIAGONALIZATION OF COEFF. MATRIX ****************************** C************** IN AXIAL ROUTINE ****************************** C****************************************************************************** lda=3 num=3 call zgefa(zrn,lda,num,ipvt,info) job=01 call zgedi(zrn,lda,num,ipvt,det,work,job) ak11=zrn(1,1) ak12=zrn(1,2) ak13=zrn(1,3) ak21=zrn(2,1) ak22=zrn(2,2) ak23=zrn(2,3) ak31=zrn(3,1) ak32=zrn(3,2) ak33=zrn(3,3) C****************************************************************************** C************* LIOUVILLE SPACE REPRESENTATION OF S-OPERATORS ****************** C************* PROJECTION VECTORS IN AXIAL ROUTINE ****************** C****************************************************************************** cz1=ak11**2-ak31**2 cz2=ak12**2-ak32**2 cz3=ak13**2-ak33**2 cz4=ak11*ak12-ak31*ak32 cz5=ak12*ak13-ak32*ak33 cz6=ak11*ak13-ak31*ak33 cz7=ak12*ak11-ak32*ak31 cz8=ak13*ak12-ak33*ak32 cz9=ak13*ak11-ak33*ak31 cp1=-sqrt(2.)*(ak21*ak31+ak11*ak21) cp2=-sqrt(2.)*(ak22*ak32+ak12*ak22) cp3=-sqrt(2.)*(ak23*ak33+ak13*ak23) cp4=-sqrt(2.)*(ak21*ak32+ak11*ak22) cp5=-sqrt(2.)*(ak22*ak33+ak12*ak23) cp6=-sqrt(2.)*(ak21*ak33+ak11*ak23) cp7=-sqrt(2.)*(ak22*ak31+ak12*ak21) cp8=-sqrt(2.)*(ak23*ak32+ak13*ak22) cp9=-sqrt(2.)*(ak23*ak31+ak13*ak21) cm1=sqrt(2.)*(ak31*ak21+ak21*ak11) cm2=sqrt(2.)*(ak32*ak22+ak22*ak12) cm3=sqrt(2.)*(ak33*ak23+ak23*ak13) cm4=sqrt(2.)*(ak31*ak22+ak21*ak12) cm5=sqrt(2.)*(ak32*ak23+ak22*ak13) cm6=sqrt(2.)*(ak31*ak23+ak21*ak13) cm7=sqrt(2.)*(ak32*ak21+ak22*ak11) cm8=sqrt(2.)*(ak33*ak22+ak23*ak12) cm9=sqrt(2.)*(ak33*ak21+ak23*ak11) C****************************************************************************** C**************** PROJECTION OF SUPERMATRIX *********************************** C**************** IN AXIAL ROUTINE *********************************** C****************************************************************************** ammcz1=a11*1e9*cz1+a12*1e9*cz2+a13*1e9*cz3 ammcz2=a21*1e9*cz1+a22*1e9*cz2+a23*1e9*cz3 ammcz3=a31*1e9*cz1+a32*1e9*cz2+a33*1e9*cz3 ammcz4=a44*1e9*cz4+a45*1e9*cz5 ammcz5=a55*1e9*cz5+a54*1e9*cz4+a56*1e9*cz6 ammcz6=a66*1e9*cz6+a65*1e9*cz5 ammcz7=a77*1e9*cz7+a78*1e9*cz8 ammcz8=a88*1e9*cz8+a87*1e9*cz7+a89*1e9*cz9 ammcz9=a99*1e9*cz9+a98*1e9*cz8 ammcp1=a11*1e9*cp1+a12*1e9*cp2+a13*1e9*cp3 ammcp2=a21*1e9*cp1+a22*1e9*cp2+a23*1e9*cp3 ammcp3=a31*1e9*cp1+a32*1e9*cp2+a33*1e9*cp3 ammcp4=a44*1e9*cp4+a45*1e9*cp5 ammcp5=a55*1e9*cp5+a54*1e9*cp4+a56*1e9*cp6 ammcp6=a66*1e9*cp6+a65*1e9*cp5 ammcp7=a77*1e9*cp7+a78*1e9*cp8 ammcp8=a88*1e9*cp8+a87*1e9*cp7+a89*1e9*cp9 ammcp9=a99*1e9*cp9+a98*1e9*cp8 ammcm1=a11*1e9*cm1+a12*1e9*cm2+a13*1e9*cm3 ammcm2=a21*1e9*cm1+a22*1e9*cm2+a23*1e9*cm3 ammcm3=a31*1e9*cm1+a32*1e9*cm2+a33*1e9*cm3 ammcm4=a44*1e9*cm4+a45*1e9*cm5 ammcm5=a55*1e9*cm5+a54*1e9*cm4+a56*1e9*cm6 ammcm6=a66*1e9*cm6+a65*1e9*cm5 ammcm7=a77*1e9*cm7+a78*1e9*cm8 ammcm8=a88*1e9*cm8+a87*1e9*cm7+a89*1e9*cm9 ammcm9=a99*1e9*cm9+a98*1e9*cm8 C****************************************************************************** C**************** SPECTRAL DENSITIES OF S ************************************* C**************** IN AXIAL ROUTINE ************************************* C****************************************************************************** !cz M cz primo=abs(cz1*ammcz1+cz2*ammcz2+cz3*ammcz3)+abs(cz4*ammcz4+ & cz5*ammcz5+cz6*ammcz6+cz7*ammcz7+cz8*ammcz8+cz9*ammcz9) !cp M cp secondo=abs(cp1*ammcp1+cp2*ammcp2+cp3*ammcp3)+abs(cp4*ammcp4+ & cp5*ammcp5+cp6*ammcp6+cp7*ammcp7+cp8*ammcp8+cp9*ammcp9) !cp M cm terzo=abs(cp1*ammcm1+cp2*ammcm2+cp3*ammcm3)+abs(cp4*ammcm4+ & cp5*ammcm5+cp6*ammcm6+cp7*ammcm7+cp8*ammcm8+cp9*ammcm9) !cp M cz quarto=abs(cp1*ammcz1+cp2*ammcz2+cp3*ammcz3)+abs(cp4*ammcz4+ & cp5*ammcz5+cp6*ammcz6+cp7*ammcz7+cp8*ammcz8+cp9*ammcz9) COLD(1,1)=gz**2*abs(secondo) COLD(1,2)=gz**2*abs(quarto) COLD(1,3)=gz**2*abs(terzo) COLD(1,4)=gz**2*abs(primo) !cm M cp quinto=cm1*ammcp1+cm2*ammcp2+cm3*ammcp3+cm4*ammcp4+cm5*ammcp5+ & cm6*ammcp6+cm7*ammcp7+cm8*ammcp8+cm9*ammcp9 !cm M cm sesto=cm1*ammcm1+cm2*ammcm2+cm3*ammcm3+cm4*ammcm4+cm5*ammcm5+ & cm6*ammcm6+cm7*ammcm7+cm8*ammcm8+cm9*ammcm9 !cm M cz settimo=cm1*ammcz1+cm2*ammcz2+cm3*ammcz3+cm4*ammcz4+cm5*ammcz5+ & cm6*ammcz6+cm7*ammcz7+cm8*ammcz8+cm9*ammcz9 !cz M cp ottavo=cz1*ammcp1+cz2*ammcp2+cz3*ammcp3+cz4*ammcp4+cz5*ammcp5+ & cz6*ammcp6+cz7*ammcp7+cz8*ammcp8+cz9*ammcp9 !cz M cm onono=cz1*ammcm1+cz2*ammcm2+cz3*ammcm3+cz4*ammcm4+cz5*ammcm5+ & cz6*ammcm6+cz7*ammcm7+cz8*ammcm8+cz9*ammcm9 C****************************************************************************** C**************** SPECTRAL DENSITIES OF G ************************************* C**************** IN AXIAL ROUTINE ************************************* C****************************************************************************** C AUTOCORRELATION FUNCTIONS C(1,1,11)=secondo C(1,1,12)=sesto C(1,1,13)=quinto C(1,1,14)= terzo C(1,1,15)=quarto C(1,1,16)= ottavo C(1,1,17)=settimo C(1,1,18)=onono C(1,1,19)=primo 540 CONTINUE GO TO 567 ENDIF 456 CONTINUE C GENERAL MATRIX OF ENERGY X=BZ*3.1415927*658.2 ZC=X*CT ZS=X*ST DO I=1,(2.*SI+1)*(2.*SPIN+1)*2 DO J=1,(2.*SI+1)*(2.*SPIN+1)*2 AR(I,J)=0. END DO END DO SSI = SI*(SI + 1.) SS=SPIN*(SPIN+1.) ISMS=2.*SPIN+1 K=0 DO I=1,(2.*SI+1)*(2.*SPIN+1),2.*SPIN+1 DO J=0,2.*SPIN COEF = SI - K COEF2 = SPIN-J AR(I+J,I+J)=2.*(SPIN-J)*ZC*GZ + (SPIN-J)*AZ*(SI-K)+DPARA* $ (COEF2**2-SS/3.)+S4/120.*(35.*COEF2**4-30.*SS*COEF2**2+ $ 25.*COEF2**2-6.*SS+3.*SS**2) IF (J+1.LT.2.*SPIN+1) THEN AR(I+J,I+J+1)=CMPLX(COEFFH*ZS*GX*COS(GAMMA)*SQRT(SS- $ (COEF2-1.)*COEF2),-ZS*GY*SIN(GAMMA)*SQRT(SS-(COEF2-1.)*COEF2)) AR(I+J+1,I+J)=CMPLX(COEFFH*ZS*GX*COS(GAMMA)*SQRT(SS-(COEF2-1.)* $ COEF2),ZS*GY*SIN(GAMMA)*SQRT(SS-(COEF2-1.)*COEF2)) IF (J+2.LT.2.*SPIN+1) THEN AR(I+J,I+J+2)=EPARA* & SQRT(SS-COEF2*(COEF2-1.))* & SQRT(SS-(COEF2-1.)*(COEF2-2.))/2. AR(I+J+2,I+J)=AR(I+J,I+J+2) ENDIF IF (J+4.LT.2.*SPIN+1) THEN AR(I+J,I+J+4)=S4/48.* & SQRT(SS-COEF2*(COEF2-1.))* & SQRT(SS-(COEF2-1.)*(COEF2-2.))* & SQRT(SS-(COEF2-2.)*(COEF2-3.))* & SQRT(SS-(COEF2-3.)*(COEF2-4.)) AR(I+J+4,I+J)=AR(I+J,I+J+4) ENDIF IF (I+(2.*SPIN+1)+J.LE.(2.*SPIN+1)*(2.*SI+1))THEN AR(I+(ISMS)+J,(I+1+J))=.5*(AX+AY)/2.*SQRT(SSI-(COEF-1.)*COEF)* $ SQRT(SS-(COEF2-1.)*COEF2) AR((I+1+J),I+(ISMS)+J)= AR(I+(ISMS)+J,(I+1+J)) ENDIF IF (I+(2.*SPIN+1)+J+1.LE.(2.*SPIN+1)*(2.*SI+1))THEN AR(I+(ISMS)+J+1,(I+J))=.5*(AX-AY)/2.*SQRT(SSI-(COEF-1.)*COEF)* $ SQRT(SS-(COEF2-1.)*COEF2) AR((I+J),I+(ISMS)+J+1)= AR(I+(ISMS)+J+1,(I+J)) ENDIF ENDIF END DO K=K+1 END DO IF (INDEX.EQ.1)THEN WRITE(6,*)'DIM. MATRIX', NMX OPEN(UNIT=17,FILE='MAT') DO I=1,(2.*SI+1)*(2.*SPIN+1) DO J=1,(2.*SI+1)*(2.*SPIN+1) WRITE(17,*)AR(I,J) END DO WRITE(17,*)' ' END DO CLOSE(17) ENDIF INDEX=INDEX+1 C WR EIGENVALUES ZR EIGENVECTORS DO 245 I=1,NMX DO 245 J=1,NMX ARR(I,J)=REAL(AR(I,J)) ARI(I,J)=IMAG(AR(I,J)) 245 CONTINUE CALL F02AXF(ARR,MBRANC,ARI,MBRANC,NMX,WR,ZRR,MBRANC,ZRI,MBRANC $ ,WK1,WK2,WK3,0) DO 246 I=1,NMX DO 246 J=1,NMX ZR(I,J)=CMPLX(ZRR(I,J),ZRI(I,J)) ! write(70,*)i,j,zr(i,j),wr(j) !scrivi 246 CONTINUE I=1 OM(1,1)=0. OMOLD(1)=0. DO 70 K=1,NMX DO 70 L=1,NMX IF (K.EQ.L)GO TO 70 I=I+1 OM(K,L)=WR(K)-WR(L) OMOLD(I)=WR(K)-WR(L) 70 CONTINUE J=0 DO I=1,(2.*SI+1)*(2.*SPIN+1) J=J+1 IF (J.GT.(2*SPIN+1)) J=1 CO1(I)=(2*SPIN+1-(2*J-1))/2. C CO1(I)=-((-1.)**J) END DO DO I=1,(2.*SI+1)*(2.*SPIN+1)
From: Nick Keighley on 21 Oct 2009 06:16 On 21 Oct, 08:03, "http://alexslemonade.org @ http://MeAmI.org" <marty.musa...(a)gmail.com> wrote: > n = 200819. 2. 782 > therefore increment t > s = a * sp + b * sq mod N. where. sp=mdp mod (p) and sq=mdq mod (q) > a/b = (rp. m+1. ± sp. m )/(rq. m+1. ± sq. m ) > [a, b, s:1] presents a plot of the mod-4 prime race over the interval > [a, b] > Let it ride:http://meami.org(C) All Rights Reserved. > +http://buildasearch.com/meami > c=Copywrite(C) 2009. [at] (c) Copyright:http://MEAMI[dot]ORG > ! Programma FINALE > > ! versione risc1 IBM > ! versione FINALE nel caso assiale > ! versione FINALE nel caso rombico (non funziona in assenza di ZFS) > > C PARAMAGNETIC ENHANCEMENT IN NMRD PROFILE <snip> > IMPLICIT REAL*8(A-H,O-Z) > PARAMETER(PI2 = 6.2831853, VL = 2.9979D+10) > COMMON /SET/SET don't post the same stuff over and over again. don't post Fortran to comp.lang.c. <snip>
From: Richard Heathfield on 21 Oct 2009 06:49 In <8cd1164c-9d0f-4dc5-ae93-13f2bfeb8888(a)d23g2000vbm.googlegroups.com>, Nick Keighley wrote: > On 21 Oct, 08:03, "http://alexslemonade.org @ http://MeAmI.org" > <marty.musa...(a)gmail.com> wrote: <snip> >> IMPLICIT REAL*8(A-H,O-Z) >> PARAMETER(PI2 = 6.2831853, VL = 2.9979D+10) >> COMMON /SET/SET > > don't post the same stuff over and over again. > don't post Fortran to comp.lang.c. Attempts to educate him (in comp.programming) have failed miserably - their only effect is to clutter up the newsgroup. You could try submitting an abuse report, I guess, but there seems to be no point in trying to wise him up within Usenet itself. -- Richard Heathfield <http://www.cpax.org.uk> Email: -http://www. +rjh@ "Usenet is a strange place" - dmr 29 July 1999 Sig line vacant - apply within
From: Dik T. Winter on 21 Oct 2009 07:16 In article <8cd1164c-9d0f-4dc5-ae93-13f2bfeb8888(a)d23g2000vbm.googlegroups.com> Nick Keighley <nick_keighley_nospam(a)hotmail.com> writes: > On 21 Oct, 08:03, "http://alexslemonade.org @ http://MeAmI.org" > <marty.musa...(a)gmail.com> wrote: .... > don't post the same stuff over and over again. > don't post Fortran to comp.lang.c. Don't reply to Marty Musatov who has already succeeded in making sci.math unreadable. -- dik t. winter, cwi, science park 123, 1098 xg amsterdam, nederland, +31205924131 home: bovenover 215, 1025 jn amsterdam, nederland; http://www.cwi.nl/~dik/
From: Nick Keighley on 21 Oct 2009 07:42 On 21 Oct, 12:16, "Dik T. Winter" <Dik.Win...(a)cwi.nl> wrote: > In article <8cd1164c-9d0f-4dc5-ae93-13f2bfeb8...(a)d23g2000vbm.googlegroups..com> Nick Keighley <nick_keighley_nos...(a)hotmail.com> writes: > > On 21 Oct, 08:03, "http://alexslemonade.org(a)http://MeAmI.org" > <marty.musa...(a)gmail.com> wrote: > > ... > > don't post the same stuff over and over again. > > don't post Fortran to comp.lang.c. > > Don't reply to Marty Musatov who has already succeeded in making sci.math > unreadable. ah, I hadn't recognised him
|
Next
|
Last
Pages: 1 2 Prev: Riemann-Siegel Z function and Lehmer's phenomenon Next: 【 P = NP Quod Erat Demonstrandum 】の検索結果 |