﻿!MS$real:8	
	program START

	use AVDef    
	use DFLIB
	
	integer, parameter:: dil=150,dl=64,del=31 !150 - 10õ10,  96 - 8õ8, 216  - 12õ12

      integer, parameter::n=6,k=n/2,nl=n/2,np=n/2
	  	common Ph0,Ph1,Ph2,Ph3,Ph4,Pha0T,oleole
	Common PhN1,PhN2,PhN3,PhN1T
	real z(N*(N-K+1)+(N-K+1)*(N-K+2)/2+1)
     real r1(N*(N-K+1)),z1(N*(N-K+1)),y(n+1),a1(N*(N+1)),oleole(N*(N+1))
     real om((N-K+1)*(N-K+2)/2)
     real rew(dil+4,31),ww(dl,dil+4),ww1(dil+4,dl)
	 real Aleft(K*(n+1)),Aright(K*(N+1)),AMat1(n/2,n+1),Amat2(n/2,n+1)
	 dimension itp(n)
	integer num1
	real xx(-5:dil+4)
	real ess(dil),x,ds,esd,ess1(n/4),ess2(n/4)
	real Mm(del,dl)
      real sina(dl)
		real suk,vnu,tempv
		character key
	real Pha0T(n/4,n/4)
	real Ph0(n/4,n/4),Ph1(n/4,n/4)
	real Ph2(n/4,n/4),Ph3(n/4,n/4),Ph4(n/4,n/4)
	real PhN1(n/4,n/4),PhN1T(n/4,n/4)
	real PhN2(n/4,n/4),PhN3(n/4,n/4),PhNN(n/4,n/4)


	real PI
	real Ex,Ey,Ez,Gxy,Gyz,Gzx,NyuXY,NyuYZ,NyuZX
	real ALFA11,ALFA22,ALFA33,ALFA12,ALFA13,ALFA23,ALFA44,ALFA55,ALFA66,LIAMBDA44,LIAMBDA55,det
	real A13, A23, A33, Beta13, Beta23, Beta33;
	integer mmmm,nnnn
	real getwarr(12) !ìàññèâ ñ ïîëó÷åííûìè w
	real mainW !ãëàâíûé ðåçóëüòàò


	
	open (7,file='dior1.txt',status='unknown')
		open (8,file='dior2.txt',status='unknown')

		

 itp=(/(i,i=1,n)/)	
!====== Äëÿ ñòàíäàðòíîé ìàòðèöû ãðàíè÷íûõ óñëîâèé ÷åðåç ñèãìû =========
 do i=n/3 + 1,n/2
	itp(i) = itp(i) + n/6;
 enddo

 do i=n/2 + 1,2*n/3
	itp(i) = itp(i) - n/6;
 enddo
!======================================================================


    
	PI = 3.14159265

	

	Ex = 0.57
	Ey = 0.14
	Ez = 0.14

	Gxy = 0.057
	Gyz = 0.05
	Gzx = 0.057

	NyuXY = 0.277
	NyuYZ = 0.4
	NyuZX = 0.068


!-------------------------------------------------------
    
	ALFA11 = 1/Ex
	ALFA22 = 1/Ey
	ALFA33 = 1/Ez

	ALFA12 = -1*NyuXY/Ey
	ALFA13 = -1*NyuZX/Ex
	ALFA23 = -1*NyuYZ/Ez

	ALFA44 = 1/Gyz
	ALFA55 = 1/Gzx
	ALFA66 = 1/Gxy



	LIAMBDA44 = 1/ALFA44
	LIAMBDA55 = 1/ALFA55




!================================== BETA DETECTING ====================================


	        det = ALFA11 * (ALFA22 * ALFA33 - ALFA23 * ALFA23) - ALFA12 * (ALFA12 * ALFA33 - ALFA13 * ALFA23) + ALFA13 * (ALFA12 * ALFA23 - ALFA13 * ALFA22);

            
            
            A13 = ALFA12 * ALFA23 - ALFA22 * ALFA13;
            A23 = -1 * (ALFA11 * ALFA23 - ALFA12 * ALFA13);
            A33 = ALFA11 * ALFA22 - ALFA12 * ALFA12;

            Beta13 = A13 / det;
            Beta23 = A23 / det;
            Beta33 = A33 / det;


mainW = 0.

open (9999,file='whistory.txt',status='unknown')

do mmmm=1,18
do nnnn=1,18

!mmmm = 1
!nnnn = 1

open (6,file='dior.txt',status='unknown')
!-------------------------------------------------------------
Aleft=0.

			Aleft(1) = -1*Beta13*mmmm*PI
			Aleft(2) = 0
			Aleft(3) = 0

			Aleft(4) = 0
			Aleft(5) = LIAMBDA55
			Aleft(6) = 0

			Aleft(10) = -1*Beta23*nnnn*PI
			Aleft(11) = 0
			Aleft(12) = 0

			Aleft(7) = 0
			Aleft(8) = 0
			Aleft(9) = LIAMBDA44

			Aleft(13) = 0
			Aleft(14) = LIAMBDA55*mmmm*PI
			Aleft(15) = LIAMBDA44*nnnn*PI

			Aleft(16) = Beta33
			Aleft(17) = 0
			Aleft(18) = 0


			Aleft(19) = 16/(PI*PI*mmmm*nnnn)
			Aleft(20) = 0
			Aleft(21) = 0


Aright=0.

			Aright(1) = -1*Beta13*mmmm*PI
			Aright(2) = 0
			Aright(3) = 0

			Aright(4) = 0
			Aright(5) = LIAMBDA55
			Aright(6) = 0

			Aright(7) = -1*Beta23*nnnn*PI
			Aright(8) = 0
			Aright(9) = 0

			Aright(10) = 0
			Aright(11) = 0
			Aright(12) = LIAMBDA44

			Aright(13) = 0
			Aright(14) = LIAMBDA55*mmmm*PI
			Aright(15) = LIAMBDA44*nnnn*PI

			Aright(16) = Beta33
			Aright(17) = 0
			Aright(18) = 0


			Aright(19) = 0
			Aright(20) = 0
			Aright(21) = 0


open (666,file='Aleft.txt',status='unknown')
open (777,file='Aright.txt',status='unknown')

do i=1,21
   write (666,2)Aleft(i)
2  FORMAT(600(E12.5,1X))
enddo

do i=1,21
   write (777,3)Aright(i)
3  FORMAT(600(E12.5,1X))
enddo

close(666)
close(777)
!======================================================================================


      N1=(N-K+1)*N
      M1=(N-K+1)*(N-K+2)/2
      NZ=N1+M1+1
      NY=N+1
      NN=N*NY
      CALL DO(N,K,X,H,N1,M1,NZ,NY,NN,NL,NP, &
     Z,R1,Z1,Y,A1,OM,Aleft,Aright,ITP, mmmm, nnnn)
  
close(6)

!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=--=-=-=-=-=-=-=
open(106,file='dior.txt',status='unknown')
	  do i=1,12
		read(106,*)getwarr(i)
	  enddo
close(106)

mainW = mainW + getwarr(11)*sin(mmmm*PI/2)*sin(nnnn*PI/2)
write (9999,11)getwarr(11)
11  FORMAT(600(E12.5,1X))
!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=--=-=-=-=-=-=-=

enddo
enddo;

close(9999)


!=================== Output result =========================

open (999,file='mainW.txt',status='unknown')

   write (999,*)mainW
9  FORMAT(600(E12.5,1X))

close(999)
!===========================================================


print *, "Complete"
key = GETCHARQQ()
 
END


	  SUBROUTINE FORWAR(N,M,X,H,IP1,IP2,IP3,NA,A)
      real(8) A(NA),h,x
	  IP1=1; IP2=0;   IP3=1
      
	  H=0.01

	  
	  IF(ABS(0.05-X).LE.H/2.) IP2=1
	  IF(ABS(0.1-X).LE.H/2.) IP2=1
	  

      IF(ABS(0.1-X).LE.H/2.) then 
		IP3=0
		X = 0
	  end if 
      RETURN
      END

      SUBROUTINE RESULT(N,NI,A)
      real(8) A(N)
		
		do i=2,n
		   write (6,1)a(i)
		1  FORMAT(600(E12.5,1X))
		enddo

      RETURN
      END
 
     
SUBROUTINE MATRIX(NN,X,NA,A, mmmm, nnnn)
	!MS$real:8
	integer, parameter:: n=6
    real A(42)
!	real mmmm, nnnn

	real PI
	real Ex,Ey,Ez,Gxy,Gyz,Gzx,NyuXY,NyuYZ,NyuZX
	real ALFA11,ALFA22,ALFA33,ALFA12,ALFA13,ALFA23,ALFA44,ALFA55,ALFA66, DELTA
	real a1,a2,a3,a4,b1,b2,b3,b4,c1,c2,c3,c4


    PI = 3.14159265


	Ex = 0.57
	Ey = 0.14
	Ez = 0.14

	Gxy = 0.057
	Gyz = 0.05
	Gzx = 0.057

	NyuXY = 0.277
	NyuYZ = 0.4
	NyuZX = 0.068


!-------------------------------------------------------

	ALFA11 = 1/Ex
	ALFA22 = 1/Ey
	ALFA33 = 1/Ez

	ALFA12 = -1*NyuXY/Ey
	ALFA13 = -1*NyuZX/Ex
	ALFA23 = -1*NyuYZ/Ez

	ALFA44 = 1/Gyz
	ALFA55 = 1/Gzx
	ALFA66 = 1/Gxy


	DELTA = ALFA11 * (ALFA22*ALFA33 - ALFA23*ALFA23) - ALFA12 * (ALFA12*ALFA33 - ALFA13*ALFA23) + ALFA13 * (ALfA12*ALFA23 - ALFA13*ALFA22)
	

!-------------------------------------------------------

	a1 = -1*ALFA55*(ALFA22*ALFA33-ALFA23*ALFA23)/DELTA
	a2 = -1*ALFA55/ALFA66
	a3 = -1*ALFA55*((ALFA13*ALFA23-ALFA12*ALFA33)/DELTA + 1/ALFA66)
	a4 = -1*(1 + ALFA55*(ALFA12*ALFA23 - ALFA13*ALFA22)/DELTA)

	b1 = -1*ALFA44*(ALFA11*ALFA33-ALFA13*ALFA13)/DELTA
	b2 = -1*ALFA44/ALFA66
	b3 = -1*ALFA44*((ALFA13*ALFA23 - ALFA12*ALFA33)/DELTA + 1/ALFA66)
	b4 = -1*(1 + ALFA44*(ALFA12*ALFA13 - ALFA11*ALFA23)/DELTA)

	c1 = -1 * (DELTA + ALFA55*ALFA12*ALFA23 - ALFA13*ALFA22*ALFA55) / (ALFA55*(ALFA11*ALFA22 - ALFA12*ALFA12))
	c2 = -1 * (DELTA + ALFA44*ALFA12*ALFA13 - ALFA11*ALFA23*ALFA44) / (ALFA44*(ALFA11*ALFA22 - ALFA12*ALFA12))
	c3 = -1 * DELTA / (ALFA55*(ALFA11*ALFA22 - ALFA12*ALFA12))
	c4 = -1 * DELTA / (ALFA44*(ALFA11*ALFA22 - ALFA12*ALFA12))


!------------------------------------------------------- Çàïîëíÿåì ìàòðèöó ---------------------------------------

	A(1) = 0
	A(2) = 1
	A(3) = 0
	A(4) = 0
	A(5) = 0
	A(6) = 0
	
	A(7) = -1*(a1*mmmm*mmmm + a2*nnnn*nnnn) * PI * PI
	A(8) = 0
	A(9) = -1*a3*mmmm*nnnn*PI*PI
	A(10) = 0
	A(11) = 0
	A(12) = a4*mmmm*PI

	A(13) = 0
	A(14) = 0
	A(15) = 0
	A(16) = 1
	A(17) = 0
	A(18) = 0

	A(19) = -1*b3*mmmm*nnnn*PI*PI
	A(20) = 0
	A(21) = -1*(b1*nnnn*nnnn + b2*mmmm*mmmm) * PI * PI
	A(22) = 0
	A(23) = 0
	A(24) = b4*nnnn*PI

	A(25) = 0
	A(26) = 0
	A(27) = 0
	A(28) = 0
	A(29) = 0
	A(30) = 1

	A(31) = 0
	A(32) = -1*c1*mmmm*PI
	A(33) = 0
	A(34) = -1*c2*nnnn*PI
	A(35) = -1*(c3*mmmm*mmmm + c4*nnnn*nnnn) * PI * PI
    A(36) = 0


	A(37) = 0
	A(38) = 0
	A(39) = 0
	A(40) = 0
	A(41) = 0
	A(42) = 0


	open (888,file='A.txt',status='unknown')

	do i=1,42
		write (888,4)A(i)
	4	FORMAT(600(E12.5,1X))
	enddo

	close(888)

RETURN
	 


END subroutine

