NOTE: See Documentation page for instructions

GRANULES source listing

##################################################################################
10 ID$="GRANULES 1.1  mod Q3O 4/21/88 Copyright (C) 1989 D.K. Hartline and R.W. Newcomb":PRINT ID$
12 'Version 1.1 = version for MS85-4
18 'Q3O implements GRANULES.INI approach
19 'Q3N allows logarithmic age histograms
20 'Q3M revises format of .PRN files, removes print-plot, etc
21 'Q3L corrects line 1720 error which failed to tally moved granules
22 'Q3K adds decrease in release rate constant with granule age
23 'Q3J=QuickBASIC version; writes .PRN files on C:
30 'Version 1.0 = version used for Soc. Neurosci. poster 1986
39 '
40 '**************************************************************
42 '* REQUIRED INPUT FILES:  1) Parameter file;  2) GRANULES.INI *
44 '**************************************************************
50 'FORMAT FOR .PRM AND .SAV FILES:
52 '"Identifying string in quotes"
54 'GRANULESQ3N - File format version number (checked for compatibility)
56 'KE,CF,KF,KREL,NC%-1 - Enz decay, cnvrsn fctr, diffn fctr, rel decay, #cmpts
58 'K(1,1), K(1,2),.. K(1,NC%-1)   - K'S TO CMPT 1
60 'K(2,1), K(2,2),.. K(2,NC%-1)   - K'S TO CMPT 2
62 '    etc
64 'K(RLSE,1),K(RLSE,2),.. K(RLSE,NC%-1)  - RELEASE K'S from each cmpt
66 'S(1),S(2),.. S(NC%-1)          - Synthesis (pMoles/day) to each cmpt
68 'C(1),C(2),.. C(NC%-1)          - Conversion rate fctrs in each cmpt
70 'V(1),V(2),.. V(NC%-1)          - Volumes of each cmpt
72 'T0,VF,DVF      - INITIAL AGE, INITIAL VOLUME FACTOR, GROWTH RATE (DVF/DAY)
74 'A0             - Initial conc of precursor per granule
75 'RN%            - Randomizer seed
76 'TH, TH0, NT%   - Age histogram span, origin (if log histo) & # bins
77 'NA%            - B/A0 histogram # bins
78 'Date$,Run$,NI%,NH%  -Date (or "END"),Run ID, # tincs/day, #granules
80 'CP%(H%);T(H%); IF NA%>0 then also CF(H%);A(H%)
87 '
90 'GRANULES.INI file format:
92 'Output drive, default PFILE$, time unit, plural of time unit
94 'Concentration units (e.g. pMoles), Max NT%, Max NA%
96 '
98 'MODEL OVERVIEW:      (see GRANULES.DOC for details) 
100' MODEL FOR DEGRADATION STORAGE AND RELEASE OF NEUROSECRETORY GRANULES
105 'GRANULES ARE SYNTHESIZED AT A SPECIFIED RATE, S, AND
110 'CONTAIN PURE 'PRECURSOR'.  NEW GRANULES ARE PLACED IN
120 'DIFFERENT 'DIFFUSIONAL COMPARTMENTS', CP%(H%), ACCORDING TO
130 'THE WEIGHTINGS, S(I%). (TYPICALLY S(1)=1 AND S(I%<>1)=0: ALL SYNTHESIS
140 'GOES INTO COMPARTMENT 1). GRANULES IN THE NTH COMPARTMENT ARE 
150 'CONSIDERED 'RELEASED'(NOTE THAT K(I%,N) MUST=0).
160 ''DIFFUSION' CAN OCCUR BETWEEN ANY COMPARTMENT, AS DETERMINED BY
170 'K(I%,J%), THE RATE CONSTANT FOR MOVEMENT INTO I FROM J.
180 'V(I%)*VF, COMPARTMENT VOLUME, GIVES CONCENTRATION BY DIVIDING K(I%,J%)
190 'VOLUME GROWS LINEARLY WITH AGE, FROM 1 AT "AGE0" WITH SLOPE "DVF" PER DAY
200 'GRANULE CONTENT DEGRADES OVER TIME, PRECURSOR A BEING CONVERTED
210 'TO PRODUCT B WITH A RATE CONSTANT CF(H%) FOR THE HTH GRANULE, A CONSTANT
220 'DETERMINED AT THE TIME OF SYNTHESIS (=C(I%) for cmpt I%).
230 'ENZYMATIC CONVERSION RATE IS IN TURN INACTIVATED WITH RATE CONSTANT KE
240 'A(H%)=AMOUNT OF PRECURSOR IN GRANULE H% (allocated only if AH%>0)
250 'CF(H%)=CONVERSION RATE OF A TO B FOR GRANULE H% (allocated only if AH%>0)
260 'T(H%)=TIME OF SYNTHESIS OF GRANULE H%
270 'NH%=# OF GRANULES
280 'NC%=# OF COMPARTMENTS
289 '                       *******************
290 '************************ INITIALIZATIONS ****************************
291 '                       *******************
299 '+++++++++++++++++++++++ SPECIAL CONSTANTS ++++++++++++++++++++++++++++++
300 FORM$="GRANULESQ3N"                'Format code for .PRM and .SAV files +
310 INPUT "MAX NBR OF GRANULES (default=6300)";SZ%: IF SZ%=0 THEN SZ%=6300 '+
315 PRM%=1                             'logical unit, parameter file        +
320 OPEN "I",#1,"GRANULES.INI"         'Defaults file:                      +
325 INPUT #1, ODSK$,PDFLT$,TI$,TIS$,CONC$ 'output dsk, dflt PFILE$,time unit+  
330 CLOSE                              '...plural of t.u,  conc units       +
335 PRINT "OUTPUT DATA DISK=";ODSK$                                        '+
340 IF ODSK$="." THEN ODSK$=""                                             '+
345 IF SZ%>6300 THEN CP%=4 ELSE CP%=11 'Max # compartments is buffer-limited+
349 '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
350 DIM CP%(SZ%),T(SZ%): IF SZ%<=6300 THEN DIM A(SZ%),CF(SZ%)
355 DIM K(CP%,CP%),M(CP%,CP%),TT(CP%),N%(CP%),AA(CP%)
360 AH=1  'B/A0 histo span fixed at 1.0; NA%=# of B/A0 histo bins
365 INPUT "OUTPUT MODE: 0=SCREEN, 1=PRINTER, 2=DISK";PF%
370 IF PF%>0 THEN INPUT "DATE";DA$: INPUT "RUN #";RU$: LPRINT ID$; ":  RUN ";RU$;" OF ";DA$
375 INPUT "PARAMETER SOURCE (DIR\NAME.EXT)";PFILE$
377 IF PFILE$="" THEN PFILE$=PDFLT$
380 IF PF%>1 THEN LPRINT "Parameter file = ";PFILE$
385 GOSUB 5000                    'Parameter read-in, printout, and inits
390 DIM TH%(5,NT%+1): IF NA%>0 THEN DIM AH%(5,NA%+1)
395 IF PF%<=1 THEN GOTO 1000
397 '
398 '************  Set-up output file structures ************
399 '
400 INPUT "OUTPUT FILE NAME (6 characters; no .EXT)";NA$: NA$=LEFT$(NA$,6)
405 IF CSF%=0 THEN OPEN ODSK$+NA$+"CS.PRN" FOR OUTPUT AS #2 'Compartment Stats
410 IF NT%>0 THEN OPEN ODSK$+NA$+"AT.PRN" FOR OUTPUT AS #3 'Age-Total termnal
415 IF NT%>0 THEN OPEN ODSK$+NA$+"AR.PRN" FOR OUTPUT AS NC%+3
420 IF NA%>0 THEN OPEN ODSK$+NA$+"BT.PRN" FOR OUTPUT AS #(4+NC%) 'B/A0-Total
425 IF NA%>0 THEN OPEN ODSK$+NA$+"BR.PRN" FOR OUTPUT AS #(4+2*NC%) 'B/A0-Rlse
430 FOR I%=1 TO NC%-1                       'Age-Cmpt# and B/A0-Cmpt# files
435  IF NT%>0 THEN OPEN ODSK$+NA$+"A"+RIGHT$(STR$(I%),1)+".PRN" FOR OUTPUT AS #(3+I%)
440  IF NA%>0 THEN OPEN ODSK$+NA$+"B"+RIGHT$(STR$(I%),1)+".PRN" FOR OUTPUT AS #(4+NC%+I%)
445  NEXT I%
450 LPRINT "OUTPUT FILES NAMED ";NA$+"xy.PRN where xy="
455 LPRINT "   CS= Compartment stats"
460 LPRINT "   AT= Age histo, total terminal   A#= Age histo, Cmpt#   AR= Age histo, Rlse"
465 LPRINT "   BT= B/A0 histo, total termnl    B#= B/A0 histo, Cmpt#  BR= B/A0 histo, Rlse"
492 '
493 '************ Send Lotus-compatible labels to .PRN files **************
494 '
495 'Age histogram file format:
496 'AGE-HISTO:_[TOTAL/ #1/ #2 .../RLSE]  NT%  SPAN[TH] ORIGIN[TH0]
497 'DAY 1Binwidth 2Bw 3Bw ... OVERFLOW
498 '
500 CH%=3: LBL$="AGE-HISTO:_TOTAL": NBR%=NT%: NBR=TH: NBR2=TH0: IF TH0<>0 THEN LBL$="LOG-AGE-HISTO:_TOTAL"
510 GOSUB 900: GOSUB 550                         'Age-Total label; bin labels
515 CH%=3+NC%: LBL$="AGE-HISTO:_RLSE": IF TH0<>0 THEN LBL$="LOG-AGE-HISTO:_RLSE"
520 GOSUB 900: GOSUB 550                         'Age-Rlse label; bins
525 FOR I%=1 TO NC%-1
530  CH%=3+I%: LBL$="AGE-HISTO:_CMPT"+STR$(I%): IF TH0<>0 THEN LBL$="LOG-AGE-HISTO:_CMPT"+STR$(I%)
535  GOSUB 900: GOSUB 550                        'Age-Cmpt# label; bin labels
540  NEXT I%
545 GOTO 700
550 LBL$=TI$: GOSUB 920                          'Age histo bin label subrtn
555 FOR L%=0 TO NT%
560  J%=L%*NBR
565  PRINT #CH%,J%;
570  NEXT L%
575 LBL$="OVERFLOW": GOSUB 910
580 RETURN
694 '
695 'B/(A0*N) histogram file format:
696 'B/(A0*N)-HISTO:_[TOTAL/ #1/ #2 .../RLSE]  NA%
697 'DAY 1Binwidth 2Bw 3Bw ... OVERFLOW
698 '
700 IF NA%=0 THEN GOTO 1000
705 CH%=4+NC%: LBL$="B/A0-HISTO:_TOTAL": NBR%=NA%: NBR=1: NBR2=0
710 GOSUB 900: GOSUB 750                         'B/A0-Total header; bin labels
715 CH%=4+2*NC%: LBL$="B/A0-HISTO:_RLSE"
720 GOSUB 900: GOSUB 750                         'B/A0-Rlse header; bin labels
725 FOR I%=1 TO NC%-1
730  CH%=4+NC%+I%: LBL$="B/A0-HISTO:_CMPT"
735  GOSUB 900: GOSUB 750                        'B/A0-Cmpt header; bin labels
740  NEXT I%
745 GOTO 800
750 LBL$=TI$:GOSUB 920                           'Non-integer histo labels
755 FOR L%=0 TO NA%
760  J=L%/NA%
765  PRINT #CH%, USING ".#### ";J;
770  NEXT L%
775 LBL$="OVERFLOW": GOSUB 910
780 RETURN
795 '
796 'Stats file labels:
797 '
798 'DAY #TOTAL MEAN-AGE B/(A0*N) #1 MEAN-AGE B/(A0*N)...#RLSE MEAN-AGE B/(A0*N)
799 '
800 CH%=2: A$="MEAN-AGE": B$="B/(A0*N)"
810 LBL$=TI$:GOSUB 920: LBL$="#TOTAL":GOSUB 920: LBL$=A$:GOSUB 920: LBL$=B$:GOSUB 920
820 FOR I%=1 TO NC%-1: LBL$="#"+RIGHT$(STR$(I%),1):GOSUB 920: LBL$=A$:GOSUB 920: LBL$=B$:GOSUB 920: NEXT I%
830 LBL$="#RLSE":GOSUB 920: LBL$=A$:GOSUB 920: LBL$=B$:GOSUB 910
840 GOTO 1000
899 '********* FILE OUTPUT ON CHANNEL CH% OF LABEL LBL$ AND (900 ONLY) NBR ****
900 PRINT #CH%,CHR$(34);LBL$;CHR$(34);" ";NBR%;NBR;NBR2:RETURN 'Label, 3 numbers, then 
910 PRINT #CH%,CHR$(34);LBL$;CHR$(34): RETURN         'Label only, then 
920 PRINT #CH%,CHR$(34);LBL$;CHR$(34);" ";: RETURN    'Label only, no 
995 '
996 '                       *************
997 '************************ MAIN MENU **********************************
998 '                       *************
999 '
1000 SCREEN 0: CLS: CLOSE #1
1020 PRINT "MAIN MENU: 0=EXIT TO BASIC       1=GO (NEW TREATMENT)  2=CONT (OLD TREATMENT)"
1022 PRINT "           3=PRELOAD FROM DISK   4=SAVE STATE ON DISK  5=COMPARTMENT STATS"
1025 PRINT "           6=AGE-HISTOGRAM       7=B/A0 HISTOGRAM      8=GRANULE ENUMERATION "
1030 PRINT "           9=SET OPTION FLAGS   10=(unassigned)       11=RESEED RANDOMIZER"
1035 PRINT "          12=CHANGE PARAMETERS"
1065 INPUT MM%
1070 IF MM%=0 THEN CLOSE: END
1075 CLS
1080 ON MM% GOSUB 1100,1200,1300,1400,1500,1600,1700,1800,1900,2000,2100,2200: GOTO 1000
1085 INPUT "ILLEGAL MENU SELECTION (0 - 11 valid); PRESS ANY KEY",A$: GOTO 1000
1097 '
1098 '********************* 1: GO (NEW TREATMENT) ****************************
1099 '
1100 RF=1: INPUT "RELEASE RATE FACTOR, RF";RF
1110 SF=1: INPUT "SYNTHESIS RATE FACTOR, SF";SF
1115 PRINT "# OF TIME INCREMENTS PER ";TI$;: INPUT NI%
1120 DT=1/NI%: IF PF%>0 THEN LPRINT "# INCS PER ";TI$;"=";NI%, "DT=";DT
1125 PRINT "TREATMENT DURATION (";TIS$;: INPUT ")";TD
1130 TN=T+TD
1135 IF PF%>0 THEN LPRINT "TREATMENT ";TIS$;TN-TD;"TO";TN;"A0=";A0;"RF=";RF;"SF=";SF
1140 SY=0
1145 FOR I%=1 TO NC%-1       'Calculate synthesis probability for each cmpt
1150  SY=SY+S(I%)*SF*DT/A0   'S(I%) in pMol per day, SY in granules per DT
1155  NEXT I%
1160 PRINT "SYNTHESIS=";SY/DT;"GRANULES PER ";TI$: IF PF%>0 THEN LPRINT "SYNTHESIS=";SY/DT;"GRANULES PER ";TI$
1170 GOSUB 3000                                  'to Main Model for 1 day
1175 IF CSF%=0 THEN GOSUB 1500                   'Compartment Stats output
1180 IF NT%>0 THEN GOSUB 1600                    'Age Histogram output
1185 IF NA%>0 THEN GOSUB 1700                    'B/(N*A0) Histogram output
1190 IF T0 THEN LPRINT "INITIAL GRANULE STATE FROM FILE ";PFILE$+".SAV"
1320 GOTO 5005                                   'Fetch parameter block
1397 '
1398 '********************* 4: SAVE STATE ON DISK ****************************
1399 '
1400 INPUT "FILE NAME (No ext.):";PSF$
1410 IF PF%>0 THEN LPRINT "GRANULE STATE SAVED AS FILE ";PSF$+".SAV"
1420 CLOSE #1: OPEN "O",#1,PSF$+".SAV"
1430 GOTO 6000                               'WRITE STATE TO DISK (RTN TO 1080)
1497 '
1498 '********************* 5: COMPARTMENT STATS OUTPUT **********************
1500 PRINT: PRINT TI$;T
1505 IF PF%>0 THEN LPRINT: LPRINT TI$;T
1515 PRINT "CMPT" TAB(10) "#GRANULES" TAB(21) "MEAN AGE" TAB(31) "B/(A0*N)"
1520 IF PF%>0 THEN  LPRINT "CMPT        #GRANULES   MEAN AGE    B/(A0*N)"
1540 GOSUB 4300: IF N%=0 THEN N%=1:RETURN        'Tally N, Age, and A
1545 PRINT "TOTAL" TAB(13) N% TAB(20) T-TT/N% TAB(30) 1-AA/N%/A0
1547 IF PF%>0 THEN LPRINT USING "TOTAL       #####       ";N%;: LPRINT USING "###.##      ";T-TT/N%;: LPRINT USING ".#### ";1-AA/N%/A0
1550 IF PF%>1 THEN PRINT#2,T; N%; T-TT/N%; 1-AA/N%/A0;
1555 FOR I%=1 TO NC%-1 'Output each cmpt: #granules, mean age, mean B/(A0*N)
1560  PRINT I% TAB(13) N%(I%);: IF N%(I%)<> 0 THEN PRINT TAB(20) T-TT(I%)/N%(I%) TAB(30) 1-AA(I%)/A0/N%(I%) ELSE PRINT
1565  IF PF%>0 THEN LPRINT USING "#####       ";I%,N%(I%);: IF N%(I%)<>0 THEN LPRINT USING "###.##      ";T-TT(I%)/N%(I%);: LPRINT USING ".#### ";1-AA(I%)/N%(I%)/A0 ELSE LPRINT
1570  IF PF%>1 THEN PRINT#2,N%(I%);: IF N%(I%)<> 0 THEN PRINT#2,T-TT(I%)/N%(I%); 1-AA(I%)/A0/N%(I%); ELSE PRINT#2,0;0
1575 NEXT I%
1580 PRINT "RLSE" TAB(13) N%(NC%);: IF N%(NC%)<>0 THEN PRINT TAB(20) TT(NC%)/N%(NC%) TAB(30) 1-AA(NC%)/A0/N%(NC%)
1585 IF PF%>0 THEN LPRINT USING "RLSE        #####       ";N%(NC%);: IF N%(NC%)<>0 THEN LPRINT USING "###.##      ";TT(NC%)/N%(NC%);: LPRINT USING ".#### ";1-AA(NC%)/A0/N%(NC%): ELSE LPRINT
1590 IF PF%>1 THEN PRINT#2, N%(NC%);: IF N%(NC%)<>0 THEN PRINT#2,TT(NC%)/N%(NC%); 1-AA(NC%)/A0/N%(NC%) ELSE PRINT#2,0;0
1595 RETURN
1597 '
1598 '********************* 6: AGE-HISTOGRAM OUTPUT **************************
1599 '
1600 IF NT%>0 THEN GOSUB 4000 ELSE RETURN       'Age histo generation
1610 PRINT: PRINT TI$;" ";T;"AGES: ": IF PF%>0 THEN LPRINT: LPRINT TI$;" ";T;"AGES: "
1620 FOR I%=0 TO NC%                             'Output for all cmpts...
1630  IF I%=0 THEN PRINT "TOTAL: ";: IF PF%>0 THEN LPRINT "TOTAL: ";
1640  IF I%=NC% THEN PRINT "RLSE:  ";: IF PF%>0 THEN LPRINT "RLSE:  ";
1650  IF I%<>0 AND I%<>NC% THEN PRINT USING "    #  ";I%;: IF PF%>0 THEN LPRINT USING "    #  ";I%;
1655  IF PF%>1 THEN PRINT #(3+I%),T;
1660  FOR J%=0 TO NT%                            '...and all bins
1670   PRINT USING "###";TH%(I%,J%);: IF PF%>0 THEN LPRINT USING "###";TH%(I%,J%);: IF PF%>1 THEN PRINT #(3+I%),TH%(I%,J%);
1680   NEXT J%
1685  PRINT "" : IF PF%>0 THEN LPRINT: IF PF%>1 THEN PRINT #(3+I%),""  '
1690  NEXT I%
1695 RETURN
1697 '
1698 '********************** 7: B/A0 HISTOGRAM OUTPUT ************************
1699 '
1700 IF NA%>0 THEN GOSUB 4100 ELSE RETURN       'GENERATE B/A0 HISTO
1710 PRINT: PRINT TI$;" ";T;"B/A0: ": IF PF%>0 THEN LPRINT: LPRINT TI$;" ";T;"B/A0: "
1720 FOR I%=0 TO NC%                             'Output for all cmpts...
1730  IF I%=0 THEN PRINT "TOTAL: ";: IF PF%>0 THEN LPRINT "TOTAL: ";
1740  IF I%=NC% THEN PRINT "RLSE:  ";: IF PF%>0 THEN LPRINT "RLSE:  ";
1750  IF I%<>0 AND I%<>NC% THEN PRINT USING "    #  ";I%;: IF PF%>0 THEN LPRINT USING "    #  ";I%;
1755  IF PF%>1 THEN PRINT#(4+NC%+I%),T;
1760  FOR J%=0 TO NA%                            '...and all bins
1770   PRINT USING "###";AH%(I%,J%);: IF PF%>0 THEN LPRINT USING "###";AH%(I%,J%);: IF PF%>1 THEN PRINT #(4+NC%+I%),AH%(I%,J%);
1780   NEXT J%
1785  PRINT "" : IF PF%>0 THEN LPRINT: IF PF%>1 THEN PRINT#(4+NC%+I%),""  '
1790  NEXT I%
1795 RETURN
1797 '
1798 '********************** 8: GRANULE ENUMERATION **************************
1799 '
1800 FOR H%=1 TO NH%
1810 LPRINT "H%=";H% TAB(10) "CP%=";CP%(H%) TAB(20) "A=";A(H%)/A0;
1820 IF CP%(H%)<>NC% THEN LPRINT TAB(35) "AGE=";T-T(H%) ELSE LPRINT TAB(35) "RELEASED";T(H%);"DAYS OLD"
1830 NEXT H%
1840 RETURN
1897 '
1898 '********************** 9: FLAG OPTIONS *********************************
1899 '
1900 PRINT "SET DF%=1 TO LPRINT GRANULE MOVEMENTS"
1910 PRINT "    GF%=1 TO LPRINT CMPT ID, CP%"
1920 PRINT "    CSF%=1 TO SUPRESS COMPARTMENT STAT OUTPUT"
1930 INPUT "input DF%,GF%,CSF%";DF%,GF%,CSF%
1950 RETURN
1997 '
1998 '********************** 10: OUTPUT MODE SELECT **************************
1999 '
2000 PRINT "INVALID SUBROUTINE CALL TO 2000": RETURN
2097 '
2098 '********************** 11: SEED RANDOMIZER ***********
2099 '
2100 INPUT "RANDOMIZER SEED:";RN%: RANDOMIZE RN%: IF PF%>0 THEN LPRINT "RANDOMIZER SEED=";RN%: RETURN ELSE RETURN
2110 RETURN
2197 '
2198 '********************** 12: EDIT PARAMETERS *****************************
2199 '
2200 CLS
2205 LOCATE 1,1
2210 PRINT "CHANGE PARAMETERS: "
2220 PRINT "  T0=INITIAL AGE      VF=VOLUME FACTOR    DVF=CHANGE IN VF PER DAY"
2225 PRINT "  TH=AGE HISTO SPAN   NT=# OF AGE BINS    NA=# OF B/A0 HISTO BINS"
2230 PRINT "  ID=RUN ID           DA=DATE             RU=RUN NUMBER"
2235 PRINT "                      KE=ENZYME DECAY     KREL=RELEASE RATE DECAY"
2240 PRINT "  CF=CNVRSN RATE FCTR KF=DIFFUSION FCTR   C=CMPT CONVERSION RATE"
2245 PRINT "                      K=CMPT DIFF'N RATE  VFLG%=VOL-DEPENDENT-K FLG"
2250 PRINT "  END=END OF CHANGES"
2260 PRINT "                                         ";: LOCATE ,1: INPUT "YOUR CHOICE (Name, New value)";MN$,VL$: IF MN$="END" THEN RETURN
2270 IF MN$="T0" THEN VL=T0: T0=VAL(VL$): T=T0
2271 IF MN$="VF" THEN VL=VF: VF=VAL(VL$): IF PF%>0 THEN LPRINT "VF=";VF
2272 IF MN$="DVF" THEN VL=DVF: DVF=VAL(VL$): IF PF%>0 THEN LPRINT "DVF=";DVF
2273 IF MN$="TH" THEN VL=TH: TH=VAL(VL$): IF PF%>0 THEN LPRINT "TH=";TH
2274 IF MN$="NT" THEN VL=NT%: NT%=VAL(VL$): IF PF%>0 THEN LPRINT "NT%=";NT%
2275 IF MN$="NA" THEN VL=NA%: NA%=VAL(VL$): IF PF%>0 THEN LPRINT "NA%=";NA%
2280 IF MN$="ID" THEN VL=0: RU$=VL$: IF PF%>0 THEN LPRINT "RUN=";RU$
2281 IF MN$="DA" THEN VL=0: DA$=VL$: IF PF%>0 THEN LPRINT "DATE=";DA$
2283 IF MN$="KE" THEN VL=KE: KE=VAL(VL$): IF PF%>0 THEN LPRINT "KE=";KE
2285 IF MN$="KREL" THEN VL=KREL: KREL=VAL(VL$): IF PF%>0 THEN LPRINT "KREL=";KREL
2286 IF MN$="CF" THEN VL=CF: CF=VAL(VL$): IF PF%>0 THEN LPRINT "CF=";CF
2287 IF MN$="KF" THEN VL=KF: KF=VAL(VL$): IF PF%>0 THEN LPRINT "KF=";KF
2288 IF MN$="C" THEN INPUT "COMPARTMENT";I%: VL=C(I%): C(I%)=VAL(VL$): IF PF%>0 THEN LPRINT "C(";I%;")=";C(I%)
2292 IF MN$="K" THEN INPUT "DESTINATION, SOURCE CMPTS";I%,J%: VL=K(I%,J%): K(I%,J%)=VAL(VL$): IF PF%>0 THEN LPRINT "K(";I%;J%;")=";K(I%,J%)
2293 IF MN$="VFLG%" THEN VL=VFLG%: VFLG%=VAL(VL$): IF PF%>0 THEN LPRINT "VFLG%=";VFLG%
2295 PRINT "PREVIOUS VALUE=";VL: GOTO  2205
2992 '
2993 '               *********************************************
2994 '**************** MAIN MODEL SUBROUTINE: ONE DAY'S KINETICS ************
2995 '               *********************************************
2996 '
3000 ZC%=0               'Count of empty granules
3005 FOR H%=1 TO NH%     'SEND GRANULES RELEASED IN PREVIOUS DAY TO FREE POOL
3010  I%=CP%(H%): IF I%=0 THEN ZC%=ZC%+1
3015  IF I%=NC% THEN CP%(H%)=0
3020  NEXT H%
3030 IF ZC%<50 THEN GOTO 3100         'Limit truly unused granules to 50
3040 H%=0
3045 FOR J%=1 TO ZC%                  'Remove ZC% empties
3050  H%=H%+1
3055  IF CP%(H%)<>0 THEN GOTO 3050    '(Note BASIC bug requires wierd 3060)
3060  I%=CP%(NH%): CP%(H%)=I%: I=T(NH%): T(H%)=I: CP%(NH%)=0: NH%=NH%-1: LOCATE ,1: PRINT "POOL SIZE=";NH%;: IF NA%<>0 THEN I=A(NH%+1): A(H%)=I: I=CF(NH%+1): CF(H%)=I
3065  NEXT J%
3100 FOR T%=1 TO NI%                  'Loop NI% DT's per day, then plot & store
3200  H%=1: LOCATE ,20: PRINT "T%=";T%;"  ";
3210  FOR I%=1 TO NC%-1               'Synthesize new granules in ea. cmpt.
3220   IF S(I%)=0 GOTO 3470
3230   MS(I%)=MS(I%)+S(I%)*SF*VF*DT/A0            '#Synthesized into cmpt I%
3240   M%=FIX(MS(I%))                 'Integerize # synth & save remainder
3250   MS(I%)=MS(I%)-M%
3260   IF DF%<>0 THEN LPRINT "T=";T;"SYNTHESIS TO CMPT";I%;"=";M%;"+";MS(I%)
3270   FOR L%=1 TO M%
3280    IF CP%(H%)=0 THEN GOTO 3320
3290    H%=H%+1             'TRY NEXT GRANULE; IF NEEDED, EXPAND POOL
3300    IF H%>NH% THEN NH%=NH%+1: CP%(NH%)=0: LOCATE ,1: PRINT "POOL SIZE=";NH%;: GOTO 3300
3310    GOTO 3280
3320    CP%(H%)=I%           'New granules immed rlsable but not in prev N% sum
3430    IF NA%>0 THEN CF(H%)=CF*C(I%) 'Fix cnvrsn rate acc to cmpt of origin
3440    IF NA%>0 THEN A(H%)=A0        'Fix original conc of precursor
3450    T(H%)=T+(T%-1)*DT    'Record synthesis-time of granule
3460    NEXT L%              'Next granule
3470   NEXT I%               'Next compartment
3480   FOR H%=1 TO NH%                           'For each granule...
3490   IF CP%(H%)=0 GOTO 3520                    '(skip unassigned granules)
3500   IF NA%>0 THEN A(H%)=A(H%)-CF(H%)*A(H%)*DT'...degrade contents (A-->B)
3510   IF NA%>0 THEN CF(H%)=CF(H%)-KE*CF(H%)*DT '...and inactivate enzyme
3520   NEXT H%
3530               'CALCULATE # OF GRANULES THAT WILL MOVE AND MOVE ONLY THOSE
3540  FOR I%=1 TO NC%                            'For all destination cmpts...
3550   FOR J%=1 TO NC%-1                         '...from all source cmpts (J%)
3560    IF J%=I% GOTO 3670                       '(skip src = dst)
3570    IF I%<>NC% THEN K=K(I%,J%)*KF/V(J%)/QRVF ELSE K=K(NC%,J%)*RF/V(J%)/QRVF 'SCALE K'S BY KF/CUBE-ROOT-VOL; RLSE BY R/CUBE-ROOT-VOL
3580    M(I%,J%)=M(I%,J%)+N%(J%)*K*DT            '# moving from J to I
3590    M%=FIX(M(I%,J%))                         'Integrze # moving; 
3595    M(I%,J%)=M(I%,J%)-M%                     'Save remainder
3600    IF M%=0 GOTO 3670
3610    IF DF%<>0 THEN IF I%<>NC% THEN LPRINT "# MOVING TO";I%;" FROM";J%;"=";M%;"+";M(I%,J%) ELSE LPRINT "# RELEASED FROM ---";J%;"=";M%;"+";M(I%,J%)
3620    FOR L%=1 TO M%
3630     H%=1+FIX(NH%*RND)                        'Select granules at random
3640     IF CP%(H%)<>J% GOTO 3630                 'If wrong cmpt, try again
3645     IF I%=NC% AND EXP(KREL*(T(H%)-T-T%/NI%))0 THEN CF(H%)=0 'T(H%)=RLSE AGE
3720   IF I%>NC% THEN CP%(H%)=I%-NC%: I%=I%-NC%  'Remove tags
3730   N%(I%)=N%(I%)+1                           'Tally # granules by cmpt
3740   IF GF%=1 THEN LPRINT USING "#";CP%(H%);   'Granule flag=>cmpt ID print
3750   NEXT H%: IF GF%>0 THEN LPRINT             'Next granule
3760  NEXT T%                                    'Loop until whole-day boundary
3765 T=T+1: VF=VF+DVF: QRVF=VF^.33333            'Growth of cmpt vol factor
3770 IF VFLG%>0 THEN QRVF=1                      'VFLG%=1: no chng in K w/ vol
3790 RETURN
3791 'end of main loop
3982 '                      ***********************
3983 '*********************** SERVICE SUBROUTINES ****************************
3984 '                      ***********************
3985 '
3987 '*********************** ANIMATION SUBROUTINE ***************************
3988 '
3995 '
3996 '***************** HISTOGRAM GENERATION SUBROUTINES ******************
3997 '
3998 '***** AGE HISTOGRAM GENERATION SUBRTN *****
3999 '
4000 FOR I%=0 TO NC%                             'CLEAR AGE HISTO
4010 FOR J%=0 TO NT%: TH%(I%,J%)=0: NEXT J%,I%
4020 FOR H%=1 TO NH%
4030 IF CP%(H%)=0 GOTO 4070
4035 IF TH0=0 THEN GOTO 4040  'CHECK FOR LOG HISTOGRAM
4037 IF CP%(H%)<>NC% THEN J%=FIX((LOG(T-T(H%))-TH0)*NT%/TH) ELSE J%=FIX((LOG(T(H%))-TH0)*NT%/TH)
4038 GOTO 4050
4040 IF CP%(H%)<>NC% THEN J%=FIX((T-T(H%))*NT%/TH) ELSE J%=FIX(T(H%)*NT%/TH)   'CALCULATE BIN #
4050 IF J%>NT% THEN J%=NT%      'BIN NT% IS OVERFLOW
4055 IF J%<0 THEN J%=0
4060 TH%(CP%(H%),J%)=TH%(CP%(H%),J%)+1: IF CP%(H%)<>NC% THEN TH%(0,J%)=TH%(0,J%)+1
4070 NEXT H%   '+1 TO CMPT BIN, AND ALSO TOTAL-TERMINAL BIN IF CMPT <> RELEASE
4080 RETURN
4097 '
4098 '***** B/A0 HISTOGRAM GENERATION SUBRTN ****
4099 '
4100 FOR I%=0 TO NC%                             'CLEAR B/A0 HISTO
4110 FOR J%=0 TO NA%: AH%(I%,J%)=0: NEXT J%,I%
4120 FOR H%=1 TO NH%
4130 IF CP%(H%)=0 GOTO 4170
4140 J%=FIX((1-A(H%)/A0)*NA%/AH)'CALCULATE BIN #
4150 IF J%>NA% THEN J%=NA%                       'BIN NA% IS OVERFLOW
4160 AH%(CP%(H%),J%)=AH%(CP%(H%),J%)+1: IF CP%(H%)<>NC% THEN AH%(0,J%)=AH%(0,J%)+1
4170 NEXT H%   '+1 TO CMPT BIN, AND ALSO TOTAL-TERMINAL BIN IF CMPT <> RELEASE
4180 RETURN
4297 '
4298 '*****************COMPARTMENT-TALLY SUBROUTINE********************
4299 '
4300 N%=0: TT=0: AA=0
4305 FOR I%=1 TO NC%: N%(I%)=0: TT(I%)=0: AA(I%)=0: NEXT I%
4310 FOR H%=1 TO NH%: I%=CP%(H%): IF I%=0 GOTO 4350
4320 N%(I%)=N%(I%)+1
4330 TT(I%)=TT(I%)+T(H%)
4340 IF NA%>0 THEN AA(I%)=AA(I%)+A(H%)
4350 NEXT H%
4360 FOR I%=1 TO NC%-1                           'TOTALS FOR TERMINAL
4370 N%=N%+N%(I%): TT=TT+TT(I%): IF NA%>0 THEN AA=AA+AA(I%)
4380 NEXT I%
4390 RETURN
4997 '
4998 '***************** PARAMETER FILE INPUT SUBROUTINE *******************
4999 '
5000 OPEN "I",#PRM%,PFILE$
5005 INPUT #PRM%,PID$,FMT$,KE,CF,KF,KREL,NC%
5010 IF FMT$<>FORM$ THEN INPUT "FILE FORMAT INCOMPATIBILITY (Press any key)",A$:CLOSE #PRM%:RETURN
5012 NC%=NC%+1                                  'ADD RELEASE CMPT TO NC%
5015 PRINT "FILE ID=";PID$: IF PF%>0 THEN LPRINT PID$
5020 PRINT "INACTIVATION RATE CONSTANT FOR CONVERSION ENZYME, KE";KE: IF PF%>0 THEN LPRINT "INACTIVATION RATE CONSTANT FOR CONVERSION ENZYME (KE): ";KE
5025 PRINT "CONVERSION RATE FACTOR, CF";CF: IF PF%>0 THEN LPRINT "CONVERSION RATE FACTOR (CF): ";CF
5030 PRINT "DIFFUSION RATE FACTOR (KF): ";KF: IF PF%>0 THEN LPRINT "DIFFUSION RATE FACTOR (KF): ";KF
5035 PRINT "RELEASE-RATE DECAY RATE (KREL): ";KREL: IF PF%>0 THEN LPRINT "RELEASE-RATE DECAY (KREL): ";KREL
5040 PRINT "K(TO,FROM)'S FOR ";NC%-1;"COMPARTMENTS:": IF PF%>0 THEN LPRINT "K(TO,FROM)'S FOR ";NC%-1;"COMPARTMENTS:"
5045 FOR I%=1 TO NC%-1                          'READ IN K(I,J)'S
5050  FOR J%=1 TO NC%-1 
5055   INPUT #PRM%,K(I%,J%)
5060   PRINT K(I%,J%);: IF PF%>0 THEN LPRINT K(I%,J%);
5065   NEXT J%: PRINT: IF PF%>0 THEN  LPRINT
5070  NEXT I%
5075 PRINT "RELEASE RATES:   ";: IF PF%>0 THEN LPRINT "RELEASE RATES:   ";
5080 FOR I%=1 TO NC%-1                          'K(NC%,I%)=RELEASE K'S
5085  INPUT #PRM%,K(NC%,I%)
5090  PRINT K(NC%,I%);: IF PF%>0 THEN LPRINT K(NC%,I%);
5095  NEXT I%: PRINT: IF PF%>0 THEN LPRINT
5100 PRINT "SYNTHESIS RATES: ";: IF PF%>0 THEN LPRINT "SYNTHESIS RATES: ";
5110 FOR I%=1 TO NC%-1                          'S(I%)= CMPTL SYNTHESIS RATES
5120  INPUT #PRM%,S(I%)
5125  PRINT S(I%);: IF PF%>0 THEN LPRINT S(I%);
5130  NEXT I%: PRINT: IF PF%>0 THEN LPRINT
5140 PRINT "CONVERSION RATES:";: IF PF%>0 THEN LPRINT "CONVERSION RATES: ";
5145 FOR I%=1 TO NC%-1                          'C(I%)= CMPTL CONVERSION RATES
5150  INPUT #PRM%,C(I%)
5155  PRINT C(I%);: IF PF%>0 THEN LPRINT C(I%);
5160  NEXT I%: PRINT: IF PF%>0 THEN LPRINT
5170 PRINT "VOLUMES:        ";: IF PF%>0 THEN LPRINT "VOLUMES:      ";
5175 FOR I%=1 TO NC%-1                          'V(I%)= COMPARTMENT VOLUMES
5180  INPUT #PRM%,V(I%)
5185  PRINT V(I%);: IF PF%>0 THEN LPRINT V(I%);
5190  NEXT I%: PRINT: IF PF%>0 THEN LPRINT
5200 INPUT #PRM%,T0,VF,DVF,A0,RN%,TH,TH0,NT%,NA%
5210 PRINT "INITIAL AGE=";T0; "INITIAL VOL FACTOR=";VF; " GROWTH RATE=";DVF;"x  PER ";TI$
5215 PRINT "INITIAL CONC OF PRECURSOR PER GRANULE=";A0;" ";CONC$
5220 IF TH0=0 THEN TH$="AGE-HISTOGRAM SPAN & # BINS=" ELSE TH$="AGE-HISTOGRAM LOG-SPAN, # BINS, & ORIGIN="
5225 PRINT TH$;TH;",";NT%;: IF TH0<>0 THEN PRINT TH0 ELSE PRINT
5230 AH$="B/A0 HISTOGRAM # BINS=":PRINT AH$;: IF SZ%>6300 AND NA%>0 THEN NA%=0: PRINT " SUPPRESSED";
5235 PRINT ""
5240 IF PF%=0 THEN GOTO 5300
5345 LPRINT "INITIAL AGE=";T0;"VOLUME FACTOR=";VF;"GROWTH/";TI$;"=";DVF
5250 LPRINT "A0=";A0;" RANDOMIZER SEED=";RN%
5260 IF NT%>0 THEN LPRINT TH$;TH;",";NT%;" BIN-WIDTH=";TH/NT%;
5265 IF NT%>0 AND TH0<>0 THEN LPRINT " ORIGIN=" ELSE LPRINT
5270 IF NA%>0 THEN LPRINT AH$;NA%
5300 QRVF=VF^.33333: T=T0: IF VFLG%>0 THEN QRVF=1
5310 RANDOMIZE RN%
5320 INPUT #PRM%,DA2$: IF DA2$="END" THEN GOTO 5390         'GRANULE STATE BLOCK
5330 INPUT #PRM%,RU2$,NI%,NH%
5340 PRINT "RUN ";RU2$;" OF ";DA2$: IF PF%>0 THEN LPRINT "STATE FROM ";DA2$;" RUN ";RU2$
5350 PRINT "#GRANULES=";NH%;: IF PF%>0 THEN LPRINT "# GRANULES=";NH%
5360 FOR H%=1 TO NH%
5370  INPUT #PRM%, CP%(H%),T(H%) : IF NA%>0 THEN INPUT #PRM%, CF(H%),A(H%)
5380  NEXT H%
5390 CLOSE #PRM%
5395 RETURN
5997 '
5998 '*******************SAVE MODEL STATE************************************
5999 '
6000 PRINT #PRM%,PID$;",";FORM$;",";KE;CF;KF;KREL;NC%-1      'PFILE DATA
6010 FOR I%=1 TO NC%
6015  FOR J%=1 TO NC%-1
6020  PRINT #PRM%,K(I%,J%);
6025  NEXT J%,I%: PRINT #PRM%,""
6030 FOR I%=1 TO NC%-1: PRINT #PRM%,S(I%);: NEXT I%: PRINT #PRM%,""
6035 FOR I%=1 TO NC%-1: PRINT #PRM%,C(I%);: NEXT I%: PRINT #PRM%,""
6040 FOR I%=1 TO NC%-1: PRINT #PRM%,V(I%);: NEXT I%: PRINT #PRM%,""
6045 PRINT #PRM%,T;VF;DVF;A0;RN%;TH;TH0;NT%;NA%         'TIME, VOL FACTOR...
6047 PRINT #PRM%,DA$;",";RU$;",";NI%;NH%  'RUN IDENTIFIERS, #INCS, #GRNS
6050 FOR H%=1 TO NH%                             'WRITE GRANULE ARRAYS
6055  PRINT #PRM%,CP%(H%);T(H%);: IF NA%>0 THEN PRINT #PRM%,CF(H%);A(H%) ELSE PRINT #PRM%,""
6060  NEXT H%
6085 CLOSE #PRM%
6090 RETURN
6997 '
6998 '************* UTILITY TO EXAMINE STORED HISTOS *************************
6999 '
7000 INPUT "STORED HISTO FILE NAME";NA$: NA$=NA$+".PRN"
7005 OPEN "I",#1,NA$
7010 I%=1
7020 INPUT #1,A$
7030 PRINT I%;":";: IF PF%>0 THEN LPRINT I%;":";
7040 PRINT A$: IF PF%>0 THEN LPRINT A$
7060 I%=I%+1
7070 IF A$="" THEN CLOSE #1: GOTO 7000 ELSE GOTO 7020
9997 '
9998 '****************** Sample parameter file ***************
9999 '
10000 '"PARAMETERS FOR STANDARD NEURAL LOBE OF 10/22/86"
10005 '0.14, 1.0, 1.0, 0, 3    :'KE, CF, KF, KREL, NC%-1
10010 '0.0, 0.33,  0.0         :'K(1,1), K(1,2) -- K'S TO CMPT 1
10020 '0.33, 0.0, 0.33         :'K(2,1), K(2,2) -- K'S TO CMPT 2
10030 '0.0, 0.33, 0.0
10040 '0.33, 0.0, 0.0          :'K(RELEASE,1),K(RELEASE,2)
10050 '1,    0.0, 0.0          :'SYNTHESIS (PMOLES/DAY)
10060 '0.1,  0.1, 0.1          :'C(I%) -- CONVERSION RATE CONST
10070 '1,      1,   1          :'V(I%) -- VOLUMES

GRANULES.INI #####################################################################

"."
"GRANTST.PRM"
"DAY"
"DAYS"
"pMoles"

GRANTST.PRM ######################################################################

"PARAMETERS FOR TESTING vrs Q3N"
GRANULESQ3N
0.14, 1.0, 1.0, 0, 3
0.0,  1.0, 0.0
1.0,  0.0, 1.0
0.0,  1.0, 0.0
0.0,  0.0, 1.0
1.0,  0.0, 0.0
0.1,  0.1, 0.1
1,    1,   1     
0,1,0,.002,5,10,0,20,20
END

##################################################################################