PROGRAM Kivits

PROGRAM kivitsl(FILIN,FILOUT,TERIN,TEROUT);
LABEL 300,400;
TYPE ARRY0 = ARRAY(.0..100.) OF REAL;
     ARRY1 = ARRAY(.1..100.) OF REAL;
     ARRY3 = ARRAY(.0..2000.) OF REAL;
     ARRY2 = ARRAY(.1..10,1..11.) OF REAL;
     ARRY8 = ARRAY(.1..8.) OF REAL;
     ARRYH = ARRAY(.1..99.) OF REAL;
     ARRY = ARRAY(.1..2.) OF REAL;
VAR LAB,PI,KR,RM,TM,EP,DH,A4,B4,C4,D4,E4,F4,XMIN,XMAX,EVX :REAL;
    S                                                      :REAL;
    G,H,I,I2,J,K,L,LS,N,M,I1,PR,NLZ,DLZ,HHH,ZZ,NF          :INTEGER;
    EVL,NPL,KPL,NML,KML                                    :ARRY3;
    RE,IM                                                  :ARRY2;
    X,Y,HH,MO                                              :ARRY1;
    A1,A2,A3,A5,B1,B2,B3,B5,C1,C2,C3,C5,D1,D2,D3,D5,DY     :ARRY3;
    NN,KK,NM,KM,MN,MK                                      :ARRY0;
    TERIN,TEROUT,FILIN,FILOUT:                              TEXT;
    FIRST,IGLEICH1,IGLEICHM,LABEL1                          :BOOLEAN;
    SAMPLEX                                      :STRING ( 50);

PROCEDURE CUSPLINE(VAR N2:            INTEGER;
                    VAR X,Y,DY:        ARRY3;
                    VAR S:             REAL;
                    VAR A,B,C,D:       ARRY3);
LABEL 100,200;
VAR    E,F,F2,G,H,P:                                           REAL;
       I,M2:                                                  INTEGER;
       R,R1,R2,T,T1,U,V:                                        ARRY3;
BEGIN
   M2:=N2+1;
R(.0.):=0;R(.1.):=0;R1(.N2.):=0;R2(.N2.):=0;R2(.M2.):=0;U(.0.):=0;
U(.1.):=0;U(.N2.):=0;
U(.M2.):=0; P:=0;
   M2:=N2-1;
   H:=X(.2.)-X(.1.);
   F:=(Y(.2.)-Y(.1.))/H;
   FOR I:=2 TO M2 DO

     BEGIN
     G:=H;
     H:=X(.I+1.)-X(.I.);
     E:=F;
     F:=(Y(.I+1.)-Y(.I.))/H;
     A(.I.):=F-E;
   T(.I.):=2*(G+H)/3;
     T1(.I.):=H/3;
     R2(.I.):=DY(.I-1.)/G;
     R(.I.):=DY(.I+1.)/H;
     R1(.I.):=-DY(.I.)/G-DY(.I.)/H;
     END;
   FOR I:=2 TO M2 DO

     BEGIN
     B(.I.):=R(.I.)*R(.I.)+R1(.I.)*R1(.I.)+R2(.I.)*R2(.I.);
     C(.I.):=R(.I.)*R1(.I+1.)+R1(.I.)*R2(.I+1.);
     D(.I.):=R(.I.)*R2(.I+2.);
     END;
   F2:=-S;
200:   FOR   I:=2 TO M2 DO

     BEGIN
     R1(.I-1.):=F*R(.I-1.);
     R2(.I-2.):=G*R(.I-2.);
     R(.I.):=1/(P*B(.I.)+T(.I.)-F*R1(.I-1.)-G*R2(.I-2.));
     U(.I.):=A(.I.)-R1(.I-1.)*U(.I-1.)-R2(.I-2.)*U(.I-2.);
     F:=P*C(.I.)+T1(.I.)-H*R1(.I-1.);
     G:=H;
     H:=D(.I.)*P;
     END;
   FOR I:=M2 DOWNTO 2 DO

     BEGIN
     U(.I.):=R(.I.)*U(.I.)-R1(.I.)*U(.I+1.)-R2(.I.)*U(.I+2.);
     END;
   E:=0; H:=0;
   FOR I:=1 TO M2 DO

     BEGIN
     G:=H;
     H:=(U(.I+1.)-U(.I.))/(X(.I+1.)-X(.I.));
     V(.I.):=(H-G)*DY(.I.)*DY(.I.);
     E:=E+V(.I.)*(H-G);
     END;
   G:= -H*DY(.N2.)*DY(.N2.);
   V(.N2.):=-H*DY(.N2.)*DY(.N2.);
   E:=E-G*H;
   G:=F2;
   F2:=E*P*P;
   IF ((F2 >= S) OR ( F2 <= G )) THEN GOTO 100;
   F:=0;
   H:=(V(.2.)-V(.1.))/(X(.2.)-X(.1.));
   FOR I:=2 TO M2 DO

     BEGIN
     G:=H;
     H:=(V(.I+1.)-V(.I.))/(X(.I+1.)-X(.I.));
     G:=H-G-R1(.I-1.)*R(.I-1.)-R2(.I-2.)*R(.I-2.);
     F:=F+G*R(.I.)*G;
     R(.I.):=G;
     END;
   H:=E-P*F;
   IF H <= 0 THEN GOTO 100;
   P:=P+(S-F2)/((SQRT(S/E)+P)*H);
   GOTO 200;
   100:FOR I:=1 TO N2 DO

     BEGIN
     A(.I.):=Y(.I.)-P*V(.I.);
     C(.I.):=U(.I.);
    END;
   FOR I:=1 TO M2 DO

     BEGIN
     H:=X(.I+1.)-X(.I.);
     D(.I.):=(C(.I+1.)-C(.I.))/(3*H);
     B(.I.):=(A(.I+1.)-A(.I.))/H-(H*D(.I.)+C(.I.))*H;
     END;
   END; (* CUSPLINE *)

FUNCTION F( X:           REAL;
            XN,A,B,C,D: ARRY3;
            N:           INTEGER)   :REAL;
LABEL 1,2;
VAR H,X1,X2:                                              REAL;
     I:                                                   INTEGER;
BEGIN

     I:=0;
     X1:=XN(.1.);

      IF X<X1     THEN
       BEGIN
       H:=X-X1;
       I:=1;
       GOTO 2 END;
    IF X>=XN(.N.) THEN
       BEGIN
       H:=X-XN(.N-1.);
       I:=N-1;
       GOTO 2 END;

     1 : I:=I+1;
       X2:=XN(.I+1.);
        IF ((X>=X1) AND ( X<X2 )) THEN H:=X-X1

      ELSE
       BEGIN
       X1:=X2;
       GOTO 1 END;

     2 : F:=((D(.I.)*H+C(.I.))*H+B(.I.))*H+A(.I.)
END; (* F *)

PROCEDURE P1(VAR RE,IM:ARRY2;M,I:INTEGER);
VAR A,B,C,D,E,F,G,H,Q,RN,RK,S,T,TR,TI,TT             :REAL;
     P                                                :INTEGER;
BEGIN
P:=TRUNC ( (I+1)/2 );
A:=NN(.P-1.); B:=NN(.P.); C:=KK(.P-1.); D:=KK(.P.);
E:=A+B; F:=C+D; Q:=(E*E)+(F*F);
G:=(2*B*E+2*D*F)/Q; H:=(2*D*E-2*B*F)/Q;
RN:=2*PI*B*HH(.P.)/LAB; RK:=2*PI*D*HH(.P.)/LAB;
S:=COS(RN)*EXP(-RK); T:=SIN(RN)*EXP(-RK);
TR:=G*S-H*T; TI:=G*T+H*S; TT:=(TR*TR)+(TI*TI);
A:=B-A; B:=D-C; C:=(A*E+B*F)/Q; D:=(E*B-F*A)/Q;
RN:=2*RN; RK:=2*RK; S:=COS(RN)*EXP(-RK); T:=SIN(RN)*EXP(-RK);
E:=(S*TR+T*TI)/TT; F:=(T*TR-S*TI)/TT;
G:=(C*TR+D*TI)/TT; H:=(D*TR-C*TI)/TT;
IF (P=1) THEN
BEGIN RE(.1,M+1.):=-E; IM(.1,M+1.):=-F;
        RE(.2,M+1.):=-G; IM(.2,M+1.):=-H;
END ELSE
BEGIN RE(.I,I-1.):=E; IM(.I,I-1.):=F;
        RE(.I+1,I-1.):=G; IM(.I+1,I-1.):=H;
END;
        RE(.I,I.):=C*E-D*F; IM(.I,I.):=D*E+C*F;
        RE(.I+1,I.):=TR/TT; IM(.I+1,I.):=-TI/TT;
(*WRITELN(FILOUT,'RE ',RE(.I,I.):13:6);
WRITELN(FILOUT,'IM ',IM(.I,I.):13:6);
WRITELN(FILOUT,'RE ',RE(.I+1,I.):13:6);
WRITELN(FILOUT,'IM ',IM(.I+1,I.):13:6);*)
END; (* P1 *)

PROCEDURE P2 (VAR RE:ARRY2;M,I,N:INTEGER);
VAR A,B,C,D,E,F,G,H,Q:REAL;
BEGIN
A:=NN(.N-1.); B:=NN(.N.); C:=KK(.N-1.); D:=KK(.N.);
E:=A+B; F:=C+D; Q:=(E*E)+(F*F); G:=A-B; H:=C-D;
RE(.M-1,M-2.):=(2*A*E+2*C*F)/Q; IM(.M-1,M-2.):=(2*C*E-2*A*F)/Q;
RE(.M,M-2.):=(G*E+H*F)/Q; IM(.M,M-2.):=(H*E-G*F)/Q;
RE(.M,M-1.):=-1;
FOR I := 1 TO M-1 DO RE(.I,I+1.):=-1;
(* FOR I := 1 TO M-1 DO
WRITELN(FILOUT,'RE   ',RE(.I,I+1.):13:6);*)
END; (* P2 *)

PROCEDURE P3(VAR RE,IM:ARRY2;I,K:INTEGER);
VAR A,B,C,D,E,F,G,H                               :REAL;
      J                                             :INTEGER;
BEGIN
C := RE(.I,K.); D := IM(.I,K.);
E:=RE(.K,K.); F:=IM(.K,K.); RE(.I,K.):=0;
IM(.I,K.):=0;
FOR J := K+1 TO M+1 DO
BEGIN A:=RE(.I,J.); B:=IM(.I,J.); G:=RE(.K,J.); H:=IM(.K,J.);
    RE(.I,J.):=(A*E*E+A*F*F-C*E*G+D*E*H-C*F*H-D*F*G)/(E*E+F*F);
    IM(.I,J.):=(B*E*E+B*F*F-C*E*H-D*E*G+C*F*G-D*F*H)/(E*E+F*F);
(*WRITELN(FILOUT,'RE ',RE(.I,J.):13:6);
WRITELN(FILOUT,'IM ',IM(.I,J.):13:6);*)
END;
END; (* P3 *)

PROCEDURE P4(VAR RE,IM:ARRY2;VAR X,Y:ARRY1;VAR NN,KK,NM,KM,MN,
                 MK:ARRY0;
             VAR MO:ARRY1;
                 I,M:INTEGER;
             VAR G:INTEGER;
             VAR IGLEICH1,IGLEICHM,LABEL1:BOOLEAN);
LABEL 500;
VAR P,Q,R,S,T,A9,B9,C9,D9                             :REAL;
VAR J:INTEGER;
BEGIN (* 1 *)
P := 0; Q := 0;
FOR J := I + 1 TO M DO

BEGIN (* 2 *)
A9:=RE(.I,J.);   B9:=IM(.I,J.);
C9:=X(.J.);      D9:=Y(.J.);
P:=P+A9*C9-B9*D9; Q:=Q+A9*D9+B9*C9;
END; (* 2 *)

P:=RE(.I,M+1.)-P; Q:=IM(.I,M+1.)-Q;
R:=RE(.I,I.); S:=IM(.I,I.); T:=R*R+S*S;
X(.I.):=(P*R+Q*S)/T; Y(.I.):=(Q*R-P*S)/T;
IF ( I=1 ) THEN
             BEGIN (* 3 *)
             MO(.G.):=X(.I.); MO(.G+1.):=Y(.I.);
             G:=G+4;   IGLEICH1 := TRUE;
             IF (G=5) THEN
                          BEGIN (* 4 *)
                          FOR J:= 0 TO N DO
                               BEGIN (* 5 *)
                               MN(.J.):=NN(.J.); MK(.J.):=KK(.J.);
                               NN(.J.):=NM(.J.); KK(.J.):=KM(.J.);
(*WRITELN(FILOUT,'MN ',MN(.J.):13:6);
WRITELN(FILOUT,'MK ',MK(.J.):13:6);
WRITELN(FILOUT,'NN ',NN(.J.):13:6);
WRITELN(FILOUT,'KK ',KK(.J.):13:6);*)
                               END; (* 5 J *)
                               LABEL1 := TRUE;
                               IF LABEL1 THEN GOTO 500;
                  END; (* 4 G *)
             END; (* 3 I *)
IF (I=M) THEN
             BEGIN (* 6 *)
             MO(.G+2.):=X(.I.); MO(.G+3.):=Y(.I.);
             IGLEICHM := TRUE;
             END; (* 6 *)
500:
END; (* 1 P4 *)

BEGIN (*************************** HAUPTPROGRAMM *******************)
PI := 3.1415926;
RESET(FILIN);
READ(FILIN,N);
READ(FILIN,PR);
WRITELN(FILOUT,(N+1):2,' SCHICHTEN ');
M := 2 * N;
HHH := 0;
FOR I:= 0 TO N DO
BEGIN
READ(FILIN,NN(.I.));
READ(FILIN,KK(.I.));
READ(FILIN,NM(.I.));
READ(FILIN,KM(.I.));
WRITELN(FILOUT,NN(.I.):9:7,' ',KK(.I.):9:7,' ',
NM(.I.):9:7,' ',KM(.I.):9:7);
IF ( NN(.I.) < 0.001 ) AND ( NM(.I.) < 0.001 ) THEN HHH := I;
END;

FOR I:=1 TO N-1 DO
BEGIN
READ(FILIN,HH(.I.));
WRITELN(FILOUT,HH(.I.):5:0);
IF (HH(.I.) <0.01) THEN H := I;
END;
READ(FILIN,LAB);
WRITELN(FILOUT,LAB:6:0);
READ(FILIN,HH(.H.));
WRITELN(FILOUT,HH(.H.),' HH(.H.)');
READ(FILIN,NLZ);
READ(FILIN,DLZ);
READ(FILIN,LAB);
XMIN := LAB;
WRITELN(FILOUT,XMIN:5:0,' VON');
XMAX := LAB + ( NLZ * DLZ );
WRITELN(FILOUT,XMAX:5:0,' BIS');
WRITELN(FILOUT,NLZ:3,' N');

READ(FILIN, SAMPLEX);
WRITELN(TEROUT,SAMPLEX);
READ(FILIN,NF);
WRITELN(TEROUT,NF,' DATEN FUR N+ K+ N- K- )');
FOR I := 1 TO NF DO
READ(FILIN,EVL(.I.),NPL(.I.),KPL(.I.),NML(.I.),KML(.I.));
S := 0;
FOR I:=1 TO NF DO
DY(.I.):= 0.01;
CUSPLINE(NF,EVL,NPL,DY,S,A1,B1,C1,D1);
B1(.NF.):=0; D1(.NF.):=0;
CUSPLINE(NF,EVL,KPL,DY,S,A2,B2,C2,D2);
B2(.NF.):=0; D2(.NF.):=0;
CUSPLINE(NF,EVL,NML,DY,S,A3,B3,C3,D3);
B3(.NF.):=0; D3(.NF.):=0;
CUSPLINE(NF,EVL,KML,DY,S,A5,B5,C5,D5);
B5(.NF.):=0; D5(.NF.):=0;
WRITE(FILOUT,
' LAMBDA KR      KE       REF      SNR     FR      FE      TRM      ');
WRITELN(FILOUT,'SNR');
FOR ZZ := 1 TO NLZ DO
BEGIN
LAB := LAB + DLZ;
EVX := 12400/LAB;
NN(.HHH.) := F(EVX,EVL,A1,B1,C1,D1,NF);
KK(.HHH.) := F(EVX,EVL,A2,B2,C2,D2,NF);
NM(.HHH.) := F(EVX,EVL,A3,B3,C3,D3,NF);
KM(.HHH.) := F(EVX,EVL,A5,B5,C5,D5,NF);

FIRST := TRUE; LABEL1 := FALSE; G:= 0;
IGLEICH1 := FALSE; IGLEICHM := FALSE;
(*FOR I := 1 TO LS DO
BEGIN *)
400:
LABEL1 := FALSE;
IF FIRST THEN
BEGIN
HH(.H.) := HH(.H.) ;
G := 1;
FIRST := FALSE;
END;
FOR I1:= 1 TO M DO
BEGIN
FOR J:= 1 TO M+1 DO
BEGIN
RE(.I1,J.) := 0;
IM(.I1,J.) := 0;
END;
END;

FOR I1:= 1 TO M-2 DO
BEGIN
IF (ODD(I1)) THEN P1(RE,IM,M,I1);
END;

P2(RE,M,I1,N);

FOR K := 1 TO M-1 DO
FOR I1 := K+1 TO M DO
BEGIN
P3(RE,IM,I1,K);
END;

FOR I1 := M DOWNTO 1 DO
BEGIN
P4(RE,IM,X,Y,NN,KK,NM,KM,MN,MK,MO,I1,M,G,IGLEICH1,IGLEICHM,LABEL1);
END;
IF LABEL1 THEN GOTO 300;
FOR J:= 0 TO N DO
BEGIN NN(.J.):=MN(.J.); KK(.J.):=MK(.J.); END;
WRITE(FILOUT,LAB:6:0,' ');
KR:=ARCTAN((MO(.5.)*MO(.2.)-MO(.6.)*MO(.1.))/(MO(.1.)*MO(.5.)+
    MO(.2.)*MO(.6.)))/2;
WRITE(FILOUT,(180/PI*KR):7:4,' ');

A4 :=         ( SQRT( SQR(MO(.5.)) + SQR(MO(.6.)) )
                -SQRT( SQR(MO(.1.)) + SQR(MO(.2.)) ) ) /
              ( SQRT( SQR(MO(.5.)) + SQR(MO(.6.)) )
                +SQRT( SQR(MO(.1.)) + SQR(MO(.2.)) ) );
EP := ARCTAN(A4);
WRITE(FILOUT,(180/PI*EP):7:4,' ');

RM:=50 * ( SQR(MO(.1.)) + SQR(MO(.5.)) +
           SQR(MO(.2.)) + SQR(MO(.6.)) );

WRITE(FILOUT,RM:8:4,' ');

WRITE(FILOUT,(100*RM*(KR*KR+EP*EP)):8:4,' ');

KR:=ARCTAN((MO(.7.)*MO(.4.)-MO(.8.)*MO(.3.))/(MO(.3.)*MO(.7.)+
    MO(.4.)*MO(.8.)))/2;

WRITE(FILOUT,(180/PI*KR):7:4,' ');

EP:=ARCTAN(   ( SQRT( SQR(MO(.7.)) + SQR(MO(.8.)) )
                -SQRT( SQR(MO(.3.)) + SQR(MO(.4.)) ) ) /
              ( SQRT( SQR(MO(.7.)) + SQR(MO(.8.)) )
                +SQRT( SQR(MO(.3.)) + SQR(MO(.4.)) ) )   );
WRITE(FILOUT,(180/PI*EP):7:4,' ');

TM:=50*(SQR(MO(.3.))+SQR(MO(.7.))
       +SQR(MO(.4.))+SQR(MO(.8.)));

WRITE(FILOUT,TM:6:4,' ');

WRITELN(FILOUT,(100*TM*(KR*KR+EP*EP)):8:4,' ');
FIRST := TRUE;
300:
IF LABEL1 THEN GOTO 400;
END; (* LAMBDA *)
END.