akaGM
Platinum Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
! _sinc3, _gauss3
!sinc
real*8 function sinc(x)
implicit none
real*8 x, MIN_FLOAT_VALUE
parameter (MIN_FLOAT_VALUE = 4.0d-16)
if (dabs(x) < MIN_FLOAT_VALUE) then
sinc = 1.0d0
else
sinc = dsin(x) / x
endif
return
end function sinc
!/sinc
!_sinc3
subroutine _sinc3(N, X, F)
implicit none
integer*4 N
real*8 X(N), F
integer*4 numPoints, i
real*8 zMin, zMax, zStep
real*8 res, sum, z, Forig, Fcalc, c
real*8 sinc
external sinc
parameter (numPoints = 2000)
parameter (zMin = 0.d0)
parameter (zMax = 60.d0)
parameter (zStep = (zMax-zMin) / dble(numPoints-1))
parameter (c = 5.d0)
z = zMin
sum = 0.0d0
do i = 1, numPoints
Forig = 0.8d0 * sinc(c*z) +
& 0.5d0 * sinc(c*(z-10.d0)) +
& 0.7d0 * sinc(c*(z-40.d0)) +
& 0.4d0 * sinc(c*(z-50.d0))
Fcalc = X(4) * sinc(c*z) +
& X(5) * sinc(c*(z-X(1))) +
& X(6) * sinc(c*(z-X(2))) +
& X(7) * sinc(c*(z-X(3)))
z = z + zStep
res = (Forig-Fcalc)
sum = sum + res*res
enddo
F = sum / dble(numPoints)
return
end subroutine _sinc3
!/_sinc3
!_gauss3
subroutine _gauss3(N, X, F)
implicit none
integer*4 N
real*8 X(N), F
integer*4 numPoints, i
real*8 zMin, zMax, zStep
real*8 res, sum, z, Forig, Fcalc
real*8 sinc
external sinc
parameter (numPoints = 2000)
parameter (zMin = 0.d0)
parameter (zMax = 60.d0)
parameter (zStep = (zMax-zMin) / dble(numPoints-1))
z = zMin
sum = 0.0d0
do i = 1, numPoints
Forig = 0.8d0 * dexp(-z*z) +
& 0.5d0 * dexp(-(z-10.d0)**2) +
& 0.7d0 * dexp(-(z-40.d0)**2) +
& 0.4d0 * dexp(-(z-50.d0)**2)
Fcalc = X(4) * dexp(-z*z) +
& X(5) * dexp(-(z-X(1))**2) +
& X(6) * dexp(-(z-X(2))**2) +
& X(7) * dexp(-(z-X(3))**2)
z = z + zStep
res = (Forig-Fcalc)
sum = sum + res*res
enddo
F = sum / dble(numPoints)
return
end subroutine _gauss3
!/_gauss3
выдачу мне типа такой:
write(*,*) '*****************************************************'
write(*,*) '3 peaks: di {10, 40, 50}; amplitudes {0.8 0.5 0.7 0.4}'
write(*,*)
write(*, 800) 4, X(4)
do i = 1, 3
write(*,900) i, X(i), i+4, X(i+4)
enddo
write(*,*) '*****************************************************'
write(*,*) 'за это мне полагается:'
write(*,*) '1. коньяк'
write(*,*) '2. водка'
write(*,*) '3. виски'
write(*,*) '4. вермут'
write(*,*) '5. ликёр'
write(*,*) '6. вино'
write(*,*) '7. пиво'
write(*,*) 'ваш выбор, сэр?'
write(*,*) '--TeXpert'
read(*,*) ibonus
write(*,*) ':)'
800 format(' 0.0000 X(', I2, ') = ', G12.6)
900 format(' X(', I2, ') = ', G12.6, ' X(', I2, ') = ', G12.6)
|
Всего записей: 24120 | Зарегистр. 06-12-2002 | Отправлено: 12:42 28-12-2010 | Исправлено: akaGM, 16:01 28-12-2010 |
|
