!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!
      subroutine StomRegression(npoints,istommodel,pco2s,
     &    rehulfsurf,gammas,assim_net,gswmeas,
     &    stomintercept,stomslope,pvapordef_s,rayDzero)
      implicit none
c
C  ODRPACK ARGUMENT DEFINITIONS
C      ==> FCN      NAME OF THE USER SUPPLIED FUNCTION SUBROUTINE
C      ==> N        NUMBER OF OBSERVATIONS 
C      ==> M        COLUMNS OF DATA IN THE EXPLANATORY VARIABLE
C      ==> NP       NUMBER OF PARAMETERS
C      ==> NQ       NUMBER OF RESPONSES PER OBSERVATION
C     <==> BETA     FUNCTION PARAMETERS
C      ==> Y        RESPONSE VARIABLE
C      ==> LDY      LEADING DIMENSION OF ARRAY Y
C      ==> X        EXPLANATORY VARIABLE
C      ==> LDX      LEADING DIMENSION OF ARRAY X
C      ==> WE       "EPSILON" WEIGHTS
C      ==> LDWE     LEADING DIMENSION OF ARRAY WE
C      ==> LD2WE    SECOND DIMENSION OF ARRAY WE
C      ==> WD       "DELTA" WEIGHTS
C      ==> LDWD     LEADING DIMENSION OF ARRAY WD
C      ==> LD2WD    SECOND DIMENSION OF ARRAY WD
C      ==> IFIXB    INDICATORS FOR "FIXING" PARAMETERS (BETA)
C      ==> IFIXX    INDICATORS FOR "FIXING" EXPLANATORY VARIABLE (X)
C      ==> LDIFX    LEADING DIMENSION OF ARRAY IFIXX
C      ==> JOB      TASK TO BE PERFORMED 
C      ==> NDIGIT   GOOD DIGITS IN SUBROUTINE FUNCTION RESULTS
C      ==> TAUFAC   TRUST REGION INITIALIZATION FACTOR
C      ==> SSTOL    SUM OF SQUARES CONVERGENCE CRITERION
C      ==> PARTOL   PARAMETER CONVERGENCE CRITERION
C      ==> MAXIT    MAXIMUM NUMBER OF ITERATIONS
C      ==> IPRINT   PRINT CONTROL 
C      ==> LUNERR   LOGICAL UNIT FOR ERROR REPORTS 
C      ==> LUNRPT   LOGICAL UNIT FOR COMPUTATION REPORTS 
C      ==> STPB     STEP SIZES FOR FINITE DIFFERENCE DERIVATIVES WRT BETA
C      ==> STPD     STEP SIZES FOR FINITE DIFFERENCE DERIVATIVES WRT DELTA
C      ==> LDSTPD   LEADING DIMENSION OF ARRAY STPD
C      ==> SCLB     SCALE VALUES FOR PARAMETERS BETA
C      ==> SCLD     SCALE VALUES FOR ERRORS DELTA IN EXPLANATORY VARIABLE 
C      ==> LDSCLD   LEADING DIMENSION OF ARRAY SCLD
C     <==> WORK     DOUBLE PRECISION WORK VECTOR
C      ==> LWORK    DIMENSION OF VECTOR WORK
C     <==  IWORK    INTEGER WORK VECTOR
C      ==> LIWORK   DIMENSION OF VECTOR IWORK
C     <==  INFO     STOPPING CONDITION 
 
C  PARAMETERS SPECIFYING MAXIMUM PROBLEM SIZES HANDLED BY THIS DRIVER
C     MAXN          MAXIMUM NUMBER OF OBSERVATIONS 
C     MAXM          MAXIMUM NUMBER OF COLUMNS IN EXPLANATORY VARIABLE
C     MAXNP         MAXIMUM NUMBER OF FUNCTION PARAMETERS
C     MAXNQ         MAXIMUM NUMBER OF RESPONSES PER OBSERVATION

C  PARAMETER DECLARATIONS AND SPECIFICATIONS
      INTEGER    LDIFX,LDSCLD,LDSTPD,LDWD,LDWE,LDX,LDY,LD2WD,LD2WE,
     +           LIWORK,LWORK,MAXM,MAXN,MAXNP,MAXNQ
      PARAMETER (MAXM=25,MAXN=10000,MAXNP=30,MAXNQ=1,
     +           LDY=MAXN,LDX=MAXN,
     +           LDWE=1,LD2WE=1,LDWD=1,LD2WD=1,
     +           LDIFX=MAXN,LDSTPD=1,LDSCLD=1,
     +           LWORK=18 + 11*MAXNP + MAXNP**2 + MAXM + MAXM**2 + 
     +                 4*MAXN*MAXNQ + 6*MAXN*MAXM + 2*MAXN*MAXNQ*MAXNP +  
     +                 2*MAXN*MAXNQ*MAXM + MAXNQ**2 + 
     +                 5*MAXNQ + MAXNQ*(MAXNP+MAXM) + LDWE*LD2WE*MAXNQ,
     +           LIWORK=20+MAXNP+MAXNQ*(MAXNP+MAXM))
C  VARIABLE DECLARATIONS 
      INTEGER          I,INFO,IPRINT,J,JOB,L,LUNERR,LUNRPT,M,MAXIT,N,
     +                 NDIGIT,NP,NQ
      INTEGER          IFIXB(MAXNP),IFIXX(LDIFX,MAXM),IWORK(LIWORK)
      DOUBLE PRECISION PARTOL,SSTOL,TAUFAC
      DOUBLE PRECISION BETA(MAXNP),SCLB(MAXNP),SCLD(LDSCLD,MAXM),
     +                 STPB(MAXNP),STPD(LDSTPD,MAXM),
     +                 WD(LDWD,LD2WD,MAXM),WE(LDWE,LD2WE,MAXNQ),
     +                 WORK(LWORK),X(LDX,MAXM),Y(LDY,MAXNQ)
c
      integer npoints,istommodel,istommodel0,i1,i2,i3,i4,i5
      double precision pco2s(npoints),gswmeas(npoints),
     &    rehulfsurf(npoints),gammas(npoints),
     &    assim_net(npoints),pvapordef_s(npoints),stomintercept,
     &    stomslope,rayDzero
      common /stommodelindicator/istommodel0

      EXTERNAL         STOMFCN     
c
C  SPECIFY DEFAULT VALUES FOR DODRC ARGUMENTS
      WE(1,1,1)  = -1.0D0
      WD(1,1,1)  = -1.0D0
      IFIXB(1)   = -1
!      IFIXX(1,1) = -1
!      JOB        = 00023
      JOB=23
      NDIGIT     = -1
      TAUFAC     = -1.0D0
      SSTOL      = -1.0D0
      PARTOL     = -1.0D0
      MAXIT      = -1
!      IPRINT     = -1
      IPRINT=0
      LUNERR     = -1
      LUNRPT     = -1
      STPB(1)    = -1.0D0
      STPD(1,1)  = -1.0D0
      SCLB(1)    = -1.0D0
      SCLD(1,1)  = -1.0D0

      MAXIT      = 200000
C  SET UP ODRPACK REPORT FILES
      LUNERR  =   9
      LUNRPT  =   9     
c
      N=npoints
      istommodel0=istommodel
      BETA(1)=stomintercept
      BETA(2)=stomslope
      do I=1,N
        X(I,1)=assim_net(I)
        Y(I,1)=gswmeas(I)
      enddo
      
      if(istommodel0.eq.1)then
! Ball-Berry
        NP=2
        M=3
        do I=1,N
          X(I,2)=pco2s(I)
          X(I,3)=rehulfsurf(I)
        enddo
      endif
      
      if(istommodel0.eq.2)then
! Leuning with leaf surface co2      
        NP=3
        BETA(3)=rayDzero
        M=4
        do I=1,N
          X(I,2)=pco2s(I)
          X(I,3)=gammas(I)
          X(I,4)=pvapordef_s(I)
        enddo
      endif
      
      if(istommodel0.eq.3)then
! Belinda Medlyn model
        NP=2
        M=3
        do I=1,N
          X(I,2)=pco2s(I)
          X(I,3)=pvapordef_s(I)
        enddo
      endif  

      if(istommodel0.eq.4)then
! Dewar model
        NP=3
        BETA(3)=rayDzero
        M=3
        do I=1,N
          X(I,2)=pco2s(I)
          X(I,3)=pvapordef_s(I)
        enddo
      endif  

      NQ=1
      
C  READ PROBLEM DATA, AND SET NONDEFAULT VALUE FOR ARGUMENT IFIXX
      DO 10 I=1,N
         DO 15 J=1, M
           IFIXX(I,J) = 1
15       CONTINUE
10    CONTINUE
60        CALL DODRC(STOMFCN,
     +           N,M,NP,NQ,
     +           BETA,
     +           Y,LDY,X,LDX,
     +           WE,LDWE,LD2WE,WD,LDWD,LD2WD,
     +           IFIXB,IFIXX,LDIFX,
     +           JOB,NDIGIT,TAUFAC,
     +           SSTOL,PARTOL,MAXIT,
     +           IPRINT,LUNERR,LUNRPT,
     +           STPB,STPD,LDSTPD,
     +           SCLB,SCLD,LDSCLD,
     +           WORK,LWORK,IWORK,LIWORK,
     +           INFO)
        i1=mod(INFO,10)
        i2=(mod(INFO,100)-i1)/10
        i3=(mod(INFO,1000)-mod(INFO,100))/100
        i4=(mod(INFO,10000)-mod(INFO,1000))/1000
        i5=(INFO-mod(INFO,10000))/10000
      
      stomintercept=BETA(1)
      stomslope=BETA(2)
      if(istommodel0.eq.2.or.istommodel0.eq.4)RayDzero=BETA(3)
      return
      END
c
      SUBROUTINE STOMFCN(N,M,NP,NQ,
     +               LDN,LDM,LDNP,
     +               BETA,XPLUSD,
     +               IFIXB,IFIXX,LDIFX,
     +               IDEVAL,F,FJACB,FJACD,
     +               ISTOP)
      implicit none      
C  SUBROUTINE ARGUMENTS
C      ==> N        NUMBER OF OBSERVATIONS
C      ==> M        NUMBER OF COLUMNS IN EXPLANATORY VARIABLE
C      ==> NP       NUMBER OF PARAMETERS
C      ==> NQ       NUMBER OF RESPONSES PER OBSERVATION
C      ==> LDN      LEADING DIMENSION DECLARATOR EQUAL OR EXCEEDING N
C      ==> LDM      LEADING DIMENSION DECLARATOR EQUAL OR EXCEEDING M
C      ==> LDNP     LEADING DIMENSION DECLARATOR EQUAL OR EXCEEDING NP
C      ==> BETA     CURRENT VALUES OF PARAMETERS
C      ==> XPLUSD   CURRENT VALUE OF EXPLANATORY VARIABLE, I.E., X + DELTA
C      ==> IFIXB    INDICATORS FOR "FIXING" PARAMETERS (BETA)
C      ==> IFIXX    INDICATORS FOR "FIXING" EXPLANATORY VARIABLE (X)
C      ==> LDIFX    LEADING DIMENSION OF ARRAY IFIXX
C      ==> IDEVAL   INDICATOR FOR SELECTING COMPUTATION TO BE PERFORMED
C     <==  F        PREDICTED FUNCTION VALUES
C     <==  FJACB    JACOBIAN WITH RESPECT TO BETA
C     <==  FJACD    JACOBIAN WITH RESPECT TO ERRORS DELTA
C     <==  ISTOP    STOPPING CONDITION, WHERE
C                     0 MEANS CURRENT BETA AND X+DELTA WERE
C                       ACCEPTABLE AND VALUES WERE COMPUTED SUCCESSFULLY
C                     1 MEANS CURRENT BETA AND X+DELTA ARE
C                       NOT ACCEPTABLE;  ODRPACK SHOULD SELECT VALUES 
C                       CLOSER TO MOST RECENTLY USED VALUES IF POSSIBLE
C                    -1 MEANS CURRENT BETA AND X+DELTA ARE
C                       NOT ACCEPTABLE;  ODRPACK SHOULD STOP

C  INPUT ARGUMENTS, NOT TO BE CHANGED BY THIS ROUTINE:
      INTEGER          I,IDEVAL,ISTOP,L,LDIFX,LDM,LDN,LDNP,M,N,NP,NQ
      DOUBLE PRECISION BETA(NP+1),XPLUSD(LDN,M)
      INTEGER          IFIXB(NP+1),IFIXX(LDIFX,M)
C  OUTPUT ARGUMENTS:
      DOUBLE PRECISION F(LDN,NQ),FJACB(LDN,LDNP,NQ),FJACD(LDN,LDM,NQ)

      integer istommodel0
      common /stommodelindicator/istommodel0

      double precision pco2s,rehulfsurf,gammas,
     &   pvapordef_s,rayDzero,assim_net,stomintercept,
     &   stomslope,gswmod,derivb,derivslope,derivd0

C  CHECK FOR UNACCEPTABLE VALUES FOR THIS PROBLEM
c
      do I=1,NP
        if(BETA(I).lt.0.0d0)then
          ISTOP = 1
          RETURN
        endif
      enddo
!
      IF (MOD(IDEVAL,10).GE.1) THEN
        DO 110 L = 1,NQ
          DO 100 I = 1,N
            stomintercept=BETA(1)
            stomslope=BETA(2)
            assim_net=XPLUSD(I,1)
            if(istommodel0.eq.1)then
! Ball-Berry
              pco2s=XPLUSD(I,2)
              rehulfsurf=XPLUSD(I,3)
            endif
            if(istommodel0.eq.2)then
! Leuning with leaf surface co2      
              RayDzero=BETA(3)
              pco2s=XPLUSD(I,2)
              gammas=XPLUSD(I,3)
              pvapordef_s=XPLUSD(I,4)
            endif
            if(istommodel0.eq.3)then
! Belinda Medlyn with leaf surface co2
              pco2s=XPLUSD(I,2)
              pvapordef_s=XPLUSD(I,3)
            endif
            if(istommodel0.eq.4)then
! dewar with leaf surface co2      
              RayDzero=BETA(3)
              pco2s=XPLUSD(I,2)
              pvapordef_s=XPLUSD(I,3)
            endif
            call StomatalConductance(pco2s,rehulfsurf,gammas,
     &        pvapordef_s,rayDzero,assim_net,istommodel0,
     &        stomintercept,stomslope,gswmod)
            F(I,L)=gswmod
  100     CONTINUE
  110   CONTINUE
      END IF
  
C  COMPUTE DERIVATIVES WITH RESPECT TO BETA
      IF (MOD(IDEVAL/10,10).GE.1) THEN
        DO 210 L = 1,NQ
          DO 200 I = 1,N
            stomintercept=BETA(1)
            stomslope=BETA(2)
            assim_net=XPLUSD(I,1)
            if(istommodel0.eq.1)then
! Ball-Berry
              pco2s=XPLUSD(I,2)
              rehulfsurf=XPLUSD(I,3)
            endif
            if(istommodel0.eq.2)then
! Leuning with leaf surface co2      
              RayDzero=BETA(3)
              pco2s=XPLUSD(I,2)
              gammas=XPLUSD(I,3)
              pvapordef_s=XPLUSD(I,4)
            endif
            if(istommodel0.eq.3)then
! Belinda Medlyn model
              pco2s=XPLUSD(I,2)
              pvapordef_s=XPLUSD(I,3)
            endif
            if(istommodel0.eq.4)then
! Dewar model
              RayDzero=BETA(3)
              pco2s=XPLUSD(I,2)
              pvapordef_s=XPLUSD(I,3)
            endif
            call Der_StomatalConductance(pco2s,rehulfsurf,gammas,
     &        pvapordef_s,rayDzero,assim_net,istommodel0,
     &        stomintercept,stomslope,derivb,derivslope,derivd0)
            FJACB(I,1,L)=derivb
            FJACB(I,2,L)=derivslope
            if(istommodel0.eq.2.or.istommodel0.eq.4)FJACB(I,3,L)=derivd0
  200     CONTINUE
  210   CONTINUE
      END IF
      RETURN
      END
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
