DECLARE SUB curva (s!, d!, la!, N!, col!, ang0, ang1, ang2, delan)

SCREEN 12

CLS

COLOR 15

pi = 4 * ATN(1)

s = .91679

d = 3.3936

N = 10

la1 = .5393

la2 = .6393

ang1 = 0

ang2 = 45

delan = 1

LOCATE 8, 1

PRINT " PROGRAMA 'REDELE'"

PRINT

PRINT

PRINT "Red de difraccion elemental."

PRINT "Grafica la funcion instrumental de una red de difraccion para dos longitudes"

PRINT "de onda"; : COLOR 11: PRINT " lambda menor"; : COLOR 15: PRINT " y"; : COLOR 12:

PRINT " lambda mayor": COLOR 15

PRINT "El ancho de cada ranura transparente es s. La distancia entre ranuras es d."

PRINT "El numero de ranuras es N. El angulo de incidencia es ang0."

PRINT "El grafico es la intensidad difractada en funcion del angulo desde "

PRINT "ang1 hasta ang2, que se imprimen, y con marcas cada intervalo delan."

PRINT "Sirve para verificar la ecuacion de la red, para calcular intensidades de"

PRINT "los ordenes, poder resolvente e intervalo espectral libre. "

PRINT "Los valores predeterminados corresponden al ejemplo de la fig. 3.9."

PRINT "Las longitudes van en micrones y los angulos en grados."

PRINT "Para terminar poner cualquiera de los 5 primeros items = 0."

DO: LOOP WHILE INKEY$ = ""

CLS

DO

LOCATE 1, 1: PRINT " ";

LOCATE 1, 1: PRINT "Ancho de cada ranura transparente s ="; s;

INPUT a$: IF a$ <> "" THEN s = VAL(a$)

IF s = 0 THEN END

LOCATE 2, 1: PRINT " ";

LOCATE 2, 1: PRINT "Distancia entre ranuras d ="; d;

INPUT a$: IF a$ <> "" THEN d = VAL(a$)

IF d = 0 THEN END

LOCATE 3, 1: PRINT " ";

LOCATE 3, 1: PRINT "Numero de ranuras N ="; N;

INPUT a$: IF a$ <> "" THEN N = VAL(a$)

IF N = 0 THEN END

LOCATE 4, 1: PRINT " ";

COLOR 11

LOCATE 4, 1: PRINT "lambda menor ="; la1;

INPUT a$: IF a$ <> "" THEN la1 = VAL(a$)

IF la1 = 0 THEN END

LOCATE 5, 1: PRINT " ";

COLOR 12

LOCATE 5, 1: PRINT "lambda mayor ="; la2;

INPUT a$: IF a$ <> "" THEN la2 = VAL(a$)

IF la2 = 0 THEN END

LOCATE 6, 1: PRINT " ";

COLOR 15

LOCATE 6, 1: PRINT "Angulo de incidencia ang0 ="; ang0;

INPUT a$: IF a$ <> "" THEN ang0 = VAL(a$)

IF ang0 = 90 THEN ang0 = 89.999

IF ang0 = -90 THEN ang0 = -89.999

LOCATE 7, 1: PRINT " ";

LOCATE 7, 1: PRINT "Angulo menor del intervalo difractado ang1 ="; ang1;

INPUT a$: IF a$ <> "" THEN ang1 = VAL(a$)

IF ang1 = 90 THEN ang1 = 89.999

IF ang1 = -90 THEN ang1 = -89.999

LOCATE 8, 1: PRINT " ";

LOCATE 8, 1: PRINT "Angulo mayor del intervalo difractado ang2 ="; ang2;

INPUT a$: IF a$ <> "" THEN ang2 = VAL(a$)

IF ang2 = 90 THEN ang2 = 89.999

IF ang2 = -90 THEN ang2 = -89.999

LOCATE 9, 1: PRINT " ";

LOCATE 9, 1: PRINT "Marcas cada"; delan; "grados."; : PRINT " delan = ";

INPUT a$: IF a$ <> "" THEN delan = VAL(a$)

IF delan = 0 THEN END

LOCATE 10, 1: PRINT " ";

CLS

LOCATE 30, 1: PRINT INT(100 * ang1 + .5) / 100;

LOCATE 30, 74: PRINT INT(100 * ang2 + .5) / 100;

FOR ang = ang1 TO ang2 STEP delan

xp = 640 * (ang - ang1) / (ang2 - ang1)

LINE (xp, 0)-(xp, 479), 8

NEXT ang

LINE (639, 0)-(639, 479), 8

FOR yp = 0 TO 479 STEP 47.9

LINE (0, yp)-(639, yp), 8

NEXT yp

col = 11

la = la1

CALL curva(s, d, la, N, col, ang0, ang1, ang2, delan)

col = 12

la = la2

CALL curva(s, d, la, N, col, ang0, ang1, ang2, delan)

DO: LOOP WHILE INKEY$ = ""

LOOP

SUB curva (s, d, la, N, col, ang0, ang1, ang2, delan)

pi = 4 * ATN(1)

FOR ang = ang1 TO ang2 STEP (ang2 - ang1) / 640

alfa = ang * pi / 180

alfa0 = ang0 * pi / 180

alfa1 = ang1 * pi / 180

alfa2 = ang2 * pi / 180

p = SIN(alfa) - SIN(alfa0)

x = pi * s * p / la

y = pi * d * p / la

IF x = 0 THEN 1

I = (SIN(N * y) / (N * SIN(y))) ^ 2 * (SIN(x) / x) ^ 2

xp = 640 * (alfa - alfa1) / (alfa2 - alfa1)

yp = 479 * (1 - I)

1 IF ang = ang1 THEN PSET (xp, yp), col

LINE -(xp, yp), col

NEXT ang

END SUB