Exemplos de Programas em FORTRAN - web.fe.up.pttavares/ensino/CFAC/Downloads/Apontamentos... · @2001 - João Tavares/JOF CFAC: Exemplos de Programas em FORTRAN 26 Exemplo V ... código

Exemplos de Programasem FORTRAN

João Manuel R. S. TavaresJoaquim O. Fonseca

@2001 - João Tavares/JOF CFAC: Exemplos de Programas em FORTRAN 2

Exemplo IPrograma simples de utilização do ciclo DO, com escrita não formatada:

PROGRAM exercicio1DIMENSION A(10)

CC Vai gerar valores que são o quíntuplo da indexaçãoC

DO 15 I = 1, 10A(I) = I*5

15 CONTINUECC ESCREVE NO SENTIDO DECRESCENTE DA INDEXAÇÃOC

DO 20 J = 10, 1, -1WRITE (*,*) A(J)

20 CONTINUESTOPEND


Exemplo IOutput:


Exemplo IIPrograma principal e subrotina para produto 2 matrizes de 2x2, com saída não formatada:

PROGRAM exercicio2DIMENSION A(2, 2), B(2, 2), C(2, 2)

CC VAI DEFINIR PONTOS A(...)C

A(1, 1) = 0.0A(1, 2) = 0.0 ! Considere, por exemplo, osA(2, 1) = 10.0 ! pontos extremos dum segmento de rectaA(2, 2) = 0.0

CC VAI LER O ÂNGULO DE ROTAÇÃOC


Exemplo IIWRITE (*, '(A\)') ' ANGULO : 'READ (*, *) TETAPI = 4*ATAN(1.0) ! Define a constante π (pi)TETA = TETA*PI/180 ! Converte graus em radianos

CC DEFINE MATRIZ DE ROTAÇÃO em torno da origemC

B(1, 1) = COS(TETA)B(1, 2) = SIN(TETA)B(2, 1) = -SIN(TETA)B(2, 2) = COS(TETA)

CCALL MULTMAT(A, B, C) ! Chamada da subrotina MULTMAT

CC ESCREVE A MATRIZ RESULTANTE DO PRODUTO C(...)


Exemplo IIC

DO 20 I = 1, 2WRITE (*,*) (C(I, J), J = 1, 2) ! Ciclo DO interno em J

20 CONTINUESTOPEND

CC Subrotina para o produto de duas matrizes de 2x2C

SUBROUTINE MULTMAT(A, B, C)DIMENSION A(2, 2), B(2, 2), C(2, 2)

CC faz ciclo sobre o número de linhas IC


Exemplo IIDO 1 I = 1, 2

CC faz produto com a matriz quadrada BC

DO 2 J = 1, 2AB = 0.0 ! Inicia valor da posição da matrizDO 3 K = 1, 2

AB = AB+A(I, K)*B(K, J) !Adiciona contribuições3 CONTINUE

C(I, J) = AB ! Guarda valor na posição da matriz2 CONTINUE1 CONTINUEC

RETURNEND


Exemplo IIOutput:


Exemplo IIIPrograma para processamento duma Figura 3D, com leitura dos dados dum ficheiro com a seguinte estrutura:

- na primeira linha o número de vértices (nós) e número de faces;

- nas linhas seguintes para todos os vértices, teremos o número do vértice e as coordenadas

- seguindo-se depois as linhas para a definição de cada face, com o número da face, número de vértices na face e os números dos vértices dessa face.

Para o caso particular dum cubo de aresta 2 e centrado na origem, será definido do modo seguinte (ficheiro exemplo.dat)


Exemplo III

8 6 ! número de vértices e número de faces 1 -1 1 1 2 1 1 1 3 1 1 -1 4 -1 1 -1 ! Coordenadas pontos 5 -1 -1 1 6 1 -1 1 7 1 -1 -1 8 -1 -1 -1 1 4 1 2 3 4 2 4 1 4 8 5 3 4 5 8 7 6 ! Faces 4 4 2 6 7 3 5 4 1 5 6 2 6 4 3 7 8 4

Y

Z

X

12

5

4

6

3

1

4

3

2

7

5

6

8


Exemplo IIIPROGRAM exercicio3

C Versão Inicial do programa de processamento duma figura 3DC**********************************************************C Programa 3DC XCORD Coordenadas dos vérticesC LNODE Número de vértices por faceC NNODE Número de cada vértice da faceC

COMMON / FACES / XCORD(100, 4), LNODE(20), NNODE(20, 8)CC Limitado a 100 pontos, 20 faces e 8 lados no máximo por faceC

CHARACTER*12 FNAMEC

NDIM = 3ICANAL = 20


Exemplo IIIWRITE (*, '(A\)')' Nome do Ficheiro : 'READ (*, '(A)') FNAMEOPEN (ICANAL, FILE = FNAME, STATUS = 'OLD')CALL LERDATA(NP, NF, NDIM, ICANAL)

CC escreve no ecrã a definição lida pela subrotina LERDATAC

DO 20 I = 1, NPWRITE (*, *) I, (XCORD( I, J ), J = 1, NDIM)

20 CONTINUEDO 30 I = 1, NF

WRITE (*, *) I, LNODE(I), (NNODE(I, J), J = 1, LNODE(I))30 CONTINUE

STOPEND


Exemplo IIIC Versão Inicial subrotina LERDATA para leitura duma figura 3DC**********************************************************

SUBROUTINE LERDATA(NP, NF, NDIM, ICANAL)C

COMMON / FACES / XCORD(100, 4), LNODE(20), NNODE(20, 8)C

READ (ICANAL, *) NP, NFDO 10 I = 1, NP

READ (ICANAL, *) II, (XCORD( II, J ), J = 1, NDIM)XCORD(II, NDIM+1) = 1 ! valor não utilizado neste exemplo

10 CONTINUEC

DO 20 I = 1, NFREAD (ICANAL, *) II, LNODE(II), (NNODE(II, J), J = 1, LNODE(II))

20 CONTINUERETURNEND


Exemplo IIIOutput:


Exemplo IVPrograma para leitura dum ficheiro, duma estrutura de faces e cálculo da área total utilizando a formula A= √p(p-a)(p-b)(p-c), com p=(a+b+c)/2, para determinar a área dum qualquer triângulo de lados a, b e c.

LNODE(I)-1

Só aplicável a Polígonos Convexos

2

1

LNODE(I)

4

3


Exemplo IVEXEMPLO de ESTRUTURA 3D dum PRISMA TRIANGULAR

6 5

1 -1 1 1 2 1 1 1 3 1 1 -1 4 -1 1 -1 ! Coordenadas 5 -1 -1 1 6 1 -1 1 1 4 1 2 3 4 2 3 1 4 5 3 4 5 6 3 4 ! Faces 4 3 2 6 3 5 4 1 5 6 2

Y

Z X

12

5

4

3

1

4

3

2

5

6


Exemplo IVPROGRAM exercicio4

C PROGRAMA 3D ! Continuação do exemplo anteriorCC COMMON /FACES/ XCOORD(100, 4), LNODE(20), NNODE(20, 8)C

PARAMETER (MPOIN = 100, MDIME = 4, MF = 20, MN = 8)DIMENSION XCOORD(MPOIN, MDIME), LNODE(MF),

+ NNODE(MF, MN) ! Vars locaisC

CHARACTER*12 FNAMENDIM = 3ICANAL = 20WRITE (*, '(A\)') ' Nome do ficheiro : 'READ (*, '(A)') FNAMEOPEN (ICANAL, FILE = FNAME, STATUS = 'OLD')

CC CALL LERDATA(NP, NF, NDIM, ICANAL)


Exemplo IVC

CALL LERDATA(MPOIN, MDIME, MF, MN, NP, NF, NDIM, + ICANAL, XCOORD, LNODE, NNODE)

CC ESCRITA PARA CONTROLO DE LEITURA DO FICHEIRO DE DADOSC

DO 20 I = 1, NPWRITE (*, 100) I, (XCOORD(I, J), J = 1, NDIM)

20 CONTINUEDO 30 I = 1, NF

WRITE (*, 110) I, LNODE(I), (NNODE(I, J), J = 1, LNODE(I))30 CONTINUECC CÁLCULO DA ÁREA TOTALC

AREAT = 0.0


Exemplo IVDO 40 I=1, NF

NO1 = NNODE(I, 1)X1 = XCOORD(NO1, 1)Y1 = XCOORD(NO1, 2)Z1 = XCOORD(NO1, 3)AREAF = 0.0DO 35 K = 3, LNODE(I)

NO2 = NNODE(I, K-1)NO3 = NNODE(I, K)X2 = XCOORD(NO2, 1)Y2 = XCOORD(NO2, 2)Z2 = XCOORD(NO2, 3)X3 = XCOORD(NO3, 1) Y3 = XCOORD(NO3, 2) Z3 = XCOORD(NO3, 3)A = SQRT((X2-X1)*(X2-X1)+(Y2-Y1)*(Y2-

+ Y1)+(Z2-Z1)*(Z2-Z1))


Exemplo IVB = SQRT((X3-X2)*(X3-X2)+(Y3-Y2)*(Y3-

+ Y2)+(Z3-Z2)*(Z3-Z2))C = SQRT((X1-X3)*(X1-X3)+(Y1-Y3)*(Y1-

+ Y3)+(Z1-Z3)*(Z1-Z3))P = (A+B+C)/2AREA = SQRT(P*(P-A)*(P-B)*(P-C))AREAF = AREAF+AREA ! Area total da face

35 CONTINUEWRITE (*, 1000) I, AREAFAREAT = AREAT+AREAF ! Area total da figura 3D

40 CONTINUEWRITE (*, 1010) AREATSTOP

100 FORMAT (4H No , I4, 3(2X, F11.4))110 FORMAT (10I5)1000 FORMAT (1X, 5HFACE , I4, 5X, 7HAREA = , E12.5)1010 FORMAT (1X, 13HAREA TOTAL = , E12.5)

END


Exemplo IVSUBROUTINE LERDATA(MP,MD,MF,MN,NP,NF,NDIM,ICAN

+ AL,XCOORD,LNODE,NNODE)************************************************************ Subrotina LERDATA, faz a leitura dos dados de um ficheiro ** MP - Número máximo de pontos em XCOORD ** MD - Máximo da dimensão (3) ** MF - Número máximo de faces ** MN - Número máximo de pontos por face ** NP - Número de pontos em processamento ** NF - Número de faces em processamento ** NDIM - Dimensão das coordenadas (2 ou 3) ** ICANAL - Número de endereço do ficheiro de leitura ** XCOORD - Vector de armazenamento das coordenadas dos pontos ** LNODE - Vector onde se guarda o número de pontos por cada face*


Exemplo IV* NNODE - Vector onde se guarda os núm. globais de cada nó da face ************************************************************

DIMENSION XCOORD(MP, MD), LNODE(MF), NNODE(MF, MN)C

READ (ICANAL, *) NP, NFDO 10 I = 1, NP

READ (ICANAL, *) II, (XCOORD(II, J), J = 1, NDIM)XCOORD(II, NDIM+1) = 1 ! Não usado neste exemplo

10 CONTINUEC

DO 20 I = 1, NFREAD (ICANAL,*) II, LNODE(II), (NNODE(II, K), K = 1,

+ LNODE(II))20 CONTINUE

RETURNEND


Exemplo IVOutput:


Exemplo VPrograma para processamento de uma cadeia de caracteres

PROGRAM exemplo5C Programa para leitura duma cadeia de caracteres e conversãoC desta em todos Maiúsculos ou Minúsculos* Variável de caso:* ISIM = 1 Passagem de minusculas a maiusculas* ISIM = 0 Passagem de maiusculas a minusculasc

CHARACTER*72 LINHACHARACTER*1 SIMNL = 72

CC Questiona da conversãoC5 WRITE(*, '(A\)') ' Texto Maiusculas (S)- Minusculas (N)[S]: '

READ (*, '(A)') SIM


Exemplo VCC Controla respostaC

IF (SIM .NE. 'S' .AND. SIM .NE. 's' .AND. SIM .NE. 'N' .AND.+ SIM .NE. 'n' .AND. SIM .NE. ' ') THEN

WRITE (*,'(A)') ' Resposta Incorrecta !'GOTO 5

END IFISIM = 1 ! Para maiusculasIF (SIM .EQ. 'N' .OR. SIM .EQ. 'n') THEN

ISIM = 0 ! Para minusculasEND IF

C Vai ler Cadeia de CaracteresC

WRITE (*, '(A\)') ' Texto : 'READ (*, '(A)') LINHA


Exemplo VC Vai determinar o número de caracteres significativosC10 IF (LINHA(NL:NL) .EQ. ' ') THEN

NL = NL-1GOTO 10

END IFC Conversão caracteres Minusculos --> Maiusculos ou Vice-VersaC

IC = 120 IASC = ICHAR(LINHA(IC:IC)) ! Código ASCII do caracter

IF (IASC .GE. 97 .AND. IASC .LE. 122 .AND. ISIM .EQ. 1) THENLINHA(IC:IC) = CHAR(IASC-32) ! passa a maiusculo

ELSE IF (IASC .GE. 65 .AND. IASC .LE. 90 .AND. ISIM .EQ. 0) THENLINHA(IC:IC) = CHAR(IASC+32) ! passa a minusculo

END IFIC = IC+1IF (IC .LE. NL) GOTO 20

(caracter a partir do código ASCII)


Exemplo VCC Escreve para o ecrã a cadeia de caracteres já convertidaC

WRITE (*, '(A\)') ' Texto : 'WRITE (*, '(A)') LINHA(1:IC)STOPEND

Output

Documents

Exemplos de Programas em FORTRAN - web.fe.up.pttavares/ensino/CFAC/Downloads/Apontamentos... · @2001 - João Tavares/JOF CFAC: Exemplos de Programas em FORTRAN 26 Exemplo V ... código