Apostila_Comandos_Basicos

PONTIFÍCIA UNIVERSIDADE CATÓLICA DE MINAS GERAIS

CAMPUS DE POÇOS DE CALDAS

FACULDADE DE ENGENHARIA CIVIL – INFORMÁTICA

COMANDOS ÚTEIS DA LINGUAGEM FORTRAN

Prof. Simone Siqueira dos Reis

1. COMANDOS:

COMANDO FUNÇÃO

Rewind(unidade) Posiciona o ponteiro no começo do arquivo

Dmod(x,y) Retorna o resto da divisão de x por y

Dsqrt(x) Retorna a Raiz Quadrada de x

Transpose(H) Retorna a Transposta da Matriz H

Matmul(H,G) Retorna o produto da matriz H pela Matriz G

DsinD(x) Seno do ângulo x

DcosD(x) Coseno do ângulo x

DtanD(x) Tangente do ângulo x

Alog10(x) Logaritmo na base 10

Alog(x) Logaritmo neperiano

Exp(x) Exponencial de X

Dabs(x) Retorna o valor absoluto de x

Dsign(x,y) Retorna x positivo se y>0 e x negativo se y<0

Dmax1(x1,x2,...) Retorna o maior valor da lista

Dmin1(x1,x2,...) Retorna o menor valor da lista

Dint(x) Trunca o valor de x

Idnint(x) Arredonda o valor de X

Ceiling(x) Retorna o menor numero inteiro maior que x

Floor(x) Retorna o maior número inteiro menor que x

Iw Formatar valores inteiros – w tamanho do campo

Fw.d Formatar valores reais - d número de casas decimais

Ew.dEe Formatar valores reais com expoente – e casas decimais do expoente

Aw Formatar caracteres

nX Deixa n posições em Branco

SP Escreve o sinal de + onde é opcional

/ Muda de linha

\ Começa a escrever onde parou






2. ARQUIVOS:

Open (unidade,FILE=’nome.ext’,status=’new’, iostat=err)

Close(unidade)

3. ESTRUTURA DE PROGRAMAÇÃO:

IF ( TESTE )

THEN

Programa 1

ELSE

Programa

END IF

DO contador=inicio,fim,passo

Programa

END DO

DO WHILE (TESTE)

Programa

END DO






4. COMANDOS ADICIONAIS:

COMANDO DESCRIÇÃO

COMMON/nome/ lista de variáveis Armazenamento de variáveis em memória

INCLUDE ‘nome.ext’ Inclui no programa declarações de variáveis externas

DATA nome/valor1,valor2,.../ Atribuir valores a variáveis

NOME [ ALLOCATABLE] (:,:) Declaração dinâmica de matriz

ALLOCATE (NOME(L,C) Definindo o tamanho da matriz

DALLOCATE (NOME) Desalocar Matriz

(Mat(i,j),i=1,4) Looping sem o DO – Só para Matrizes

5. EXEMPLOS

1) Cálculo de Derivada numérica: Program derivada use msimsl implicit none INTEGER KORDER REAL BGSTEP, DERV, fcn, TOL, X external fcn X = 3.0 BGSTEP = 0.2 TOL = 0.01 KORDER = 1 DERV = DERIV(FCN,KORDER,X,BGSTEP,TOL) WRITE (*,99999) DERV 99999 FORMAT (/, 1X, A primeira derivada é: ', 1PE10.3) END REAL FUNCTION FCN (X) REAL X FCN = 2*sin(x)*cos(x) END






2) Cálculo de Integral numérica: Program integral use msimsl REAL A, B, ERRABS, ERREST, ERRREL,F, RESULT EXTERNAL F A = -0.25 B = 0.75 ERRABS = 0.0 ERRREL = 1*e-30 CALL QDAGS (F, A, B, ERRABS, ERRREL, RESULT, ERREST) WRITE (*,99999) RESULT, ERREST 99999 FORMAT (' Calculado =', F8.3, 13X, /, /,' Erro estimado =', 1PE10.3, 6X) END REAL FUNCTION F (X) REAL X F = (-1/x)*(0.75-x) RETURN END 3) Executa um programa: Program executa USE MSFLIB ia = runqq('write.exe','readme.doc') end






4) Cálculo de Auto valor e auto vetor: Program Instabilidade use msimsl integer n,ldainv,ldevec REAL*8 A(3,3), AINV(3,3) COMPLEX*16 EVAL(3), EVEC(3,3) n=3 ldainv=3 ldevec=3 ! Matriz A ! A = ( 1.0 3.0 3.0) ! ( 1.0 3.0 4.0) ! ( 1.0 4.0 3.0) DATA A/1.0,1.0,1.0,3.0,3.0,4.0,3.0,4.0,3.0/ !CALCULA A INVERSA DE A CALL DLINRG (N, A, N, AINV, LDAINV) ! IMPRIME A MATRIZ INVERSA CALL DWRRRN ('AINV', N, N, AINV, LDAINV, 0) !CALCULA O AUTO VALOR( EVAL) AUTO VETOR (EVEC) DE A CALL DEVCRG (N, A, N, EVAL, EVEC, LDEVEC) !IMPRIME OS RESULTADOS CALL DWRCRN ('Auto valor', 1, N, EVAL, 1, 0) CALL DWRCRN ('Auto vetor', N, N, EVEC, LDEVEC, 0) End






5) Operação com textos: Program textos character(20) a a= trim('aaaa ')// 'bbbb' print*, a pause 'Digite uma tecla' end 6) Conversão de número em texto e vice-versa: program character_real implicit none character (255) text,text1 real r integer i !Conversão do caractere "text" em um real "r": read(text, *) r !************************************************************** text = '10.2' read (text, *) r write (*,*) 'O string continha o valor: ', r !************************************************************** !Conversão do real "r" em um caractere "text": write(text, *) r !************************************************************** r = 25.4 write (text,*) r text1 = 'O real foi convertido no string: ' // trim(text) write (*,*) 'A string contem o valor: ', text1 pause 'reis' !************************************************************** end






7) Produto interno: Program produto_interno use msimsl implicit none real*8 x,a(3),b(3),c(2),d(2,3) a=RESHAPE((/1, 2, 3/), (/3/)) b=RESHAPE((/1, 2, 3/), (/3/)) !a=(/1,2,3/) !b=(/4,5,6/) x=dot_product(a,b) write(*,*) x pause 'reis' d = RESHAPE((/7, 8, 9, 10, 11, 12/), (/2, 3/)) c=sum(d,dim=2) write(*,*)c(1),c(2),c(2) pause 'reis' end 8) Integral por Gauss: Program Gauss use MSIMSL PARAMETER (N=4) INTEGER I, IWEIGH, NFIX REAL*8 ALPHA, BETA1, QW(N), QX(N), QXFIX(2) IWEIGH = 1 ALPHA = 0.0 BETA1 = 0.0 NFIX = 0 QXFIX(1) = -1.0 QXFIX(2) = 1.0 CALL DGQRUL (N, IWEIGH, ALPHA, BETA1, NFIX, QXFIX, QX, QW)






WRITE (*,9) (I,QX(I),I,QW(I),I=1,N) 9 FORMAT (2X,'QX(',I1,') = ',e24.17e3,2x,'QW(',I1,') = ',e24.17e3,/) End 9) Calcula as raízes de um Polinômio: Program raiz use msimsl implicit none INTEGER ITMAX, NROOT REAL*8 EPS, ERRABS, ERRREL, ETA INTEGER INFO[allocatable](:) REAL*8 F, X[allocatable](:), XGUESS[allocatable](:) EXTERNAL f NROOT=2 ALLOCATE(INFO(NROOT)) ALLOCATE(X(NROOT)) ALLOCATE(XGUESS(NROOT)) XGUESS=0D0 EPS = 1.0E-5 ERRABS = 1.0E-5 ERRREL = 1.0E-5 ETA = 1.0E-2 ITMAX = 100 CALL DZREAL (F, ERRABS, ERRREL, EPS, ETA, NROOT, ITMAX, XGUESS,& X, INFO) CALL DWRRRN ('AS RAIZES SAO:', 1, NROOT, X, 1, 0) END REAL*8 FUNCTION F (X) REAL*8 X F = X*X + 2.0*X - 3.0 END






10) Calcula as raízes: implicit none REAL*8 ERRABS, ERRREL INTEGER MAXFN, NOUT REAL*8 A, B, F EXTERNAL F A = -10.0 !inicio B = 0.0 !fim ERRABS = 0.0 ERRREL = 0.001 MAXFN = 100 CALL DZBREN (F, ERRABS, ERRREL, A, B, MAXFN) WRITE (NOUT,99999) B, MAXFN 99999 FORMAT (' RAIZ:',& F5.1, '.', /, ' f(x):', I2, '.', //) END REAL*8 FUNCTION F (X) REAL*8 X F = X**2 + 2*X - 3.0 RETURN END 11) Operação com vetor: PROGRAM ORDEM USE MSIMSL IMPLICIT NONE INTEGER N,j PARAMETER (N=4) INTEGER INCX, INDEX,Imax REAL*8 VALUE, X(N) , X1(N),minimo,maximo DATA X/4.0, 1.0, 3.0,2.0/






!Coloca o vetor em ormdem crescente CALL DSVRGN(N,X,X1) Write(*,9) (x1(j),j=1,4) 9 format (4(f5.1)) !Descobre a posiçao de um número no vetor INCX = 1 VALUE = 1.0 CALL DSRCH (N, VALUE, X1, INCX, INDEX) WRITE (*,*)index Imax=1 minimo=idmin(N,X1,Imax) !verifica o valor minimo de um vetor maximo=idmax(N,X1,Imax) !verifica o valor maximo de um vetor write(*,*) minimo,maximo END 12) Resolução de sistema linear , número aleatório, saída formatada para arquivo: Program Matriz_aleatorio use msimsl implicit none INTEGER nl,ipath,lda,i,j Real*8, ALLOCATABLE :: a(:,:),b(:,:),x(:,:) OPEN(1,FILE='sistema.TXT',status='replace') Write(*,'(2x,"numero de linhas: ",\)') read*, nl ALLOCATE (a(nl,nl)) ALLOCATE (b(nl,1)) ALLOCATE (x(nl,1)) a=0 b=0 CALL RANDOM_NUMBER(a) CALL RANDOM_NUMBER(b) a=100*A b=100*B ipath=1 lda=nl Call DLSLRG (nl, A, nl, B, IPATH, X) !Resolução do sistema CALL DWRRRN ('Matriz Gerada', nl, nl, a , LDA,0)






CALL DWRRRN ('Vetor gerado', nl, 1, b , LDA,0) CALL DWRRRN ('solucao', nl, 1, x , LDA,0) Write(1,*) 'Simone Siqueira dos Reis' write(1,*) Write(1,*) 'EU' write(1,*) write(1,*) 'Solução do sistema A.X=B' write(1,*) write(1,*) 'Matriz A' do i=1,nl write(1,'(/,\)') do j=1,nl Write(1,10) a(i,j) 10 format (f10.4,\) enddo enddo write(1,'(/)') write(1,*) 'Matriz B' write(1,*) do i=1,nl Write(1,12) b(i,1) 12 format(sp,f10.4) enddo write(1,*) write(1,*) 'Matriz x' write(1,*) do i=1,nl Write(1,13) x(i,1) 13 format(sp,f10.4) enddo END 13) Interpolação e Cópia de vetor: Program Interpola_copy use msimsl INTEGER LDA, LDB, N,incx,incy,nu PARAMETER (LDA=3, LDB=3, N=3) REAL*8 MATA(LDA,LDA),DX(N), DY(N),resposta,valor






! Set values for A ! A = ( 1.0 4.0 7.0 ) ! ( 2.0 5.0 8.0 ) ! ( 3.0 6.0 9.0 ) DATA MATA/1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0,8.0,9.0/ incx=1 !Incremento da matriz Original incy=1 !Incremento do vetor nu=3 CALL DCOPY (Nu, MATA, INCX, DX, INCY) incx=2 !Incremento da matriz Original incy=1 !Incremento do vetor nu=3 CALL DCOPY (Nu, MATA, INCX, DY, INCY) CALL DWRRRN ('vet1', N, 1, DX, N, 0) CALL DWRRRN ('vet2', N, 1, DY, N, 0) !Interpolação entre dois vetores valor=1.5 resposta=DQDVAL(valor,N,DX,DY,.TRUE.) Write(*,*) resposta END 14) Condição de TYPE: Program notas Implicit none Type aula character nome*5 character disciplina*15 Real*8 valornota endtype type (aula) arquivo1 arquivo1=aula('reis','informatica',10)






write(*,1) arquivo1%nome,arquivo1%disciplina,arquivo1%valornota 1 format (1x,a5,1x,a15,1x,f5.1) end 15) Erros de Arquivos: Program Erros_arquivo use msimsl integer err open (1, file='erros.txt', status='old', iostat=err) if (err==0) then write(1,*) 'seu arquivo abriu com sucesso' else write(*,*) 'seu arquivo não existe' open (1, file='erros.txt', status='New') write(1,*) 'seu arquivo abriu com sucesso' endif end 16) Erros do IMSL: Program Erros_imsl use msimsl INTEGER N PARAMETER (N=2) REAL A(N,N), AINV(N,N), B(N), X(N) DATA A/2.0, -3.0, 2.0, -3.0/ DATA B/1.0, 2.0/






CALL ERSET (0, 1, 0) ! 0 - Geral ! 0 não imprime , 1 imprime ! 0 não para , 1 para CALL UMACH (-3, 9) OPEN (UNIT=9,FILE='CHECKERR.txt') call sis (a,b,x) ! Generate level 5 terminal error. CALL LINRG (-1, A, 2, AINV, 2) write(*,*) 'terminou' end __________________________________________ subroutine sis (a,b,x) REAL A(2,2), B(2), X(2) CALL LSARG (2, A, 2, B, 1, X) End 17) Verifica se o numero e inteiro ou fracionário: Program inteiro_fracionario character*8 a logical b a='35' b=index(a,'.') If (b) then write(*,*) 'O numero e fracionário' else write(*,*) 'O numero e inteiro' endif






end 18) Erros matemáticos e de entrada de dados via teclado : Program erro_matematicos USE DFLIB INTERFACE FUNCTION Tipo_erro (sig,excec) !DEC$ ATTRIBUTES C :: Tipo_erro INTEGER(4) Tipo_erro INTEGER(2) sig,excec END FUNCTION END INTERFACE INTEGER(4) iret,err REAL*8 r1, r2 iret = SIGNALQQ(SIG$FPE, Tipo_erro) Write(*,*) 'Digite o valor de x' read(*,*,iostat=err) r1 if (err==0) then write(*,*) 'Gravação de variável com sucesso' else stop 'falha na gravação' endif Call inverso(r1,r2) Write(*,*) 'O inverso de ',r1,' e : ',r2 END

! Subrotina que calcula o inverso de de um Número






Subroutine inverso(r1,r2) Real*8 r1,r2 r2=1/r1 end

! Tipo de exceção FUNCTION Tipo_erro (sig,excec) !DEC$ ATTRIBUTES C :: Tipo_erro USE DFLIB INTEGER(2) sig,excec SELECT CASE(excec) CASE( FPE$INVALID ) STOP 'NUMERO INVALIDO' CASE( FPE$DENORMAL ) STOP ' NUMERO DESNOMALIZADO' CASE( FPE$ZERODIVIDE ) STOP ' DIVISAO POR ZERO' CASE( FPE$OVERFLOW ) STOP ' OVERFLOW' CASE( FPE$UNDERFLOW ) STOP ' UNDERFLOW' CASE( FPE$INEXACT ) STOP ' PRECISAO INESATA' CASE DEFAULT STOP ' ERRO NAO AVALIADO' END SELECT Tipo_erro = 1 END

Documents

Apostila_Comandos_Basicos