درخواست کمک در نرم افزار فرترن

مدیر انجمن: parse

ارسال پست
arezooo_m

عضویت : یک‌شنبه ۱۳۹۲/۶/۲۴ - ۱۴:۴۶


پست: 7

سپاس: 1

درخواست کمک در نرم افزار فرترن

پست توسط arezooo_m »

با سلام
میخواستم درخواست کمک کنم برای محاسبه ی ویژه مقادیر و ویژه بردارهای یک ماتریس ،با استفاده از نرم افزار فرترن ممنون میشم از راهنمایی راهنماگر دانا
باتشکر smile020

نمایه کاربر
ADMIN

عضویت : شنبه ۱۳۸۴/۲/۲۴ - ۱۹:۱۷


پست: 2401

سپاس: 560

جنسیت:

تماس:

Re: درخواست کمک در نرم افزار فرترن

پست توسط ADMIN »

کد: انتخاب همه

  Program Main
!====================================================================
!  eigenvalues and eigenvectors of a real symmetric matrix
!  Method: calls Jacobi
!====================================================================
implicit none
integer, parameter :: n=3
double precision :: a(n,n), x(n,n)
double precision, parameter:: abserr=1.0e-09
integer i, j

! matrix A
  data (a(1,i), i=1,3) /   1.0,  2.0,  3.0 /
  data (a(2,i), i=1,3) /   2.0,  2.0, -2.0 /
  data (a(3,i), i=1,3) /   3.0, -2.0,  4.0 /

! print a header and the original matrix
  write (*,200)
  do i=1,n
     write (*,201) (a(i,j),j=1,n)
  end do

  call Jacobi(a,x,abserr,n)

! print solutions
  write (*,202)
  write (*,201) (a(i,i),i=1,n)
  write (*,203)
  do i = 1,n
     write (*,201)  (x(i,j),j=1,n)
  end do

200 format (' Eigenvalues and eigenvectors (Jacobi method) ',/, &
            ' Matrix A')
201 format (6f12.6)
202 format (/,' Eigenvalues')
203 format (/,' Eigenvectors')
end program main

subroutine Jacobi(a,x,abserr,n)
!===========================================================
! Evaluate eigenvalues and eigenvectors
! of a real symmetric matrix a(n,n): a*x = lambda*x 
! method: Jacoby method for symmetric matrices 
! Alex G. (December 2009)
!-----------------------------------------------------------
! input ...
! a(n,n) - array of coefficients for matrix A
! n      - number of equations
! abserr - abs tolerance [sum of (off-diagonal elements)^2]
! output ...
! a(i,i) - eigenvalues
! x(i,j) - eigenvectors
! comments ...
!===========================================================
implicit none
integer i, j, k, n
double precision a(n,n),x(n,n)
double precision abserr, b2, bar
double precision beta, coeff, c, s, cs, sc

! initialize x(i,j)=0, x(i,i)=1
! *** the array operation x=0.0 is specific for Fortran 90/95
x = 0.0
do i=1,n
  x(i,i) = 1.0
end do

! find the sum of all off-diagonal elements (squared)
b2 = 0.0
do i=1,n
  do j=1,n
    if (i.ne.j) b2 = b2 + a(i,j)**2
  end do
end do

if (b2 <= abserr) return

! average for off-diagonal elements /2
bar = 0.5*b2/float(n*n)

do while (b2.gt.abserr)
  do i=1,n-1
    do j=i+1,n
      if (a(j,i)**2 <= bar) cycle  ! do not touch small elements
      b2 = b2 - 2.0*a(j,i)**2
      bar = 0.5*b2/float(n*n)
! calculate coefficient c and s for Givens matrix
      beta = (a(j,j)-a(i,i))/(2.0*a(j,i))
      coeff = 0.5*beta/sqrt(1.0+beta**2)
      s = sqrt(max(0.5+coeff,0.0))
      c = sqrt(max(0.5-coeff,0.0))
! recalculate rows i and j
      do k=1,n
        cs =  c*a(i,k)+s*a(j,k)
        sc = -s*a(i,k)+c*a(j,k)
        a(i,k) = cs
        a(j,k) = sc
      end do
! new matrix a_{k+1} from a_{k}, and eigenvectors 
      do k=1,n
        cs =  c*a(k,i)+s*a(k,j)
        sc = -s*a(k,i)+c*a(k,j)
        a(k,i) = cs
        a(k,j) = sc
        cs =  c*x(k,i)+s*x(k,j)
        sc = -s*x(k,i)+c*x(k,j)
        x(k,i) = cs
        x(k,j) = sc
      end do
    end do
  end do
end do
return
end
موجیم که آسودگی ما عدم ماست ... ما زنده به آنیم که آرام نگیریم ...

نمایه کاربر
*شارش*

نام: فاطمه غمكده

محل اقامت: بلبلان

عضویت : دوشنبه ۱۳۹۱/۶/۲۰ - ۱۱:۳۰


پست: 1076

سپاس: 595

جنسیت:

Re: درخواست کمک در نرم افزار فرترن

پست توسط *شارش* »

راستی جناب ادمین در مورد نرم افزار پروتئوس میشه یکم توضیح بدین
و یه پیشنهادی هم که داشتم چرا برنامه نویسی رو بهمون اموزش نمیدید البته رایگان

arezooo_m

عضویت : یک‌شنبه ۱۳۹۲/۶/۲۴ - ۱۴:۴۶


پست: 7

سپاس: 1

Re: درخواست کمک در نرم افزار فرترن

پست توسط arezooo_m »

خیلی خیلی ممنون از لطف شما (Admin) امیدوارم که موفق باشید .
با تشکر فراوان.

نمایه کاربر
ADMIN

عضویت : شنبه ۱۳۸۴/۲/۲۴ - ۱۹:۱۷


پست: 2401

سپاس: 560

جنسیت:

تماس:

Re: درخواست کمک در نرم افزار فرترن

پست توسط ADMIN »

girl. نوشته شده:راستی جناب ادمین در مورد نرم افزار پروتئوس میشه یکم توضیح بدین
و یه پیشنهادی هم که داشتم چرا برنامه نویسی رو بهمون اموزش نمیدید البته رایگان
نرم افزار Proteus یه نرم افزار کاربردی در زمینه الکترونیک هست و به عنوان زبان برنامه نویسی شناخته نمیشه. متاسفانه من تجربه ای در کار با این برنامه ندارم ولی منابع زیادی روی شبکه برای آشنایی با اون هست. همینطور بچه های رشته مهندسی الکترونیک معمولا با این برنامه به شکل حرفه ای کار میکنند.

در مورد یادگیری برنامه نویسی، محیطی مثل تالار گفتگو، جای مناسبی برای آموزش نیست و بهتر هست اگر فردی علاقه مند به یادگیری برنامه نویسی هست، شخصا منابع مختلف رو تهیه و مطالعه کنه و البته پشتکار و ممارست زیادی هم در این زمینه داشته باشه. نهایتا برای مشاوره، رفع اشکال و یادگیری تکنیک های مختلف از تالارهای گفتگوی مختلف میشه استفاده کرد.
موجیم که آسودگی ما عدم ماست ... ما زنده به آنیم که آرام نگیریم ...

qountum

عضویت : پنج‌شنبه ۱۳۹۳/۳/۸ - ۱۹:۱۴


پست: 3

سپاس: 1

Re: درخواست کمک در نرم افزار فرترن

پست توسط qountum »

سلام جناب ادمین اگه امکانش باشه برنامه فرترن برای حل معادله ویژه مقداری که گذاشتین حل ریاضی شو بزارین ببینیم از کدوم روش رفتین مرسی

نمایه کاربر
You-See

نام: U30

محل اقامت: تهران

عضویت : یک‌شنبه ۱۳۹۳/۵/۱۹ - ۱۹:۰۵


پست: 1281

سپاس: 787

جنسیت:

تماس:

Re: درخواست کمک در نرم افزار فرترن

پست توسط You-See »

سلام.
من برای آموزش اعلام آمادگی می کنم!
دوستای گلم حمایت کنید : https://cafebazaar.ir/app/com.nikanmehr.marmarxword/

نمایه کاربر
ADMIN

عضویت : شنبه ۱۳۸۴/۲/۲۴ - ۱۹:۱۷


پست: 2401

سپاس: 560

جنسیت:

تماس:

Re: درخواست کمک در نرم افزار فرترن

پست توسط ADMIN »

qountum نوشته شده:سلام جناب ادمین اگه امکانش باشه برنامه فرترن برای حل معادله ویژه مقداری که گذاشتین حل ریاضی شو بزارین ببینیم از کدوم روش رفتین مرسی


Jacobi method
موجیم که آسودگی ما عدم ماست ... ما زنده به آنیم که آرام نگیریم ...

نمایه کاربر
بهزاد

عضویت : جمعه ۱۳۸۵/۱۱/۲۷ - ۱۶:۴۹


پست: 816

سپاس: 85

جنسیت:

تماس:

Re: درخواست کمک در نرم افزار فرترن

پست توسط بهزاد »

arezooo_m نوشته شده:با سلام
میخواستم درخواست کمک کنم برای محاسبه ی ویژه مقادیر و ویژه بردارهای یک ماتریس ،با استفاده از نرم افزار فرترن ممنون میشم از راهنمایی راهنماگر دانا
باتشکر smile020


از توابع کتابخانه ای هم بتونی استفاده کنی کارت راحت تر میشه

مثلا کتابخانه LAPACK که سابروتین های زیاد و کامل بهینه ای داره (http://www.netlib.org/lapack)
و یا کتاب خانه فوق العااااااااااده عالی mkl

mkl رو اول نصب میکنی بعد کافیه داخل برنامه ت فقط یه خط کد بنویسی و از اون تابع مورد نظر استاده کنی
البته کامپایلرت باید فقط و فقط ifort باشه

مثلا برای قطری کردن ماتریس و بدست اوردن ویژه مقادیر و ویژه بردار ها با توجه به شکل ماتریست باید از توابعی مثل
dsyev ، dsyev ، ..... استفاده کنی

یه نمونه میذارم که برای حلش از تابع dsyev استفاده کردم
اول راهنمای استفاده از توابع مربوط به این مساله در mkl

کد: انتخاب همه

?syev
Computes all eigenvalues and, optionally, eigenvectors of a real symmetric matrix.
Syntax
FORTRAN 77:
call ssyev(jobz, uplo, n, a, lda, w, work, lwork, info)

call dsyev(jobz, uplo, n, a, lda, w, work, lwork, info)

Fortran 95:
call syev(a, w [,jobz] [,uplo] [,info])

C:
lapack_int LAPACKE_<?>syev( int matrix_order, char jobz, char uplo, lapack_int n, <datatype>* a, lapack_int lda, <datatype>* w );

Include Files
The FORTRAN 77 interfaces are specified in the mkl_lapack.fi and mkl_lapack.h include files, the Fortran 95 interfaces are specified in the lapack.f90 include file, and the C interfaces are specified in the mkl_lapacke.h include file.
Description
The routine computes all eigenvalues and, optionally, eigenvectors of a real symmetric matrix A.
Note that for most cases of real symmetric eigenvalue problems the default choice should be ?syevr function as its underlying algorithm is faster and uses less workspace.
Input Parameters
The data types are given for the Fortran interface. A <datatype> placeholder, if present, is used for the C interface data types in the C interface section above. See C Interface Conventions for the C interface principal conventions and type definitions.
jobz
CHARACTER*1. Must be 'N' or 'V'.
If jobz = 'N', then only eigenvalues are computed.
If jobz = 'V', then eigenvalues and eigenvectors are computed.
uplo
CHARACTER*1. Must be 'U' or 'L'.
If uplo = 'U', a stores the upper triangular part of A.
If uplo = 'L', a stores the lower triangular part of A.
n
INTEGER. The order of the matrix A (n ≥ 0).
a, work
REAL for ssyev
DOUBLE PRECISION for dsyev
Arrays:
a(lda,*) is an array containing either upper or lower triangular part of the symmetric matrix A, as specified by uplo.
The second dimension of a must be at least max(1, n).
work is a workspace array, its dimension max(1, lwork).
lda
INTEGER. The leading dimension of the array a.
Must be at least max(1, n).
lwork
INTEGER.
The dimension of the array work.
Constraint: lwork ≥ max(1, 3n-1).
If lwork = -1, then a workspace query is assumed; the routine only calculates the optimal size of the work array, returns this value as the first entry of the work array, and no error message related to lwork is issued by xerbla.
See Application Notes for the suggested value of lwork.
Output Parameters
a
On exit, if jobz = 'V', then if info = 0, array a contains the orthonormal eigenvectors of the matrix A.
If jobz = 'N', then on exit the lower triangle
(if uplo = 'L') or the upper triangle (if uplo = 'U') of A, including the diagonal, is overwritten.
w
REAL for ssyev
DOUBLE PRECISION for dsyev
Array, DIMENSION at least max(1, n).
If info = 0, contains the eigenvalues of the matrix A in ascending order.
work(1)
On exit, if lwork > 0, then work(1) returns the required minimal size of lwork.
info
INTEGER.
If info = 0, the execution is successful.
If info = -i, the i-th parameter had an illegal value.
If info = i, then the algorithm failed to converge; i indicates the number of elements of an intermediate tridiagonal form which did not converge to zero.
Fortran 95 Interface Notes
Routines in Fortran 95 interface have fewer arguments in the calling sequence than their FORTRAN 77 counterparts. For general conventions applied to skip redundant or restorable arguments, see Fortran 95 Interface Conventions.
Specific details for the routine syev interface are the following:
a
Holds the matrix A of size (n, n).
w
Holds the vector of length n.
job
Must be 'N' or 'V'. The default value is 'N'.
uplo
Must be 'U' or 'L'. The default value is 'U'.
Application Notes
For optimum performance set lwork ≥ (nb+2)*n, where nb is the blocksize for ?sytrd returned by ilaenv.
If you are in doubt how much workspace to supply, use a generous value of lwork for the first run or set lwork = -1.
If you choose the first option and set any of admissible lwork sizes, which is no less than the minimal value described, the routine completes the task, though probably not so fast as with a recommended workspace, and provides the recommended workspace in the first element of the corresponding array work on exit. Use this value (work(1)) for subsequent runs.
If you set lwork = -1, the routine returns immediately and provides the recommended workspace in the first element of the corresponding array (work). This operation is called a workspace query.
Note that if you set lwork to less than the minimal required value and not -1, the routine returns immediately with an error exit and does not provide any information on the recommended workspace.
If it is not clear how much workspace to supply, use a generous value of lwork for the first run, or set lwork = -1.
If lwork has any of admissible sizes, which is no less than the minimal value described, then the routine completes the task, though probably not so fast as with a recommended workspace, and provides the recommended workspace in the first element of the corresponding array on exit. Use this value (work(1)) for subsequent runs.
If lwork = -1, then the routine returns immediately and provides the recommended workspace in the first element of the corresponding array work. This operation is called a workspace query.
Note that if lwork is less than the minimal required value and is not equal to -1, then the routine returns immediately with an error exit and does not provide any information on the recommended workspace.


ویه مثال برای بدست اوردن ویژه مقادیر و ویژه بردار و .... ( ببخشید کثیفه یه بخشی از برنامه خودمه وقت نبود تمیزش کنم)
از طریق توابع mkl

کد: انتخاب همه

PROGRAM MATRIX
integer::I,J
real::sume(5,5),m(5),x(5)
integer::info,lwork,n
real(8)::a(5,5), w(5), work(100)
CHARACTER*1 :: v,u
!------------------
integer::ipiv
real(8)::a1(5),a2(5),a3(5),a4(5),a5(5),b(5),res1 ,res2,res3,res4,res5,ddot
!-------------------
a(1,1)=5 ; a(1,2)=-2 ; a(1,3)=0 ;a(1,4)=-1 ; a(1,5)=0;
a(2,1)=-2; a(2,2)=5  ; a(2,3)=0 ; a(2,4)=0 ;  a(2,5)=-1;
a(3,1)=0  ; a(3,2)=0 ;  a(3,3)=5; a(3,4)=0 ; a(3,5)=0;
a(4,1)=-1 ;  a(4,2)=0 ;  a(4,3)=0; a(4,4)=5 ;  a(4,5)=-2;
a(5,1)=0 ;  a(5,2)=-1  ; a(5,3)=0 ; a(5,4)=-2 ;  a(5,5)=5;

call dsyev ( 'v','u', 5, a, 5, w, work,100, info)
write (*,*) ,'eigen value= ', w(4)
write (*,*) 'eigen vectors=' ,a
write (*,*) 'info='  ,info


همونطور که میبینی کل برنامه فقط یه خطه
ماتریس رو میدی
call dsyev میکنی
برنامه خودش سراغ نرم افزار mkl میره تابع رو میخونه و با توجه به داده ها حلش میکنه
و ویژه مقادیر و ویژه بردار ها رو بدست میاره

و اگه بخوای از LAPACK استفاده کنی باید سابروتین dsyev و .... را از سایتی که معرفی کردم برداری و بهش ماتریس معرفی کنی
همین
اینم یه مثال از LAPACK

کد: انتخاب همه


*  DSYEV Example.
*  ==============
*
*  Program computes all eigenvalues and eigenvectors of a real symmetric
*  matrix A:
*
*    1.96  -6.49  -0.47  -7.20  -0.65
*   -6.49   3.80  -6.39   1.50  -6.34
*   -0.47  -6.39   4.17  -1.51   2.67
*   -7.20   1.50  -1.51   5.70   1.80
*   -0.65  -6.34   2.67   1.80  -7.10
*
*  Description.
*  ============
*
*  The routine computes all eigenvalues and, optionally, eigenvectors of an
*  n-by-n real symmetric matrix A. The eigenvector v(j) of A satisfies
*
*  A*v(j) = lambda(j)*v(j)
*
*  where lambda(j) is its eigenvalue. The computed eigenvectors are
*  orthonormal.
*
*  Example Program Results.
*  ========================
*
* DSYEV Example Program Results
*
* Eigenvalues
* -11.07  -6.23   0.86   8.87  16.09
*
* Eigenvectors (stored columnwise)
*  -0.30  -0.61   0.40  -0.37   0.49
*  -0.51  -0.29  -0.41  -0.36  -0.61
*  -0.08  -0.38  -0.66   0.50   0.40
*   0.00  -0.45   0.46   0.62  -0.46
*  -0.80   0.45   0.17   0.31   0.16
*  =============================================================================
*
*     .. Parameters ..
      INTEGER          N
      PARAMETER        ( N = 5 )
      INTEGER          LDA
      PARAMETER        ( LDA = N )
      INTEGER          LWMAX
      PARAMETER        ( LWMAX = 1000 )
*
*     .. Local Scalars ..
      INTEGER          INFO, LWORK
*
*     .. Local Arrays ..
      DOUBLE PRECISION A( LDA, N ), W( N ), WORK( LWMAX )
      DATA             A/
     $  1.96, 0.00, 0.00, 0.00, 0.00,
     $ -6.49, 3.80, 0.00, 0.00, 0.00,
     $ -0.47,-6.39, 4.17, 0.00, 0.00,
     $ -7.20, 1.50,-1.51, 5.70, 0.00,
     $ -0.65,-6.34, 2.67, 1.80,-7.10
     $                  /
*
*     .. External Subroutines ..
      EXTERNAL         DSYEV
      EXTERNAL         PRINT_MATRIX
*
*     .. Intrinsic Functions ..
      INTRINSIC        INT, MIN
*
*     .. Executable Statements ..
      WRITE(*,*)'DSYEV Example Program Results'
*
*     Query the optimal workspace.
*
      LWORK = -1
      CALL DSYEV( 'Vectors', 'Upper', N, A, LDA, W, WORK, LWORK, INFO )
      LWORK = MIN( LWMAX, INT( WORK( 1 ) ) )
*
*     Solve eigenproblem.
*
      CALL DSYEV( 'Vectors', 'Upper', N, A, LDA, W, WORK, LWORK, INFO )
*
*     Check for convergence.
*
      IF( INFO.GT.0 ) THEN
         WRITE(*,*)'The algorithm failed to compute eigenvalues.'
         STOP
      END IF
*
*     Print eigenvalues.
*
      CALL PRINT_MATRIX( 'Eigenvalues', 1, N, W, 1 )
*
*     Print eigenvectors.
*
      CALL PRINT_MATRIX( 'Eigenvectors (stored columnwise)', N, N, A,
     $                   LDA )
      STOP
      END
*
*     End of DSYEV Example.
*
*  =============================================================================
*
*     Auxiliary routine: printing a matrix.
*
      SUBROUTINE PRINT_MATRIX( DESC, M, N, A, LDA )
      CHARACTER*(*)    DESC
      INTEGER          M, N, LDA
      DOUBLE PRECISION A( LDA, * )
*
      INTEGER          I, J
*
      WRITE(*,*)
      WRITE(*,*) DESC
      DO I = 1, M
         WRITE(*,9998) ( A( I, J ), J = 1, N )
      END DO
*
 9998 FORMAT( 11(:,1X,F6.2) )
      RETURN
      END


موفق باشی smile023
“It doesn’t matter how beautiful your theory is, it doesn’t matter how smart you are or what your name is.
If it doesn’t agree with experiment, it’s wrong.”

Richard Feynman

mhz2

نام: محمد حسین

عضویت : سه‌شنبه ۱۳۹۴/۲/۸ - ۱۷:۵۷


پست: 1



Re: درخواست کمک در نرم افزار فرترن

پست توسط mhz2 »

سلام دوستان خواهشا به دادم برسید
کد نویسی روش بیراستو برای بدست آوردن ریشه معادله در زبان فورترن لازم دارم خیلی خیلی فوری
ممنون می شم

ارسال پست