Coding in Fortran

Aplicatii simple Fortran

Coding in Fortran

Prima varianta: folosim compilatorul g77
g77 -o nume_executabil sursa.for
A doua varianta: folosim compilatorul gfortran
gfortran -o nume_executabil sursa.for
A treia varianta: convertim codul sursa Fortran in cod C, si apoi il compilam
f2c sursa.for && gcc -o nume_exec sursa.c -lf2c -lm

!Afisare nume
PROGRAM hello
IMPLICIT NONE
!declaram un sir de 6
CHARACTER*6 NUME
PRINT *,'cum te cheama ?'
READ *,NUME
PRINT *,NUME,",TE SALUT!"
END PROGRAM Hello

!suma a trei numere
PROGRAM ab
! I,J,K,L,M,N-var.intregi,restul-var.reale
READ *,a,b,c
x=a+b+c
PRINT *, 'x=',x
END

!Adunare si concatenare
PROGRAM ad2
!cu DATA initializam variabilele,I si J cu 5 ,K=3
! cu CHARACTER declaram 2 siruri de lungime 80
CHARACTER*80 n1,n2
DATA I,J,K /2*5,3/
DATA n1 /"sarbu "/, n2 /"george"/
x=I+J+K
PRINT *,"x=",x
!concatenare-//
PRINT *,n1//n2
END

!alocare dinamica
!tablou alocabil-i se aloca spatiu in
!timpul executiei (dinamic)
PROGRAM aloca
REAL,ALLOCATABLE::a(:,:) !tablou de rang 2
INTEGER::n
WRITE(*,'(A)',ADVANCE='NO') 'n='
READ *,n
!alocarea dinamica a unei matrici
ALLOCATE(a(n,n))
!tabloul se umple cu numere aleatoare cu
!distributia uniforma pe [0,1)
CALL random_number(a)
WHERE(a/=0.0)  !/= diferit
  a=10.0/a
ELSEWHERE
  a=-1.0
END WHERE
PRINT *,'a='
PRINT *,a
END PROGRAM aloca

!calculeaza aria cercului folosind o
!subrutina interna(cerc)
PROGRAM aria_cerc
IMPLICIT NONE
REAL::aria,PI,raza
PI=4.*ATAN(1.)
WRITE(*,"(A)",ADVANCE='NO') "raza:"
READ *,raza
CALL cerc(raza,aria)   !apelul subrutinei int.
PRINT *,"aria=",aria
CONTAINS  !inceputul subrutinei interne
   SUBROUTINE cerc(raza,aria)
      IMPLICIT NONE
      REAL,INTENT(IN)::raza
      REAL,INTENT(OUT)::aria
      aria=PI*raza**2
   END SUBROUTINE cerc
END PROGRAM aria_cerc

!calculeaza aria triunghi oarecare cu o
!procedura interna-aria_triunghi
PROGRAM triunghi
IMPLICIT NONE
REAL::a,b,c
WRITE(*,'(A)',ADVANCE='NO') "a,b,c:"
READ *,a,b,c
PRINT *,"aria triunghiului=",aria_triunghi(a,b,c)
!incepe partea de procedura interna
CONTAINS
   REAL FUNCTION aria_triunghi(a,b,c)
      IMPLICIT NONE
      REAL,INTENT(IN)::a,b,c
      REAL::h,unghi_B
      unghi_B=ACOS((a**2+b**2-c**2)/(2.*A*B))
      h=a*SIN(unghi_b)
      aria_triunghi=0.5*h*b
    END FUNCTION aria_triunghi
 END PROGRAM triunghi

!Arii
!compilat cu gfortran
!triunghiul se pp. ca este echilateral
PROGRAM arii
IMPLICIT NONE
CHARACTER:: figura
REAL aria,latura,PI,raza
REAL lungime,latime
PRINT *,"Figura? alegeti P-pentru patrat"
PRINT *,"C-pentru cerc"
PRINT *,"T-pentru triunghi"
PRINT *,"D-pentru dreptunghi"
!tastam o litera mare(P,C,T sau D) care se pastreaza in
!variabila figura(variabila de tip caracter)
READ *,figura
SELECT CASE(figura)
CASE('C')
   PRINT *,"raza cercului?"
   READ *,raza
   PI=4.0*ATAN(1.0)
   aria=PI*raza*aria
   PRINT *,"Aria=",aria
CASE('P')
   PRINT *,"Latura patratului?"
   READ *,latura
   aria=latura*latura
   PRINT *,"Aria=",aria
 CASE('D')
   PRINT *,"Lungime?"
   READ *,lungime
   PRINT *,"Latimea?"
   READ *,latime
   aria=lungime*latime
   PRINT *,"Aria=",aria
  CASE('T')
   PRINT *,"Latura?"
   READ *,latura
   aria=0.25*latura*latura*SQRT(3.)
   PRINT *,"Aria=",aria
   !daca tastam alte litere:
 CASE DEFAULT
   PRINT *, "Eroare"

 END SELECT
 STOP
 END

!calculeaza volumul si aria cilindrului
!pi il putem defini si asa pi=4.*ATAN(1.)
PROGRAM cilindru
IMPLICIT NONE
REAL r,h,pi,aria,volum
PARAMETER(pi=3.14159)
PRINT *,"Introduceti raza"
READ *,r
PRINT *,"Introduceti inaltimea"
READ *,h
volum=pi*r*r*h
aria=2.0*pi*r*(r+h)
PRINT *,"volum=",volum
PRINT *,"aria=",aria
END PROGRAM cilindru

!Sfera
PROGRAM corp
IMPLICIT NONE
TYPE punct  !se defineste tipul derivat punct
   REAL::x,y,z  !componente
END TYPE punct
TYPE sfera
TYPE(punct)::centru !centru este de tip punct
REAL::raza
END TYPE sfera
!declaram variabile
TYPE(sfera)::minge !var. minge este de tip sfera
TYPE(sfera)::bila
minge%raza=0.1  !%-selector de componenta
minge%centru%x=0.0
minge%centru%y=1.0
minge%centru%z=2.0
bila=minge
print *,bila!afiseaza x,y,z,raza
END PROGRAM corp
!folosind constructuri de structuri
!minge%centru=punct(0.0,1.0,2.0)
!minge=sfera(minge%centru,0.1)

!minge=sfera(punct(0.0,1.0,2.0),0.1)

!calculeaza factorialul unui numar folosind
!functia recursiva factorial
!recurenta la coada--singurul apel recursiv
!apare la sfarsitul procedurii
PROGRAM factor
IMPLICIT NONE
INTEGER::n
INTEGER factorial
WRITE(*,'(A)',ADVANCE='NO') "n:"
READ *,n
PRINT *,"n!=",factorial(n)
END PROGRAM factor

RECURSIVE INTEGER FUNCTION factorial(n) RESULT(fact)
   IMPLICIT NONE
   INTEGER,INTENT(IN)::n
   IF(n <= 0)THEN
     fact=1
   ELSE
      fact=n*factorial(n-1)
    END IF
    END FUNCTION factorial

!foloseste o functie iterativa
PROGRAM factor_it
IMPLICIT NONE
INTEGER::n
INTEGER factorial
WRITE(*,'(A)',ADVANCE='NO') "n:"
READ *,n
PRINT *,"n!=",factorial(n)
END PROGRAM factor_it

INTEGER FUNCTION factorial(n) RESULT(fact)
IMPLICIT NONE
INTEGER,INTENT(IN)::n
INTEGER::i
fact=1
DO i=1,n
  fact=fact*i
END DO
END FUNCTION factorial

!formatare iesire
!1X-tab la dreapta cu o pozitie
!F-converteste la iesire date de tip real fara exponent
!I-date de tip intreg
!E16.6-afiseaza datele in notatia stiintifica
PROGRAM formatare
CHARACTER*20 fmt
REAL:: a,c
INTEGER::b
READ *,a,b,c
!in loc de FORMAT(1X,F10.2,I5,E16.6)folosim:
fmt="(1X,F10.2,I5,E16.6)"
WRITE(6,fmt) a,b,c
END PROGRAM formatare

!afisare pe coloane
PROGRAM formate
IMPLICIT NONE
INTEGER i,n
PARAMETER(n=12)
INTEGER a(n) !tablou cu n elemente
DATA a/10,20,30,40,50,60,70,80,90,100,110,120/
PRINT *,'Format 2I5'
!2I5-specificator de format,se afiseaza pe 2 coloane
PRINT "(2I5)",(a(i),i=1,n) !DO implicit
PRINT *
PRINT *,'Format 3I5'
PRINT "(3I5)",(a(i),i=1,n)  !pe 3 coloane
PRINT *
PRINT *,'Format 4I5'
PRINT "(4I5)",(a(i),i=1,n)  !pe 4 coloane
END PROGRAM formate

!afisare sir pe verticala
PROGRAM litera
IMPLICIT NONE
INTEGER::i
CHARACTER(6)::string
READ "(A)",string !citeste un sir
PRINT *,"Input string"
DO i=1,LEN(string)
 PRINT *,string(i:i)  !afiseaza cate o litera
END DO
PRINT *,"========"
END PROGRAM litera

!transpusa matrice
PROGRAM matrice
IMPLICIT NONE
INTEGER i,j,n
PARAMETER(n=3)
INTEGER a(n,n)  !matrice 3x3
!citeste matricea pe coloane
READ *,((a(i,j),i=1,n),j=1,n)
!afiseaza matricea pe linii
PRINT *,((a(i,j),j=1,n),i=1,n)  !afiseaza transpusa
END PROGRAM matrice

!media
PROGRAM media1
IMPLICIT NONE
REAL x1,x2,x3
PRINT *,"Introduceti x1="
READ *,x1
PRINT *,"Introduceti x2="
READ *,x2
PRINT *,"Introduceti x3="
READ *,x3
PRINT *,"Media este",(x1+x2+x3)/3.0
END PROGRAM media1

!media alta varianta
! calculeaza media ,alta varianta
!se citesc toate numerele la inceput
PROGRAM media2
IMPLICIT NONE
REAL x1,x2,x3
READ *,x1,x2,x3
PRINT *,"x1=",x1
PRINT *,"x2=",x2
PRINT *,"x3=",x3
PRINT *,"Media este",(x1+x2+x3)/3.0
END PROGRAM media2

!metoda trapezelor
!calculeaza: integrala de la a la b din exp(x)
!prin metoda trapezelor
!se imparte int.[a,b] in n subintervale egale
!val integralei este suma ariilor celor n trapeze
PROGRAM metoda_trapez
IMPLICIT NONE
INTEGER::i,n
REAL::a,b,h,suma
PRINT *,"Enter n"   !n-nr.de subintervale
READ *,n
PRINT *,"Enter a,b"
READ *,a,b
h=(b-a)/FLOAT(n)
suma=0.5*(EXP(a)+EXP(b))
DO i=1,n-1
  suma=suma+EXP(a+FLOAT(i)*h)
END DO
PRINT *,"Aria este",h*suma
END PROGRAM metoda_trapez

!minimul dintre 2 numere
PROGRAM minim
IMPLICIT NONE
INTEGER m,n,nr_min
PRINT *,"Introduceti 2 numer intregi separate prin blancuri"
READ *,n,m
IF(m < n)THEN
 nr_min=m
ELSE
 nr_min=n
END IF
PRINT *,nr_min," este cel mai mic numar!!!"
END PROGRAM minim

!operatori
!scriem o expresie si ne da rezultatul
!in functie de operator
PROGRAM oper
IMPLICIT NONE
CHARACTER:: op
REAL a,b
PRINT *,"Scrieti expresia"
!tastam o cifra,pauza,un operator,pauza o cifra
READ *,a,op,b
SELECT CASE(op)
CASE("+")
  PRINT *,a+b
CASE('-')
  PRINT *,a-b
CASE('*')
  PRINT *,a*b

CASE DEFAULT
  PRINT *,"operator necunoscut!!!"
END SELECT
END PROGRAM oper

!formatare plural
!TRIM-elimina blancurile din sir
!//-concatenare
PROGRAM plural
IMPLICIT NONE
INTEGER::IOS
CHARACTER(LEN=20)::cuvant
DO
 READ(*,"(A)",IOSTAT=IOS) cuvant
 IF(IOS<0)EXIT !sfarsit de fisier
 PRINT *,"Cuvant:",cuvant
 PRINT *,"Pluralul cuvantului:",TRIM(cuvant)//"i"
END DO
END PROGRAM plural

!progresie aritmetica
!termenul initial este a+m*r
!termenul final este a+n*r
PROGRAM progresie_arit
IMPLICIT NONE
INTEGER::m,n
REAL::a,r
REAL::progresie
!apare textul a:,apoi apare promterul,tastam cifra
!va fi afisata pe aceiasi linie
WRITE(*,'(A)',ADVANCE='NO') "a:"
READ *,a
PRINT *,"Introduceti r:" !ratia
READ *,r
PRINT *,"Introduceti m:"
READ *,m
PRINT *,"Introduceti n:"
READ *,n
PRINT *,"Suma este:",progresie(a,r,m,n)
END PROGRAM progresie_arit

REAL FUNCTION progresie(a,r,m,n) RESULT(suma)
INTEGER::i,m,n
REAL::a,r
suma=0.
DO i=m,n     !m,n-capetele intervalului
 suma=suma+a+r*FLOAT(i)
END DO
END FUNCTION progresie

!puteri
!calculeaza puterile lui 2 pana la 2**n<5000
PROGRAM puteri
IMPLICIT NONE
INTEGER putere_2,MAXIM
PARAMETER(MAXIM=5000)
!initializare
putere_2=1
DO
 PRINT *,putere_2
 putere_2=2*putere_2
 IF(putere_2 >= MAXIM)EXIT
END DO
END PROGRAM puteri

!testeaza semnul unui numar
PROGRAM semn_numar
IMPLICIT NONE
INTEGER numar,semn
PRINT *,"Introduceti un numar intreg"
READ *,numar
IF(numar < 0)THEN
semn=-1
ELSE IF(numar == 0)THEN
semn=0
ELSE
semn=+1
ENDIF
PRINT *,"Semnul este",semn
END PROGRAM semn_numar

!sin si cos tabelate
!functiile sin si cos sunt tabelate in n puncte din
!grad in grad(pas_grad=1.0) incepand de la o valoare initiala
!data in grade
PROGRAM tabel_sin_cos
IMPLICIT NONE
INTEGER i,n
REAL pas_grad,pas_rad,xinit_grad,xinit_rad
REAL PI,x_grad,x_rad,y_sin,y_cos
PARAMETER(pas_grad=1.0)
PRINT *,"Numarul de puncte"
READ *,n
PRINT *,"Valoarea initiala in grade"
READ *,xinit_grad
PI=4.*ATAN(1.0)
!Transformarea gradelor in radiani
xinit_rad=xinit_grad*PI/180
pas_rad=pas_grad*PI/180
!initializare
i=1
x_rad=xinit_rad
x_grad=xinit_grad
!ciclare
DO WHILE(i <= n)
 y_sin=SIN(x_rad)
 y_cos=COS(x_rad)
 PRINT *,x_grad,y_sin,y_cos
 x_grad=x_grad+pas_grad
 x_rad=x_rad+pas_rad
 i=i+1
END DO
END PROGRAM tabel_sin_cos

!sortare
!citeste 3 numere reale si le afiseza in
!ordine crescatoare
PROGRAM sortare
IMPLICIT NONE
REAL::x1,x2,x3
PRINT *,"Input data x1:"
READ *,x1
PRINT *,"           x2:"
REAd *,x2
PRINT *,"           x3:"
READ * ,x3
!sortare numere
IF(x1 > x2)THEN
   CALL schimb(x1,x2)  !apeleaza subrutina
END IF
IF(x1 > x3)THEN
   CALL schimb(x1,x3)
END IF
IF(x2 > x3)THEN
   CALL schimb(x2,x3)
END IF
!tiparire
PRINT *,"Numerele in ordinea crescatoare sunt:"
PRINT *,x1,x2,x3
END PROGRAM sortare
!subrutina externa
SUBROUTINE schimb(A,B)
IMPLICIT NONE
REAL::A,B,TEMP
TEMP=A  !interschimbare
A=B
B=TEMP
RETURN
END SUBROUTINE schimb

!calculeaza media aritmetica si abaterea standard
PROGRAM statistica
IMPLICIT NONE
INTEGER i,n
PARAMETER(n=3)
REAL sigma,suma,s2abat,xmediu
REAL::x(n)
DO i=1,n
READ *,x(i)
END DO
suma=0.
DO i=1,n
 suma=suma+x(i)
END DO
xmediu=suma/FLOAT(n)
s2abat=0.
DO i=1,n
 s2abat=s2abat+(x(i)-xmediu)**2
END DO
sigma=SQRT(s2abat/FLOAT(n-1))
PRINT *,"xmediu=",xmediu
PRINT *,"sigma=",sigma
END PROGRAM statistica

!calcul suma unui sir de 3 numere
PROGRAM suma
IMPLICIT NONE
INTEGER i
INTEGER,PARAMETER::n=3

REAL s
REAL::x(n) !tablou unidim. cu 3 elem.
i=1
READ *,(x(i),i=1,n)  !DO implicit
s=0
!la fiecare pas,la termenul general se adauga x(i)
DO i=1,n
   s=s+x(i)
END DO
PRINT *,"suma=",s
END PROGRAM suma

!tabelare functie
!afiseaza valorile functiei y=x**2 + 2 pe doua coloane
PROGRAM tabel
IMPLICIT NONE
REAL pas,x,xinit,xfinal,y
PRINT *,"Introduceti x_initial,x_final si pasul de tabelare"
READ *,xinit,xfinal,pas
x=xinit
DO WHILE(x <= xfinal)
y=x**2+2.0
PRINT *,x,y   !afiseaza xinit si y
x=x+pas    !incrementare,trece la urmatoarea valoare
END DO
END PROGRAM tabel

!Tabelare functie-alta varianta
!se tabeleaza functia y=x**2+2
PROGRAM tabel2
IMPLICIT NONE
INTEGER::i,n  !n-numar de puncte(valori)
REAL::h,x,xinit,y  !h-pasul de tabelare
PRINT *,"Introduceti xinit,h,n"
READ *,xinit,h,n
x=xinit
!ciclu cu contor,similar cu for din C
DO i=1,n    !1-valoarea initiala,n-val.finala
  y=x**2+2.0
  PRINT *,x,y  !afiseaza pe 2 coloane
  x=x+h
END DO
END PROGRAM tabel2

Life means Coding

Aplicatii simple Fortran

Life means
Coding