книги / Численные методы решения некорректных задач
..pdf0 0 5 2
0 0 5 3
0 0 5 4
0 0 5 5
0 0 5 6
0 0 5 7
0 0 5 8
0 0 5 9
0 0 6 0
0061
0 0 6 2
0 0 6 3
006 4
0 0 6 5
0 0 6 6
0 0 6 7
0 0 6 8
0 0 6 9
0 0 7 0
0071
0 0 7 2
0 0 7 3
0 0 7 4
0 0 7 5
0 0 7 6
007 7
0 0 7 8
0 0 7 9
0 0 8 0
0081
0 0 8 2
0 0 8 3
0 084
0 0 8 5
0 0 8 6
008 7
0 088
0 0 8 9
0 0 9 0
С * БЛОК ВЫЧИСЛЕНИЯ НЕВЯЗОК F 1 = 0 .0
F 2= 0•0
F 3= 0•0
00 4 М=1, N
U2—URE(М)* *2+UIМ( М)* *2 A2=ARE<M)#*2+AIM<M)**2
X=*i.0+W(M)
I F (A 2 .E Q .0 .0 ) 60 ТО 41 BA=X/(A2+ALP*X)
АВ=1. 0-ALP*8A C1=HA*U2*( BA*ALP) **2 C2=HA*U2*AB*BA
C3=2.0*C1*AB F1=F1+C1 F2=F2+C2 F3«F3+C3
GO TO 4
41 F1=F1+HA*U2
4CONTINUE
С* ВЫЧИСЛЕНИЕ НЕВЯЗКИ -BETA,
С * НОРМЫ РЕШЕНИЯ 8 W21 -ZNOR,
С* ОБОБЩЕННОЙ НЕВЯЗКИ - RO
С* И ЕЕ ПРОИЗВОДНОЙDR BETA^Fl
ZN0R=0SQRT(F2)
R0=BETA-( DEL+HH*ZNQR) **2
IF ( ALP•EQ. 0 . 0 ) GO TO 68
DR=-F3*ALP-( DEL+HH* ZNOR) *HH*F3/ZNOR
С* ПЕРЕХОД К ВЫЧИСЛЕНИЮ РЕШЕНИЯ,
С* ЕСЛИ ТОЧНОСТЬ ДОСТИГНУТА
IF ( DABS( R0)« LT•EPRO) GO ТО 10
С* ПЕРЕХОД НА МЕТОД ХОРД,
С* ЕСЛИ ОБОБЩЕННАЯ НЕВЯЗКА НЕ ВЫПУКЛА
I F ( RO. LT. 0 . 0 ) GO ТО 61
С* ВЫЧИСЛЕНИЕ НОВОГО АРГУМЕНТА
С* ПО МЕТОДУ НЬЮТОНА
С* И ПЕРЕХОД К СЛЕДУЮЩЕМУ ШАГУ DQ=-RO/DR
A1=ALP
R1=R0
ALP=1. 0 / ( 1 . 0/ALP+DQ)
IF(IQ.GE.IMAX) GO TO 66
GO TO 3
С* МЕТОД ХОРД 61 CONTINUE
С* ИЗМЕНЕНИЕ ИНТЕРВАЛА ПРИ RO<0
6 |
CONTINUE |
|
|
A0=ALP |
|
7 |
R0=RO |
|
CONTINUE |
|
|
|
IGNIQ+i |
|
С * ВЫЧИСЛЕНИЕ НОВОГО АРГУМЕНТА |
|
|
С * ПО МЕТОДУ ХОРД |
|
|
|
ALP«A0*A1* ( R 0-R 1) / ( A0*R0-A1*Ri > |
|
С * ВЫЧИСЛЕНИЕ НЕВЯЗОК |
181 |
|
0091
0 0 9 2
0 0 9 3
0 0 9 4
0 0 9 5
0 0 9 6
0 0 9 7
0 0 9 8
0 0 9 9
0100
0101
0102
0 1 0 3
0 1 0 4
0 1 0 5
0106
0 1 0 7
0 1 0 8
0 1 0 9
0110
0111
0112
0 1 1 3
0 1 1 4
0 1 1 5
0 1 1 6
0 1 1 7
0 1 1 8
0 1 1 9
0120
0121
0122
0 1 2 3
0 1 2 4
0 1 2 5
0 1 2 6
0 1 2 7
0 1 2 8
0 1 2 9
0 1 3 0
0131
0 1 3 2
0 1 3 3
8CONTINUE F i= 0 . 0
F 2 = 0 .0
DO 9 M=1,N U2=URE(M)##2+UIM(M)#*2 A2=ARE(M)**2+AIM(M)*#2
|
X=1.0+W(M) |
|
I F ( A2. EQ. 0 . 0 ) GO TO 91 |
|
BA=X/(A2+ALP*X) |
|
AB=1.0—ALP*BA |
|
Cl=HA*U2*( BA#ALP) **2 |
|
C2=HA*U2*AB*BA |
|
F1=F1+C1 |
|
F2=F2+C2 |
91 |
GO TO 9 |
F1=F1+HA*U2 |
|
9 |
CONTINUE |
С* ВЫЧИСЛЕНИЕ НЕВЯЗКИ,
С* ОБОБЩЕННОЙ НЕВЯЗКИ И НОРМЫ РЕШЕНИЯ
BETA=F1
ZNOR=DSQRT( F 2 )
RO=BETA—( DEL+HH* ZNOR)* *2
IF ( ALP. EQ. 0 . 0 ) GO TO 68
С* ПЕРЕХОД К ВЫЧИСЛЕНИЮ РЕШЕНИЯ,
С* КОГДА ТОЧНОСТЬ ДОСТИГНУТА
IF ( DABS(RO).LT.EPRO) GO ТО 11
IF СIQ.EQ.IMAX) |
GO |
ТО 67 |
|
IF ( RO .LT . 0 . 0 ) |
GO |
TO |
6 |
С * ИЗМЕНЕНИЕ ИНТНРВАЛА, |
КОГДА RO>0 |
||
A1=ALP |
|
|
|
Rl=RO |
|
|
|
GO TO 7 |
|
|
|
65CONTINUE
С# HE УДАЛОСЬ ПОДОБРАТЬ ALP, ТАК
С* ЧТО RO(ALP) БОЛЬШЕ НУЛЯ IERR=65
GO ТО 999
66CONTINUE
С* СДЕЛАНО IMAX ИТЕРАЦИЙ МЕТОДОМ НЬЮТОНА! IERR=66
GO ТО 999
67CONTINUE
С* СДЕЛАНО IMAX ИТЕРАЦИЙ,
С* ПРИМЕНЯЛСЯ МЕТОД ХОРД
IERR=67
GO ТО 999
68CONTINUE
С* ЗАДАНО ИЛИ ПОЛУЧИЛОСЬ ALP=0.0 IERR=68
GO ТО 999
11CONTINUE
С* РЕШЕНИЕ НАЙДЕНО МЕТОДОМ ХОРД
IERR=1
GO ТО 999
10CONTINUE
С* НОРМАЛЬНОЕ ОКОНЧАНИЕ
182
0 134
013 5
0 136
013 7
0 1 3 8
0139
0 140
0141
0 1 4 2
0 1 4 3
0144
014 5
0146
0 1 4 7
0 1 4 8
0 1 4 9
0 1 5 0
0001
0002
0 0 0 3
0004
0 0 0 5
0 0 0 6
0 0 0 7
0 0 0 8
0 0 0 9
0010
0011
0012
0 0 1 3
0 0 1 4
0 0 1 5
0 0 1 6
IERR=0
999CONTINUE
С* ВЫЧИСЛЕНИЕ ФУРЬЕ—ПРЕОБРАЗОВАНИЯ РЕШЕНИЯ S S I = - 1 . 0
DO 12 M=i ,N SSI= -SSI
ZZ=N*(ARE(M)**2+AIM(M)**2+ +ALP*(l-0+W (M )))
IF ( Z Z . NE. 0 . 0 ) GO TO 111 ZRE(M)=0.0
ZIM(M)=0.0 GO TO 12
111 ZRE(M)=SSI*(ARE(M)*URE(M)+ +AIM(M)*UIM(M))/ZZ
ZIM(M)=SSI*(ARE(M)*UIM(M)- -AIM(M)*URE(M))/ZZ
12CONTINUE
С* ОБРАТНОЕ ФУРЬЕ-ПРЕОБРАЗОВАНИЕ РЕШЕНИЯ P = -1 .0
CALL FTF1C( Z R E ,Z IM ,N ,1,1,P ) RETURN
END
SUBROUTINE FTF1C( ARE, AIM, N , IN ,K ,P)
IMPLICIT REAL*8(A-H,0-Z)
С* ПРОГРАММА БЫСТРОГО ПРЕОБРАЗОВАНИЯ ФУРЬЕ
С* ФУНКЦИИ, ДЕЙСТВИТЕЛЬНАЯ ЧАСТЬ КОТОРОЙ
С * НАХОДИТСЯ В ARE(N) , А МНИМАЯ - В AIM(N).
С* ПРОИЗВОДИТСЯ ПРЯМОЕ ПРЕОБРАЗОВАНИЕ ФУРЬЕ,
С* ЕСЛИ Р БОЛЬШЕ НУЛЯ
С# И ОБРАТНОЕ ПРЕОБРАЗОВАНИЕ,
С* ЕСЛИ Р МЕНЬШЕ НУЛЯ.
С* ПРИ ОБРАЩЕНИИ ПАРАМЕТР Р
С* ДОЛЖЕН ВЫЗЫВАТЬСЯ ПО НАИМЕНОВАНИЮ.
С * РЕЗУЛЬТАТ - НА МЕСТЕ МАССИВОВ ARE И AIM.
С* N - ЦЕЛАЯ СТЕПЕНЬ ДВОЙКИ.
С* ИМЕЕТСЯ ВОЗМОЖНОСТЬ НАХОЖДЕНИЯ
С* ОБРАЗА ФУРЬЕ ЛИШЬ НЕКОТОРОГОПОДМНОЖЕСТВА
С |
* |
ТОЧЕК МАССИВОВ ARE И AIM (НАЧАЛЬНАЯ ТОЧКА |
||
С |
* |
ПОДМНОЖЕСТВА В IN, ШАГ - В К ). |
||
|
|
|
REAL*8 |
A R E ,A IM ,P ,R ,A ,B ,S ,C ,T ,S I, СО |
|
|
|
INTEGER |
N ,I N ,К , I , I I , J , J J , M, MM,N 1,N 2 |
|
|
|
DIMENSION ARE(N),AIM(N) |
|
|
|
|
Nl=N/2 |
|
|
|
|
MM=Ni/2 |
|
|
|
|
N2=N1+K |
|
|
|
|
J = IN |
|
|
|
1 |
JJ=J |
|
|
|
J=J+K |
|
|
|
|
2 |
IF (J - N l ) 2 , 2 , 1 0 |
|
|
|
II=JJ+Ni |
||
|
|
|
R-ARE(J) |
|
|
|
|
ARE( J )=ARE(II) |
|
|
|
|
ARE(II)=R |
|
183
0 0 1 7 |
|
R=AmtJ> |
0 0 1 8 |
|
AIM<J>=AIM(II) |
0 0 1 9 |
|
AIM (II)=R |
0020 |
|
M=KK |
0021 |
3 |
|
0022 |
IF<JJ-H >5*5,4 |
|
0 0 2 3 |
4 |
JJ=JJ-M |
0 0 2 4 |
|
'1=M/2 |
0 0 2 5 |
5 |
60 TO 3 |
0 0 2 6 |
JJ=JJ+W |
|
0 0 2 7 |
6 |
IF ( J J —J > 1 ,1 ,6 |
0 0 2 8 |
R=ARECJ) |
|
0 0 2 9 |
|
ARECJ)=ARECJJ) |
0 0 3 0 |
|
ARE ( J J )=R |
0031 |
|
R=AIMCJ) |
0 0 3 2 |
|
Am CJ)=Aim (JJ) |
0 0 3 3 |
|
AIM CJJ)=R |
0 0 3 4 |
|
I=J+N2 |
0 0 3 5 |
|
II=JJ+N2 |
0 0 3 6 |
|
R=ARE(I) |
003 7 |
|
ARE( I > =ARE С1 1 ) |
0 0 3 8 |
|
ARE (I I )* R |
0 0 3 9 |
|
R=AIM(I) |
0 0 4 0 |
|
А1М(П=А1М(П) |
0041 |
|
AIM fII)=R |
0 0 4 2 |
10 |
GO TO 1 |
0 0 4 3 |
I=K |
|
0 0 4 4 |
|
T = 3 .14159265359 |
0 0 4 5 |
11 |
I Р ( Р ) 1 3 ,1 7 ,1 1 |
0 0 4 6 |
T=-T |
|
0047 |
13 |
P=-T |
0 0 4 8 |
14 |
51= 0 . |
0 0 4 9 |
|
CCJ = 1 . |
0 0 5 0 |
|
S-OSINCT) |
0051 |
|
C=DCOS(T) |
005 2 |
|
T=0.5*T |
0053 |
|
II = I |
0 054 |
|
1 = 1 +1 |
0 0 5 5 |
|
DO 16 M = IN ,IIt K |
0 0 5 6 |
|
oo i s J =M, N , I |
005 7 |
|
J J =J +I I |
0 0 5 8 |
|
A=ARE(JJ) |
0 0 5 9 |
|
B=AIM(JJ) |
0 0 6 0 |
|
R=A*CO-B*SX |
0061 |
|
ARE CJ J ) =ARE(J ) —R |
0062 |
|
ARE(J)=ARE(J)+R |
0063 |
|
R=B*CQ+A*SI |
0064 |
|
AIM (JJ)=AIM (J) —R |
0 0 6 5 |
15 |
AIM(J)=AIM(J)+R |
0 0 6 6 |
|
R=C#CO-S#SI |
0 0 6 7 |
16 |
SI=C*SI+S*CO |
0 0 6 8 |
CQ=R |
|
0 0 6 9 |
17 |
I F ( I - N ) 1 4 , 1 7 ,1 7 |
0 0 7 0 |
RETURN |
|
0071 |
|
END |
t84
V . Программа решения двумерных интегральных уравнений типа свертки
0 0 0 1
0002
0003
0004
0005
0006
0007
0008
0009
0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
0020
0021
0022
0023
0024
0025
0026
0027
SUBROUTINE PTITR(AK,U0,ALIM,N1,N2,Z, *DL, HH, C l, ALPHA, AN, U, NU, IMAX, IERR)
IMPLICIT REAL*8(A-H, 0 - Z)
INTEGER IERR, IMAX, IP , IQ,N1,N2,NA I,NAR, *NMAX,NU,NUI,NUR,NW.NZI,NQI
REAL*8 AK,ALIM,ALPHA, AN, С1 ,DL, HH, *OM,T1,T2,U,U0,Z,EFRO
DIMENSION U(NU),U0(N1,N2) DIMENSION Z(N1,N 2 ),ALIM(12)
c |
* |
ТАБЛИЦА СООТВЕТСТВИЯ |
||
c |
* |
ИМЯ |
ДЛИНА |
НАЗНАЧЕНИЕ |
c |
* |
ARE |
N1*N2 |
ДЕЙСТВ. ЧАСТЬ |
c |
* |
AIM |
N1*N2 |
ОБРАЗА ФУРЬЕ ЯДРА |
c |
* |
МНИМ. ЧАСТЬ |
||
c |
* |
URE |
N1*N2 |
ОБРАЗА ФУРЬЕ ЯДРА |
c |
* |
ДЕЙСТВ. ЧАСТЬ |
||
c |
* |
UIM |
N1*N2 |
ОБРАЗА ФУРЬЕ ПРАВОЙ ЧАСТИ |
c |
* |
МНИМ. ЧАСТЬ |
||
c |
* |
ZIM |
N1*N2 |
ОБРАЗА ФУРЬЕ ПРАВОЙ ЧАСТИ |
c |
* |
МНИМАЯ ЧАСТЬ РЕШЕНИЯ |
||
c |
* |
W1 И W2 |
N1 и N2 |
СТАБИЛИЗАТОРЫ |
C |
* |
IF=1 |
|
|
IP - ПРИЗНАК РАБОТЫ: |
||||
С* ПРИ ПЕРВОМ ОБРАЩЕНИИ 1Р=+1
С* ПРИ ПОВТОРНОМ ВХОДЕ ЧЕРЕЗ FTIKRE 1Р=-1
EFRO=0.
IF(C1 ,GT. 1. )EPR0=:(C1-1. )*DL
C * EPRO - ТОЧНОСТЬ РЕШЕНИЯ УРАВНЕНИЯ НЕВЯЗКИ С * ЕСЛИ EFRO=0, ТО ВЫЧИСЛЯЕТСЯ ЭКСТРЕМАЛЬ
С * ПРИ ФИКСИРОВАННОМ ALFA
100CONTINUE
С* ВЫЧИСЛЕНИЕ ЛОКАЛЬНОГО НОСИТЕЛЯ РЕШЕНИЯ ALIM(1)=ALIM(5)-.5*(ALIM(9)+ALIM(10)) ALIM(2)=ALIM(6 ) - . 5 * (ALIM(9 )+ALIM(10))
ALIM(3 )=ALIM(7 ) - .5 * ( ALIM(11)+ALIM(12)) ALIM( 4 )=ALIM(8 ) - . 5*(ALIM(11)+ALIM(12))
C * T l, T2 - ПЕРИОДЫ ПРОДОЛЖЕНИЯ T1=ALIM(6)-ALIM(5) T2=ALIM(8)-ALIM(7)
С * ФОРМИРОВАНИЕ НАЧАЛ МАССИВОВ NAR=1
NQU=N1*N2
NAI=NAR+NQU
NWlrNAI+NQU
NW2=NW1+N1
NZI=NW2+N2
NUR=NZI+NQU
NUI=NUR+NQU
NMAX=NUI+NQU
С * КОНТРОЛЬ ДЛИНЫ РАБОЧЕГО МАССИВА IFCNMAX-l.GT.NU) GOTO 64
IF (IP .E Q .-l) GOTO 101
185
0028 |
С * |
ЗАДАНИЕ ПРАВОЙ ЧАСТИ |
|||
|
|
CALL РТICR1(U0, U0, U( NUR) , NQU,0 .) |
|||
0029 |
|
|
CALL PTICR2(U(NUI) ,0 . ,NQU) |
||
0030 |
101 |
CONTINUE |
|||
0031 |
С * |
СОБСТВЕННО РЕШЕНИЕ УРАВНЕНИЯ |
|||
|
|
CALL PTIKR3(АК,U(NAR),U(NAI), Z,U (N ZI), |
|||
|
|
*U(NUR), U(NUI) , U(NW1) , U(NW2),N 1,N 2, |
|||
|
|
*ALPHA, ALIM, AN, ОМ, T1 ,T2, DSQRT(DL), |
|||
0032 |
|
*DSQRT(HH) , IF , EPRO, IQ, IMAX, IERR) |
|||
|
64 |
GOTO 999 |
|||
0033 |
С * |
CONTINUE |
|||
0034 |
HE ХВАТАЕТ ДЛИНЫ РАБОЧЕГО МАССИВА |
||||
|
|
IERR=64 |
|||
0035 |
|
|
GOTO 999 |
||
|
С * ВХОД PTITRE ПРЕДНАЗНАЧЕН |
||||
|
С * ДЛЯ ПОВТОРНОГО РЕШЕНИЯ УРАВНЕНИЯ |
||||
0036 |
С * |
С ТЕМИ ЖЕ ЯДРОМ И ПРАВОЙ ЧАСТЬЮ |
|||
|
|
ENTRY PTITRE |
|||
0037 |
|
|
IF=-1 |
|
|
0038 |
999 |
GOTO 100 |
|||
0039 |
CONTINUE |
||||
0040 |
|
|
RETURN |
||
0041 |
|
|
END |
|
|
0001 |
|
|
SUBROUTINE PTIKR3(AK, ARE, AIM, ZRE, ZIM, |
||
|
|
*URE,UIM,W1, W2,N 1,N 2,ALP,ALIM,BETA,RO, |
|||
|
|
*T1,T2,DEL,HH,IPAR,EPRO,IQ,IMAX,IERR) |
|||
0002 |
|
|
IMPLICIT REAL*8(A-H,0-Z) |
||
0003 |
|
|
INTEGER I,IERR,IM A X ,IPA R,IQ ,J,M ,N ,N 1,N2 |
||
0004 |
|
|
REAL*8 AB, AIM,ALIM,ALP, ARE, ARG1, ARG2, |
||
|
|
*A0, Al,A2,BA,BETA, C l, C2, C3, DEL, DQ, DR, |
|||
|
|
*EPRO,Fl,F2,F3,HA,HH,H1,H2,P,RO, |
|||
|
|
*R0, R1, S S I, T1, T2,UIM,URE, U2, |
|||
0005 |
|
*W1, W2, X,ZIM,ZNOR,ZRE,ZZ |
|||
|
|
DIMENSION ARE(N1,N 2 ) ,ZRE(N1,N 2), |
|||
|
|
*URE(N1,N 2 ),AIM(N1,N 2 ) ,ZIM (N1,N2), |
|||
0006 |
|
*UIM(N1,N 2 ),W1(N 1 ),W2(N 2 ),ALIM(12) |
|||
|
|
H1=T1/N1 |
|||
0007 |
|
|
H2=T2/N2 |
||
0008 |
С * |
|
HA=H1/N1*H2/N2 |
||
0009 |
ПРОВЕРЯЕМ, ПЕРВЫЙ ЛИ ВХОД |
||||
С * |
|
IF(IPA R .EQ .-1 ) GOTO 2 |
|||
0 0 1 0 |
ЗАДАНИЕ ЯДРА УРАВНЕНИЯ |
||||
|
|
DO |
1 |
1=1,N1 |
|
001 1 |
|
|
DO |
1 |
J= 1 ,N2 |
0 0 1 2 |
|
|
A R G l= (I-N l/2 -l)*H l+ |
||
0013 |
|
+ 0 .5*(ALIM(9 )+ALIM(10)) |
|||
|
|
ARG2=(J-N2/2-1)*H2+ |
|||
0014 |
|
+0. 5*( АЦМ( 11 )+ALIM( 12)) |
|||
|
|
ARE( I , J ) =AK(ARG1, ARG2) *H1*H2 |
|||
0015 |
|
|
A IM (I, J ) =0. |
||
0016 |
|
|
IF(ARG1. LT.ALIM (9). OR.ARG1. GT. ALIM(1 0 ). |
||
|
|
.OR. ARG2. LT.ALIM(1 1 ) .OR.ARG2. GT.ALIM(12)) |
|||
|
|
* |
|
|
A R E (I,J)= 0 . |
186
0017 |
|
|
W l(I)= (2 .0 /H 1 * |
||
|
|
|
* |
|
DSIN(3 . 14159265359D0/N1*(1 - 1 ) ) )**2 |
0018 |
|
|
W2(J )= (2 .0/H2* |
||
0019 |
|
1 |
* |
|
DSIN(3. 14159265359D 0/N 2*(J-l) ) )**2 |
|
CONTINUE |
||||
0020 |
|
|
P=1.0 |
|
|
|
С * ПРЕОБРАЗОВАНИЕ ФУРЬЕ ЯДРА И ПРАВОЙ ЧАСТИ |
||||
0021 |
|
|
CALL FTFTC(ARE,AIM,N1,N2,P) |
||
0022 |
|
|
Р=1.0 |
|
|
0023 |
|
2 |
CALL FTFTC(URE,UIM,N1,N2,P) |
||
0024 |
С * |
CONTINUE |
|||
0025 |
ПОДБИРАЕМ ALP ТАК, ЧТО RO(ALP) > 0 |
||||
77 |
I®=0 |
|
|||
0026 |
CONTINUE |
||||
0027 |
С * |
|
IQ=IQ+1 |
||
0028 |
ВЫЧИСЛЕНИЕ НЕВЯЗОК |
||||
|
|
F1=0. |
|
||
0029 |
|
|
F2=0. |
M=1,N1 |
|
0030 |
|
|
DO |
44 |
|
0031 |
|
|
DO |
44 |
N=1,N2 |
0032 |
|
|
U2=URE(M,N)**2+UIM(M,N)**2 |
||
0033 |
|
|
A2=ARE(M,N)**2+AIM(M,N)**2 |
||
0034 |
|
|
X=1.+(W1(M)+W2(N))**2 |
||
0035 |
|
|
IF (A 2 .E Q .0 .) GOTO 42 |
||
0036 |
|
|
ВА=Х/(A2+ALP*X) |
||
0037 |
|
|
AB=1. -ALP*BA |
||
0038 |
|
|
Cl=HA*U2*(BA*ALP)**2 |
||
0039 |
|
|
C2=HA*U2*AB*BA |
||
0040 |
|
|
F1=F1+C1 |
||
0041 |
|
|
F2=F2+C2 |
||
0042 |
|
42 |
GOTO 44 |
||
0043 |
|
F1=F1+HA*U2 |
|||
0044 |
|
44 |
CONTINUE |
||
|
С * ВЫЧИСЛЕНИЕ ОБОБЩЕННОЙ НЕВЯЗКИ |
||||
0045 |
С * ДЛЯ ПРОВЕРКИ RO(ALP)>0 |
||||
|
|
BETA=F1 |
|||
0046 |
|
|
RO=Fl-(DEL+HH*DSQRT(F2))**2 |
||
С* ЕСЛИ ЗАДАНО EPRO=0, ТО КОНЧАЕМ 0047 IFCEPRO.EQ.0.) GOTO 10
С* ЕСЛИ ЗАДАНО ALP=0.0, ТО КОНЧАЕМ
0048 |
|
IF(A LP .EQ .0.) |
GOTO 68 |
0049 |
|
IFCRO.GT.0.) GOTO 33 |
|
С * ПЕРЕХОД К ВЫЧИСЛЕНИЮ РЕШЕНИЯ, |
|||
С * ЕСЛИ НЕ УДАЛОСЬ ПОДОБРАТЬ ALP ТАКОЕ, |
|||
С |
* |
ЧТО RO(ALP) > 0 |
GOTO 65 |
0050 |
|
IF(IQ.GT.IMAX) |
|
0051 |
|
ALP=2. *ALP |
|
0052 |
|
GOTO 77 |
|
С * НАЧАЛО ПОИСКА КОРНЯ МЕТОДОМ НЬЮТОНА |
|||
0053 |
33 |
CONTINUE |
|
0054 |
3 |
IQ=0 |
|
0055 |
CONTINUE |
|
|
0056 |
|
IQ=IQ+1 |
|
С * БЛОК ВЫЧИСЛЕНИЯ НЕВЯЗОК |
|||
0057 |
|
F1=0. |
|
187
0058
0059
0060
0061
0062
0063
0064
0065
0066
0067
0068
0069
0070
0071
0072
0073
0074
0075
0076
0077
0078
0079
0080
0081
0082
0083
0084
0085
0086
0087
0088
0089
0090
0091
0092
0093
0094
0095
0096
0097
F2=0.
F3=0.
DO 4 M=1,N1
DO 4 N=1,N2
U2=URE(M,N )**2+UIM(M,N)**2 A2=ARE(M,N)**2+AIM(M,N)**2
X=1. +(W1(M)+W2(N))**2
IF ( A2. EQ.0 .) GOTO 41 BA=X/(A2+ALP*X) AB=1. -ALP*EA C1=HA*U2*(ВA*ALP)**2 C2=HA*U2*AE*EA C3=2.*C1*AB
F1=F1+C1
F2=F2+C2
F3=F3+C3
GOTO 4
41 F1=F1+HA*U2
4CONTINUE
С* ВЫЧИСЛЕНИЕ НЕВЯЗКИ -BETA,
С* НОРМЫ РЕШЕНИЯ В W21 -ZNOR,
С* ОБОБЩЕННОЙ НЕВЯЗКИ -RO
С* И ЕЕ ПРОИЗВОДНОЙDR BETA=F1
ZNOR=DSQRT(F 2) RO=BETA-(DEL+HH*ZNOR)**2 IF (ALP. EQ.0 . ) GOTO 68
DR=-F3*ALP-(DEL+HH*ZNOR)*HH*F3/ZNOR
С* ПЕРЕХОД К ВЫЧИСЛЕНИЮ РЕШЕНИЯ,
С* ЕСЛИ ТОЧНОСТЬ ДОСТИГНУТА
IF (DABS(RO) . LT. EP/RO) GOTO 10
С* ПЕРЕХОД НА МЕТОД ХОРД,
С* ЕСЛИ ОБОБЩЕННАЯ НЕВЯЗКА НЕ ВЫПУКЛА
IF (RO. LT. 0 . ) GOTO 61
С* ВЫЧИСЛЕНИЕ НОВОГО АРГУМЕНТА
С* ПО МЕТОДУ НЬЮТОНА
С* И ПЕРЕХОД К СЛЕДУЮЩЕМУ ШАГУ
DQ=-RO/DR A1=ALP Rl=RO
ALP=1. / ( 1 •/ALP+DQ)
IF ( IQ . GE. IMAX) GOTO 66 GOTO 3
С * МЕТОД ХОРД
61 CONTINUE
С* ИЗМЕНЕНИЕ ИНТЕРВАЛА ПРИ R0<0
6CONTINUE A0=ALP R0=RO
7CONTINUE IQ=IQ+1
С* ВЫЧИСЛЕНИЕ НОВОГО АРГУМЕНТА
С* ПО МЕТОДУ ХОРД
ALP=A0*A1*(R0-R1) / ( A0*R0-A1*R1) С * ВЫЧИСЛЕНИЕ НЕВЯЗОК
F1=0.
188
0098
0099
0100
0101
0102
0103
0104
0105
0106
0107
0108
0109
0110
0111
0112
0113
0114
0115
0116
0117
0118
0119
0120
0121
0122
0123
0124
0125
0126
0127
0128
0129
0130
0131
0132
0133
0134
0135
0136
0137
0138
0139
0140
F2=0.
DO 9 M= 1, N1
DO 9 N=1,N2 U2=URE(M,N)**2+UIM(M,N)**2 A2=ARE(M,N)**2+AIM(M,N)**2 X=1.+(W1(M)+W2(N))**2
IF (A2. EQ.0 .) GOTO 91 BA=X/(A2+ALP*X) AB=1.-ALF*BA C1=HA*U2*(BA*ALP)**2 C2=HA*U2*AB*BA F1=F1+C1
F2=F2+C2
GOTO 9
91 F1=F1+HA*U2
9CONTINUE
С* ВЫЧИСЛЕНИЕ НЕВЯЗКИ, ОБОБЩЕННОЙ НЕВЯЗКИ
С* И НОРМЫ РЕШЕНИЯ
BETA=F1
ZNOR=DSQRT(F2)
RO=BETA-(DEL+HH*ZNOR)**2
IF(A L P .E Q .0.) GOTO 68
С* ПЕРЕХОД К ВЫЧИСЛЕНИЮ РЕШЕНИЯ,
С* КОГДА ТОЧНОСТЬ ДОСТИГНУТА IF(DABS(RO). LT.EPRO) GOTO 11
IF(IQ.EQ.IMAX) GOTO 67 IF (RO. LT. 0 .) GOTO 6
С * ИЗМЕНЕНИЕ ИНТЕРВАЛА, КОГДА RO>0 A1=ALP
Rl=RO
GOTO 7
65CONTINUE
С* HE УДАЛОСЬ ПОДОБРАТЬ ALP ТАК,
С* ЧТО RO(ALP) БОЛЬШЕ НУЛЯ IERR=65
GOTO 999
66CONTINUE
С* СДЕЛАНО IMAX ИТЕРАЦИЙ МЕТОДОМ НЬЮТОНА IERR=66
GOTO 999
67CONTINUE
С* СДЕЛАНО IMAX ИТЕРАЦИЙ,
С* ПРИМЕНЯЛСЯ МЕТОД ХОРД IERR=67
GOTO 999
68 CONTINUE
С* ЗАДАНО ИЛИ ПОЛУЧИЛОСЬ ALP=0.0
IERR=68
GOTO 999
11CONTINUE
С* РЕШЕНИЕ НАЙДЕНО МЕТОДОМ ХОРД
IERR=1
GOTO 999
10CONTINUE
С* НОРМАЛЬНОЕ ОКОНЧАНИЕ
IERR=0
189
0141 |
999 |
CONTINUE |
0142 |
С * ВЫЧИСЛЕНИЕ ФУРЬЕ-ПРЕОБРАЗОВАНИЕ РЕШЕНИЯ |
|
|
SSI=1.0 |
|
0143 |
|
DO 12 M=1,N1 |
0144 |
|
SSI=-SSI |
0145 |
|
DO 12 N=1,N2 |
0146 |
|
SSI=-SSI |
0147 |
|
ZZ=N1*N2*(ARE(M,N)**2+AIM(M,N)**2+ |
0148 |
|
+ALP*(1.0+(W1(M)+W 2(N))**2)) |
|
IF (Z Z .N E .0 .) GOTO 111 |
|
0149 |
|
ZRE( M, N) =0. |
0150 |
|
ZIM(M,N)=0. |
0151 |
111 |
GOTO 12 |
0152 |
ZRE(M,N)= SSI*(ARE(M,N )*URE(M,N)+ |
|
0153 |
|
+AIM(M,N)*UIM(M,N))/ZZ |
|
ZIM(M,N)=SSI*(ARE(M,N)*UIM(M,N)- |
|
0154 |
12 |
-AIM(M,N)*URE(M,N))/ZZ |
CONTINUE |
||
0155 |
С * ОБРАТНОЕ ФУРЬЕ-ПРЕОБРАЗОВАНИЕ РЕШЕНИЯ |
|
|
F = - 1 . 0 |
|
0156 |
|
CALL FTFTC(ZRE,ZIM,N 1,N 2,P) |
0157 |
|
RETURN |
0158 |
|
END |
0001 SUBROUTINE FTFTC(ARE,AIM,N1,N2,P)
С* ПРОГРАММА БЫСТРОГО ДВУМЕРНОГО
С* ДИСКРЕТНОГО ПРЕОБРАЗОВАНИЯ ФУНКЦИИ,
С* ДЕЙСТВИТЕЛЬНАЯ ЧАСТЬ КОТОРОЙ НАХОДИТСЯ
С |
* |
В ARE(N1,N 2 ), А |
МНИМАЯ - В AIM(N1,N2). |
|
С |
* |
ЕСЛИ Р > 0 , |
ТО |
ПРОИЗВОДИТСЯ ПРЯМОЕ, |
С |
* |
А ЕСЛИ Р < |
0 - |
ОБРАТНОЕ ПРЕОБРАЗОВАНИЕ. |
С* РЕЗУЛЬТАТ ОСТАЕТСЯ НА МЕСТЕ МАССИВОВ
С* ARE И AIM. РАЗМЕРНОСТИ МАССИВОВ N1 И N2
С* ДОЛЖНЫ БЫТЬ ЦЕЛЫМИ СТЕПЕНЯМИ ДВОЙКИ.
С* ПАРАМЕТР Р НЕ СОХРАНЯЕТСЯ.
0002 |
|
IMPLICIT |
REAL*8(А-Н, О -Z) |
0003 |
|
INTEGER |
I,J,N 1 ,N 2 |
0004 |
|
REAL*8 ARE,AIM,Р |
|
0005 |
|
DIMENSION ARE(N1,N2),AIM(N1,N2) |
|
0006 |
|
DO 1 1=1,N1 |
|
0007 |
1 |
CALL FTF1C(ARE,AIM,N1*N2, I,N 1 ,P ) |
|
0008 |
CONTINUE |
||
0009 |
|
DO 2 J= 1 ,N2 |
|
0010 |
2 |
CALL FTF1C(ARE(1 ,J ) , AIM(1 ,J ) ,N 1 ,1 ,1 ,P) |
|
0011 |
CONTINUE |
||
0012 |
|
RETURN |
|
0013 |
|
END |
|
0001 |
|
SUBROUTINE FTF1C(XARE, XAIM,N ,IN, К, P ) |
|
0002 |
|
IMPLICIT REAL*8(A-H,0-Z) |
|
0003 |
|
INTEGER |
N , I N , K , I , I I , J , J J , M,MM,N1,N2 |
190