100  REM USPOP - US POPULATION PROJECTION SIMULATION
102  REM HEWLETT-PACKARD HP 36802A, 6/74
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  DIM B[10],M[4,16]
135  READ Y1,F2,J,T,F,I9,R9
140  DATA 0,0,0,0,0,0,0
145  READ B2
150  FOR N=3 TO 10
155  READ B[N]
160  NEXT N
165  READ M
170  FOR N=1 TO 4
175  FOR N1=1 TO 16
180  READ M[N,N1]
185  NEXT N1
190  NEXT N
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  INPUT Y2
230  PRINT 
235  PRINT "DO YOU ASSUME STANDARD FERTILITY (1=YES,0=N0)";
240  INPUT Q
245  IF Q*(Q-1) <> 0 THEN 235
250  GOSUB 880
255  PRINT 
260  PRINT "DO YOU ASSUME STANDARD BIRTH DISTRIBUTION (1=YES,0=NO)";
265  INPUT Q
270  IF Q=1 THEN 285
275  IF Q <> 0 THEN 260
280  GOSUB 1010
285  PRINT 
290  PRINT "DO YOU ASSUME STANDARD SEX RATIO (1=YES,0=NO)";
295  INPUT Q
300  IF Q=1 THEN 315
305  IF Q <> 0 THEN 290
310  GOSUB 985
315  PRINT 
320  PRINT "DO YOU ASSUME STANDARD MORTALITY (1=YES,0=NO)";
325  INPUT Q
330  IF Q=1 THEN 345
335  IF Q <> 0 THEN 320
340  GOSUB 1085
345  PRINT 
350  PRINT "DO YOU ASSUME STANDARD POPULATION (1=YES,0=NO)";
355  INPUT Q
360  IF Q=1 THEN 375
365  IF Q <> 0 THEN 350
370  GOSUB 1120
375  FOR N=1 TO 16
380  LET T=T+M[1,N]+M[2,N]
385  NEXT N
390  IF F=1 THEN 455
395  PRINT 
400  PRINT "REPORT:";
405  IF Y1=0 THEN 415
410  GOTO 420
415  PRINT "1)SHORT 2)LONG 3)GRAPH 4)CHANGE ASSUMPTIONS 5)END";
420  INPUT R
425  LET F=1
430  IF (R-1)*(R-2)*(R-3)*(R-4)*(R-5) <> 0 THEN 415
435  IF R=5 THEN 1410
440  IF R<4 THEN 455
445  GOSUB 805
450  GOTO 395
455  IF Y1=0 THEN 625
460  IF Z=1 THEN 495
465  IF F2=1 THEN 490
470  IF Y3 >= Y1 THEN 480
475  LET J=0
480  LET B2=B2+J
485  GOTO 495
490  LET F2=0
495  LET B=(B2+B1)/2
500  LET Q=0
505  FOR N=3 TO 10
510  LET Q=Q+B*M[1,N]*B[N]
515  NEXT N
525  LET I9=2667
530  LET M[2,16]=M[4,16]*(M[2,16]+M[2,15]+I9)
535  LET M[1,16]=M[3,16]*(M[1,16]+M[2,15]+I9)
540  LET T=M[2,16]+M[1,16]
545  FOR N=0 TO 13
550  IF N>1 THEN 565
555  LET I9=2667
560  GOTO 585
565  IF N>7 THEN 580
570  LET I9=35100.
575  GOTO 585
580  LET I9=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  LET T=T+M[2,15-N]+M[1,15-N]
600  NEXT N
605  LET M[2,1]=M*Q*M[4,1]
610  LET M[1,1]=(1-M)*Q*M[3,1]
615  LET T=T+M[1,1]+M[2,1]
620  IF Y2+Y1*5+4<R9 THEN 785
625  PRINT 
630  PRINT "YEAR";Y2+Y1*5,"POP= ";
635  IF T<1.E+06 THEN 650
640  PRINT INT(T/100000.+.5)/10;"MILLION",
645  GOTO 655
650  PRINT INT(T+.5),
655  PRINT "FERTILITY";B2
660  LET F=0
665  IF T*(R-1)=0 THEN 760
670  IF R <> 3 THEN 690
675  PRINT TAB(25);"PPCT. TOTAL POP."
680  PRINT TAB(10);"0.........5........10........15.......20"
685  GOTO 695
690  PRINT " AGES";TAB(9);"FEMALES <-MILLIONS-> MALES"," PCT. TOTAL"
695  FOR N=1 TO 16
700  IF N=16 THEN 715
705  PRINT (N-1)*5;"-";N*5-1;
710  GOTO 725
715  IF R=3 THEN 745
720  PRINT " 75 AND OVER";
725  IF R=3 THEN 750
730  PRINT TAB(14);INT(M[1,N]/100000.)/10,INT(M[2,N]/100000.)/10,
735  PRINT INT((M[1,N]+M[2,N])*1000/T)/10
740  GOTO 755
745  PRINT " 75+";
750  PRINT TAB(10);".";TAB(10+200*(M[1,N]+M[2,N])/T);"*"
755  NEXT N
760  IF F1=1 THEN 790
765  PRINT "YEAR FOR NEXT REPORT";
770  INPUT R9
775  IF Y2+Y1*5<R9 THEN 790
778  PRINT "YEAR MUST  GREATER THAN";Y2+Y1*5
780  GOTO 765
785  REM YEAR COUNTER
790  LET Y1=Y1+1
795  LET B1=B2
800  GOTO 390
805  PRINT 
810  PRINT "WHAT DO YOU WANT TO CHANGE?"
815  PRINT "1FERTILITY, 2-BIRTH DISTRIBUTION, 3-SEX RATIO"
820  PRINT "4-MORTALITY, 5- POPULATION";
825  INPUT Q
830  IF INT(ABS(Q)) <> Q THEN 815
835  IF ABS(Q-3)>2 THEN 815
840  IF Q>1 THEN 850
845  GOTO 885
850  IF Q>2 THEN 860
855  GOTO 1010
860  IF Q>3 THEN 870
865  GOTO 985
870  IF Q>4 THEN 1120
875  GOTO 1085
880  IF Q=1 THEN 910
885  PRINT "FERTILITY IN";Y2+Y1*5;
890  IF Y1=0 THEN 900
895  LET F2=1
900  INPUT B2
905  IF B2<0 THEN 885
910  PRINT "WILL FERTILITY (1) STAY AT";B2;" OR (2) CHANGE SLOWLY"
915  PRINT "TO A NEW LEVEL";
920  INPUT Z
925  IF (Z-1)*(Z-2) <> 0 THEN 910
930  IF Z <> 2 THEN 980
935  PRINT "WHAT FERTILITY WILL BE STABLE";
940  INPUT B3
945  IF B3<0 THEN 935
950  PRINT "HOW MANY DECADES UNTIL FERTILITY REACHES";B3;
955  INPUT Y3
960  IF Y3 <= 0 THEN 950
965  IF Y3*2 <> INT(Y3*2) THEN 950
970  LET J=(B3-B2)/(Y3*2)
975  LET Y3=Y3*2+Y1
980  RETURN 
985  PRINT "PERCENT FEMALE BIRTHS";
990  INPUT M
995  LET M=1-M/100
1000  IF ABS(M-.5)>.5 THEN 985
1005  RETURN 
1010  PRINT "PCT. FERTILITY OCCURING IN FEMALES AGES:"
1015  LET T=0
1020  FOR N=3 TO 10
1025  IF N=10 THEN 1040
1030  PRINT (N-1)*5;"-";N*5-1;
1035  GOTO 1045
1040  PRINT " 45 AND OLDER";
1045  INPUT B[N]
1050  LET B[N]=B[N]/100
1055  LET T=T+B[N]
1060  NEXT N
1065  IF ABS(T-1)<.02 THEN 1080
1070  PRINT "TOTAL MUST BE 100"
1075  GOTO 1015
1080  RETURN 
1085  LET I=3
1090  PRINT "CHANGE IN MORTALITY OCCURING IN FEMALES"
1095  GOSUB 1145
1100  LET I=4
1105  PRINT "CHANGE IN MORTALITY OCCURING IN MALES"
1110  GOSUB 1145
1115  RETURN 
1120  LET I=1
1125  PRINT "CHANGE IN FEMALE POPULATION"
1130  GOSUB 1145
1135  LET I=2
1140  PRINT "CHANGE IN MALE POPULATION"
1145  PRINT "GROUPS (FROM AGE, TO AGE)";
1150  INPUT Q,Q1
1155  IF Q=Q1 THEN 1315
1160  Q=INT(Q/5)+1
1165  Q1=INT(Q1/5)+1
1170  IF Q1<Q THEN 1145
1175  IF Q<1 THEN 1145
1180  IF Q1<16 THEN 1190
1185  LET Q1=16
1190  PRINT "GROUP","CURRENT","NEW VALUE"
1195  IF I<3 THEN 1210
1200  PRINT " ","DEATH/1000"
1205  GOTO 1215
1210  PRINT TAB(9);"POPULATION MILLIONS"
1215  FOR N=Q TO Q1
1220  IF N=16 THEN 1235
1225  PRINT (N-1)*5;"-";N*5-1,
1230  GOTO 1240
1235  PRINT "75 AND OVER",
1240  IF I<3 THEN 1255
1245  PRINT 1000-INT(M[I,N]*10000+.5)/10," ";
1250  GOTO 1260
1255  PRINT INT(M[I,N]/100000.+.5)/10," ";
1260  INPUT Z2
1265  IF I>2 THEN 1285
1270  IF Z2<0 THEN 1220
1275  LET M[I,N]=Z2*1.E+06
1280  GOTO 1310
1285  LET M[I,N]=1-Z2/1000
1290  IF M[I,N] <= 1 THEN 1300
1295  LET M[I,N]=1
1300  IF M[I,N] >= 0 THEN 1310
1305  LET M[I,N]=0
1310  NEXT N
1315  RETURN 
1320  DATA 2.45
1325  DATA .002,.143,.338,.285,.147,.066,.018,.001
1330  DATA .515
1335  DATA 8.43E+06,9.749E+06,1.0209E+07,9.492E+06,8.531E+06,6.931E+06
1340  DATA 5.834E+06,5.703E+06,6.116E+06,6.293E+06,5.747E+06,5.221E+06
1345  DATA 4.612E+06,3.756E+06,3.263E+06,4.697E+06
1350  REM - MALE POPULATION FIGURES
1355  DATA 8.753E+06,1.0127E+07,1.0596E+07,9.793E+06,8.645E+06,6.827E+06
1360  DATA 5.686E+06,5.505E+06,5.802E+06,5.917E+06,5.312E+06,4.771E+06
1365  DATA 4.044E+06,3.075E+06,2.372E+06,2.994E+06
1370  REM FEMALE MORTALITY 5 YEAR SURVIVAL RATES
1375  DATA .982188,.997241,.998528,.99781,.996649,.996013
1380  DATA .994799,.992589,.988883,.983307,.975232
1385  DATA .965217,.948579,.92106,.878601,.662675
1390  REM MALE MORTALITY
1395  DATA .977536,.996465,.997803,.99507,.990384
1400  DATA .989478,.989692,.987119,.981037,.970752,.954883
1405  DATA .930882,.893099,.84355,.77933,.59007
1410  PRINT 
1415  PRINT "ANOTHER PROJECTION (1=YES, 0=NO)";
1420  INPUT Q
1425  IF Q=1 THEN 125
1430  END 
