Prova

calcular hipotnusa [subrotina]

progam pitagoras

implicit none

real::a,b,c

print,"digite b

read(*,*)b

print*,"digite c"

read(*,*)c

call hipo(b,c,a)

print*,"hipotenusa:",a

end program

sbtoutine hipo (l1,l2,h)

implicit none

real,intent(in)::l1,l2

real,intent(out)::h

h=sqrt(l1**2+l2**2)

return

end subtoutine

exemplo [surotina]

program exemplo

implicit none

integer, parameter::max=5

character(len=20),dimensionnt(max)::nome

print*,"digite nomes"

read(*,*)nome

call ordena(max,nome)

print*,"nomes ordenados:"

print*,nome

end program

sbroutine ordena(n,vet)

implicit none

integer,intent(in):n

character(len=20),intent(inout),diemsnion(n)::vet

integer::i,j

character(len=20)::aux

do i=1,n-1

do j=i+1,n

if(vet(i)>vet(j)) then

aux=vet(i)

vet(i)=vet(j)

vet(j)=aux

endif

end do

end do

return

end subroutine

programa todo em subrotina

bla bla bla

call entrada(max,nome)

call ordena(max,nome)

call saida(max, nome)

end program

subroutine entrada(n,vet)

implicit none

integer, intent(in)::n

character(len=20),intent(out),dimension(in)::vet

integer::i

do i=1,n

write(*,10)i

read(*,*)vet(i)

end do

10 format (1x,"digite o",I2,"º nome)

return

end subroutine

exemplo de programa com funçao separado

real function calc_hipo(b,c)

implicit none

real,intent(in)::b,c

calc_hipo=sqrt(b**2+c**2)

return

end function

program exfunc

implicit none

real::l1,l2,h

real::calc_hipo

print*,"digite o tamanho do lado 1:"

read(*,*)l1

print*,"digite o tamanho do lado 2:"

read(*,*)l2

h=calc_hipo(l1,l2)

write(*,100)h

100 format("hipotenusa",F6.2)

end program

module=compartilhamento entre programas e sbrotinas

module comum

implicit none

save

integer,parameter::max=5,tam=30

character(len=tam),dimension(max)::nome

integer::i

end module

subrotune entrada(  )

use comum

implicit none

do i=1,max

print*,"digite nome:"

read(*,*)nome (i)

end do

end subroutine

subroutine saida(  )

use comum

do i=1,max

print*,nome(i)

end do

end subroutine

subroutine ordena(  )

use comum

implicit none

integer::j

character(len=tam)::aux

do i=1,max-1

do j=i+1,max

if(nome(i)>nome(j)) then

aux=nome(i)

nome(i)=nome(j)

nome(j)=aux

endif

end do

end do

end subroutine

program test_modulo

implicit none

call entrada(  )

call ordena(  )

call saida(  )

end program

fatorial [recursividade-sbroutinas ou funções d invocarem a si msm]

se recursive integer function fat_rec(n)

implicit none

integer, intent(in)::n

if(n==0)then

fat_rec=1

else

fat_rec=n*fat_rec(n-1)

endif

return

end function

program fatorial

implicit none

integer::n,fat, fat_rec

print*,"o fatorial de ",n,"eh",fat

end program

ARQUIVOS

program exarq1

implicit none

integer, parameter::max=12

integer::n,i

open(1,file="dados.txt")

do i=1,max

read(1,*)n

print*,n

end do

close(1)

end program

program exarq2

implicit none

integer,parameter::max=12,lin=4,col=3

integer::l,c

integer,dimension(lin,col)::vet

open(1,files="dados.txt")

open(2,file="saida.txt")

do l=1,lin

do c=1, col

read(1,*)vet(l,c)

end do

end do

do l=1,lin

print2,(vet(l,c),c=1,col)

end do

close(1)

close(2)

end program

calculo da media

program calcmedia1

imlicit none

integer, parameter::max=12

real::soma, media

integer::i,n

open(1,file="dados.txt")

soma=0

do i=1,max

read(1,*)n

soma=soma/max

print*,"media=",media

close(1)

end program

calculo da media [podendo occorer um erro]

program calcmedia2

implicit none

real::soma,media

integern,qtd,erro

soma=0

qtd=0

open(1,"dados.txt")

do

read(1,*, IOSTAT=erro)n

if(erro/=0)exit

qtd=qtd+1

soma=soma+n

end do

if(qtd>0) then

meida=soma/qtd

print*,"meida=",media

else

print*,"arquivo vazio"

endif

close(1)

end program

FORMTATAÇÃO

program test_format

implicit none

character(len=20)::nome

integer::matric

real::nota

print*,"digite matricula"

read(*,*)matric

print*,"digite nota"

read(*,*)nota

write(*,*)matric,nome,nota

write(*,100)matric,nome,nota

100 format(5x,I6,A30,F5.1)

write(*,'(5x,I6,A30,F5.1)')

write(*,'(I6/A30/F5.1)')

write(*,'("matricula=",I6/,"nome=",A30/,"nota=",F5.1)')

write(*,'(T4,I6,T15,A30,T60,F4.1)')matric,nome,nota

end program

programa capaz d gerar um arquivo veiculos.txt

program veiculos

implicit none

character(len=20)::nome

real::gas,gnv,alcool

open(1,file="veiculos.txt")

do

print*,"nome do veiculo:"

read(*,'(A20)')nome

wirte(*,*)"consumo medio gasolina:"

read(*,*)gas

write(*,*)"consumo medio gnv:"

read(*,*)gnv

wirte(*,*)"consumo medio alcool:"

read(*,*)alcool

write(1,'(A20,T30,3F6.1)')nome gas,gnv,alcool

print*,"novo veiculo?S/N"

read(*,*)resp

if(resp/='S'.and.resp/='s')exit

end do

close(1)

end program

programa capaz d gerar arquivo cidades.txt

program cidades

implicit none

character(len=30)::nome

real::distancia

character::resp

open(2,file="veiculos.txt")

do

print*,"nome da cidade"

read(*,'(A30)')::nome

print*,"distancia da cidade a volta redonda"

read(*,*)distancia

Write(1,'(A30,F10.1)')nome,distancia

print*,"nova cidade? S/N"

read(*,*)resp

if(resp/="s".and. resp/="S") exit

end do

close(2)

end program

programa capaz d mostrar o valor gasto dependendo do tipo d comb e da cidade

program pesquisa

implicit none

integer::erro,tipo,media

real::alc,gas,gnv,dist,preco

character(len=20)::carro,pesq

character(len=30)::cidade

character::resp

open(1,file="veiculos.txt")

open(2,files="cidades.txt")

do

print*,"informe o veiculo"

read(*,'(A20)')pesq

do

print*,"tipo de combustivel(1)alcool(2)gasolina(3)gnv"

read(*,*)tipo

if(tipo>0.and.tipo>4) exit

print*,"favor informar 1, 2 ou 3"

end do

print*,"valor unitario do combustivel:"

read(*,*)preco

do

read(1,*,IOSTAT=erro) carro,alc,gas,gnv

if(erro/=0.or.pesq==carro)exit

end do

if(erro/=0)then

print*,"veiculo nao encontrado"

else

print*,"custo utilizando o veiculo",carro

if(tipo==1) then

media=alc

else if(tipo==2) then

meida=gas

else

media=gnv

endif

do

read(2,*,IOSTAT=erro)dicade,dist

if(erro/=0)exit

print*,cidade,dist,(dist/media)*preco

end do

endif

print*,"nova consulta? S/N"

read(*,*)resp

if(resp/="s".and.resp/="S") exit

rewind(1)

rewind(2)

end do

close(1)

close(2)

end program

´

programa para incluir dados em um arquivo

program arq_cid

implicit none

character(len=30)cid

real::dist

character::resp

open(1,file="cidades.txt,acess="apend")

do

print*,"nome da cidade"

read(*,'(A30)')cid

wirte(1,*)cid, dist

print*,"nova cidade? S/N"

if(resp/="S".and.resp/="s")exit

end do

close(1)

end program