Dismiss Notice
Join Physics Forums Today!
The friendliest, high quality science and math community on the planet! Everyone who loves science is here!

Fortran to Maple

  1. Jun 25, 2004 #1
    Hello,
    I have a program in Fortran language, and i need to translate it to Mapel program,
    can somebody help me?
    thank you.
    This is the program:



    Program SMOL1A3M
    c
    c23456789 123456789 123456789 123456789 123456789 123456789 123456789 12
    c
    c Resolution de l equation de Smoluchowski
    c k(x,y) = 1
    c methode Monte Carlo avec N = 3**n
    c calcul des erreurs sur les moments
    c Compilation:
    c
    c frt -o a6413.out smol1a3m.f -Am -Ss -X9 -M/usr/local/include/imsl64
    c -L/usr/local/lib/lib64/imsl -limsl -limsls_err -L/usr/local/lib/lib64/ -lnag
    c
    c-----------------------------------------------------------------------
    c
    implicit none
    integer b,n,np,nr,nt
    double precision tf
    Parameter(b=3,n=13,np=b**n,
    & tf=10.0d0,nr=100,nt=64000)
    integer ni
    integer ial(np),x(np),xaux(np)
    double precision alea,dt,errmom0,errmom2,n1em0,n2em0,nsem0,
    & n1em2,n2em2,nsem2,tn
    double precision erm0(nt),erm2(nt),val(np)
    real etime,tm(4),t1,t2,t3
    external G05CBF
    c
    tm = 1.0e0
    t1 = etime(tm)
    open(10,file='smol1a3m64313.out')
    dt=tf/dble(nt)
    write (10,1000) tf,nt,np
    PRINT*, tf,nt,np
    c
    c Initialisation de la suite des nombres pseudo-aleatoires
    c On utilise le programme G05CBF de la bibliotheque NAG
    c
    call G05CBF(0)
    c
    c Calcul des positions initiales
    c
    ni = 0
    tn = 0.0d0
    call initialisation(np,x)
    c
    c Evolution des particules
    c
    do ni=1,nt
    tn = dble(ni)*dt
    c
    c Calcul de la position des particules a l'instant tn
    c
    call evolution(alea,dt,np,x,ial,val,xaux)
    c
    c Calcul des erreurs sur les moments
    c
    call errmom(np,tn,x,errmom0,errmom2)
    erm0(ni) = errmom0
    erm2(ni) = errmom2
    write(10,1010) tn,erm0(ni),erm2(ni)
    enddo
    call normes(nr,nt,erm0,erm2,n1em0,n2em0,nsem0,n1em2,n2em2,nsem2)
    t2 = etime(tm)
    t3=t2-t1
    write(10,1020) t3,n1em0,n2em0,nsem0
    write(10,1020) t3,n1em2,n2em2,nsem2
    PRINT*, 'temps = ',t3
    PRINT*, n1em0,n2em0,nsem0
    PRINT*, n1em2,n2em2,nsem2
    close(10)
    1000 format (1x,d13.6,2x,i8,2x,i11)
    1010 format (1x,d13.6,2x,d13.6,2x,d13.6)
    1020 format (1x,e13.6,2x,d13.6,2x,d13.6,2x,d13.6)
    end
    c
    c-----------------------------------------------------------------------
    subroutine initialisation(np,x)
    c-----------------------------------------------------------------------
    c
    c On calcule les positions initiales des particules
    c
    implicit none
    integer np,i
    integer x(np)
    c
    do i=1,np
    x(i) = 1
    enddo
    return
    end
    c
    c-----------------------------------------------------------------------
    subroutine evolution(alea,dt,np,x,ial,val,xaux)
    c-----------------------------------------------------------------------
    c
    c Evolution des particules pendant un pas de temps
    c On utilise le programme G05CAF de la bibliotheque NAG
    c
    implicit none
    integer np,i
    integer ial(np),x(np),xaux(np)
    double precision alea,dt,frac
    double precision val(np)
    double precision G05CAF
    external G05CAF
    c
    do i=1,np
    ial(i) = 1+int(dble(np)*alea)
    alea = G05CAF(alea)
    enddo
    do i=1,np
    val(i) = alea
    alea = G05CAF(alea)
    enddo
    do i=1,np
    xaux(i) = x(i)
    enddo
    do i=1,np
    frac = dt/dble(x(ial(i)))
    if (val(i).lt.frac) then
    xaux(i) = x(i)+x(ial(i))
    endif
    enddo
    do i=1,np
    x(i) = xaux(i)
    enddo
    return
    end
    c
    c-----------------------------------------------------------------------
    subroutine errmom(np,tn,x,errmom0,errmom2)
    c-----------------------------------------------------------------------
    c
    c Calcul des erreurs sur les moments d ordre 0 et 2 a l'instant tn
    c
    implicit none
    integer i,np
    integer x(np)
    double precision errmom0,errmom2,inv,map0,map2,mom0,mom2,tn
    c
    mom0 = 2.0d0/(tn+2.0d0)
    mom2 = tn+1.0d0
    inv = 1.0d0/dble(np)
    map0 = 0.0d0
    map2 = 0.0d0
    do i=1,np
    map0 = map0+1.0d0/dble(x(i))
    map2 = map2+dble(x(i))
    enddo
    map0 = inv*map0
    map2 = inv*map2
    errmom0 = mom0-map0
    errmom2 = mom2-map2
    return
    end
    c
    c-----------------------------------------------------------------------
    subroutine normes(nr,nt,erm0,erm2,n1em0,n2em0,nsem0,
    & n1em2,n2em2,nsem2)
    c-----------------------------------------------------------------------
    c
    c Calcule des normes 1,2 et sup des erreurs sur les moments d ordre 0 et 2
    c
    implicit none
    integer nr,nt,i,nint
    double precision inv,n1em0,n2em0,nsem0,n1em2,n2em2,nsem2
    double precision erm0(nt),erm2(nt)
    c
    nint = nt/nr
    inv = 1.0d0/dble(nr)
    n1em0 = 0.0d0
    n2em0 = 0.0d0
    nsem0 = 0.0d0
    n1em2 = 0.0d0
    n2em2 = 0.0d0
    nsem2 = 0.0d0
    do i =1,nr
    n1em0 = n1em0+abs(erm0(nint*i))
    n2em0 = n2em0+(erm0(nint*i)*erm0(nint*i))
    nsem0 = max(nsem0,abs(erm0(nint*i)))
    n1em2 = n1em2+abs(erm2(nint*i))
    n2em2 = n2em2+(erm2(nint*i)*erm2(nint*i))
    nsem2 = max(nsem2,abs(erm2(nint*i)))
    enddo
    n1em0 = inv*n1em0
    n2em0 = sqrt(inv*n2em0)
    n1em2 = inv*n1em2
    n2em2 = sqrt(inv*n2em2)
    return
    end

    thank you verry much......
    Babowski...
     
  2. jcsd
Know someone interested in this topic? Share this thread via Reddit, Google+, Twitter, or Facebook

Can you help with the solution or looking for help too?
Draft saved Draft deleted



Similar Discussions: Fortran to Maple
  1. Maple procedure (Replies: 0)

  2. Plotting With Maple (Replies: 1)

Loading...