Sharp PC-E500/E500S Technikersoftware

METEO.231

Meteorologie

METEO.231 (4.026 Bytes)

10 ' METEOROL.231 (Meteorological conversion)
15 CLEAR
20 MERGE "G:COMN.00$"
30 ON ERROR GOTO *ERR
40 GOSUB *CG:DIM QMS$(2),QMG$(2,5)
100 DATA 0,"",""
110 DATA 1,1,0.3
120 DATA 2,4,1.6
130 DATA 3,7,3.4
140 DATA 4,11,5.5
150 DATA 5,17,8.0
160 DATA 6,22,10.8
170 DATA 7,28,13.9
180 DATA 8,34,17.2
190 DATA 9,41,20.8
200 DATA 10,48,24.5
210 DATA 11,56,28.5
220 DATA 12,64,32.7
230 DATA 12,64,32.7
240 QMI=100 : QMA=220
250 QMS$(0)="             *  METEOROLOGY  *"
260 QMS$(1)="   atmospheric pressure ...1"
270 QMS$(2)="   wind velocity        ...2"
280 QMG$(1,0)="       * atmospheric pressure *"
290 QMG$(1,1)=" atm  "
300 QMG$(1,2)="  mb  "
310 QMG$(1,3)=" mmHg "
320 QMG$(1,4)=""
330 QMG$(1,5)="[ atm  ][  mb  ][ mmHg ]"
340 QMG$(2,0)="           * wind velocity *"
350 QMG$(2,1)=" m/s  "
360 QMG$(2,2)=" knot "
370 QMG$(2,3)="km/day"
380 QMG$(2,4)="force "
390 QMG$(2,5)="[ m/s  ][ knot ][km/day][force ]"
400 ' display routine
410 CLS :PRINT QMS$(0):PRINT QMS$(1):PRINT QMS$(2)
420 GOSUB *KRD
450 IF P1=&31 OR P1=&32 THEN QMN=P1-&30 ELSE 420
480 ' data input
490 CLS :PRINT QMG$(QMN,0):LOCATE 2,1:QDT$="":PRINT "X= ";:INPUT QDT$
500 IF QDT$="" THEN 410
510 QDT=EVAL QDT$:QDT$=STR$ QDT
515 CLS :PRINT QMG$(QMN,0):LOCATE 2,1:PRINT "X= ";QDT:LOCATE 0,3:PRINT QMG$(QMN,5)
520 LOCATE 2,2:PRINT "from ?"
530 GOSUB *KRD
560 QDT1=P1-240:IF QDT1<1 OR QDT1>4 OR (QDT1=4 AND QMN=1) THEN 530
590 LOCATE 6,2:PRINT "  [";QMG$(QMN,QDT1);"]   to ?"
610 QKY$=INKEY$ :IF QKY$<>"" THEN 610
630 GOSUB *KRD
660 QDT2=P1-240:IF QDT2<1 OR QDT2>4 OR (QDT2=4 AND QMN=1) THEN 630
690 LOCATE 19,2:PRINT "to   [";QMG$(QMN,QDT2);"]"
700 QANS=0:QANS$="":IF QMN=2 THEN 830
710 ON QDT1 GOSUB 800,810,820
720 ' Answer disp.
730 LOCATE 0,3:PRINT QCL$
740 QDT$=STR$ QDT:QFK$=QDT$:QY=4:GOSUB 1280
750 QFK$=QANS$:QY=20:GOSUB 1280
790 GOSUB *REK:GOTO 480
800 ON QDT2 GOTO 900,910,920
810 ON QDT2 GOTO 930,900,940
820 ON QDT2 GOTO 950,960,900
830 ' wind velocity
840 ON QDT1 GOSUB 860,870,880,890
850 GOTO 730
860 ON QDT2 GOTO 900,970,980,1050
870 ON QDT2 GOTO 990,900,1000,1050
880 ON QDT2 GOTO 1010,1020,900,1040
890 ON QDT2 GOTO 1050,1050,1050,1030
900 QANS$=STR$ QDT:RETURN
910 QANS$=STR$ (QDT*1013.25):RETURN
920 QANS$=STR$ (QDT*760):RETURN
930 QANS$=STR$ (QDT/1013.25):RETURN
940 QANS$=STR$ (INT (QDT/13.5951/980.665*10000*100+0.5)/100):RETURN
950 QANS$=STR$ (QDT/760):RETURN
960 QANS$=STR$ (INT (QDT*13.5951*980.665/10000*100+0.5)/100):RETURN
970 QANS$=STR$ (QDT*1.944):RETURN
980 QANS$=STR$ (QDT*86.4):RETURN
990 QANS$=STR$ (QDT/1.944):RETURN
1000 QANS$=STR$ (QDT/1.944*86.4):RETURN
1010 QANS$=STR$ (QDT/86.4):RETURN
1020 QANS$=STR$ (QDT/86.4*1.944):RETURN
1030 IF QDT>12 THEN QANS$="12":RETURN ELSE QANS$=STR$ INT QDT:RETURN
1040 QDT$=STR$ (QDT/86.4)
1050 FOR QI=QMI TO QMA STEP 10
1060 RESTORE QI:READ QW1$,QW2$,QW3$
1070 READ QK1$,QK2$,QK3$
1080 ON QDT1 GOSUB 1110,1130,1110,1150
1090 NEXT
1100 RETURN
1110 IF VAL QDT$>=32.7 THEN QANS$="12":QI=QMA:RETURN
1120 IF VAL QK3$<=VAL QDT$ THEN RETURN ELSE QANS$=QW1$:QI=QMA:RETURN
1130 IF VAL QDT$>=64 THEN QANS$="12":QI=QMA:RETURN
1140 IF VAL QK2$<=VAL QDT$ RETURN ELSE QANS$=QW1$:QI=QMA:RETURN
1150 IF VAL QW1$<=VAL QDT$ AND VAL QDT$<VAL QK1THEN ON QDT2 GOSUB 1210,1230,1250:QI=QMA:RETURN
1160 IF VAL QDT$>=12 THEN QI=QMA:ON QDT2 GOTO 1180,1190,1200
1170 RETURN
1180 QANS$="32.7"+CHR$ &E5+"v":RETURN
1190 QANS$="64"+CHR$ &E5+"v":RETURN
1200 QANS$="2825.28"+CHR$ &E5+"v":RETURN
1210 IF QW3$<>"" THEN QANS$=QW3$+CHR$ &E5
1220 QANS$=QANS$+"v<"+QK3$:RETURN
1230 IF QW2$<>"" THEN QANS$=QW2$+CHR$ &E5
1240 QANS$=QANS$+"v<"+QK2$:RETURN
1250 IF QW3$<>"" THEN QDTX=VAL QW3$:QDTX=QDTX*86.4:QANS$=STR$ QDTX+CHR$ &E5
1260 QDTX=VAL QK3$:QDTX=QDTX*86.4:QANS$=QANS$+"v<"+STR$ QDTX
1270 RETURN
1280 QY=QY+7-INT (LEN QFK$/2):LOCATE QY,3:PRINT QFK$:RETURN
3000 *ERR IF ERL =490 OR ERL =510 RESUME 490
3010 '
3020 CLS :PRINT QMS$(0):GOSUB *DPA:GOSUB *REK:RESUME 400
3030 *KRD QKY$=INKEY$ &1:P1=ASC QKY$:RETURN

Generated by (c) Casio FX-850P/FX-880P Notepad 2.02

(c) by mani.becker@web.de - http://blog.manib.bplaced.net