Return to calling text
* Fx7dGDim21iEp.Ftn as modified by B. Tracy Nixon, 1/95
************* Original notes from Donald Senear **************************
*
* Dim in name => can fit data files w/ conc. in tot. monomer, and will
* calc. [dimer] from Kdssn. This fx does NOT have a % act. correction
* though, so must give tot. ACTIVE monomer.
* Kdssn is now Ans(8) (actually Ans(NDelG+1)), so endpts start at Ans(9).
* Changes needed: 1. Renumber endpt. Ans elements, in endpt. map section
* 2. Dimension Ans(NDelG+1) in Ginit
* 3. Add two lines in Ginit to define Kdssn=Ans(NDelg+1)
* and call Dimer
* 4. Append Function Dimer to code.
*****************************************************************************
*
C
C This is a Fittr suitable function for determining the interaction
C constants for lambda right operator regions from footprint titrations.
C THIS FUNCTION WILL PERFORM SIMILTANEOUS ANALYSIS OF ANY NUMBER OF DATA
C SETS OF ANY TYPE, AND WILL FIT ENDPTS. TO ANY 11 ISOTHERMS THE USER
C WISHES. THIS MUST BE RUN WITH THE LARGE FITTR VERSION, WHICH ALLOWS 50
C ANS ELEMENTS (USE MYLGFIT TO LINK). THIS FUNCTION FITS 7 dG VALUES. RT
C IS HARDWIRED WITH A DATA STATEMENT AT THE BEGINNING OF THE FUNCTION.
C
C To use this function for a particular problem, proceed as follows:
C 1) The sites can have any numbers as long as they are multiples of
C 1-3, according to whether the site is Or1, Or2 or Or3. The
C function subtracts 3 from the entered site number (X(2)) in an
C infininte do loop until it finds a value from 1 to 3.
C 2) Any site can be mapped to any pr. of fitted endpts. (Ans(i) &
C ANS(i+1), for i even and .ge. 6, .le. 26) by changing the
C values of Ipoint in a set of IF statements (marked below) which
C do the actual assigning of endpts.
C 3) The simplist thing to do is to reserve a set of site #'s, e.g.
C 1-3, 4-6, etc. for each seperate expt. Of course, if the expt.
C for which 4-6 is reserved is an Or2+ expt., then only 5 will be
C used, and 4 & 6 will not be. If there are 7 tot. expts., then
C 1-3, 4-6, ....19-21 will all be reserved. Then decide which of
C the 21 potential curves (note: in general will be less than 21
C unless all 7 expts. are Or+) you want to have fitted endpts.
C and map those to prs. of endpts by including the appropriate
C site #'s 1-21 in the IF statements
C
C In this program, the three site w.t. operator is allowed to exist
C in any of 8 configurations. For mutants, a subset of those 8 is
C considered by specifying a competency parameter (see below).
C
C The SPECIES matrix of the program indicates which delta
C G's are needed to describe the energetics of each species (i.e.
C which sites are filled, and which pairwise interactions occur).
C
C When used with Fittr, the ANS vector has 50 parameters and the X
C vector has 3. These are the 7 intrinsic dG's, and 10 pairs of endpts.
C in the case of ANS, and the free ligand concentration (dimers in the
C case of cI repressor protein) the site (1-n, where normally 1-3, 4-6
C etc. refer to sites 1-3 for the data from two seperate experiments)
C and the competency (mutant or wildtype) in the case of X.
C Note: the order of dG's is: dG1, dG2, dG3, dG12, dG13, dG23, dG123
C
C*********************************************************************
*
SUBROUTINE UNPAK(IFROM,IDEST,N)
C*********************************************************************
C
C SUBROUTINE WILL UNPACK THE CONTENTS OF INTEGER WORD IFROM
C INTO THE INTEGER ARRAY IDEST ON THE FOLLOWING BASIS:
C IF BIT (I) IS 0 THEN IDEST(I) WILL BE ZERO AND IF THE BIT
C IS 1 THEN THE WORD WILL BE SET TO 1
C
C THIS WILL BE CARRIED OUR FOR THE N LEAST SIGNIFICANT BITS OF THE
C WORD IFROM.
C
C*********************************************************************
INTEGER MASK(16),IDEST(N)
C Data Mask/'1'o,'2'o,'4'o,'10'o,'20'o,'40'o,'100'o,'200'o,'400'o,
C * '1000'o,'2000'o,'4000'o,'10000'o,'20000'o,'40000'o,
C * '100000'o/
C
***************** NOTE from B. Tracy Nixon **************************
C ABOVE IS TO ASSIGN MASK OCTAL NUMBERS REPRESENTING BINARY POWERS
C OF 2 FROM 0 TO 15 FOR BIT OPERATIONS THAT FOLLOW. APPARENTLY
C LAHEY FORTRAN F77L DOES NOT RECOGNIZE THE VAX FORTRAN 77 SYNTAX
C SO I REPLACED THE DATA ASSIGNMENT WITH THE following:
Data Mask /1,2,4,8,16,32,64,128,256,512,1024,2048,4096,
*8192,16384,32768/
DO 10 I=1,N
IBIT = 0
IRSLT = IAND(MASK(I),IFROM)
IF(IRSLT.NE.0) IBIT = 1
IDEST(I) = IBIT
10 CONTINUE
RETURN
END
C
C
C
C
FUNCTION FX(ANS,X,Y,IERR,N)
******************************************
* In the following line, the number 44 reflects the number of parameters needed for this anlaysis.
* If the model is modified to fit another situation, make sure this number agrees with the rest of the
* model. Also, make sure that the file funits.h has the appropriate values to accomodate the
* indicated number of parameters.
******************************************
REAL X(3),ANS(44),ETOGR(8)
*****************
* Make sure the number of columns and rows, number of available sites, number of occupancy
* states, and stoichiometries in the following model are reflected in the next line assignments
* ***************
INTEGER SPECIE(8,7),AVSITE(3),OCCUP(8),STOICH(8),SITE
DATA SPECIE /0,1,0,0,1,1,0,1,
1 0,0,1,0,1,0,1,1,
2 0,0,0,1,0,1,1,1,
3 0,0,0,0,1,0,0,0,
4 0,0,0,0,0,1,0,0,
5 0,0,0,0,0,0,1,0,
6 0,0,0,0,0,0,0,1/
DATA NDELG,NSITES,NSPECI/7,3,8/
DATA RTEMP/0.582/
DATA STOICH/0,1,1,1,2,2,2,3/
************
* Remove the "*" at the first of the next line to force dG13 to be set equal to dG12
************
* ANS(5)=ANS(4)
CALL CROCC(X(3),NSITES,AVSITE,SPECIE,NSPECI,NDELG,OCCUP)
CALL GINIT(ANS,SPECIE,NDELG,NSPECI,STOICH,RTEMP,X(1),ETOGR,
* Ierr,K,*30)
SITE = X(2) + 0.01
*****************
* Make sure the next routine accurately anticipates the numbering convention used in the
* data file for identifying the individual titrations.
*****************
* GET SITE 1-3 FROM X(2), WHICH CAN BE 1-3, 4-6, 7-9, ETC.
DO WHILE (.TRUE.)
IF (SITE.GE.4) THEN
SITE = SITE - 3
ELSE
GO TO 103
ENDIF
END DO
C103 LU=LOGLU(IDUM)
C WRITE(LU,10) X(3),AVSITE,OCCUP
C10 FORMAT(F5.0," IS SHORTHAND FOR ",3I1," INDICATING",
C *" AVAILABLE SITES(0=MUTANT,1=WILD).", 8I1," TELLS",
C *" WHICH ENERGETIC SPECIES MAY OCCUR.")
C WRITE(LU,20) X(1),(J,ETOGR(J),J=1,NSPECI)
C20 FORMAT("FOR PROTEIN CONCENTRATION =",2X,G10.4,2X/
C * "THE FOLLOWING IS A LIST OF STATISTICAL WEIGHTS FOR EACH
C * OF THE SPECIES:"/("ETOGR(",I3,")= ",E10.4))
103 FX=YBAR(SPECIE,NSPECI,NDELG,OCCUP,ETOGR,SITE)
******************
* NOTE: THIS SECTION ASSIGNS ENDPTS. MUST MAP ENDPTS TO SITES DEPENDING
* ON WHICH ONES YOU WANT TO FIT. TO DO THIS, SIMPLY CHANGE THE
* SITE #'S IN THE "IF(IPOINT.EQ.#) TO REFLECT THE #'S YOU ASSIGNED
* TO THE ISOTHERMS YOU WANT FITTED ENDPTS.
******************
IPOINT=X(2)+0.01
IF(IPOINT.EQ.1) FX = ANS(9) + (ANS(10)-ANS(9))*FX
IF(IPOINT.EQ.2) FX = ANS(11) + (ANS(12)-ANS(11))*FX
IF(IPOINT.EQ.4) FX = ANS(13) + (ANS(14)-ANS(13))*FX
IF(IPOINT.EQ.5) FX = ANS(15) + (ANS(16)-ANS(15))*FX
IF(IPOINT.EQ.7) FX = ANS(17) + (ANS(18)-ANS(17))*FX
IF(IPOINT.EQ.8) FX = ANS(19) + (ANS(20)-ANS(19))*FX
IF(IPOINT.EQ.10) FX = ANS(21) + (ANS(22)-ANS(21))*FX
IF(IPOINT.EQ.11) FX = ANS(23) + (ANS(24)-ANS(23))*FX
IF(IPOINT.EQ.13) FX = ANS(25) + (ANS(26)-ANS(25))*FX
IF(IPOINT.EQ.15) FX = ANS(27) + (ANS(28)-ANS(27))*FX
IF(IPOINT.EQ.16) FX = ANS(29) + (ANS(30)-ANS(29))*FX
IF(IPOINT.EQ.18) FX = ANS(31) + (ANS(32)-ANS(31))*FX
IF(IPOINT.EQ.19) FX = ANS(33) + (ANS(34)-ANS(33))*FX
IF(IPOINT.EQ.21) FX = ANS(35) + (ANS(36)-ANS(35))*FX
IF(IPOINT.EQ.22) FX = ANS(37) + (ANS(38)-ANS(37))*FX
IF(IPOINT.EQ.24) FX = ANS(39) + (ANS(40)-ANS(39))*FX
IF(IPOINT.EQ.26) FX = ANS(41) + (ANS(42)-ANS(41))*FX
IF(IPOINT.EQ.29) FX = ANS(43) + (ANS(44)-ANS(43))*FX
30 RETURN
END
C
C
C
C
C
SUBROUTINE CROCC(X,NSITES,AVSITE,SPECIE,NSPECI,NDELG,OCCUP)
INTEGER SPECIE(Nspeci,Ndelg),AVSITE(3),OCCUP(Nspeci)
IX = X + 0.01
CALL UNPAK(IX,AVSITE,NSITES)
DO 10 I=1,NSPECI
10 OCCUP(I)=1
DO 20 I=1,NSITES
20 IF(AVSITE(I).NE.1) CALL BMULT(OCCUP,SPECIE(1,I),NSPECI)
RETURN
END
SUBROUTINE BMULT(INOUT,FACTOR,N)
INTEGER INOUT(N),FACTOR(N)
DO 10 I=1,N
10 INOUT(I)=INOUT(I)*ICMPL(FACTOR(I))
RETURN
END
INTEGER FUNCTION ICMPL(I)
ICMPL=IABS(I-1)
RETURN
END
C
C
C
C
SUBROUTINE GINIT(ANS,SPECIE,NDELG,NSPECI,STOICH,RTEMP,RCONC,ETOGR,
* Ierr,K,*)
INTEGER SPECIE(NSPECI,NDELG) ,STOICH(NSPECI)
REAL RTEMP,ETOGR(NSPECI),ANS(NDELG+1),Kdssn
Kdssn = Ans(Ndelg+1)
RDim = DIMER(Rconc,KDssn) !Calc. dim conc. from tot. active monomer
RLNC=ALOG(RDim)
DO 10 I=1,NSPECI
POWER = CREXP(ANS,SPECIE,NSPECI,NDELG,RTEMP,I)
POWER = -POWER + STOICH(I)*RLNC
If (Abs(Power).gt.88) then
Ierr = 1
K = 1
Return K
Endif
10 ETOGR(I) = EXP(POWER)
RETURN
END
C
C
C
C
FUNCTION CREXP(ANS,SPECIE,NSPECI,NDELG,RTEMP,I)
REAL ANS(NDELG),RTEMP
INTEGER SPECIE(NSPECI,NDELG),I
POWER = 0
DO 20 J=1,NDELG
20 POWER = ANS(J)*SPECIE(I,J) + POWER
POWER = POWER/RTEMP
CREXP=POWER
RETURN
END
REAL FUNCTION YBAR(SPECIE,NSPECI,NDELG,OCCUP,ETOGR,SITE)
REAL ETOGR(NSPECI),NUMER
INTEGER SPECIE(NSPECI,NDELG),OCCUP(NSPECI),SITE
NUMER = 0
DO 10 I=1,NSPECI
10 NUMER=SPECIE(I,SITE)*OCCUP(I)*ETOGR(I) + NUMER
DENOM=0
DO 20 I=1,NSPECI
20 DENOM = OCCUP(I)*ETOGR(I) + DENOM
YBAR = NUMER/DENOM
RETURN
END
************************************************************************
REAL FUNCTION DIMER(CTOTAL,KDSSN)
* Calculates concentration of dimer species given total concentration
* in monomer units and a dissociation equilibrium constant
*
* If KDSSN = 0 then assume that the function is being used in
* a manner where free dimer concentration is being used and
* return DIMER = CTOTAL
REAL CTOTAL, KDSSN
IF (CTOTAL.LE.0.) CTOTAL = 1E-37
C CTOTAL = CMONOMER + 2*CDIMER
C KDSSN*CDIMER = CMONOMER**2
IF (KDSSN .LE. 0) THEN
DIMER = CTOTAL
RETURN
ENDIF
B24AC = SQRT(1 + 8*CTOTAL/KDSSN)
CMONO = (KDSSN/4)*(B24AC-1)
CDIMER = CMONO**2/KDSSN
DIMER = CDIMER
RETURN
END
C
************
* Required for interfacing with NONLIN, and is model dependent. Make sure
* that the number of parameters is correct, and that each one is listed below.
************
SUBROUTINE START(NAME,MAXP,MAXV)
CHARACTER*4 NAME(44),NAMES(44)
DATA NAMES /
&' dG1',' dG2',' dG3',
&'dG12','dG13','dG23','G123',
&'KDSN',
&'lo1 ','up1 ',
&'lo2 ','up2 ',
&'lo4 ','up4 ',
&'lo5 ','up5 ',
&'lo7 ','up7 ',
&'lo8 ','up8 ',
&'lo10','up10',
&'lo11','up11',
&'lo13','up13',
&'lo15','up15',
&'lo16','up16',
&'lo18','up18',
&'lo19','up19',
&'lo21','up21',
&'lo22','up22',
&'lo24','up24',
&'lo26','up26',
&'lo29','up29'/
MAXV=3
MAXP=44
DO 10 I=1,MAXP
10 NAME(I)=NAMES(I)
RETURN
END
Return to calling text