книги / Численные методы решения некорректных задач
..pdf0048
0049
0050
0051
0052
0053
0054
0055
0056
0057
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
IF (DABS(AN4) . LE. EPS) GOTO 100
С* ЕСЛИ ОБОБЩЕННАЯ НЕВЯЗКА <-EPS,
С* TO ПЕРЕХОДИМ НА МОДИФИЦИРОВАННЫЙ
С* МЕТОД ХОРД
IF(AN4.LE.-EPS)GOTO 2
IF(ALFA.EQ.0.)GOTO 68 K2=K2+1
IF (K2. EQ. IMAX)GOTO 66 С * СОБСТВЕННО МЕТОД ХОРД
Y=X0-F0/(AN4-F0)* (X-X0) X0=X
X=Y
F0=AN4 ALFA=1 ./X
С * МЕТОД СОПРЯЖЕННЫХ ГРАДИЕНТОВ
CALL PTIZR1(U(NA), Zt U0,N,Mf ITER, * 0 . ,0 . ,N ,AN2, ALFA*DD, RO, Z, *U(NGRD), U(NS), U(NP), IER)
С * ВЫЧИСЛЯЕМ OBOBIHEHHYK) HEBfl3KY
CALL PTIZRA(AN2,Z,N,DU,DH,HX,HY,RO,AN4) GOTO 14
2CONTINUE
С* СЮДА ПОПАДАЕМ, ЕСЛИ ОБОБЩЕННАЯ НЕВЯЗКА
С* СТАЛА <-EPS. ПЕРЕХОДИМ НА МОДИФИЦИРОВАННЫЙ
С* МЕТОД ХОРД
F=AN4
23CONTINUE
Y=X0+F* (X-X0) / (F -F 0) ALFA=1./Y
С* МЕТОД СОПРЯЖЕННЫХ ГРАДИЕНТОВ
CALL PTIZR1(U(NA), Z,U0,N,M,ITER, * 0 . ,0 . ,N ,AN2, ALFA*DD, RO, Z, *U(NGRD),U(NS),U(NP), IER)
С * ВЫЧИСЛЯЕМ OBOBDIEHHYK) HEBH3KY
CALL PTIZRA(AN2, Z ,N ,DY,DH,HX,HY,RO,AN4)
С* ЕСЛИ ОБОБЩЕННАЯ НЕВЯЗКА <EPS,HO >-EPS,
С* TO ПРОГРАММА PABOTY ЗАКАНЧИВАЕТ IF(DABS(AN4). LE.EPS) GOTO 101 IF(AN4. LE.-EPS) GOTO 37 IFCALFA.EQ.0.)GOTO 68
K2=K2+1
IF(K2.EQ.IMAX)GOTO 67
X0=Y
F0=AN4
GOTO 23
37 CONTINUE
С* ИЗМЕНЕНИЕ ИНТЕРВАЛА
X=Y
F=AN4
GOTO 23 ENTRY PTIZRE
C * ВХОД ДЛЯ ПРОДОЛЖЕНИЯ ICONT=l
GOTO 110 64 CONTINUE
171
0084 |
С * |
НЕ ХВАТАЕТ ДЛИНЫ РАБОЧЕГО МАССИВА |
|
IERR=64 |
|
0085 |
65 |
GOTO 999 |
0086 |
CONTINUE |
|
|
С * СДЕЛАНО IMAX УМНОЖЕНИЙ НА 2, |
|
0087 |
С * |
А НЕВЯЗКА-ОТРИЦАТЕЛЬНАЯ |
|
IERR=65 |
|
0088 |
66 |
GOTO 999 |
0089 |
CONTINUE |
|
0090 |
С * |
СДЕЛАНО IMAX ИТЕРАЦИЙ МЕТОДОМ ХОРД |
|
IERR=66 |
|
0091 |
67 |
GOTO 999 |
0092 |
CONTINUE |
|
|
С * |
СДЕЛАНО IMAX ИТЕРАЦИЙ, |
0093 |
С * |
ПРИМЕНЯЛСЯ МОДИФИЦИРОВАННЫЙ МЕТОД |
|
IERR=67 |
|
0094 |
68 |
GOTO 999 |
0095 |
CONTINUE |
|
0096 |
С * |
ЗАДАНО ИЛИ ПОЛУЧИЛОСЬ ALFA=0. |
|
IERR=68 |
|
0097 |
|
GOTO 999 |
0098 |
100 CONTINUE |
|
0099 |
С * |
РЕШЕНИЕ НАЙДЕНО МЕТОДОМ ХОРД |
|
IERR=0 |
|
0100 |
101 |
GOTO 999 |
0101 |
CONTINUE |
|
|
С * РЕШЕНИЕ НАЙДЕНО С ПРИМЕНЕНИЕМ |
|
0102 |
С * |
МОДИФИЦИРОВАННОГО МЕТОДА ХОРД |
999 |
IERR=1 |
|
0103 |
CONTINUE |
|
0104 |
|
RETURN |
0105 |
|
END |
0001 |
|
SUBROUTINE PTIZR1(A,Z0,U0,N,M,ITER, DL2, |
|
|
*ANGRD,IMAX, AN2 , ALF, RO, Z, GRAD, S , U, IERR) |
С* ПОДПРОГРАММА МИНИМИЗИРУЕТ ФУНКЦИОНАЛ
С* ТИХОНОВА МЕТОДОМ СОПРЯЖЕННЫХ ГРАДИЕНТОВ
С * |
AK(M,N) - |
МАТРИЦА ОПЕРАТОРА В УР-НИИ AZ=U |
||
С * |
Z0 - |
НАЧАЛЬНОЕ ПРИБЛИЖЕНИЕ |
||
С * |
U0 - |
ПРАВАЯ ЧАСТЬ УРАВНЕНИЯ AZ=U |
||
С * |
DL2 - |
УРОВЕНЬ ВЫХОДА ПО НЕВЯЗКЕ |
||
С * |
ANGRD - ПО НОРМЕ ГРАДИЕНТА |
|||
С * |
AN2 - |
ПОЛУЧЕННАЯ НЕВЯЗКА |
||
С |
* |
ALF - |
ПАРАМЕТР РЕГУЛЯРИЗАЦИИ |
|
С |
* |
НО - |
ВЕС РАЗНОСТНОЙ ПРОИЗВОДНОЙ |
|
С * |
РЕШЕНИЕ - |
В СТАБИЛИЗАТОРЕ |
||
С * |
ЭКСТРЕМАЛЬ В МАССИВЕ Z |
|||
0002 |
|
IMPLICIT REAL*8(А -Н,О -Z) |
||
0003 |
|
INTEGER ITER, N, М, IMAX, IERR, IED |
||
0004 |
|
REAL*8 |
A, Z0, U0, Z, GRAD, S , U |
|
0005 |
|
REAL*8 |
DL2,ANGRD,AN2,ALF,RO,ALM |
|
0006 |
|
REAL*8 |
RNORM1, RNORM, BETA, RNM |
|
0007 |
|
DIMENSION A(M,N), Z0(N),U0(M ), |
||
|
|
*Z(N),GRAD(N),S(N) ,U(M) |
||
172
0 0 0 8
0009
0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
0020
0021
0022
0023
0024
0025
0026
0027
0028
0029
0030
0031
0032
0033
0034
0035
0036
0037
0038
0039
0040
0041
0042
0043
EXTERNAL PTICR1, PTICR4, PTICR8, *FTICR6, PTICR3, PTICR5, PTICRO
ITER=0
CALL PT IC R 1(Z 0,Z 0,Z ,N ,0 .)
С* НАХОДИМ ГРАДИЕНТ ФУНКЦИОНАЛА CALL PTICR3(A, Z, U, N, M)
CALL PT ICR4 (GRAD, U, CJ0, A, N, M) CALL PTICR8 (GRAD, Z, N, ALF, RO)
С* НАХОДИМ СОПРЯЖЕННОЕ НАПРАВЛЕНИЕ S
CALL PTICR1(GRAD, GRAD, S , N, 0 .) C * НАХОДИМ НОРМУ S
CALL PTICR6( S , S ,N ,RNORM1) С * ВНИМАНИЕ! МАШИННАЯ КОНСТАНТА
ALM=1. E+18
С* РЕШАЕМ ОДНОМЕРНУЮ ЗАДАЧУ МИНИМИЗАЦИИ,
С* НАХОДИМ ШАГ
7 CONTINUE
CALL PTICRO( А, Z, GRAD, U, S , ALM, BETA, *N, M, ALF, RO, IED)
IF(BETA.EQ.0.)GOTO 14 BETA=-BETA
C * НАХОДЙМ НОВОЕ ПРИБЛИЖЕНИЕ Z CALL PTICR1( Z, S , Z,N ,BETA)
С * ВЫЧИСЛЯЕМ НЕВЯЗКУ
CALL FTICR3(A,Z,U,N,M)
CALL PTICR5(U, U0, M, AN2)
С* ЕСЛИ НЕВЯЗКА < DL2,
С* TO ПРОГРАММА РАБОТУ ЗАКАНЧИВАЕТ IF(AN2'.LE.DL2)GOTO 10
ITER=ITER+1
С* НАХОДИМ ГРАДИЕНТ ФУНКЦИОНАЛА CALL PTICR4(GRAD, U, U0, А, N, М) CALL PTICR8CGRAD,Z,N,ALF,RO)
С* НАХОДИМ НОРМУ ГРАДИЕНТА
CALL PTICR6(GRAD,GRAD,N,RNORM)
RNM=RNORM/RNORMl
С* НАХОДИМ СОПРЯЖЕННОЕ НАПРАВЛЕНИЕ CALL PTICR1(GRAD, S , S ,N ,RNM) RNORMl=RNORM
С* . ЕСЛИ НОРМА ГРАДИЕНТА < ANGRD,
С* ПРОГРАММА РАБОТУ ЗАКАНЧИВАЕТ
IF (RNORM1. LE. ANGRD) GOTO 11
IF ( ITER.GE.IMAX) GOTO 13
GOTO 7
10CONTINUE
С* НЕВЯЗКА СТАЛА < DL2
IERR=0
GOTO 999
11CONTINUE
С* НОРМА ГРАДИЕНТА СТАЛА < ANGRD
IERR=1
GOTO 999
13CONTINUE
С* СДЕЛАНО IMAX ИТЕРАЦИЙ IERR=2
GOTO 999
0044 |
14 |
CONTINUE |
0045 |
С * шаг МИНИМИЗАЦИИ НУЛЕВОЙ |
|
999 |
IERR= 3 |
|
0046 |
CONTINUE |
|
0047 |
|
RETURN |
0048 |
|
END |
0001 |
|
SUBROUTINE PTIZRACAN2, Z,N, |
*DL, DH, HX, HY, RO, AN4)
С * ПОДПРОГРАММА ВЫЧИСЛЯЕТ ОБОБЩЕННУЮ НЕВЯЗКУ
0002 |
|
IMPLICIT REAL*8(A-H,0-Z) |
|
0003 |
|
INTEGER I ,N |
|
0004 |
|
REAL*8 AN2 , AN4 , DL, DH, HX, HY, S , S I ,RO, Z |
|
0005 |
|
DIMENSION |
Z(N) |
0006 |
* |
EXTERNAL PTICR6,DSQRT |
|
С |
НОРМИРУЕМ НЕВЯЗКУ |
||
0007 |
|
AN2=AN2*HY |
|
0008 |
* |
AN4=AN2-DL**2 |
|
С |
ЕСЛИ H=0. , |
TO |
|
С* ВЫЧИСЛЯТЬ НОРМУ РЕШЕНИЯ HE НУЖНО 0009 IFCDH.EQ.0.)GOTO 999
С* ВЫЧИСЛЯЕМ НОРМУ РЕШЕНИЯ В W21
0010 |
|
CALL PTICR6C Z,Z ,N ,S) |
0011 |
|
S=S*HX |
С |
Ж S - КВАДРАТ НОРМЫ РЕШЕНИЯ В L2 |
|
0012 |
|
S1=0'. |
0013 |
|
DO 1 1=2,N |
0014 |
1 |
S 1 = S 1 + (Z (I)-Z (I-1 ))* * 2 |
0015 |
CONTINUE |
|
0016 |
* SI |
S1=S1*HX |
C |
- КВАДРАТ НОРМЫ ПРОЗВОДНОЙ РЕШЕНИЯ В L2 |
|
0017 |
|
S=DSQRT(S+RO*Sl) |
С Ж S - НОРМА РЕШЕНИЯ В W21 |
||
0018 |
999 |
AN4=AN2-(DL+DH*S)**2 |
0019 |
CONTINUE |
|
0020 |
|
RETURN |
0021 |
|
END |
111. Программа решения интегральных уравнений Фредгольма
1-го рода на множестве неотрицательных функций
методом |
регуляризации |
0001 |
SUBROUTINE РТIPR( АК, U 0,A ,B ,C ,D ,N ,M ,Z , |
|
♦ IС, AN2, DL, Н, C l , ANGRD, IMAX, |
|
♦ALFA, R, NR, IERR) |
С* ПРОГРАММА РЕШЕНИЯ ИНТЕГРАЛЬНОГО УРАВНЕНИЯ
С* ПЕРВОГО РОДА МЕТОДОМ РЕГУЛЯРИЗАЦИИ
С * ТИХОНОВА С ВЫБОРОМ ПАРАМЕТРА РЕГУЛЯРИЗА-
С* ЦИИ В СООТВЕТСТВИИ С ПРИНЦИПОМ ОБОБЦЕННОй
С* НЕВЯЗКИ. ДЛЯ МИНИМИЗАЦИИ ФУНКЦИОНАЛА
С* ТИХОНОВА ИСПОЛЬЗУЕТСЯ МЕТОД
С* СОПРЯЖЕННЫХ ГРАДИЕНТОВ
0002 |
IMPLICIT REAL*8(A-H,0-Z) |
0003 |
INTEGER IERR, К1 , K2, NR, M,N ,NA, NG, NH , NU, |
174
0004
0005
000 6
0007
0008
000 9
0010
0011
0012
0 013
0014
0015
0016
0017
001 8
0 019
0020
0021
0022
0023
0024
0025
0026
002 7
0028
0 029
0 0 3 0
0031
0 0 3 2
0 0 3 3
0034
0035
|
|
*NU1 , NS , NMAX , N1 , I , IMAX , ITER, IER |
||
|
|
REAL*8 |
U 0 ,R ,Z , DU,DH,AK,DD |
|
|
|
REAL*8 |
A , В , C , D , AN2, DL, H, C l , ALFA |
|
|
|
REAL*8 |
RQ, EPS, AN4, F 0 , F , X0, X, Y, HX, HY |
|
|
|
DIMENSION U 0(M ),R (N R ), Z(N) |
||
|
|
EXTERNAL PTICR0, PTICR1, |
||
С * |
♦PTISR1, PTISR2, PTISR3 |
|
||
AK - ПОДПРОГРАММА-ФУНКЦИЯ ВЫЧИСЛЕНИЯ ЯДРА |
||||
С * |
ТАБЛИЦА СООТВЕТСТВИЯ |
|
||
С * |
ИМЯ |
ДЛИНА |
СОДЕРЖАНИЕ |
|
С * |
A: |
N*M |
МАТРИЦА ОПЕРАТОРА |
|
С * |
H: |
N |
НАПРАВЛЕНИЕ СПУСКА |
|
С * |
G: |
N |
ГРАДИЕНТ |
|
С * |
Us |
M |
ЗНАЧЕНИЕ ОПЕРАТОРА |
|
с |
* |
Ul: |
M |
РАБОЧИЙ МАССИВ |
с |
* |
S: |
N |
РАБОЧИЙ МАССИВ |
с*
с* NR=N*M+3N+2M
с |
* |
ICONT=0 |
|
ICONT - |
ПРИЗНАК РАБОТЫ С ПРОДОЛЖЕНИЕМ |
||
с |
* |
ICONT=0 |
НАЧАЛО РАБОТЫ |
с |
* |
ICONT=l |
ВХОД ДЛЯ ПРОДОЛЖЕНИЯ |
110CONTINUE
IF ( IС. NE. 0 . AND.IC.NE• 1 ) GOTO 69
с* ФОРМИРОВАНИЕ НАЧАЛА МАССИВОВ NA=1
NH=N*M+i
NG=NH+N
NU=NG+N
NUi=NU+M
NS=NU1+M
NMAX=NS+N
IF(NMAX—1 • GT. NR)GOTO 64 DU=DSQRT(DL) DH=DSQRT(H)
с * K1,K2 - СЧЕТЧИКИ ИТЕРАЦИЙ K1=0
K2=0
N1=N+1
HX=(В- A ) / (N - i . ) HY=(D—C) / ( M—1 • ) DD=HX/HY
с * RO - ВЕС ПРОИЗВОДНОЙ В ПРОСТРАНСТВЕ W21,
с* ДЕЛЕННЫЙ НА КВАДРАТ ШАГА СЕТКИ IF(IC .E Q .0)R O =1./H X **2
IF ( IC .E Q .1 )RO=0.0
с* EPS - ТОЧНОСТЬ РЕШЕНИЯ УРАВНЕНИЯ НЕВЯЗКИ
EPS=(C 1-1.)*DL
IF(ICO NT .EQ .l) GOTO 111
с * ФОРМИРУЕМ МАТРИЦУ ОПЕРАТОРА A
CALJ_ PT ICR0 ( AK , R ( NA ) ,A ,B ,C ,D ,N ,M )
111 CONTINUE
с* ПЕРЕХОДИМ В ПИ-ПЛЮС
CALL |
PTISR2( R( NA) , Z,N ,M, IC, R<NS)) |
CALL |
PTICR1( Z , Z , R ( NH) , N , 0 . ) |
с * ПОДБИРАЕМ ALFA ТАК, ЧТОБЫ
175
0036
0037
0 038
0 039
0 0 4 0
0041
0 0 4 2
0 0 4 3
0044
0 0 4 5
004 6
0047
004 8
0 0 4 9
005 0
0051
0052
0 053
0054
005 5
0 0 5 6
005 7
0058
0059
0060
0061
0062
0063
0064
0065
0066
0067
С * ОБОБЩЕННАЯ НЕВЯЗКА БЫЛА ПОЛОЖИТЕЛЬНОЙ
13CONTINUE
С* ИЩЕМ МИНИМУМ ФУНКЦИОНАЛА
С* МЕТОДОМ СОПРЯЖЕННЫХ ГРАДИЕНТОВ
CALL PTISRKR(NA) ,Z ,U 0,N ,M , ITER, * 0 • , 0 . , N , AN2, ALFA*DD, RO, Z, R( NU), *R (N U 1),R (N H ),R (N G ),R (N S), IER)
С * ВЫЧИСЛЯЕМ ОБОБЩЕННУЮ НЕВЯЗКУ
CALL PTIZRA( AN2, Z,N , DU, DH, HX , HY, RO, AN4) IF ( C l . LE. 1 . ) GOTO 100
IF (ALFA•EQ. 0 . ) GOTO 68
I F ( AN4. GT. EPS) GOTO 11
С * ЕСЛИ ОБОБЩЕННАЯ НЕВЯЗКА <EPS,
С * TO УМНОЖАЕМ ALFA НА 2 , ПОКА НЕ СТАНЕТ >EPS
С* ИЛИ НЕ БУДЕТ СДЕЛАНО IMAX ИТЕРАЦИЙ К1=К1+1
IF(Kl.EQ.IMAX) GOTO 65 ALFA=2. *ALFA
GOTO 13
С* ЗАДАЕМ ДВЕ НАЧАЛЬНЫЕ ТОЧКИ МЕТОДА ХОРД 11 CONTINUE
F0=SAN4 Х0=1• /ALFA
ALFA=ALFA*2. X = i• /ALFA
С* МЕТОД СОПРЯЖЕННЫХ ГРАДИЕНТОВ
CALL PTISR1(R(NA), Z,U0,N,M ,ITER, * 0 . , 0 . ,N,AN2,ALFA*DD,R0,Z,R(NU), *R(NU1), R( NH) ,R (NG) ,R (N S ),IE R )
С # ВЫЧИСЛЯЕМ ОБОБЩЕННУЮ НЕВЯЗКУ
CALL PTIZRA(AN2,Z, N,DU,DH,HX,HY,R0,AN4) 14 CONTINUE
С* ЕСЛИ ОБОБЩЕННАЯ НЕВЯЗКА <EPS,HO >-EPS,
С* TO ПРОГРАММА РАБОТУ ЗАКАНЧИВАЕТ
I F ( DABS( AN4) . LE. EPS) GOTO 100
С* ЕСЛИ ОБОБЩЕННАЯ НЕВЯЗКА <-EPS,
С* TO ПЕРЕХОДИМ НА МОДИФИЦИРОВАННЫЙ
С* МЕТОД ХОРД
I F ( AN4•LE. -E P S ) GOTO 2
I F ( ALFA. EQ. 0 . )GOTO 68 K2=K2+i
I F ( K2. EQ. IMAX)GOTO 66 С * СОБСТВЕННО МЕТОД ХОРД
Y = X 0 -F 0/(AN4-F0) * ( X-X0) X0=X
X=Y
F0=AN4
ALFA=1./X
С * МЕТОД СОПРЯЖЕННЫХ ГРАДИЕНТОВ
CALL PTISR1(R(NA),Z,U0,N,M ,ITER, *0 0 . , N, AN2 , ALFA*DD , RO , Z , R ( NU ) , *R(NU1), R( NH) , R( NG) , R( NS) , IER)
С * ВЫЧИСЛЯЕМ ОБОБЩЕННУЮ НЕВЯЗКУ
CALL |
PTIZRA( AN2, Z,N ,DU, DH, HX, HY, RO, AN4) |
GOTO |
14 |
2 CONTINUE
176
0068
0069
007 0
0071
0072
0073
0074
0075
007 6
0077
0078
0 079
0080
0081
008 2
0083
0084
0085
0086
0087
0088
0089
009 0
0091
0 092
0093
0094
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
0104
С* СЮДА ПОПАДАЕМ ЕСЛИ ОБОБЩЕННАЯ НЕВЯЗКА
С* СТАЛА <-EPS
С* ПЕРЕХОДИМ НА МОДИФИЦИРОВАННЫЙ МЕТОД ХОРД
F=AN4
23CONTINUE
Y=X0+F*( X-X0) / ( F - F 0 ) ALFA=1./У
С* МЕТОД СОПРЯЖЕННЫХ ГРАДИЕНТОВ
CALL PTISR1(R(NA),Z,U0,N,M ,ITER, * 0 . , 0 . , N , AN2, ALFA#DD, RO, Z, R(NU) , *R(NU1),R(NH), R( NO) , R( NS) »IER)
С * ВЫЧИСЛЯЕМ ОБОБЩЕННУЮ НЕВЯЗКУ
CALL PTIZRA(AN2,Z,N,DY,DH,HX,HY>R0,AN4)
С* ЕСЛИ ОБОБЩЕННАЯ НЕВЯЗКА <EPS,HO >-EPS,
С* TO ПРОГРАММА РАБОТУ ЗАКАНЧИВАЕТ
I F ( DABS( AN4) • LE. EPS) GOTO 101
I F ( AN4. LE• —EPS) GOTO 37
IF ( ALFA. EQ• 0 . ) GOTO 68
K2=K2+1
I F (K2«EQ• IMAX)GOTO 67
X0=Y
F0=AN4
GOTO 23
37CONTINUE
С* ИЗМЕНЕНИЕ ИНТЕРВАЛА X=Y
F=AN4 GOTO 23
ENTRY PTIPRE
C * ВХОД ДЛЯ ПРОДОЛЖЕНИЯ
ICONT=l
GOTO 110
64CONTINUE
С* HE ХВАТАЕТ ДЛИНЫ РАБОЧЕГО МАССИВА IERR=64
GOTO 9999
65CONTINUE
С* СДЕЛАНО IMAX УМНОЖЕНИЙ HA 2 ,
С* А НЕВЯЗКА-ОТРИЦАТЕЛЬНАЯ IERR=65
GOTO 999
66CONTINUE
С* СДЕЛАНО IMAX ИТЕРАЦИЙ МЕТОДОМ ХОРД IERR=66
GOTO 999
67CONTINUE
С* СДЕЛАНО IMAX ИТЕРАЦИЙ,
С* ПРИМЕНЯЛСЯ МОДИФИЦИРОВАННЫЙ МЕТОД IERR=67
GOTO 999
68CONTINUE
СЖ ЗАДАНО ИЛИ ПОЛУЧИЛОСЬ ALFA=0. IERR=68
69 |
GOTO 999 |
CONTINUE |
|
C # |
IC HE PABEHO 0 ИЛИ 1 |
177
010 5 |
|
|
IERR=69 |
|
0 106 |
100 |
GOTO 9999 |
||
0 1 0 7 |
CONTINUE |
|||
0 1 0 8 |
С * |
РЕШЕНИЕ НАЙДЕНО МЕТОДОМ ХОРД |
||
|
|
IERR=0 |
||
010 9 |
101 |
|
GOTO 999 |
|
0110 |
|
CONTINUE |
||
|
С * РЕШЕНИЕ НАЙДЕНО С ПРИМЕНЕНИЕМ |
|||
0111 |
С * |
МОДИФИЦИРОВАННОГО МЕТОДА ХОРД |
||
999 |
|
IERR=1 |
||
0112 |
|
CONTINUE |
||
0 1 1 3 |
С * |
ВОЗВРАТ |
ИЗ ПИ-ПЛЮС |
|
|
|
CALL |
PTIC R 1(Z,Z,R (N H ), N , 0 . ) |
|
0114 |
9999 |
|
CALL |
РТISR3( Z , N , IC , R( NS)) |
011 5 |
|
CONTINUE |
||
0116 |
|
|
RETURN |
|
0 1 1 7 |
|
|
END |
|
IV. Программарешения одномерных интегральных уравнений типа свертки
0001
0002
0003
0004
0005
0006
0007
0008
0009
SUBROUTINE РТIKR( АК, U 0, А , В , С , D, |
|
*L1, L 2 , N, Z, AN, DL, НИ, C l , IMAX, ALPHA, |
|
#U, NU, IERR) |
|
IMPLICIT REAL*8(A-H,0-Z) |
|
REAL*8 |
A, AK, ALPHA, AN, В , C, C l , D, DL, HH |
REAL*8 |
L1,L2,OM ,T,U,U0,Z,EPRO |
INTEGER |
IERR,IMAX, IP ,IQ ,N |
INTEGER |
NAI, NAR, NMAX, NU, NUI, NUR, NW, NZI |
DIMENSION U( NU) , U 0( N ) , Z(N) |
|
EXTERNAL PTICR1, РТICR2, PTIKR1 |
|
С |
* |
ТАБЛИЦА СООТВЕТСТВИЯ |
|
|
||
С |
* |
имя |
ДЛИНА |
НАЗНАЧЕНИЕ |
|
|
с |
* |
ARE |
N |
ДЕЙСТВ. ЧАСТЬ |
ЯДРА |
|
с |
* |
AIM |
N |
ОБРАЗА |
ФУРЬЕ |
|
с |
» |
МНИМ. ЧАСТЬ |
ЯДРА |
|||
с |
* |
URE |
N |
ОБРАЗА |
ФУРЬЕ |
|
с |
* |
ДЕЙСТВ. |
ЧАСТЬ |
ПРАВОЙ ЧАСТИ |
||
с |
* |
UIM |
N |
ОБРАЗА ФУРЬЕ |
||
с |
* |
МНИМ. ЧАСТЬ |
ПРАВОЙ ЧАСТИ |
|||
с |
* |
ZIM |
N |
ОБРАЗА ФУРЬЕ |
||
с |
* |
МНИМАЯ ЧАСТЬ РЕШЕНИЯ |
||||
с |
* |
W |
N |
СТАБИЛИЗАТОР |
|
|
с |
* |
IP==1 |
РАБОТЫ: |
|
|
|
IP - |
ПРИЗНАК |
|
|
|||
С* ПРИ ПЕРВОМ ОБРАЩЕНИИ 1Р=+1
С* ПРИ ПОВТОРНОМ ВХОДЕ ЧЕРЕЗ PTIKRE 1Р=-1
0010 |
|
EPRO=0. |
0011 |
* |
I F ( C l . GT• 1 . ) EPRO=( C l - 1 . )*DL |
C |
EPRO - ТОЧНОСТЬ РЕШЕНИЯ УРАВНЕНИЯ НЕВЯЗКИ |
|
С |
* |
ЕСЛИ EPRO=0, ТО ВЫЧИСЛЯЕТСЯ ЭКСТРЕМАЛЬ |
С * ПРИ ФИКСИРОВАННОМ ALFA |
||
0012 |
100 |
CONTINUE |
С * ВЫЧИСЛЕНИЕ ЛОКАЛЬНОГО НОСИТЕЛЯ РЕШЕНИЯ |
||
0013 |
|
A =C -.5*(L1+L2) |
0014 |
|
B =D -.5*(L 1+L 2) |
178 |
|
|
0015
001 6
0017
0 0 1 8
0 0 1 9
0020
0021
0022
0 0 2 3
002 4
002 5
0026
0 0 2 7
0 0 2 8
0 0 2 9
0 0 3 0
0031
0 0 3 2
003 3
0034
003 5
0 0 3 6
0 0 3 7
0 0 3 8
0001
0002
0 0 0 3
000 4
0 0 0 5
0 0 0 6
0 0 0 7
0 0 0 8
0009
С* Т- ПЕРИОД ПРОДОЛЖЕНИЯ T=D-C
С* ФОРМИРОВАНИЕ НАЧАЛ МАССИВОВ NAR=i
NAI=NAR+N
NW=N A I +N
NZI=NW+N
NUR=NZI+N
NUI=NUR+N
NMAXbfslUI+N
С * КОНТРОЛЬ ДЛИНЫ |
РАБОЧЕГО МАССИВА |
|||
IF ( NMAX-1. GT. NU) |
GO |
TO 64 |
||
I F ( I P . E Q . - l) |
GO |
TO |
101 |
|
С * ЗАДАНИЕ ПРАВОЙ |
ЧАСТИ |
|
||
CALL |
PTICR1(U 0, U0, U(NUR) , N , 0 . ) |
|||
CALL |
PTICR2(U(NUI) , 0 . ,N) |
|||
101CONTINUE
С♦ СОБСТВЕННО РЕШЕНИЕ УРАВНЕНИЯ CALL PTIKR1 ( AK, U( NAR) , U( NAI ) , Z ,
♦U(NZI) , U( NUR) , U( NUI) ,U(NW),N,ALPHA, *Li,L2,AN,0M ,T,DSQRT(DL), DSQRT( HH) , ♦ I P , EPRO, IQ,IMAX,IERR)
GO TO 999
64CONTINUE
С* HE ХВАТАЕТ ДЛИНЫ РАБОЧЕГО МАССИВА IERR=64
GO TO 999
С♦ ВХОД PTIKRE ПРЕДНАЗНАЧЕН
С* ДЛЯ ПОВТОРНОГО РЕШЕНИЯУРАВНЕНИЯ
С# С ТЕМИ ЖЕ ЯДРОМ И ПРАВОЙ ЧАСТЬЮ ENTRY PTIKRE
IP=-1
GO TO 100
999CONTINUE RETURN END
SUBROUTINE PTIKR1 ( AK, ARE,AIM,ZRE,ZIM, *URE, UIM, W,N , ALP, L I , L 2, BETA, RO, A, ♦DEL, HH, IPAR, EPRO, IQ,IMAX, IERR)
IMPLICIT REAL*8(A-H,0-Z)
REAL*8 A, AB, AIM, AK, ALP, ARE, A0, A1, A2, ♦BA, BETA, C l , C 2, C3, DEL, DP, DQ, EPRO,
♦F1 , F 2 , F 3 , H, HA, HH, L I , L 2, P , RO, R0, R1, S S I , ♦UIM, URE, U 2, W, X, ZIM, ZNOR, ZRE, Z Z
INTEGER I , IERR,IMAX, IPAR,IQ,M,N
DIMENSION ARE( N ) , ZRE( N ) , URE(N ), ♦AIM(N), ZIM(N),UIM(N),W(N) EXTERNAL FTF1C
H=A/N
HA=H/N
C ♦ ПРОВЕРЯЕМ ПЕРВЫЙ ЛИ ВХОД I F ( IPAR. EQ- —1) GO TO 2
C ♦ ЗАДАНИЕ ЯДРА УРАВНЕНИЯ
179
0 0 1 0
0011
0012
0 013
001 4
0 0 1 5
0 0 1 6
0 0 1 7
0 0 1 8
0 0 1 9
0020
0021
0022
0 0 2 3
0024
0 0 2 5
002 6
002 7
0 0 2 8
0 0 2 9
0 0 3 0
0031
0 0 3 2
0 0 3 3
0034
003 5
0036
0037
0 0 3 8
0 0 3 9
0 0 4 0
0041
0 0 4 2
0 0 4 3
0 0 4 4
0 0 4 5
0 0 4 6
0 0 4 7
0 0 4 8
0 0 4 9
0 0 5 0
0051
DO 1 1=1,N
AR6=( I - N / 2 - 1 ) *H+0. 5 * ( L1+L2) ARE( I ) =AK( ARG) *H
AIM( I ) = 0 . 0
I F ( ARG•L T .L I . OR•ARG. GT. L 2 ) A R E (I)= 0 .0
W< I)= (2 .0 /H * D S IN (3 .1 4 1 5 9 2 6 5 3 5 8 D 0 /
/N * ( 1 - 1 ) ) ) **2
1CONTINUE
P=1.0
С* ПРЕОБРАЗОВАНИЕ ФУРЬЕ ЯДРА И ПРАВОЙ ЧАСТИ
|
CALL |
FTF1C( ARE, AIM, N, 1 , 1 ,Р ) |
|
CALL |
FTF1C(URE,UIM,N,1 , 1 ,P ) |
С * |
2 CONTINUE |
|
ПОДБИРАЕМ ALP ТАК, ЧТО RO(ALP) > 0 |
||
C * |
IQ - СЧЕТЧИК ИТЕРАЦИЙ |
|
|
IQ=0 |
|
77CONTINUE IQ=IQ+1
С* ВЫЧИСЛЕНИЕ НЕВЯЗОК
F i= 0 .0 F 2= 0•0
DO 44 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•EG. 0 . 0 ) GO TO 42 BA=X/ ( A2+ALP* X)
AB=1. 0-ALP*BA C1=HA*U2*( BA*ALP) **2 C2=HA*U2*AB*BA F1=F1+C1
F2=F2+C2
GO TO 44
42 F1=F1+HA*U2
44CONTINUE
С* ВЫЧИСЛЕНИЕ ОБОБЩЕННОЙ НЕВЯЗКИ
С* ДЛЯ ПРОВЕРКИ RO( ALP)>0 BETA=Fi
С * |
R Q =Fi-( DEL+HH*DSQRT( F 2 ) )**2 |
||
ЕСЛИ ЗАДАНО EPRO=0, |
ТО КОНЧАЕМ |
||
С * |
I F ( EPRO. EQ. 0 . 0 ) |
GO |
ТО 10 |
ЕСЛИ ЗАДАНО ALP=0.0, |
ТО КОНЧАЕМ |
||
|
IF ( ALP. EQ. 0 . 0 ) |
GO |
ТО 68 |
IF (R O .G T .0 .0) GO ТО 33
С* ПЕРЕХОД К ВЫЧИСЛЕНИЮ РЕШЕНИЯ,
С* ЕСЛИ НЕ УДАЛОСЬ
С * ПОДОБРАТЬ ALP ТАКОЕ, |
ЧТО RO(ALP) > 0 |
I F ( IQ.GT.IMAX) GO |
TO 65 |
ALP=2.0*ALP GO TO 77
С * НАЧАЛО ПОИСКА КОРНЯ МЕТОДОМ НЬЮТОНА 33 CONTINUE
IQ=0
3 CONTINUE
IQ=IQ+1
180