CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C PROGRAMA MUESTRA DE COMO PROGRAMAR EN FORTRAN77
PROGRAM MUESTRA
C DEFINICION DE TIPOS DE VARIABLES
IMPLICIT REAL*8(A-H,O-Z)
C IMPLICIT NONE IMPLICARIA QUE NO SE ASUME NADA
REAL*8 MPLA
CHARACTER*8 ARCH, ARCHI*12,ARCH2*18
C
C VARIABLES Y CONSTANTES COMUNES CON SUBRUTINAS Y FUNCIONES
COMMON /ENTEROS/ N1,N2,N3
COMMON/CTE/GAU,PI
COMMON/PLA/APLA,EPLA
C PARAMETRO QUE DEFINE NUMERO DE ELEMENTOS DE LOS VECTORES
C PARAMETER (NPART=100)
C PERO MEJOR LO CARGO DESDE muestra.inc PARA NO TENER QUE DEFINIRLO
C TAMBIEN EN LAS SUBRUTINAS
INCLUDE 'muestra.inc'
C DONDE EL ARCHIVO 'muestra.inc' DEBERIA SER SIMPLEMENTE:
C PARAMETER (NPART=100)
C AUNQUE TAMBIEN PODEMOS AGREGAR OTRAS COSAS COMO CONSTANTES, ETC
C
C DIMENSIONES DE VECTORES
DIMENSION MPLA(NPART),APLA(NPART),EPLA(NPART),ARCH(NPART)
C GUITA ES UNA MATRIZ 13X12 CON INDICES ELEGIDOS
C DESDE 1990 HASTA 2002 Y DE 1 A 12
DIMENSION GUITA(1990:2002,12)
C
C DSIN NO ES VARIABLE SINO FUNCION INTRINSECA QUE SE USARA
C COMO ARGUMENTO EN SUBRUTINA:
INTRINSIC DSIN
C LA DECLARACION DE FUNCION EXTERNA NO ES NECESARIA PERO....
EXTERNAL RND
C ESTA ES UNA FUNCION QUE DEFINO AQUI MISMO, NO ES EXTERNA
FILULITA(X)=PI*DSIN(X)
C
C DEFINICION DE CONSTANTES
PI=4.D0*DATAN(1.D0)
GAU=0.01720209895D0
C
C VALORES INICIALES, VARIAS ALTERNATIVAS CON DATA, DO...
DATA APLA/NPART*1.D0/, EPLA/NPART*0.D0/, MPLA/NPART*2.D0/
DATA GUITA /156*1.D0/
DO 80 I=1,NPART
ARCH(I)='ABCDEFGH'
80 CONTINUE
NN=N1-N2-N3
C INPUT DE DATOS POR PANTALLA SIN NECESIDAD DE PONER COMILLAS
WRITE(*,*) 'ENTRE EL NOMBRE DEL ARCHIVO'
READ(*,'(A)') ARCHI
PRINT *,ARCHI
TOT=0.D0
C LECTURA DE ARCHIVO
C PUEDE ESTAR EN OTRA UNIDAD
C OPEN(1,FILE='E:\DATOS\DATOS.DAT',STATUS='OLD')
C PUEDE ESTAR EN BINARIO PARA MAXIMA PRECISION
C OPEN(2,FILE='BINARIO.BIN',SATUS='OLD',FORM='UNFORMATTED')
C READ(2) X1,X2,X3
C CLOSE(2)
OPEN(1,FILE=ARCHI,STATUS='OLD',IOSTAT=KODE)
C SI LA VARIABLE KODE=0 EL ARCHIVO EXISTE Y SE PUEDE LEER
IF(KODE.NE.0) THEN
PRINT *,'PROBLEMAS CON EL ARCHIVO'
GOTO 77
END IF
20 READ(1,*,END=999,ERR=999) DATO
TOT=TOT+DATO
GOTO 20
999 WRITE(*,30)'SUMA TOTAL = ',TOT
CLOSE(1)
30 FORMAT(A14,F12.6)
C AL OPERAR CON MATRIZ EL INDICE DE VARIACION RAPIDA ES EL PRIMERO:
77 SUMA=0.D0
DO J=1,12
DO I=1990,2002
SUMA=SUMA+GUITA(I,J)
ENDDO
ENDDO
C POTENCIA ENTERA NO PONERLA COMO REAL SUMA**2.0 !!!!
SUM2=SUMA**2
PRINT *, 'SUM2 = ', SUM2
C MANEJO DE CARACTERES
ARCHI='123456'
PRINT *, ARCHI
C GUAMBIA: ARCHI='123456 ' PORQUE LA DEFINIMOS CON DE LONG 12
ARCHI='123456' // 'ABCDEF'
PRINT *, 'ARCHI =',ARCHI
C ESTO MUESTRA '123'
WRITE(*,*) 'ARCHI(1:3)=',ARCHI(1:3)
C ESTO MUESTRA '56AB'
WRITE(*,*) 'ARCHI(5:8)=',ARCHI(5:8)
C ARCHI QUEDARA IGUAL A 'DEF 6ABCDEF'
ARCHI(1:5)=ARCHI(10:12)
C BUSCA EL LUGAR QUE OCUPA UN CARACTER
K=INDEX(ARCHI,'F')
C K DEBERIA SER = 3
PRINT *, 'K = ', K
PRINT *, 'ingrese un numero entero'
READ *, M
C USO DEL IF ELSE
IF (M.GT.0) THEN
PRINT *, 'M ES POSITIVO'
ELSE IF (M.EQ.0) THEN
PRINT *, 'M = 0'
ELSE
PRINT *, 'M ES NEGATIVO'
END IF
C
C USO DE GOTO CONDICIONADO
C SI EL MES ES 1 VA A 100, ETC: GOTO(100,200,300)MES
C USO LA FUNCION EXTERNA RND
DSEED=12.3D0
RAN=RND(DSEED)
C USO DE LA FUNCION INTERNA FILULITA
Y=FILULITA(PI)
C AQUI USO LA INTRINSECA DSIN
CALL GRAPH(DSIN,0.D0,PI)
C Y TAMBIEN LA EXTERNA
CALL GRAPH(RND,0.1D0,0.9D0)
C PERO NO LA INTERNA NO CAMINA;
C CALL GRAPH(FILULITA,0.,1.)
C PUES DEBERIA DEFINIR FILULITA COMO EXTERNA
C LLAMADA A SUBRUTINA
CALL MOV(MPLA,RAN)
C GUARDO RESULTADOS
OPEN (1,FILE='salida.dat',STATUS='UNKNOWN')
WRITE(1,15)(I,MPLA(I),I=1,NPART)
CLOSE(1)
15 FORMAT(1X,I6,F20.6)
PRINT *,'CHAU, SE TERMINO TODO'
READ *,ARCH2
C TERMINA EL PROGRAMA
END
C SUBRUTINA MOV
SUBROUTINE MOV(MPLA,RAN)
IMPLICIT REAL*8(A-H,O-Z)
REAL*8 MPLA
COMMON/CTE/GAU,PI
COMMON/PLA/APLA,EPLA
INCLUDE 'muestra.inc'
DIMENSION MPLA(NPART),APLA(NPART),EPLA(NPART)
DO I=1,NPART
MPLA(I)=APLA(I)+EPLA(I)*PI+GAU-MPLA(I)*RAN
ENDDO
RETURN
END
C EJEMPLO DE SUBRUTINA QUE TIENE UNA FUNCION COMO ARGUMENTO
SUBROUTINE GRAPH(FUNCION,XMIN,XMAX)
IMPLICIT REAL*8(A-H,O-Z)
XDELTA=(XMAX-XMIN)/100.D0
DO 25 I=0,100
X=XMIN+I*XDELTA
Y=FUNCION(X)
WRITE(*,*) X,Y
25 CONTINUE
END
C FUNCION RND
DOUBLE PRECISION FUNCTION RND(DSEED)
REAL*8 DSEED,D2A32
D2A32=2.D0**32
DSEED=DMOD(3125.D0*DSEED,D2A32)
RND=DSEED/D2A32
RETURN
END
C BLOCK DE DATOS CON NOMBRE OPCIONAL
BLOCK DATA POCHOLA
COMMON /ENTEROS/ N1,N2,N3
DATA N1,N2,N3 /1,2,3/
END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC