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

Maple 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
Share this great discussion with others via Reddit, Google+, Twitter, or Facebook

Can you offer guidance or do you also need help?
Draft saved Draft deleted