PROGRAM  ASV02Z, /*RING*/NR,NA, NB,RR,NG,GR,MECHR,NPL,
/*SHELL*/NS,NC,NH,GS,GEOMS,MECHS,NX,XS,MS,NP,KZ,
/*ADD*/N0, FM,QR,EPSQ,NK,NJ,IMAX,ZERO,
/*RESULT*/EPSR, EPSI,QM,US,UR);
DCL   (MS,RR)(*),NH, NB,GR, GS,XS)KZ(*,*),QR FLOAT (16),
(QM,(US,UR)(*,*))FLOAT (16) CPLX,
 (GEOMS,MECHS, MECHS) ENTRY,ZERO LABEL;
DCL    (N,M1,SC,IN,NI,P)FIXED BIN,LK,M,
(A1,A2,PSI,K1,K2,X0,XL,Q1, OM1,
FI(NS,2,4,4),KSI(NS,2)) FLOAT(16);
(E11, E12, E22, K11, K12, K22, T22, M12, M22, Q22, TETA2,  NA2, DD, CC, ROM, A(13), Q, QV, EZ, CZ, OM,VZ) FLOAT (16) CPLX;
N=8: M1=4*NR; LK=1; SC=0;
/*ВЫЧИСЛЯЕМ МАТРИЦЫ И КОЭФФИЦИЕНТЫ ПРЕОБРАЗОВАНИЙ  ДЛЯ ВСЕХ ОБОЛОЧЕЧНЫХ ЭЛЕМЕНТОВ*/ 
CALL MTRF(N,N0,NS,NX,NH, RR,GS,GEOMS,XS,FI,KSI);
CALL LONGP(N,NS,NH,NR,IN,NI);
DO P=1 TO NC;
IF MS(P)>SC THEN SC=MS(P);
END;
      BLOK1; BEGIN;
DCL PIJ(M1,(1-IN-IN*NI);NI); NI),
(YS(0:SC,8)  FLOAT(16)CPLX;
OM1=QR*FM;
CALL MULLRZ (OM1,IMAX, EPSQ,ZERO,QV,EPSR, EPSI);
QM=QV/FM;
CALL FORMV(US,UR);
MULLRZ:  PROG (QR,IMAX,EPSQ,ZERO,QV, EPSR, EPSI);
DCLQR FLOAT(16),QV FLOAT(16) CPLX, ZERO LABEL;
                DCL (QQR, QQI, E1, E2, QA, QA1, QA2) FLOAT(16), K, LK, I0, I1, I2, 
(Z0, Z1, Z2, D0, D1, DZ, U, A, B, C, F, Q1, Q2,) FLOAT(16) CPLX,            SC FIXED BIN;  
                        SC=0; K=0; LK=1;
    Q, Z0=QR*(1-30*EPSQ);
               CALL DETRM (SC,I0, D0);   CALL PRTKLZ (0,LK, N0, Q,D1,I1);
      Q, Z2=QR;
CALL DETRM (SC, I2, D2);CALL PRTKLZ (0, LK,N0,Q, D2, I2);
     LAB01;      U=(Z2-Z1)/(Z1-Z0); C=(1+U)*D2*10**(I2-I0);
    A=U*D2*10**(I2-I0)-U*(1+U)*D1*10**(I1-I0)+U*U*D0;
    B=(1+2*U)*D2*10**(I2-I0)-(1+U)**2*D1*10**(I1-10)+U*U*D0;
    F=1-4*A/B*C/B;
    Q1=Z2-(Z2-Z1)*B*(1-SQRT(F))/2/A;
    Q2=Z2-(Z2-Z1)*B(1-SQRT(F))/2/A;    
    EPSR, EPSI=1;
IF ABS(Z2-Q1)<ABS(Z2-Q2) THEN Q=1; ELSE Q=Q2;
    IF REAL(Q)=0 THEN EPSR=ABS((REAL(Q)-QQR)/REAL(Q));
IF I MAG(Q)=0 THEN EPSI=ABS((IMAG(Q)-QQI)/IMAG(Q));
K=K+1; QQR=REAL(Q); , QQI=I MAG(Q);
IF EPSR<EPSQ & EPSI<EPSQ I K>IMAX THEN GOTO LAB02;
Z0=Z1; Z1=Z2; Z2=Q; D0=D1; D1=D2; I0=I1; I1=I2;
  CALL DETRM (SO, I2, D2); CALL PRTKLZ(0,LK,N0,Q,D2,I2);
GOTO LAB01;
LAB02; QV=Q; CALL PRTKLZ(2, LK,N0,Q,D2,I2); IF K>IMAX THEN GOTO ZER
END MULLERZ;
DETRM;  PROG(SC,IS, DS);
DCLSC FIXED BIN, DS FLOAT (16) CPLX;
DCL (L,K,I,DI,S) FIXED BIN,
(TR,OM,(G0,G1,G)(4,4), KP(NC,8,8) FLOAT(16) CPLX;
L=0; PIJ=0; Q1=REAL(Q);
MEMBER NAME ASV02Z
/*ВЫЧИСЛЯЕМ МАТРИЦЫ ЖЕСКОСТИ ОБОЛОЧЕЧНЫХ ЭЛЕМЕНТОВ РАЗЛИЧНОГО ТИПА*/
DO P=1 TO NC;
M=MS (P); X0=GS(P,1); XL=GS(P,2);
CALL YSC_1(P,MS,US0,YC);
CALL STIFMZ (L,N,X0, XL,M,NP, FCTSM, KP (P,*,*));
END;
/*ОБРАБАТЫВАЕМ УЗЛОВЫЕ ЭЛЕМЕНТЫ КОНСТРУКЦИИ */ DO K=1 TO NG;
I=GR(K,0); DI=(I-1)*N/2;
CALL MACHR (K, Q1, EZ, VZ, CZ);
CALL MATRGZ (N0, RR(I), GR(K, *), EZ, VZ, GZ, G0, G1,G);
OM=Q*Q*GR(K,1)*GR(K,8);
DO S=1,2,4; G(S,S)=G(S,S)-OM; END;
DO S=1  TO  N/2;
DO L=1  TO  N/2;
PIJ(DI+S, DI-IN*(DI+S)*L)=G(S,L);
END;
END;
END;
  IF N0=0 THEN
CALL MTRPLZ (N,RR,NS, NPL, NH,GS, MECHS, Q,IN,PIJ);
/* ФОРМИРУЕМ МАТРИЦУ[P]*/
CALL MATRPZ (IN,N,NS, NH,FI,KSI, KP,PIJ);
CALL BNDRPZ (IN,N,NA,NB,PIJ);
/*ВЫЧИСЛЯЕМ ОПРЕДЕЛИТЕЛЬ МАТРИЦЫ [P]*/
IF SC=0 & IN=0 THEN CALL GAUSDZ(M1, PIJ, IS, DS);
IF SC=0 & IN=1 THEN CALL BANDDZ (M1,NI, PIJ, IS, DS);
END DETRM;
FORMV;  PROG(US,UR); DCL (US,UR)(*,*)FLOAT(16) CPLX;
    DCL (NKJ,L,I,SC,S,J) FIXED BIN,WM FLOAT (16) CPLX;
    (WIJ(NS,2,4), AA,  (T,W)(M1)) FLOAT (16) CPLX;
/*ФОРМИРУЕМ СИСТЕМУ РАЗРЕШАЮЩИХ УРАВНЕНИЙ*/
NKJ=N/2*(NK-1)+NJ; T=0; SC=1; L=1;
CALL DETRM(SC,I,AA);
PIJ(NKJ,*)=0; PIJ(NKJ, NKJ*(1-IN))=1; T(NKJ)=1;
/*РЕШАЕМ ПОЛУЧЕННУЮ СИСТЕМУ УРАВНЕНИЙ*/
IF  IN=0 THEN CALL GAUSSZ(M1,PIJ, T,W);
  ELSE CALL BANDSZ (M1, NI,PIJ,T,W);
/*ОПРЕДЕЛЯЕМ ПЕРЕМЕЩЕНИЯ УЗЛОВ КОНСТРУКЦИИ И 
КРАЕВЫЕ СМЕЩEНИЯ ОБОЛОЧЕЧНЫХ ЭЛЕМЕНТОВ*/
CALL VECTWZ (N,NR,NS,NH,FI,W,UR,WIJ);
/*ВЫЧИСЛЯЕМ КОМПОНЕНТЫ ВЕКТОРОВ РЕШЕНИЯ ДЛЯ 
ОБОЛОЧЕЧНЫХ ЭЛЕМЕНТОВ*/
DO I=1 TO NS;
P=NH(I,3); M=MS(P); X0=GS(P,1); XL=GS(P,2);
CALL BNDPRZ (N,X0,XL,M,NP,WIJ(I,1,*), 
WIJ (I,2,*), FOTSM, YS);
DO S=0 TO M;
US(S+L,*)=YS(S,*);
END;
L=L+M+1;


                END;
/*НОРМИРУЕМ ПОЛУЧЕННОЕ РЕШЕНИЕ*/
L=L-1; WM=0;
DO S=1 TO L;
DO J=5 TO 8;
  IF ABS(US(S,J))>WM THEN WM=ABS(US(S,J));
      END;
END;
DO S=1 TO NR;
DO J=1 TO 4;
IF ABS(UR(S,J))>WM THEN WM=ABS(UR(S,J));
END;
END;

MEMBER NAME ASV02Z
US=US/WM; UR=UR/WM;
END FORMV;
FOTSM: PROG(X,Y,F,B);
  DCLX  FLOAT(16); (Y, F, B) (*) B FLOAT (16) CPLX;
             CALL GEOMS(P,X,GS,A1,A2,PSI,K1,K2);
     CALL MECHS (P,X,Q1, A);
     NA2=N0/A2;  DD=A(1)*A(9)-A(5)**2;
    E22= NA2*Y(8)+PSI*Y(5)+K2*Y(6);
    TETA2=K2*Y(8)+NA2*Y(6);
    K22=NA2*TETA2+PSI*Y(7);
    K11=((Y(3)-A(6)*E22-A(10)*K22)*A(1)
    -(Y(1)-A(2)*E22-A(6)*K22)*A(5)/DD;
  E11=( Y(1)-A(2)*E22-A(6)*K22)-A(5)*K11)/A(1);
  T22=A(2)*E11+A(3)*E22+A(6)*K11+A(7)*K22;
  M22=A(6)*E11+A(7)*E22+A(10)*K11+A(11)*K22;
  CC=NA2*(K2*Y(5)-PSI*Y(6)-Y(7));
  E12=(Y(4)-2*(A(8)+2*K2*A(12))*(CC);
  /(A(4)+4*K2*(A(8)+K2*A(12));
K12=K2*E12+CC;
M12=A(8)*E12+2*A(12)*K12;
Q22=-(NA2*M22;
ROM=-A(13)*Q**2;
F(1)=PSI*(T22-Y(1))-NA2*(Y(4)-2*K2*M12)
-K1*Y(2)+ROM*Y(5)+KZ(P,1);
F(2)=-PSI*Y(2)-NA2*(Q22+2*PSI*M12)
+K1*Y(1)+K2*T22+ROM*Y(6)+KZ(P,3);
F(3)=PSI*(M22-Y(3))+Y(2)-2*NA2*M12;
F(4)=-2*PSI*Y(4)+NA2*T22-K2*Q22+ROM*Y(8)+KZ(P,2);
F(5)=E11-K1*Y(6);
F(6)=K1*Y(5)-Y(7);
  F(7)=K11;
  F(8)=E12+PSI*Y(8)+NA2*Y(5);
  F=F*A1; B=0;
END FCTSM;
    END BLOK1;
END ASV02Z;