Документ взят из кэша поисковой машины. Адрес оригинального документа : http://www.uafo.ru/sw90/pdf/rkgs.pdf Дата изменения: Sun May 31 08:20:19 2015 Дата индексирования: Sat Apr 9 22:34:31 2016 Кодировка: Поисковые слова: п п п п п п п п п п

- , , :
TYPE TyETA = RECORD DL : REAL; X : REAL; EP,EB,ER : REAL; RP,RB,RR : REAL; EI,EQ,EU,EV : REAL; RQ,RU,RV : REAL; EC : REAL; EF : REAL; ERER : REAL; EERR : REAL; B : REAL; S : REAL; C10 : REAL; END;

(* (* (* (* (* (* (* (* (* (* (* (* (*

DELTA_LAMBDA *) LG(TAU) *) ETA-PI,ETA-BLUE,ETA-RED *) RO-PI, RO-BLUE, RO-RED *) ETA_I,ETA_Q,ETA_U,ETA_V *) RO_Q, RO_U, RO_V *) ETA_LAM / ETA_5000 *) EF=EC+EI *) EQ*RQ+EU*RU+EV*RV *) EQ*EQ+EU*EU+EV*EV-RQ*RQ-RU*RU-RV*RV *) - *) - *) 1/CTETA*LN(10)*10^X *)

X ( ) , :
PROCEDURE LINA(V,VH,A:REAL;VAR ZEE:TZEEMAN;VAR E:TyETA); (* * (_,_,_R)/0 * ( RO_P, RO_B, RO_R)/0 * : * A - * V - DLAMB/DLD * VH - DLH/DLD * DLD - * ZEE.(NPI,NCOMP,RUNGE,PNORM) - *) VAR P,R : REAL; VB,VR : REAL; H ,F : REAL; J : INTEGER; BEGIN WITH ZEE DO BEGIN WITH E DO BEGIN EP:=0.0;EB:=0.0;ER:=0.0; RP:=0.0;RB:=0.0;RR:=0.0; FOR J:=1 TO NCOMP DO BEGIN P:=PNORM[J]; R:=RUNGE[J]; (*IF (R=0.0) THEN P:=P/2.0; - *) VB:=V-VH*R; VR:=V+VH*R; IF J<=NPI THEN BEGIN VOIG(A,VB,H,F); EP:=EP+H*P; RP:=RP+F*P; VOIG(A,VR,H,F); EP:=EP+H*P; RP:=RP+F*P END ELSE BEGIN VOIG(A,VB,H,F);


IF (H<1.E-30) THEN H:=0; EB:=EB+H*P; RB:=RB+F*P; VOIG(A,VR,H,F); (* A=0 , H<1.5-38 *) IF (H<1.E-30) THEN H:=0; ER:=ER+H*P; RR:=RR+F*P END; END; (* VR:=0.0; VOIG(A,VR,H,F); IF IsBit(IO,12) THEN H:=1.0; RP:=-2./H*RP; (? H(A,V=0)? ?) RB:=-2./H*RB; RR:=-2./H*RR; *) RP:=-2.*RP; RB:=-2.*RB; RR:=-2.*RR; END;(*WITH E*) END;(*WITH ZEE*) END;(*LINA*)

PROCEDURE XETA(VAR E:TyETA;ETA0:REAL); (* - _0*) BEGIN WITH E DO BEGIN EP:=EP*ETA0;ER:=ER*ETA0;EB:=EB*ETA0; RP:=RP*ETA0;RR:=RR*ETA0;RB:=RB*ETA0 END;(*WITH E*) END;(*XETA*)

PROCEDURE COEF(VAR E:TyETA;SG2,CG,SX,CX:REAL); (* - - *) VAR QU : REAL; BEGIN (* EP,EB,ER => EI,EQ,EU,EV *) (* RP,RB,RR => ,RQ,RU,RV *) WITH E DO BEGIN EI:=EP*SG2+(EB+ER)*(2.0-SG2); QU:=(EP-(EB+ER))*SG2; EQ:=QU*CX; EU:=QU*SX; EV:=2.0*(ER-EB)*CG; QU:=(RP-(RB+RR))*SG2; RQ:=QU*CX; RU:=QU*SX; RV:=2.0*(RR-RB)*CG EF:=EI+EC; (* EC ? *) END;(*WITH E*) END;(*COEF*)

(* CONT.WK.E X DL *) PROCEDURE FACX; VAR (* CONT.WK.X - , . CONT.WK.DL - . ., - CONT.WK.E - -, X DL *) DLH : REAL; (* . G=1 ( .)*) DLD : REAL; (* . . *) DLVD : REAL; (* .. ( ..) *) GM : REAL; (* .. *)


CG,SG2: XI : CX,SX : A : ETA0 : V : VH :

REAL; REAL; REAL; REAL; REAL; REAL; REAL;

(* (* (* (* (* (* (*

COS(GM),SIN(GM)^2 *) *) COS(XI),SIN(XI) *) . *) . *) . . ./..*) DLH/DLD *)

QX : boolean; iILIN : integer;

(* X - *) (* *)

sEI,sEQ,sEU,sEV,sRQ,sRU,sRV : real; (* . *) BEGIN QX := (CONT.WK.X <> (* X, *) CONT.WK.E.X); (* X, . *) IF QX OR (CONT.WK.DL<>CONT.WK.E.DL) THEN BEGIN CONT.WK.E.X :=CONT.WK.X; CONT.WK.E.DL:=CONT.WK.DL; (* X DL *)

if QX then begin CONT.WK.E.C10:=C_LN10*EXP10(CONT.WK.X)/CONT.CTETA; (* TAU/COS(TETA) *) CONT.WK.E.B := CONT.MB.func(CONT.WK.X); CONT.WK.E.S := CONT.MS.func(CONT.WK.X); CONT.WK.E.EC := CONT.MEC.func(CONT.WK.X); DLH GM XI DLVD CG SG2 CX SX end; := := := := := := := := CONT.MDLH.func (CONT.WK.X); CONT.MGM.func (CONT.WK.X); CONT.MXI.func (CONT.WK.X); CONT.MDLVD.func(CONT.WK.X); COS(GM*C_PI180); 1.0-CG*CG; COS(C_PI90*XI); SIN(C_PI90*XI);

if CONT.NLIN > 1 then begin (* *) sEI := 0; sEQ := 0; sEU := 0; sEV := 0; sRQ := 0; sRU := 0; sRV := 0; end; for iILIN := 1 to CONT.NLIN do begin if QX then begin DLD := CONT.MLI[iILIN].MDLD.func(CONT.WK.X); A := CONT.MLI[iILIN].MA.func (CONT.WK.X); ETA0 := CONT.MLI[iILIN].META.func(CONT.WK.X); end; VH := DLH/DLD; V := (CONT.WK.DL+DLVD)/DLD; LINA(V,VH,A,CONT.MLI[iILIN].ZEE,CONT.WK.E); (* EP:=0.0;EB:=0.0;ER:=0.0; RP:=0.0;RB:=0.0;RR:=0.0; *) XETA(CONT.WK.E,ETA0); (* E/R(P/B/R) ETA0 *) COEF(CONT.WK.E,SG2,CG,SX,CX); (* E/R(I,Q,U,V) *) if CONT.NLIN > 1 then begin sEI := sEI + CONT.WK.E.EI; sEQ := sEQ + CONT.WK.E.EQ; sEU := sEU + CONT.WK.E.EU; sEV := sEV + CONT.WK.E.EV; sRQ := sRQ + CONT.WK.E.RQ; sRU := sRU + CONT.WK.E.RU; sRV := sRV + CONT.WK.E.RV; end; end; if CONT.NLIN > 1 then begin (* - *)


CONT.WK.E.EI CONT.WK.E.EQ CONT.WK.E.EU CONT.WK.E.EV CONT.WK.E.RQ CONT.WK.E.RU CONT.WK.E.RV end;

:= := := := := := :=

sEI; sEQ; sEU; sEV; sRQ; sRU; sRV;

END;(*IF X<>X,DL<>DL*) END;(*FACX*)

PROCEDURE TRACH.RACHI (* *) (VAR P:TMILN; (* .- - *) VAR ZEE:TZEEMAN; (* *) VAR UN:TUNNO); VAR I : INTEGER; (* *) V : REAL; (* . ./.. *) VH : REAL; (* DLH/DLD *) E12,EE,RRRR,ZN:REAL; (* *) (*EF,ER,RR : REAL*) E : TyETA; (* - .( .) . *) BC : REAL; (* Betta*Cos(Teta)/(1+Betta*Cos(Teta)) *) CG,SG2: REAL; (* COS(GM),SIN(GM)^2 *) CX,SX : REAL; (* COS(XI),SIN(XI) *) BEGIN if P.DLD = 0 then App.Err('RACH DLD=0!!!'); UN.InitIQUV; E.EC:=1.0; WITH P DO BEGIN CG:=COS(GM*C_PI180); SG2:=1.0-CG*CG; CX:=COS(C_PI90*XI); SX:=SIN(C_PI90*XI); BC:=BET*CTEM/(1+BET*CTEM); VH:=DLH/DLD; FOR I:=1 TO UN.NDL DO BEGIN V:=UN.UL[I]/DLD; LINA(V,VH,A,ZEE,E); XETA(E,ETA0); COEF(E,SG2,CG,SX,CX); WITH E DO BEGIN IF IsBit(IO,14) (* *) THEN BEGIN RQ:=0;RU:=0;RV:=0 END; EF:=EI+EC; E12:=EF*EF; ERER:=EQ*RQ+EU*RU+EV*RV; (* IF (ABS(ERER))<1.E-15 THEN ERER:=0.0; *) RRRR:=RQ*RQ+RU*RU+RV*RV; EE :=EQ*EQ+EU*EU+EV*EV; EERR:=EE-RRRR; ZN:=E12*(E12-EERR)-ERER*ERER; IF IsBit(IO,12) (* *) THEN BEGIN UN.UI[I]:=1.0-EI/ETA0; UN.UQ[I]:=0.0-EQ/ETA0;


IF IsBit(IO,14) THEN UN.UU[I]:=ZN/E12/ETA0 ELSE UN.UU[I]:=ZN/ETA0/ETA0; UN.UV[I]:=0.0-EV/ETA0; END ELSE BEGIN UN.UI[I]:=1.0-BC*(1.0-EF*(E12+RRRR)/ZN); UN.UQ[I]:=0.0-BC*(E12*EQ+EF*(EV*RU-EU*RV)+RQ*ERER)/ZN; UN.UU[I]:=0.0-BC*(E12*EU+EF*(EQ*RV-EV*RQ)+RU*ERER)/ZN; UN.UV[I]:=0.0-BC*(E12*EV+ RV*ERER)/ZN; END; END;(*WITH E*) END;(*FOR I *) END;(*WITH P*) UN.CONT := 1.0; UN.KCONT := 1; UN.K4 := 4; UN.KSym := 1; (* *) END;(*RACHI *)