Seguinte: 4. Integração e derivação Acima: 3.11 Geradores de Números Anterior: 3.11.1 Um Gerador de Conteúdo
!PROGRAMA GERADOR DE NUMEROS ALEATORIOS COM PERIODICIDADE DE 10^22
!PODE-SE ALTERAR OS VALORES k1, k2 e k3 (ix=ieor(ix,ishft(ix,k1)))
!PARA AUMENTAR A PERIODICIDADE.
!
!Extraido das referencias abaixo:
!Marsaglia, G., and Zaman, A. 1994, Computers in Physics, vol. 8, pp. 117-121.
!Marsaglia, G. 1985, Linear Algebra and Its Applications, vol. 67, pp. 147-156.
!
!PRIMEIRA IMPLEMENTACAO: JOSIEL CARLOS DE SOUZA GOMES SEGUNDO SEMESTRE DE 2016
!ALTERACAO: FERNANDO SATO PRIMEIRO SEMESTRE DE 2017
!COMENTARIOS: LEONARDO DA MOTTA DE VASCONCELOS TEIXEIRA 1o. SEMESTRE DE 2017
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!PROGRAMA MAIN
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
program alea5
!
implicit none
!
!!VARIAVEL PARA ARAZENAR O NUMERO ALEATORIO
real(kind = 8) :: xx
!!VARIAVEL SEMENTE INICIAL, VARIAVEL TAMANHO ARRAYS
integer(8) :: id,n
!!VARIAVEIS DE CONTROLE DOS DO'S
integer(8) :: i, j
!!CONTADORES PARA CONTROLE
integer(8) :: cont, K
!!VARIAVEIS DE VERIFICACAO DE ERRO DE ABERTURA DOS ARQUIVOS
integer :: error_output, error_output1
!!ARRAYS PARA COMPARACAO DE REPETICOES DE NUMEROS GERADOS
real(kind = 8),allocatable,dimension (:) :: a,b
!
!!SEMENTE INICIAL
id = 6677
!!CONTADOR QUE INDICA O PASSO CORRESPONDENTE AO NUMERO ALEATORIO GERADO
cont=0
!!QUANTIDADE DE NUMEROS ALEATORIOS SEQUENCIIS A SE VERIFICAR AS REPETICOES
n=10
!
!
!ARQUIVO QUE ARMAZENA QUANTAS VEZES O PRIMEIRO NUMERO DO ARRAY FOI REPETIDO NA
!SEQUENCIA DE NUMEROS ALEATORIOS GERADOS
open(unit=19,file='contador6.dat',status='replace',action='write',
iostat=error_output)
!
if (error_output /=0 ) then
write(*,*) 'PROBLEMA COM ARQUIVO CONTADOR6.DAT'
end if
!
!
!ARQUIVO QUE ARMAZENA OS NUMEROS CONSECUTIVOS, NO ARRAY a, AO VALOR ARMAZENADO
!EM a(1,) QUE SE REPETIRAM APOS CONFIRMADA
!A REPETICAO DO PRIMEIRO VALOR
open(unit=20,file='result.dat',status='replace',action='write',
iostat=error_output1)
!
if (error_output1 /=0 ) then
write(*,*) 'PROBLEMA COM ARQUIVO CONTADOR.DAT'
end if
!
!
!ALOCACAO DE UM TAMANHO n AOS ARRAYS DE CONTROLE DE COMPARACAO
allocate(a(n))
allocate(b(n))
!
!
!ARMAZENAMENTO DOS n PRIMEIROS NUMEROS ALEATORIOS GERADOS, NO ARRAY a, QUE
SERAO
!UTILIZADOS PARA VERIFICACAO DE REPETICOES DE NUMEROS DO METODO
!
do i = 1, n
call ran1sub(id,xx)
a(i) = xx
write(*,*) a(i)
end do
!
!
!DEFINICAO DE i PARA GARANTIR QUE O LOOP CONTINUE AD INFINITUM ATE A CONDICAO
DE
!REPETICAO SER ATINGIDA
i = 1
!
!
!COMANDO DO ONDE CHAMAMOS A SUBROTINA GERADORA DE NUMEROS ALEATORIOS
!INDEFINIDAMENTE, E EXECUTAMOS A VERIFICACAO DOS NUMEROS GERADOS PARA
!REPETICOES SE OS n NUMEROS INICIAIS ARMAZENADOS FOREM TODOS REPETIDOS,
!O PROCESSO E INTERROMPIDO ESTE LOOPING SERVE PARA VERFICARMOS A
!FREQUENCIA DESTE CODIGO
!
do while (i>0)
!
cont = cont + 1
call ran1sub(id,xx)
!
!VERIFICACAO SE O PRIMEIRO NUMERO ALEATORIO GERADO SE REPETE
!
if (xx==a(1)) then
!
!CASO HAJA REPETICAO DO PRIMEIRO NUMERO ALEATORIO GERADO, O NUMERO DO
!PASSO EM QUE OCORREU E REGISTRADO NO ARQUIVO 19 E EM SEGUIDA ESCRITO
!NA TELA. EM SEGUIDA, ESTE VALOR E ATRIBUIDO AO ARRAY b, QUE SERVIRA
!COMO CONTROLE SECUNDARIO PARA A VERIFICACAO DOS n-1 NUMEROS
!ALEATORIOS SEGUINTES
!
write(19,*) cont
write(*,*) cont
!
b(1) = xx
K=0 !CONTADOR DE CONTROLE QUE INDICA QUANTOS
!NUMEROS ALEATORIOS, ALEM DO PRIMEIRO,
!FORAM REPETIDOS APOS ESTE
!
!COMANDO DO ONDE OS n-1 NUMEROS ALEATORIOS SEGUINTES SAO
!VERIFICADOS PARA REPETICOES
!
do j = 2, n
!
cont = cont + 1
call ran1sub(id,xx)
!
b(j) = xx
!
!VERIFICANDO SE O j-ESIMO NUMERO SEGUINTE E IGUAL AO
!RESPECTIVO NUMERO NO ARRAY a
!
if (a(j) == b(j)) then
!
!CASO HAJA REPETICAO, O PROGRAMA REGISTRA O
!NUMERO REPETIDO NO ARQUIVO 20, JUNTAMENTE
!COM SEU RESPECTIVO PASSO
!
write(20,*) b(j), cont
K=K+1
!
end if
!
if (K == n-1) stop
!
end do
!
end if
!
end do
!
end program alea5
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!SUBROTINA GERADORA DE NUMEROS ALEATORIOS
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!O PRINCIPIO PARA GERAR NUMEROS ALEATORIOS DESTA SUBROTINA SE BASEIA EM
!SUBSTITUIR OS BITS NA REPRESENTACAO BINARIA DA SEMENTE, UTILIZANDO UMA
!SERIE SE NUMEROS QUE FORAM GERADOS DA MESMA FORMA. PARA ISTO, SAO UTILIZADAS
!UMA SERIE DE FUNCOES QUE MUDAM OS BITS UM A UM DO NUMERO SOB
!UMA DADA CONDICAO PRE ESTABELESCIDA. ABAIXO TEMOS A EXPICACAO DAS FUNCOES
!UTILIZADAS
!
!NEAREST(X,Y) => RETORNA O MAIS PROXIMO NUMERO REPRESENTAVEL AO VALOR DE X,
! COM O SENTIDDO INDICADO PELO SINAL DE Y. ISTO E, SE Y < 0,
! RETORNA O PRIMEIRO NUMERO REPRESENTAVEL MENOR DO QUE X.
! SE Y > 0, RETORNA O PRIMEIRO NUMERO REPRESENTAVEL QUE E
! MAIOR DO QUE X.
!
!IOR(X,Y) => REALIZA UM OR INCLUSIVO EM CADA PAR DE BITS DAS STRINGS
! BINARIAS DOS NUMEROS X E Y, EM SEQUENCIA, GERANDO UMA
! TERCEIRA STRING BINARIA COMO RESULTADO. UM OR INCLUSIVO
! RETORNA UM VALOR 1 SE PELO MENOS UM DOS DOIS BITS COMPARADOS
! FOR 1, E 0 CASO CONTRARIO
!
!IEOR(X,Y) => REALIZA UM OR EXCLUSIVO EM CADA PAR DE BITS DAS STRINGS
! BINARIAS DOS NUMEROS X E Y, EM SEQUENCIA, GERANDO UMA
! TERCEIRA STRING BINARIA COMO RESULTADO. UM OR EXCLUSIVO
! RETORNA UM VALOR 1 SE HOUVER UM NUMERO IMPAR DE 1'S ENTRE OS
! DOIS BITS COMPARADOS E RETORNA 0 CASO CONTRARIO
!
!ISHIFT(X,Y) => RETORNA UM NUMERO CORRESPONDENTE A STRING BINARIA DE X COM
! TODOS OS BITS MOVIDOS Y POSICOES. SE Y FOR POSITIVO, OS BITS
! SAO MOVIDOS PARA A ESQUERDA. SE Y FOR NEGATIVO, OS BITS SERAO
! MOVIDOS PARA A DIREITA. SE Y FOR ZERO, NAO HA MOVIMENTACAO.
! NOTE NOTE QUE O VALOR DE Y PRECISA SER DO MESMO TAMANHO OU
! MENOR DO QUE A STRING BINARIA QUE REPRESENTA O VALOR DE X.
!
!IAND(X, Y) => REALIZA UM AND LOGICO EM CADA PAR DE BITS DAS STRINGS
! BINARIAS DOS NUMEROS X E Y, EM SEQUENCIA, GERANDO UMA TERCEIRA
! STRING BINARIA COMO RESULTADO. UM AND LOGICO RETORNA UM
! RESULTADO 1 SOMENTE SE OS DOIS BITS COMPARADOS FOREM 1.
!
!OBSERVACAO: NAS FUNCOES IOR, IEOR E IAND, OS NUMEROS X E Y DEVEM POSSUIR
!STRINGS BINARIAS CORRESPONDENTES CUJO COMPRIMENTO DE AMBAS E O MESMO
!
!
SUBROUTINE ran1sub(idum,x)
!
IMPLICIT NONE
!
!RETORNA O VALOR DE KIND QUE REPRESENTA O MENOR TIPO INTEIRO QUE REPRESENTA
!TODOS OS VALORES ENTRE 1E-9 E 1E9
INTEGER, PARAMETER :: K4B = selected_int_kind(9)
!SEMENTE DO NUMERO RANDOMICO, PRECISAO K4B
INTEGER(K4B), INTENT(INOUT) :: idum
!NUMERO RANDOMICO FINAL
REAL(kind=8) :: x
!PARAMETROS DE MANIPULACAO, PRECISAO DADA POR K4B
INTEGER(K4B), PARAMETER :: IA=16807, IM=2147483647,IQ=127773,IR=2836
!VARIAVEL DE CONTROLE
REAL(kind=8), SAVE :: am
!VARIAVEIS DE CONTROLE, PRECISAO DADA POR K4B
INTEGER(K4B), SAVE :: ix = -1, iy = -1, k
!
!
if (idum <= 0 .or. iy < 0) then
!am RECEBE O PRIMEIRO NUMERO REPRESENTAVEL MENOR QUE 1.0
am = nearest(1.0,-1.0)/IM
!GERA O PRIMEIRO PARAMETRO INTEIRO PSEUDO-ALEATORIO, BASEADO NO VALOR
!DE idum
iy = ior(ieor(888889999,abs(idum)),1)
!SEGUNDO PARAMETRO INTEIRO PREUDO-ALEATORIO, DEPENDENTE DO VALOR
!DE idum
ix = ieor(777755555,abs(idum))
!VALOR DE idum SE TORNA POSITIVO E INCREMENTADO
idum = abs(idum)+1
end if
!
!ATUALIZA O PARAMETRO ix, GERANDO UM PARAMETRO COM UM 'NIVEL DE ALEATORIEDADE'
!MAIOR, BASEADO NO VALOR ANTERIOR ARMAZENADO E UTILIZANDO OPERACOES NOS
!PROPRIOS BITS
ix = ieor(ix,ishft(ix,13))
!REALIZA UMA SEGUNDA ATUALIZACAO NO PARAMETRO ix, BASEADO NO VALOR ACIMA
!ESTABELECIDO E REALIZANDO MAIS UMA SERIE DE TROCAS DE BITS NO VALOR
ix = ieor(ix,ishft(ix,-17))
!REALIZA UMA ATUALIZACAO FINAL NO NUMERO ix, COM UM RESULTADO FINAL
!PSEUDO-ALEATORIO COM POUCA REALACAO PROXIMAL COM A SEMENTE INICIAL idum
ix = ieor(ix,ishft(ix,5))
!GERA UM TERCEIRO PARAMETRO PSEUDO-ALEATORIO, BASEADO NO VALOR DO PARAMETRO iy
k = iy/IQ
!ATUALIZA O VALOR DE iy, USANDO COMO PARAMETROS O VALOR JA EXISTENTE EM iy E O
!PARAMETRO k DEFINIDO ACIMA. ESTA OPERACAO DIMINUI A RELACAO COM O VALOR DA
!SEMENTE idum
iy = IA*(iy-k*IQ)-IR*k
!TRANSFORMA iy NUM VALOR POSITIVO, CASO SEJA NEGATIVO, EM SOMANDO O MAIOR
!INTEIRO QUE O SISTEMA CONSEGUE REGISTRAR A ELE, DE MODO QUE TORNA O RESULTADO
!FINAL UM POUCO MAIS ALEATORIO
if (iy < 0) iy = iy + IM
!GERA O NUMERO ALEATORIO REAL AO FINAL, UTILIZANDO OS PARAMETROS
!am, ix, iy E IM.
x = am*ior(iand(IM,ieor(ix,iy)),1)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
END SUBROUTINE ran1sub
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!