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