silence...

[Evangelos Bertakis]

Hi there!

It seems that we are either all too busy, or too tired to write an
email to the list... So I thought of sending you this little program
to stir things up a bit:

program WilliamShakespeare

character*(5):: Hamlet='(A20)'
logical:: tobe=.true.
integer:: Yorick_grave=1

open(Yorick_grave,file='take.skull')

if ((tobe).or.(.not.tobe)) then
write(Yorick_grave,Hamlet)'that is the question'
close(Yorick_grave)
end if

end

Notice that no matter the value of variable "tobe" the block-if is
executed. Somebody needs to send an email to this Shakespeare guy and
inform him of the bug...

Vangelis

[Dimitrios Papadopoulos]

Hi ho,

on the same spirit, some ideas to have fun on holidays:

program main

implicit none
real :: harvest
integer :: random

1 call random_seed()

2 call random_number(harvest)
random = int(harvest*10)+1
print*, 'Life is so dull'
goto random
3 call random_number(harvest)
random = int(harvest*10)+1
print*, 'are we going all to die?'
goto random
4 call random_number(harvest)
random = int(harvest*10)+1
print*, 'and how?'
goto random
5 call random_number(harvest)
random = int(harvest*10)+1
print*, 'because it is like this'
goto random
6 call random_number(harvest)
random = int(harvest*10)+1
print*, '... you all'
goto random
7 call random_number(harvest)
random = int(harvest*10)+1
print*, 'die Welt ist alles was es ist'
goto random
8 call random_number(harvest)
random = int(harvest*10)+1
print*, 'Who says that love is beautiful?'
goto random
9 call random_number(harvest)
random = int(harvest*10)+1
print*, 'me'
goto random
10 stop

end

! ------------------------------------------

It's also written with the forgotten but still almighty "goto".

Enjoy the day,

Dimitris

[Dimitrios Papadopoulos]

Hi again,

enjoying working from the command line, I thought you would like to
test this premitive function plotting utility:

real :: testme
external testme
call scrsho(testme)
end

real function testme(x)
real :: x

testme = x**2-x
end function testme

SUBROUTINE scrsho(fx)
INTEGER ISCR,JSCR
REAL fx
EXTERNAL fx
PARAMETER (ISCR=60,JSCR=21)
INTEGER i,j,jz
REAL dx,dyj,x,x1,x2,ybig,ysml,y(ISCR)
CHARACTER*1 scr(ISCR,JSCR),blank,zero,yy,xx,ff
SAVE blank,zero,yy,xx,ff
DATA blank,zero,yy,xx,ff/' ','-','l','-','x'/
1 continue
write (*,*) ' Enter x1,x2 (= to stop)'
read (*,*) x1,x2
if(x1.eq.x2) return
do 11 j=1,JSCR
scr(1,j)=yy
scr(ISCR,j)=yy
11 continue
do 13 i=2,ISCR-1
scr(i,1)=xx
scr(i,JSCR)=xx
do 12 j=2,JSCR-1
scr(i,j)=blank
12 continue
13 continue
dx=(x2-x1)/(ISCR-1)
x=x1
ybig=0.
ysml=ybig
do 14 i=1,ISCR
y(i)=fx(x)
if(y(i).lt.ysml) ysml=y(i)
if(y(i).gt.ybig) ybig=y(i)
x=x+dx
14 continue
if(ybig.eq.ysml) ybig=ysml+1.
dyj=(JSCR-1)/(ybig-ysml)
jz=1-ysml*dyj
do 15 i=1,ISCR
scr(i,jz)=zero
j=1+(y(i)-ysml)*dyj
scr(i,j)=ff
15 continue
write (*,'(1x,1pe10.3,1x,80a1)') ybig,(scr(i,JSCR),i=1,ISCR)
do 16 j=JSCR-1,2,-1
write (*,'(12x,80a1)') (scr(i,j),i=1,ISCR)
16 continue
write (*,'(1x,1pe10.3,1x,80a1)') ysml,(scr(i,1),i=1,ISCR)
write (*,'(12x,1pe10.3,40x,e10.3)') x1,x2
goto 1
END

Have fun,

Dimitris

[Evangelos Bertakis]

Wow. This is what I call "a blast from the past"...

Vangelis

[Dimitrios Papadopoulos]

As far as I know, it is possible in fortran to define new types and to
overload the existing operators in order to operator on the new type.
It is also possible to define a function/subroutine that does
calculations with the new type. But is it possible to define
completely new operators?

Dimitris

[Evangelos Bertakis]

Well, there is "operator overloading" for that purpose. Otherwise, a
simple fortran function may as well be looked upon as an "operator".

Vangelis

[Dimitrios Papadopoulos]

You didn't say anything different than I said.

But I found the answer.

module mymodule
type point
real :: x, y
end type point

interface operator(.dist.)
module procedure calcdist
end interface

contains

function calcdist(p1, p2)
type(point) :: p1, p2
real :: calcdist

calcdist = sqrt((p1%x-p2%x)**2 + (p1%y-p2%y)**2)
end function calcdist

end module mymod

and then used as

use mymodule
real :: d
type(point) :: p1, p2

d = p1.dist.p2