Contoh Program Menggunakan Fortran
implicit none
real tanya
10 print *, 'Halo! :)'
print *, 'Perkenalkan nama saya Ef :)'
print *, 'Ef bisa menghitung macam-macam hal loh~ hehe :)'
print *, 'Ayo sekarang kita mulai menghitung!'
20 print *, 'Silahkan pilih fitur'
print *, '1. Menghitung Pythagoras'
print *, '2. Menghitung Konversi Suhu'
print *, '3. Menghitung Jarak & Sudut 4 Titik Koordinat di Peta'
print *, '4. Menghitung Modulus Young (Elastisitas)'
print *, '5. Menghitung Persamaan Diferensial Eksak'
print *, '99. Bersihkan Layar'
print *, '0. Keluar program :('
read *, tanya
if (tanya.EQ.1) then
call pythagoras()
else if (tanya.EQ.2) then
call konversiSuhu()
else if (tanya.EQ.3) then
call menghitungJarakKoordinat()
else if (tanya.EQ.4) then
call modulusYoung()
else if (tanya.EQ.5) then
call diferensialEksak()
else if (tanya.EQ.99) then
call system('CLS')
else if (tanya.EQ.0) then
print *, ''
print *, "Bye bye ~ :'D"
print *, 'Terima kasih sudah menghitung bersama Ef :)'
print *, 'Semoga harimu menyenangkan :)'
pause
stop
else
print *, 'Aduh maaf, Ef tidak mengerti perintah kamu :('
print *, 'Tolong masukan angka 1 sampai 5 saja ya :)'
print *, 'Atau masukan angka 99 supaya tulisannya dihapus :)'
print *, ''
goto 20
endif
goto 10
end program tugasBesar
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! P Y T H A G O R A S
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine pythagoras()
implicit none
real c,a,b,tanya
20 print *, ''
print *, 'Pythagoras adalah perhitungan untuk mencari'
print *, 'panjang sisi miring dari bentuk segitiga :)'
print *, 'Rumusnya adalah C = akarkuadrat(A^2 + B^2)'
print *, 'Panjang sisi A kamu berapa? :)'
read *, a
print *, 'Terus panjang sisi B kamu berapa ? :)'
read *, b
c=sqrt((a*2)+(b*2))
write (*,'( 1x, "Panjang sisi A = " f10.2)') a
write (*,'( 1x, "Panjang sisi B = " f10.2)') b
write (*,'( 1x, "Panjang sisi C = " f10.2)') c
print *, ''
print *, 'Perhitungan selesai :)'
!Pertanyaan terakhir
print *, 'Perhitungan Selesai, apakah ingin mengulangi lagi? :)'
print *, '1 = Ya'
print *, '0 = Tidak'
read *, tanya
if (tanya.EQ.1) then
goto 20
else
print *, ''
endif
print *, ''
end subroutine pythagoras
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! K O N V E R S I S U H U
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine konversiSuhu
implicit none
real a,b,c,r,k,f,tanya
print *, ''
print *, 'Kamu tau gak, setiap suhu itu mempunyai'
print *, 'satuannya masing-masing loh :)'
print *, 'Ada Celcius, Reamur, Kelvin, dan Fahrenheit :D'
print *, 'Sekarang Ef akan membantu kamu menghitung nilai suhu'
print *, 'menjadi satuan suhu yang berbeda-beda :D'
print *, 'Ayo kita mulai!'
print *, ''
30 print *, 'Masukan Nilai yang ingin kamu konversikan :)'
read *, a
40 print *, ''
print *, '1 = Celcius'
print *, '2 = Reamur'
print *, '3 = Kelvin'
print *, '4 = Fahrenheit'
print *, 'Nah sekarang tentukan satuan suhu kamu (1-4)'
read *, b
!Celcius
if(b==1) then
r=a*4/5
k=a+273
f=(a*9/5)+32
write (*,'(1x, "Celcius =",f12.2)') a
write (*,'(1x, "Reamur =",f12.2)') r
write (*,'(1x, "Kelvin =",f12.2)') k
write (*,'(1x, "Fahrenheit =",f12.2)') f
print *, 'Hitungannya Selesai :)'
print *, ''
!Reamur
else if (b==2) then
c=a*5/4
k=(a*5/4)+273
f=(a*9/4)+32
write (*,'(1x, "Reamur =",f12.2)') a
write (*,'(1x, "Celcius =",f12.2)') c
write (*,'(1x, "Kelvin =",f12.2)') k
write (*,'(1x, "Fahrenheit =",f12.2)') f
print *, 'Hitungannya Selesai :)'
print *, ''
!Kelvin
else if (b==3) then
c=a-273
r=(a-273)*4/5
f=((a-273)*9/5)+32
write (*,'(1x, "Kelvin =",f12.2)') a
write (*,'(1x, "Celcius =",f12.2)') c
write (*,'(1x, "Reamur =",f12.2)') r
write (*,'(1x, "Fahrenheit =",f12.2)') f
print *, 'Hitungannya Selesai :)'
print *, ''
!Fahrenheit
else if (b==4) then
c=(a-32)*5/9
r=(a-32)*4/9
k=((a-32)*5/9)+32
write (*,'(1x, "Fahrenheit =",f12.2)') a
write (*,'(1x, "Celcius =",f12.2)') c
write (*,'(1x, "Reamur =",f12.2)') r
write (*,'(1x, "Kelvin =",f12.2)') k
print *, 'Hitungannya Selesai :)'
print *, ''
!else
else
print *, 'Maaf, mohon masukan angka 1 sampai 4 saja ya :)'
goto 40
!end if
endif
!Pertanyaan terakhir
print *, 'Perhitungan Selesai, apakah ingin mengulangi lagi? :)'
print *, '1 = Ya'
print *, '0 = Tidak'
read *, tanya
if (tanya.EQ.1) then
goto 30
else
print *, ''
endif
print *, ''
end subroutine konversiSuhu
! J A R A K K O O R D I N A T
subroutine menghitungJarakKoordinat
implicit none
real value, A,B,C,D !Nama Titik
real xa,ya,xb,yb,xc,yc,xd,yd !Titik Koordinat
real AC,CD,DB !Titik Koordinat
real ACh, CDh, DBh !Jarak
real skala, totalJarak !Skala dan total jarak
real tanya !Pertanyaan akhir
print *, ''
print *, 'Pernah gak kamu lagi ingin tau jarak dari'
print *, 'Jakarta ke Bandung waktu kamu liat peta,'
print *, 'Tapi sayangnya kamu lupa gak bawa penggaris :('
print *, 'Nah disini Ef akan ngebantu kamu menghitung'
print *, 'jarak antara titik di peta tanpa penggaris! :D'
print *, 'Caranya adalah dengan menggunakan titik Koordinat! :)'
20 print *, 'Pertama-tama, kita tentukan dulu koordinat titik A :)'
print *, ''
print *, 'Koordinat titik A nya berapa ya ? :)'
read *, xa,ya
print *, 'Kalau koordinat titik B ?'
read *, xb,yb
print *, 'Sekarang masukan koordinat titik C ya :)'
read *, xc,yc
print *, 'Nah sekarang masukan koordinat titik D kamu :)'
read *, xd,yd
!Print Titik Koordinat yang di input
print *, ''
write (*,'(1x,"Titik A ="f10.2,1x,","f10.2)')xa,ya
write (*,'(1x,"Titik B ="f10.2,1x,","f10.2)')xb,yb
write (*,'(1x,"Titik C ="f10.2,1x,","f10.2)')xc,yc
write (*,'(1x,"Titik D ="f10.2,1x,","f10.2)')xd,yd
print *, ''
!Rumus Perhitungan Jarak Pada Peta
print *, 'Nah sekarang Ef akan memberitahu kamu'
print *, 'Jarak pada peta, satuannya dalam cm ya :)'
AC=sqrt(((xc-xa)**2)+((yc-ya)**2))
CD=sqrt(((xd-xc)**2)+((yd-yc)**2))
DB=sqrt(((xb-xd)**2)+((yb-yd)**2))
write (*,'(1x,"Jarak titik A ke titik C ="f12.2," cm")') AC
write (*,'(1x,"Jarak titik C ke titik D ="f12.2," cm")') CD
write (*,'(1x,"Jarak titik D ke titik B ="f12.2," cm")') DB
print *, ''
!Konversi ke satuan lain berdasarkan skala
print *, 'Untuk bisa mengetahui jarak sebenarnya,'
print *, 'Kita skala kan sesuai dengan skala pada peta kamu :)'
print *, 'Skarang masukan skala peta kamu :)'
read *, skala
print *, ''
print *, 'Okay, sekarang kita skala kan'
ACh=AC*skala/100
CDh=CD*skala/100
DBh=DB*skala/100
write (*,'(1x,"Skala ="f15.2)') skala
write (*,'(1x,"Jarak titik A ke titik C ="f15.2," m")') ACh
write (*,'(1x,"Jarak titik C ke titik D ="f15.2," m")') CDh
write (*,'(1x,"Jarak titik D ke titik B ="f15.2," m")') DBh
!Disini tanya apakah ingin dikonversikan ke satuan lain
!Cancel
!Total Jarak
totalJarak = ACh+CDh+DBh
write (*,'(1x,"Total Jarak ="f28.2," m")') totalJarak
print *, ''
print *, 'Selesai :D'
print *, 'Sekarang kita sudah tau berapa jarak'
print *, 'antara 4 titik tersebut :)'
print *, ''
!Pertanyaan terakhir
print *, 'Perhitungan Selesai, apakah ingin mengulangi lagi? :)'
print *, '1 = Ya'
print *, '0 = Tidak'
read *, tanya
if (tanya.EQ.1) then
goto 20
else
print *, ''
endif
end subroutine menghitungJarakKoordinat
! M O D U L U S Y O U N G
subroutine modulusYoung
implicit none
real x1,x2,deltaX,a,f,e,i,tanya
real aluminium,baja,besi,karet,kuningan
real nikel,tembaga,timah,beton,kaca,wolframe
10 print *, ''
print *, 'Modulus Young atau Modulus Elastisitas adalah'
print *, 'perhitungan yg menentukan kelenturan dan'
print *, 'kekakuan suatu material :)'
print *, 'Disini Ef akan membantu kamu menghitung dan'
print *, 'menentukan seberapa besar kelenturan dan kekakuan'
print *, 'suatu material, sehingga nantinya, kamu bisa'
print *, 'menentukan apakah material tersebut cocok digunakan'
print *, 'sebagai material konstruksi atau tidak :)'
20 print *, ''
print *, 'Pertama-tama, tentukan panjang material awal kamu :)'
print *, '(Kondisi material tanpa melalui pengetesan apapun)'
print *, 'Satuannya meter :)'
read *, x1
print *, 'Lalu, masukan panjang material kamu setelah melalui'
print *, 'proses pengetesan material :)'
print *, 'Satuannya meter juga :)'
read *, deltaX
print *, 'Setelah itu, masukan Luas Penampang material kamu'
print *, 'Kalau yg ini satuannya meter persegi :D'
read *, a
print *, 'Dan yg terakhir, masukan jumlah gaya (tekan/tarik)'
print *, 'yang kamu aplikasikan pada proses pengetesan material'
print *, 'Yg ini satuannya Newton :) jangan salah yaa :D'
read *, f
i=(f*x1)/(a*deltaX)
print *, ''
write (*,'(1x,"Jadi, modulus young nya adalah "f20.2," N/m2")')i
print *, ''
! TABEL MODULUS YOUNG
aluminium=70000
baja=200000
besi=210000
karet=500
kuningan=90000
nikel=210000
tembaga=110000
timah=16000
beton=23000
kaca=55000
wolframe=410000
e=i/1000000
if (e.GE.wolframe) then
print *, 'Sedikit info mengenai elastisitas material kamu,'
print *, 'Elastisitasnya setara dengan Wolframe! :)'
else if (e.GE.besi.AND.e.LT.wolframe) then
print *, 'Sedikit info mengenai elastisitas material kamu,'
print *, 'Elastisitasnya setara dengan Besi! :)'
else if (e.GE.aluminium.AND.e.LT.besi) then
print *, 'Sedikit info mengenai elastisitas material kamu,'
print *, 'Elastisitasnya setara dengan Aluminium! :)'
else if (e.GE.baja.AND.e.LT.aluminium) then
print *, 'Sedikit info mengenai elastisitas material kamu,'
print *, 'Elastisitasnya setara dengan Baja! :)'
else if (e.GE.tembaga.AND.e.LT.baja) then
print *, 'Sedikit info mengenai elastisitas material kamu,'
print *, 'Elastisitasnya setara dengan Tembaga! :)'
else if (e.GE.kuningan.AND.e.LT.tembaga) then
print *, 'Sedikit info mengenai elastisitas material kamu,'
print *, 'Elastisitasnya setara dengan Kuningan! :)'
else if (e.GE.kaca.AND.e.LT.kuningan) then
print *, 'Sedikit info mengenai elastisitas material kamu,'
print *, 'Elastisitasnya setara dengan Kaca! :)'
else if (e.GE.beton.AND.e.LT.kaca) then
print *, 'Sedikit info mengenai elastisitas material kamu,'
print *, 'Elastisitasnya setara dengan Beton! :)'
else if (e.GE.timah.AND.e.LT.beton) then
print *, 'Sedikit info mengenai elastisitas material kamu,'
print *, 'Elastisitasnya setara dengan Timah! :)'
else if (e.GE.karet.AND.e.LT.timah) then
print *, 'Sedikit info mengenai elastisitas material kamu,'
print *, 'Elastisitasnya setara dengan Karet! :)'
else
print *, 'Sedikit info mengenai elastisitas material kamu,'
print *, 'Elastisitasnya lebih lentur daripada Karet! :)'
endif
!Pertanyaan terakhir
print *, ''
print *, 'Perhitungan Selesai, apakah ingin mengulangi lagi? :)'
print *, '1 = Ya'
print *, '0 = Tidak'
read *, tanya
if (tanya.EQ.1) then
goto 20
else
print *, ''
endif
print *, ''
end subroutine modulusYoung
subroutine diferensialEksak
implicit none
real a,aaa,b,bbb
character(200) :: aa,aaaa,bb,bbbb
real aY,aX,bY,bX,My,Mx,MxMy,aXp,aYp,bXp,bYp
real numA,numB
real bil1A,bil2Ai,bil3A,bil1fA,bil3fA
real bil1B,bil2Bi,bil3B,bil1fB,bil3fB
real qA,rA,sA,qB,rB,sB
real tandaA,tandaB
character(200) :: bil2A,bil2B,pA,pB
print *, 'Model matematika num+(a)dx+num+(b)dy=0'
! Test apakah My=Nx ?
! Input Nilai My
print *, 'Masukan NUM,A,x=1/y=2),pangkat,(dx=1/dy=2)'
read *, numA,a,aa,aaa,aaaa
if (aa=='x'.AND.aaaa=='dx') then
write(*,'(1x,f6.2,1x,"+"f6.2,1x,"x^"f6.2,1x,"dx"f6.2)')numA,a,aaa
aX=a*aaa
aXp=aaa-1
aY=0
aYp=0
print *, 'My = 0'
My=0
bil1A=A+0
bil2A='x'
bil3A=aaa+0
bil1fA=bil1A*bil3A
bil3fA=bil3A-1
if (bil3fA==0) then
bil2A=''
else
bil2A='x'
endif
tandaA=1
else if (aa=='x'.AND.aaaa=='dy') then
write(*,'(1x,f6.2,1x,"+"f6.2,1x,"x^"f6.2,1x,"dy"f6.2)')numA,a,aaa
aX=a*aaa
aXp=aaa-1
aY=0
aYp=0
write (*,'(1x,"Mx ="f6.2,1x,"x^"f6.2)') aX,aXp
Mx=aX*aXp
bil1A=A+0
bil2A='x'
bil3A=aaa+0
bil1fA=bil1A*bil3A
bil3fA=bil3A-1
if (bil3fA==0) then
bil2A=''
else
bil2A='x'
endif
tandaA=2
else if (aa=='y'.AND.aaaa=='dx') then
write(*,'(1x,f6.2,1x,"+"f6.2,1x,"y^"f6.2,1x,"dx"f6.2)')numA,a,aaa
aX=a*aaa
aXp=aaa-1
aY=a*aaa
aYp=aaa-1
write (*,'(1x,"Mx ="f6.2,1x,"y^"f6.2)') aX,aXp
Mx=aX*aXp
bil1A=A+0
bil2A='y'
bil3A=aaa+0
bil1fA=bil1A*bil3A
bil3fA=bil3A-1
if (bil3fA==0) then
bil2A=''
else
bil2A='y'
endif
tandaA=3
else if (aa=='y'.AND.aaaa=='dy') then
write(*,'(1x,f6.2,1x,"+"f6.2,1x,"y^"f6.2,1x,"dy"f6.2)')numA,a,aaa
aX=a*aaa
aXp=aaa-1
aY=a*aaa
aYp=aaa-1
print *, 'Mx = 0'
Mx=0
bil1A=A+0
bil2A='y'
bil3A=aaa+0
bil1fA=bil1A*bil3A
bil3fA=bil3A-1
if (bil3fA==0) then
bil2A=''
else
bil2A='y'
endif
tandaA=4
endif
! Test apakah My=Nx ?
! Input Nilai Nx
print *, 'Masukan num,A,x=1/y=2),pangkat,(dx=1/dy=2)'
read *, numB,b,bb,bbb,bbbb
if (bb=='x'.AND.bbbb=='dx') then
write(*,'(1x,f6.2,1x,"+"f6.2,1x,"x^"f6.2,1x,"dx"f6.2)')numB,b,bbb
bX=b*bbb
bXp=bbb-1
bY=0
bYp=0
print *, 'My = 0'
My=0
bil1B=B+0
bil2B='x'
bil3B=bbb+0
bil1fB=bil1B*bil3B
bil3fB=bil3B-1
if (bil3fB==0) then
bil2B=''
else
bil2B='x'
endif
tandaB=1
else if (bb=='x'.AND.bbbb=='dy') then
write(*,'(1x,f6.2,1x,"+"f6.2,1x,"x^"f6.2,1x,"dy"f6.2)')numB,b,bbb
bX=b*bbb
bXp=bbb-1
bY=0
bYp=0
write (*,'(1x,"My ="f6.2,1x,"x^"f6.2)') bX,bXp
Mx=bX*bXp
bil1B=B+0
bil2B='x'
bil3B=bbb+0
bil1fB=bil1B*bil3B
bil3fB=bil3B-1
if (bil3fB==0) then
bil2B=''
else
bil2B='x'
endif
tandaB=2
else if (bb=='y'.AND.bbbb=='dx') then
write(*,'(1x,f6.2,1x,"+"f6.2,1x,"y^"f6.2,1x,"dx"f6.2)')numB,b,bbb
bX=b*bbb
bXp=bbb-1
bY=0
bYp=0
write (*,'(1x,"Mx ="f6.2,1x,"y^"f6.2)') bX,bXp
My=bX*bXp
bil1B=B+0
bil2B='x'
bil3B=bbb+0
bil1fB=bil1B*bil3B
bil3fB=bil3B-1
if (bil3fB==0) then
bil2B=''
else
bil2B='x'
endif
tandaB=3
else if (bb=='y'.AND.bbbb=='dy') then
write(*,'(1x,f6.2,1x,"+"f6.2,1x,"y^"f6.2,1x,"dy"f6.2)')numB,b,bbb
bX=b*bbb
bXp=bbb-1
bY=0
bYp=0
print *, 'Mx = 0'
Mx=0
bil2B='x'
bil3B=bbb+0
bil1fB=bil1B*bil3B
bil3fB=bil3B-1
if (bil3fB==0) then
bil2B=''
else
bil2B='x'
endif
tandaB=4
! if input = xy
else if (bb=='xy'.AND.bbbb=='dx') then
write(*,'(1x,f6.2,1x,"+"f6.2,1x,"xy^"f6.2,1x,"dy"f6.2)')numB,b,bbb
bX=b*bbb
bXp=bbb-1
bY=0
bYp=0
write (*,'(1x,"Mx ="f6.2,1x,"y^"f6.2)') bX,bXp
Mx=0
bil2B='xy'
bil3B=bbb+0
bil1fB=bil1B*bil3B
bil3fB=bil3B-1
if (bil3fB==0) then
bil2B=''
else
bil2B='xy'
endif
tandaB=5
else if (bb=='xy'.AND.bbbb=='dy') then
write(*,'(1x,f6.2,1x,"+"f6.2,1x,"xy^"f6.2,1x,"dy"f6.2)')numB,b,bbb
bX=b*bbb
bXp=bbb-1
bY=0
bYp=0
print *, 'Mx = 0'
Mx=0
bil2B='xy'
bil3B=bbb+0
bil1fB=bil1B*bil3B
bil3fB=bil3B-1
if (bil3fB==0) then
bil2B=''
else
bil2B='xy'
endif
tandaB=6
endif
pA=bil2A
qA=bil3A+0
rA=bil1fA+0
sA=bil3fA+0
pB=bil2B
qB=bil3B+0
rB=bil1fB+0
sB=bil3fB+0
if(pA==pB.AND.qA==qB.AND.rA==rB.AND.sA==sB)then
print *, 'Eksak !'
else
print *, 'Tidak Eksak!'
endif
if (tandaA==1) then
write(*,'(1x,f6.2,1x,"+"f6.2,1x,"x^"f6.2,1x,"dx"f6.2)')numA,a,aaa
else if (tandaA==2) then
write(*,'(1x,f6.2,1x,"+"f6.2,1x,"x^"f6.2,1x,"dy"f6.2)')numA,a,aaa
else if (tandaA==3) then
write(*,'(1x,f6.2,1x,"+"f6.2,1x,"y^"f6.2,1x,"dx"f6.2)')numA,a,aaa
else if (tandaA==4) then
write(*,'(1x,f6.2,1x,"+"f6.2,1x,"y^"f6.2,1x,"dy"f6.2)')numA,a,aaa
else
print *, 'Wrong'
endif
if (tandaB==1) then
write(*,'(1x,f6.2,1x,"+"f6.2,1x,"x^"f6.2,1x,"dx"f6.2)')numB,b,bbb
else if (tandaB==2) then
write(*,'(1x,f6.2,1x,"+"f6.2,1x,"x^"f6.2,1x,"dy"f6.2)')numB,b,bbb
else if (tandaB==3) then
write(*,'(1x,f6.2,1x,"+"f6.2,1x,"y^"f6.2,1x,"dx"f6.2)')numB,b,bbb
else if (tandaB==4) then
write(*,'(1x,f6.2,1x,"+"f6.2,1x,"y^"f6.2,1x,"dy"f6.2)')numB,b,bbb
else
print *, 'Wrong'
endif
pause
end subroutine diferensialEksak
0 komentar:
Posting Komentar