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