- #1
Babowski
- 1
- 0
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...
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...