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
##################################################################################