mirror of
https://github.com/PDP-10/stacken.git
synced 2026-03-01 09:21:15 +00:00
270 lines
6.6 KiB
QBasic
270 lines
6.6 KiB
QBasic
100 REM USPOP - US POPULATION PROJECTION SIMULATION
|
||
105 REM COPYRIGHT 1973 STATE UNIVERSITY OF NEW YORK
|
||
110 REM DEVELOPED BY J. FRIEDLAND
|
||
115 REM PROGRAMMMED BY J. FRIEDLAND, S. HOLLANDER
|
||
120 REM LATEST REVISION: JULY 30,1973
|
||
125 RESTORE
|
||
130 DIMB(10),M(4,16)
|
||
135 READY1,F2,J,T,F,I9,R9
|
||
140 DATA 0,0,0,0,0,0,0
|
||
145 READ B2
|
||
150 FORN=3TO10
|
||
155 READ B(N)
|
||
160 NEXTN
|
||
165 READM
|
||
170 FORN=1TO4
|
||
175 FOR N1=1TO16
|
||
180 READ M(N,N1)
|
||
185 NEXTN1
|
||
190 NEXTN
|
||
195 PRINT"DO YOU WANT REPORTS 1) EVERY 5 YEAR INTERVAL"
|
||
200 PRINT"OR 2) SELECTED YEARS";
|
||
205 INPUT F1
|
||
210 IF (F1-1)*(F1-2)<>0 THEN 195
|
||
215 PRINT
|
||
220 PRINT"YEAR AT START OF PROJECTION";
|
||
225 INPUTY2
|
||
230 PRINT
|
||
235 PRINT"DO YOU ASSUME STANDARD FERTILITY (1=YES,0=N0)";
|
||
240 INPUTQ
|
||
245 IFQ*(Q-1)<>0THEN235
|
||
250 GOSUB880
|
||
255 PRINT
|
||
260 PRINT"DO YOU ASSUME STANDARD BIRTH DISTRIBUTION (1=YES,0=NO)";
|
||
265 INPUTQ
|
||
270 IFQ=1THEN285
|
||
275 IFQ<>0THEN260
|
||
280 GOSUB1010
|
||
285 PRINT
|
||
290 PRINT"DO YOU ASSUME STANDARD SEX RATIO (1=YES,0=NO)";
|
||
295 INPUTQ
|
||
300 IFQ=1THEN315
|
||
305 IFQ<>0THEN290
|
||
310 GOSUB 985
|
||
315 PRINT
|
||
320 PRINT"DO YOU ASSUME STANDARD MORTALITY (1=YES,0=NO)";
|
||
325 INPUTQ
|
||
330 IFQ=1THEN345
|
||
335 IFQ<>0THEN320
|
||
340 GOSUB1085
|
||
345 PRINT
|
||
350 PRINT"DO YOU ASSUME STANDARD POPULATION (1=YES,0=NO)";
|
||
355 INPUTQ
|
||
360 IFQ=1THEN375
|
||
365 IFQ<>0THEN350
|
||
370 GOSUB 1120
|
||
375 FOR N=1TO16
|
||
380 LETT=T+M(1,N)+M(2,N)
|
||
385 NEXTN
|
||
390 IF F=1 THEN 455
|
||
395 PRINT
|
||
400 PRINT"REPORT:";
|
||
405 IFY1=0THEN415
|
||
410 GOTO420
|
||
415 PRINT"1)SHORT 2)LONG 3)GRAPH 4)CHANGE ASSUMPTIONS 5)END";
|
||
420 INPUTR
|
||
425 LET F=1
|
||
430 IF(R-1)*(R-2)*(R-3)*(R-4)*(R-5)<>0THEN415
|
||
435 IFR=5THEN1410
|
||
440 IFR<4THEN455
|
||
445 GOSUB805
|
||
450 GOTO395
|
||
455 IFY1=0THEN625
|
||
460 IFZ=1THEN495
|
||
465 IFF2=1THEN490
|
||
470 IFY3>=Y1THEN480
|
||
475 LETJ=0
|
||
480 LETB2=B2+J
|
||
485 GOTO495
|
||
490 LET F2=0
|
||
495 LETB=(B2+B1)/2
|
||
500 LETQ=0
|
||
505 FORN=3TO10
|
||
510 LETQ=Q+B*M(1,N)*B(N)
|
||
515 NEXTN
|
||
520 LETQ=Q+174845
|
||
525 LETI9=2667
|
||
530 LETM(2,16)=M(4,16)*(M(2,16)+M(2,15)+I9)
|
||
535 LETM(1,16)=M(3,16)*(M(1,16)+M(2,15)+I9)
|
||
540 LETT=M(2,16)+M(1,16)
|
||
545 FORN=0TO13
|
||
550 IFN>1THEN565
|
||
555 LETI9=2667
|
||
560 GOTO 585
|
||
565 IFN>7THEN580
|
||
570 LETI9=35100
|
||
575 GOTO585
|
||
580 LETI9=116200
|
||
585 LET M(2,15-N)=M(4,15-N)*(M(2,14-N)+I9)
|
||
590 LET M(1,15-N)=M(3,15-N)*(M(1,14-N)+I9)
|
||
595 LETT=T+M(2,15-N)+M(1,15-N)
|
||
600 NEXTN
|
||
605 LETM(2,1)=M*Q*M(4,1)
|
||
610 LETM(1,1)=(1-M)*Q*M(3,1)
|
||
615 LETT=T+M(1,1)+M(2,1)
|
||
620 IFY2+Y1*5+4<R9THEN785
|
||
625 PRINT
|
||
630 PRINT"YEAR";Y2+Y1*5,"POP= ";
|
||
635 IFT<1E6THEN650
|
||
640 PRINT INT(T/1E5+.5)/10;" MILLION",
|
||
645 GOTO655
|
||
650 PRINT INT(T+.5),
|
||
655 PRINT"FERTILITY";B2
|
||
660 LETF=0
|
||
665 IFT*(R-1)=0THEN760
|
||
670 IFR<>3THEN690
|
||
675 PRINTTAB(25);"PCT. TOTAL POP."
|
||
680 PRINTTAB(10);"0.........5........10........15.......20"
|
||
685 GOTO695
|
||
690 PRINT" AGES";TAB(9);"FEMALES <-MILLIONS-> MALES"," PCT. TOTAL"
|
||
695 FORN=1TO16
|
||
700 IFN=16THEN715
|
||
705 PRINT(N-1)*5;"-";N*5-1;
|
||
710 GOTO725
|
||
715 IFR=3THEN745
|
||
720 PRINT" 75 AND OVER";
|
||
725 IFR=3THEN750
|
||
730 PRINTTAB(14);INT(M(1,N)/1E5)/10,INT(M(2,N)/1E5)/10,
|
||
735 PRINTINT((M(1,N)+M(2,N))*1000/T)/10
|
||
740 GOTO755
|
||
745 PRINT" 75+";
|
||
750 PRINTTAB(10);".";TAB(10+200*(M(1,N)+M(2,N))/T);"*"
|
||
755 NEXTN
|
||
760 IF F1=1THEN790
|
||
765 PRINT"YEAR FOR NEXT REPORT";
|
||
770 INPUT R9
|
||
775 IF Y2+Y1*5<R9 THEN790
|
||
778 PRINT"YEAR MUST BE GREATER THAN";Y2+Y1*5
|
||
780 GOTO765
|
||
785 REM YEAR COUNTER
|
||
790 LET Y1=Y1+1
|
||
795 LETB1=B2
|
||
800 GOTO 390
|
||
805 PRINT
|
||
810 PRINT"WHAT DO YOU WANT TO CHANGE?"
|
||
815 PRINT"1-FERTILITY, 2-BIRTH DISTRIBUTION, 3-SEX RATIO"
|
||
820 PRINT"4-MORTALITY, 5- POPULATION";
|
||
825 INPUTQ
|
||
830 IFINT(ABS(Q))<>QTHEN815
|
||
835 IFABS(Q-3)>2THEN815
|
||
840 IFQ>1THEN850
|
||
845 GOTO885
|
||
850 IFQ>2THEN860
|
||
855 GOTO1010
|
||
860 IFQ>3THEN870
|
||
865 GOTO985
|
||
870 IFQ>4THEN1120
|
||
875 GOTO1085
|
||
880 IFQ=1THEN910
|
||
885 PRINT"FERTILITY IN";Y2+Y1*5;
|
||
890 IFY1=0THEN900
|
||
895 LETF2=1
|
||
900 INPUTB2
|
||
905 IFB2<0THEN885
|
||
910 PRINT"WILL FERTILITY (1) STAY AT";B2;" OR (2) CHANGE SLOWLY"
|
||
915 PRINT"TO A NEW LEVEL";
|
||
920 INPUTZ
|
||
925 IF(Z-1)*(Z-2)<>0THEN910
|
||
930 IFZ<>2THEN980
|
||
935 PRINT"WHAT FERTILITY WILL BE STABLE";
|
||
940 INPUTB3
|
||
945 IFB3<0THEN935
|
||
950 PRINT"HOW MANY DECADES UNTIL FERTILITY REACHES";B3;
|
||
955 INPUTY3
|
||
960 IFY3<=0THEN950
|
||
965 IFY3*2<>INT(Y3*2)THEN950
|
||
970 LETJ=(B3-B2)/(Y3*2)
|
||
975 LETY3=Y3*2+Y1
|
||
980 RETURN
|
||
985 PRINT"PERCENT FEMALE BIRTHS";
|
||
990 INPUTM
|
||
995 LETM=1-M/100
|
||
1000 IFABS(M-.5)>.5THEN985
|
||
1005 RETURN
|
||
1010 PRINT"PCT. FERTILITY OCCURING IN FEMALES AGES:"
|
||
1015 LETT=0
|
||
1020 FORN=3TO10
|
||
1025 IFN=10 THEN 1040
|
||
1030 PRINT(N-1)*5;"-";N*5-1;
|
||
1035 GOTO1045
|
||
1040 PRINT" 45 AND OLDER";
|
||
1045 INPUTB(N)
|
||
1050 LETB(N)=B(N)/100
|
||
1055 LETT=T+B(N)
|
||
1060 NEXTN
|
||
1065 IFABS(T-1)<.02THEN1080
|
||
1070 PRINT"TOTAL MUST BE 100"
|
||
1075 GOTO1015
|
||
1080 RETURN
|
||
1085 LETI=3
|
||
1090 PRINT"CHANGE IN MORTALITY OCCURING IN FEMALES"
|
||
1095 GOSUB1145
|
||
1100 LETI=4
|
||
1105 PRINT"CHANGE IN MORTALITY OCCURING IN MALES"
|
||
1110 GOSUB 1145
|
||
1115 RETURN
|
||
1120 LETI=1
|
||
1125 PRINT"CHANGE IN FEMALE POPULATION"
|
||
1130 GOSUB 1145
|
||
1135 LETI=2
|
||
1140 PRINT"CHANGE IN MALE POPULATION"
|
||
1145 PRINT"GROUPS (FROM AGE, TO AGE)";
|
||
1150 INPUTQ,Q1
|
||
1155 IFQ=Q1THEN1315
|
||
1160 LETQ=INT(Q/5)+1
|
||
1165 LETQ1=INT(Q1/5)+1
|
||
1170 IFQ1<QTHEN1145
|
||
1175 IFQ<1THEN1145
|
||
1180 IFQ1<16THEN1190
|
||
1185 LETQ1=16
|
||
1190 PRINT"GROUP","CURRENT","NEW VALUE"
|
||
1195 IF I<3 THEN 1210
|
||
1200 PRINT" ","DEATH/1000"
|
||
1205 GOTO 1215
|
||
1210 PRINTTAB(9);"POPULATION MILLIONS"
|
||
1215 FORN=QTOQ1
|
||
1220 IFN=16THEN1235
|
||
1225 PRINT(N-1)*5;"-";N*5-1,
|
||
1230 GOTO1240
|
||
1235 PRINT"75 AND OVER",
|
||
1240 IF I<3 THEN 1255
|
||
1245 PRINT1000-INT(M(I,N)*1E4+.5)/10," ";
|
||
1250 GOTO 1260
|
||
1255 PRINT INT(M(I,N)/1E5+.5)/10," ";
|
||
1260 INPUT Z2
|
||
1265 IFI>2THEN1285
|
||
1270 IFZ2<0THEN1220
|
||
1275 LETM(I,N)=Z2*1E6
|
||
1280 GOTO1310
|
||
1285 LET M(I,N)=1-Z2/1E3
|
||
1290 IFM(I,N)<=1THEN1300
|
||
1295 LETM(I,N)=1
|
||
1300 IFM(I,N)>=0THEN1310
|
||
1305 LETM(I,N)=0
|
||
1310 NEXTN
|
||
1315 RETURN
|
||
1320 DATA2.45
|
||
1325 DATA.002,.143,.338,.285,.147,.066,.018,.001
|
||
1330 DATA.515
|
||
1335 DATA8.430E6,9.749E6,10.209E6,9.492E6,8.531E6,6.931E6
|
||
1340 DATA5.834E6,5.703E6,6.116E6,6.293E6,5.747E6,5.221E6
|
||
1345 DATA4.612E6,3.756E6,3.263E6,4.697E6
|
||
1350 REM - MALE POPULATION FIGURES
|
||
1355 DATA8.753E6,10.127E6,10.596E6,9.793E6,8.645E6,6.827E6
|
||
1360 DATA5.686E6,5.505E6,5.802E6,5.917E6,5.312E6,4.771E6
|
||
1365 DATA4.044E6,3.075E6,2.372E6,2.994E6
|
||
1370 REM FEMALE MORTALITY 5 YEAR SURVIVAL RATES
|
||
1375 DATA.982188,.997241,.998528,.997810,.996649,.996013
|
||
1380 DATA.994799,.992589,.988883,.983307,.975232
|
||
1385 DATA.965217,.948579,.921060,.878601,.662675
|
||
1390 REM MALE MORTALITY
|
||
1395 DATA.977536,.996465,.997803,.995070,.990384
|
||
1400 DATA.989478,.989692,.987119,.981037,.970752,.954883
|
||
1405 DATA.930882,.893099,.843550,.779330,.590070
|
||
1410 PRINT
|
||
1415 PRINT "ANOTHER PROJECTION (1=YES, 0=NO)";
|
||
1420 INPUT Q
|
||
1425 IFQ=1THEN125
|
||
1430 END
|
||
*U*
|
||
(5 |