Форум программистов [Powered by Invision Power Board]

Код

program fvmfd
implicit none
REAL H0,F,F1,F2,Ff1(3),Ff2(3),i1,i2,i3,i4,k0,EF,W
complex MP1,KM1,KA1,k
real*8 Lmin,L

INTEGER  i,znak,N,y1,y2,fi,Lf,H0i

complex*8,allocatable,dimension(:,:)::AA
complex*8,allocatable,dimension(:)::EVAL
real*8,allocatable,dimension(:)::Lpr,Lob,Vot 
real*8,allocatable,dimension(:)::FF,L1

real*8 d,pi,delta,t1,t2,t3
PARAMETER (pi=3.1415926535)
character cmdchar*5,cmdchar1*5,cmdchar2*5,cmdchar3*5
integer varianty
common /mycom/cmdchar
common /myc/H0

EXTERNAL EVLCG

N=100
W=70e-3
allocate(AA(N,N))
allocate(eval(N))
allocate(L1(N))
do varianty=1,3
VARIANT: select case (varianty)
       
case (1)
    cmdchar1='40CH2'
    cmdchar2='40CH2'
    cmdchar3='40CH2'
    t1=0.1
    t2=0.2
    t3=0.2
case (2)
    cmdchar1='30CH6'
    cmdchar2='30CH6'
    cmdchar3='30CH6'
    t1=0.35
    t2=0.0
    t3=0.15
case (3)
    cmdchar1='10CH6'
    cmdchar2='10CH6'
    cmdchar3='10CH6'
    t1=0.2
    t2=0.15
    t3=0.15

end select VARIANT

H0i=0
do H0=16,28,6

H0i=H0i+1
cmdchar=cmdchar1
call diapason(Ff1(1),Ff2(1))
cmdchar=cmdchar2
call diapason(Ff1(2),Ff2(2))
cmdchar=cmdchar3
call diapason(Ff1(3),Ff2(3))
F1=maxval(Ff1)
F2=minval(Ff2)

print *,F1,F2,H0
fi=0
    do F=F1,F2,0.1
    fi=fi+1
    end do
    
    allocate(Lpr(fi))
    allocate(Lob(fi))
!    allocate(Vot(fi))
    allocate(FF(fi))

Lf=0
do F=F1,F2,0.1
        Lf=Lf+1
        FF(Lf)=F
        do znak=-1,1,2
            CALL MATRIX(W,N,F,znak,cmdchar1,cmdchar2,cmdchar3,t1,t2,t3,AA)
            CALL EVLCG (N, AA, N, EVAL)
L=0
Lmin=1000000
!Выбор корня определителя
            do i=1,N
                L=abs(imag((N*sqrt(EVAL(i)))/W))
                L1(i)=abs(imag((N*sqrt(EVAL(i)))/W))            
                if (L.ne.0.and.Lmin>L) then
                    Lmin=L
                else
                    Lmin=Lmin
                end if                
            end do 
            if (znak==-1) then
                Lob(Lf)=8.67*(N/16.6)*Lmin
            else 
                Lpr(Lf)=8.67*Lmin
            end if    
        end do
    end do

OPEN (UNIT=1, FILE='ROOTS1.txt', STATUS='old', FORM='FORMATTED') 
WRITE (1,'(TR5,F5.2)') H0
do Lf=1,fi
WRITE (1,'(F5.3,F20.12,F20.12,F20.12)') FF(Lf),Lpr(Lf),Lob(Lf)
end do    

deallocate(Lpr)
deallocate(Lob)
deallocate(FF)    
end do
    print *,F
end do
END program fvmfd