/OPENFVS_DIR_RESTRUCT_TEST_BRANCH/src/variants/ni/src/cwcalc.f

Large files files are truncated, but you can click here to view the full file

      SUBROUTINE CWCALC(ISPC,P,D,H,CR,IICR,CW,IWHO,JOSTND)
      IMPLICIT NONE
C----------
C  **CWCALC--NI   DATE OF LAST REVISION:   02/08/12
C----------
COMMONS
C
      INCLUDE 'PRGPRM.F77'
C
C
      INCLUDE 'PLOT.F77'
C
COMMONS
C----------
C  THIS ROUTINE CONTAINS A LIBRARY OF CROWN WIDTH EQUATIONS AVAILABLE
C  FOR USE IN THE WESTERN UNITED STATES.
C  EQUATIONS ARE GROUPED BY SPECIES ACCORDING TO THEIR FIA CODE.
C  THIS ROUTINE COMPUTES LARGEST CROWN WIDTH.
C  IT IS CALLED FROM **CWIDTH** TO PRODUCE CROWTH WIDTH ESTIMATES FOR
C  OF FOREST GROWN TREES.
C
C  DEFINITION OF VARIABLES:
C        CW = LARGEST CROWN WIDTH
C      IWHO = 0 IF CALLED FROM CWIDTH
C      ISPC = FVS SPECIES SEQUENCE NUMBER
C         P = TREES PER ACRE
C         D = TREE DBH
C        CR = CROWN RATIO IN PERCENT (REAL)
C      IICR = CROWN RATIO IN PERCENT (INTEGER))
C        CL = CROWN LENGTH
C         H = TREE HEIGHT
C     BAREA = BASAL AREA
C     HILAT = LATITUDE IN DECIMAL DEGREES
C    HILONG = LONGITUDE (-) IN DECIMAL DEGREES
C    HIELEV = ELEVATION IN FEET
C        HI = HOPKINS BIOCLIMATIC INDEX, SEE BECHTOLD 2003.
C        EL = ELEVATION IN 100's OF FEET
C       MIND= MIN. DBH FOR BECHTOLD EQN.
C      OMIND= MIN. DBH FOR OTHER AUTHORS EQN.
C      CWEQ = CW EQUATION NUMBER (FIA # + EQN #)
C               BECHTOLD MODEL 1 EQN#      = 01
C               BECHTOLD MODEL 2 EQN#      = 02
C               CROOKSTON(R1) EQN#         = 03
C               CROOKSTON(R6) MODEL 1 EQN# = 04
C               CROOKSTON(R6) MODEL 2 EQN# = 05
C               DONNELLY EQN#              = 06
C               MOEUR EQN#                 = 07
C
C  SOURCES OF FOREST GROWN CROWN WIDTH EQUATIONS:
C  BECHTOLD, WILLIAM A. 2004. LARGEST-CROWN-DIAMETER PREDICTION MODELS FOR
C     53 SPECIES IN THE WESTERN UNITED STATES. WJAF. 19(4):245-251.
C  CROOKSTON, NICHOLAS 2005. DRAFT: ALLOMETRIC CROWN WIDTH EQUATIONS FOR 34
C     NORTHWEST UNITED STATES TREE SPECIES ESTIMATED USING GENERALIZED LINEAR
C     MIXED EFFECTS MODELS.
C  CROOKSTON, NICHOLAS 2003. INTERNAL DOCUMENT ON FILE, MOSCOW IDAHO. DATA
C     PROVIDED FROM REGION 1.
C  DONNELLY, DENNIS 1996. INTERNAL DOCUMENT ON FILE, FORT COLLINS, CO. DATA
C     PROVIDED FROM REGION 6.
C  MOEUR, MELINDA 1981. CROWN WIDTH AND FOLIAGE WEIGHT OF NORTHERN
C     ROCKY MOUNTAIN CONIFERS. USDA-FS, INT-183.
C----------
C      LOGICAL DEBUG
      CHARACTER CWEQN*5, VVER*7,FIASP*3
      CHARACTER AKMAP(13)*5, BMMAP(18)*5, CAMAP(49)*5, CIMAP(19)*5
      CHARACTER CRMAP(38)*5, ECMAP(11)*5, EMMAP(19)*5, IEMAP(23)*5
      CHARACTER KTMAP(11)*5, NCMAP(11)*5, NIMAP(11)*5, PNMAP(39)*5
      CHARACTER SOMAP(33)*5, TTMAP(18)*5, UTMAP(24)*5, WCMAP(39)*5
      CHARACTER WSMAP(43)*5
      INTEGER ISPC,IICR, IWHO, JCR, ICYC, JOSTND
      REAL D, H, CW, HI, HILAT, HILONG, HIELEV,EL,MIND,CR,CL,BAREA
      REAL BF,P,OMIND
C----------
C  DATA STATEMENTS
C----------
      DATA MIND/5./,OMIND/1./
C----------
C  MAP EQUATION NUMBERS FOR VARIANT
C----------
C----------
C  SOUTHEAST ALASKA
C----------
C                      WS       RC       SF       MH       WH       YC
       DATA AKMAP/ '09305', '24205', '01105', '26403', '26305', '04205',
C             LP       SS       AF       RA       CW   OHtoCW   OStoWS
     &    '10805', '09805', '01905', '35106', '74705', '74705', '09305'/
C----------
C  BLUE MOUNTAINS
C----------
C                      WP       WL       DF       GF       MH       WJ
       DATA BMMAP/ '11905', '07303', '20205', '01703', '26403', '06405',
C                      LP       ES       AF       PP       WB       LM
     &             '10805', '09305', '01905', '12205', '10105', '11301',
C                      PY       YC       AS       CW       OS       OH
     &             '23104', '04205', '74605', '74705', '12205', '31206'/
C----------
C  INLAND CALIFORNIA
C----------
C                      PC       IC       RC       WF       RF      SH
       DATA CAMAP/ '04105', '08105', '24205', '01505', '02006', '02105',
C             DF       WH       MH       WB       KP       LP   CPtoLP
     &    '20205', '26305', '26403', '10105', '10305', '10805', '10805',
C             LM       JP       SP       WP       PP   MPtoGP       GP
     &    '11301', '11605', '11705', '11905', '12205', '12702', '12702',
C             WJ       BR   GStoRW       PY   OStoJP       LO       CY
     &    '06405', '09204', '21104', '23104', '11605', '80102', '80502',
C             BL   EOtoBL       WO       BO       VO       IO       BM
     &    '80702', '80702', '81505', '81802', '82102', '83902', '31206',
C         BUtoBM       RA       MA   GCtoTO   DGtoRA   FLtoBM   WNtoBM
     &    '31206', '35106', '36102', '63102', '35106', '31206', '31206',
C             TO   SYtoTO       AS       CW   WItoBM   CNtoCL       CL
     &    '63102', '63102', '74605', '74705', '31206', '98102', '98102',
C             OH
     &    '31206'/
C----------
C  CENTRAL IDAHO
C----------
       DATA CIMAP/
C            WP       WL       DF       GF       WH  
     &   '11903',  '07303', '20203', '01703', '26305',
C            RC       LP       ES       AF       PP 
     &   '24203',  '10803', '09303', '01905', '12203',
C            WB       PY       AS       WJ       MC 
     &   '10105',  '23104', '74605', '06405', '47502',
C            LM       CW       OS       OH 
     &   '11301',  '74902', '12205', '74902'/
C----------
C  CENTRAL ROCKIES
C----------
C                      AF       CB       DF       GF       WF       MH
       DATA CRMAP/ '01905', '01801', '20205', '01703', '01505', '26403',
C             RC       WL       BC       LM       LP       PI       PP
     &    '24205', '07303', '10201', '11301', '10805', '10602', '12205',
C             WB       SW       UJ       BS       ES       WS       AS
     &    '10105', '11905', '06602', '09305', '09305', '09305', '74605',
C             NC       PW       GO       AW       EM       BK       SO
     &    '74902', '74902', '81402', '81402', '81402', '81402', '81402',
C             PB       AJ       RM       OJ       ER       PM       PD
     &    '74605', '06602', '06602', '06602', '06602', '10602', '10602',
C             AZ       CI       OS       OH
     &    '10602', '12205', '12205', '74902'/
C----------
C  EAST CASCADES
C----------
C                      WP       WL       DF       SF       RC       GF
       DATA ECMAP/ '11905', '07303', '20205', '01105', '24205', '01703',
C             LP       ES       AF       PP       OT
     &    '10805', '09305', '01905', '12205', '12205'/
C----------
C  EASTERN MONTANA
C----------
C                      WB       WL       DF       LM       LL       RM
       DATA EMMAP/ '10105', '07303', '20203', '11301', '07204', '06602',
C             LP       ES       AF       PP       GA       AS       CW
     &    '10803', '09303', '01903', '12203', '74902', '74605', '74705',
C             BA       PW       NC       PB    OS(MH)      OH
     &    '74902', '74902', '74902', '37506', '26405', '74902'/
C----------
C  INLAND EMPIRE (23)
C----------
C                      WP       WL       DF       GF       WH       RC
       DATA IEMAP/ '11903', '07303', '20203', '01703', '26303', '24203',
C             LP       ES       AF       PP      MH        WB       LM
     &    '10803', '09303', '01903', '12203', '26405', '10105', '11301',
C             LL       PI       RM       PY       AS       CO       MM
     &    '07204', '10602', '06602', '23104', '74605', '74902', '32102',
C             PB       OH       OS
     &    '37506', '74902', '12205'/
C----------
C  NORTHERN IDAHO (11)
C----------
C                      WP       WL       DF       GF       WH       RC
       DATA NIMAP/ '11903', '07303', '20203', '01703', '26303', '24203',
C             LP       ES       AF       PP       OT(MH)
     &    '10803', '09303', '01903', '12203', '26405'/
C----------
C  KOOKANTL
C----------
C                      WP       WL       DF       GF       WH       RC
       DATA KTMAP/ '11903', '07303', '20203', '01703', '26303', '24203',
C             LP       ES       AF       PP       OT(MH)
     &    '10803', '09303', '01903', '12203', '26405'/
C----------
C  KLAMATH MOUNTAINS
C----------
C                      OC       SP       DF       WF       MA       IC
       DATA NCMAP/ '12205', '11705', '20205', '01505', '36102', '08105',
C             BO       TO       RF       PP       OH
     &    '81802', '63102', '02006', '12205', '81802'/
C----------
C  PACIFIC COAST
C----------
C                      SF       WF       GF       AF       RF      SS
       DATA PNMAP/ '01105', '01505', '01703', '01905', '02006', '09805',
C             NF       YC       IC       ES       LP       JP       SP
     &    '02206', '04205', '08105', '09305', '10805', '11605', '11705',
C             WP       PP       DF       RW       RC       WH       MH
     &    '11905', '12205', '20205', '21104', '24205', '26305', '26403',
C             BM       RA   WAtoBM       PB   GCtoTO       AS       CW
     &    '31206', '35106', '31206', '37506', '63102', '74605', '74705',
C             WO        J       LL       WB       KP       PY   DGtoRA
     &    '81505', '06405', '07204', '10105', '10305', '23104', '35106',
C         HTtoRA   CHtoRA   WItoBM       --       OT
     &    '35106', '35106', '31206', '12205', '12205'/
C----------
C  SOUTHERN OREGON/ NORTHERN CALIF
C----------
C                      WP       SP       DF       WF       MH       IC
       DATA SOMAP/ '11905', '11705', '20205', '01505', '26403', '08105',
C             LP       ES       SH       PP       WJ       GF       AF
     &    '10805', '09305', '02105', '12205', '06405', '01703', '01905',
C             SF       NF       WB       WL       RC       WH       PY
     &    '01105', '02206', '10105', '07303', '24205', '26305', '23104',
C         WAtoBM       RA       BM       AS       CW   CHtoRA       WO
     &    '31206', '35106', '31206', '74605', '74705', '35106', '81505',
C         WItoBM   GCtoTO       MC   MBtoMC       OS       OH
     &    '31206', '63102', '47502', '47502', '12205', '31206'/
C----------
C  TETONS
C----------
C                      WB       LM       DF       PM       BS       AS
       DATA TTMAP/ '10105', '11301', '20205', '10602', '09305', '74605',
C             LP       ES       AF       PP       UJ       RM       BI
     &    '10805', '09305', '01905', '12203', '06405', '06405', '31206',
C             MM       NC       MC       OS       OH
     &    '32102', '74902', '47502', '12205', '74902'/
C----------
C  UTAH
C----------
C                      WB       LM       DF       WF       BS       AS
       DATA UTMAP/ '10105', '11301', '20205', '01505', '09305', '74605',
C             LP       ES       AF       PP       PI       WJ       GO
     &    '10805', '09305', '01905', '12205', '10602', '06405', '81402',
C             PM       RM       UJ       GB       NC       FC       MC
     &    '10602', '06405', '06405', '10201', '74902', '74902', '47502',
C             BI       BE       OS       OH
     &    '31206', '74902', '12205', '81402'/
C----------
C  WEST CASCADES
C----------
C                      SF       WF       GF       AF       RF      SS
       DATA WCMAP/ '01105', '01505', '01703', '01905', '02006', '09805',
C             NF       YC       IC       ES       LP       JP       SP
     &    '02206', '04205', '08105', '09305', '10805', '11605', '11705',
C             WP       PP       DF       RW       RC       WH       MH
     &    '11905', '12205', '20205', '21104', '24205', '26305', '26403',
C             BM       RA   WAtoBM       PB   GCtoTO       AS       CW
     &    '31206', '35106', '31206', '37506', '63102', '74605', '74705',
C             WO       WJ       LL       WB       KP       PY   DGtoRA
     &    '81505', '06405', '07204', '10105', '10305', '23104', '35106',
C         HTtoRA   CHtoRA   WItoBM       --       OT
     &    '35106', '35106', '31206', '12205', '12205'/
C----------
C  WESTERN SIERRAS
C----------
       DATA WSMAP/
C          SP       DF       WF       GS       IC
     & '11705', '20205', '01505', '21104', '08105',   
C          JP       RF       PP       LP       WB
     & '11605', '02006', '12205', '10805', '10105',   
C          WP       PM       SF       KP       FP
     & '11905', '10602', '01105', '10305', '10305',   
C          CP       LM       MP       GP       WE
     & '10805', '11301', '12205', '12702', '10305',   
C          GB       BD       RW       MH       WJ
     & '10201', '20205', '21104', '26403', '06405',   
C          UJ       CJ       LO       CY       BL
     & '06405', '06405', '80102', '80502', '80702',   
C          BO       VO       IO       TO       GC
     & '81802', '82102', '83902', '63102', '63102',   
C          AS       CL       MA       DG       BM
     & '74605', '98102', '36102', '35106', '31206',   
C          MC       OS       OH
     & '47502', '12205', '81802'/  
C
C----------
C  SET THE EQUATION NUMBER
C  OR IF THIS IS AN R5 FOREST BRANCH TO THE R5CRWD ROUTINE
C----------
      CALL VARVER(VVER)
C
      IF((VVER(:2).EQ.'SO').AND.(IFOR.GE.4))THEN
        CALL R5CRWD(ISPC,D,H,CW)
        GO TO 9000
      ELSEIF ((VVER(:2).EQ.'WS').AND.(IFOR.LE.12))THEN
        CALL R5CRWD(ISPC,D,H,CW)
        GO TO 9000
      ELSEIF ((VVER(:2).EQ.'NC').AND.((IFOR.LE.3).OR.(IFOR.GE.9)))THEN
        CALL R5CRWD(ISPC,D,H,CW)
        GO TO 9000
      ELSEIF ((VVER(:2).EQ.'CA').AND.((IFOR.LE.5).OR.(IFOR.GE.8)))THEN
        CALL R5CRWD(ISPC,D,H,CW)
        GO TO 9000
      ENDIF
C
      SELECT CASE (VVER(:2))
        CASE('AK')
          CWEQN=AKMAP(ISPC)
        CASE('BM')
          CWEQN=BMMAP(ISPC)
        CASE('CA')
          CWEQN=CAMAP(ISPC)
        CASE('CI')
          CWEQN=CIMAP(ISPC)
        CASE('CR')
          CWEQN=CRMAP(ISPC)
        CASE('SM')
          CWEQN=CRMAP(ISPC)
        CASE('SP')
          CWEQN=CRMAP(ISPC)
        CASE('BP')
          CWEQN=CRMAP(ISPC)
        CASE('SF')
          CWEQN=CRMAP(ISPC)
        CASE('LP')
          CWEQN=CRMAP(ISPC)
        CASE('EC')
          CWEQN=ECMAP(ISPC)
        CASE('EM')
          CWEQN=EMMAP(ISPC)
        CASE('IE')
          CWEQN=IEMAP(ISPC)
        CASE('KT')
          CWEQN=KTMAP(ISPC)
        CASE('NC')
          CWEQN=NCMAP(ISPC)
        CASE('NI')
          CWEQN=NIMAP(ISPC)
        CASE('PN')
          CWEQN=PNMAP(ISPC)
        CASE('SO')
          CWEQN=SOMAP(ISPC)
        CASE('TT')
          CWEQN=TTMAP(ISPC)
        CASE('UT')
          CWEQN=UTMAP(ISPC)
        CASE('WC')
          CWEQN=WCMAP(ISPC)
        CASE('WS')
          CWEQN=WSMAP(ISPC)
      END SELECT
C----------
C      IF(DEBUG)WRITE(JOSTND,*)
C     &' ENTERING CWCALC: ISPC,CWEQN,VVER(:2)= ',ISPC,CWEQN,VVER(:2)
C      IF(DEBUG)WRITE(JOSTND,*)' ISPC,P,D,H,CR,IICR,CW,IWHO,JOSTND= ',
C     &ISPC,P,D,H,CR,IICR,CW,IWHO,JOSTND
C----------
C SET R6 FOREST SPECIFIC CONSTANTS FOR CROOKSTON(R6) MODELS
C----------
      FIASP=FIAJSP(ISPC)
      BF=1.0
      IF (IFOR.LT.601 .OR. IFOR.GT.621)GO TO 10
      SELECT CASE (IFOR)
        CASE(601)
          SELECT CASE (FIASP)
            CASE('015')
              BF=1.044
            CASE('019')
              BF=0.936
            CASE('022')
              BF=1.301
            CASE('081')
              BF=0.837
            CASE('073')
              BF=0.818
            CASE('117')
              BF=1.048
            CASE('122')
              BF=0.918
            CASE('202')
              BF=1.055
            CASE('263')
              BF=1.097
          END SELECT
        CASE(602)
          SELECT CASE (FIASP)
            CASE('011')
              BF=1.032
            CASE('108')
              BF=1.114
            CASE('119')
              BF=1.090
            CASE('122')
              BF=0.946
            CASE('264')
              BF=1.257
          END SELECT
        CASE(603)
          SELECT CASE (FIASP)
            CASE('011')
              BF=1.032
            CASE('019')
              BF=0.906
            CASE('022')
              BF=1.123
            CASE('073')
              BF=0.952
            CASE('119')
              BF=1.128
            CASE('242')
              BF=0.920
            CASE('263')
              BF=1.028
            CASE('264')
              BF=1.077
          END SELECT
        CASE(604)
          SELECT CASE (FIASP)
            CASE('019')
              BF=1.110
            CASE('073')
              BF=0.818
            CASE('108')
              BF=1.196
            CASE('093')
              BF=1.121
            CASE('119')
              BF=1.081
            CASE('202')
              BF=1.058
          END SELECT
        CASE(605)
          SELECT CASE (FIASP)
            CASE('019')
              BF=0.886
            CASE('022')
              BF=1.075
            CASE('073')
              BF=0.907
            CASE('093')
              BF=0.949
            CASE('119')
              BF=1.081
            CASE('202')
              BF=1.019
            CASE('242')
              BF=0.973
          END SELECT
        CASE(606)
          SELECT CASE (FIASP)
            CASE('011')
              BF=1.296
            CASE('015')
              BF=1.130
            CASE('017')
              BF=1.086
            CASE('019')
              BF=1.038
            CASE('022')
              BF=1.301
            CASE('042')
              BF=1.493
            CASE('073')
              BF=0.907
            CASE('108')
              BF=0.944
            CASE('119')
              BF=1.081
            CASE('242')
              BF=1.115
            CASE('263')
              BF=1.260
            CASE('264')
              BF=1.106
          END SELECT
        CASE(607)
          SELECT CASE (FIASP)
            CASE('019')
              BF=1.110
            CASE('073')
              BF=0.879
            CASE('108')
              BF=1.196
            CASE('093')
              BF=1.169
            CASE('202')
              BF=1.055
          END SELECT
        CASE(608)
          SELECT CASE (FIASP)
            CASE('073')
              BF=0.952
            CASE('108')
              BF=1.114
            CASE('119')
              BF=1.081
            CASE('242')
              BF=0.905
            CASE('264')
              BF=0.900
          END SELECT
        CASE(609)
          SELECT CASE (FIASP)
            CASE('011')
              BF=1.032
            CASE('108')
              BF=1.114
            CASE('098')
              BF=1.146
            CASE('242')
              BF=0.941
          END SELECT
        CASE(610)
          SELECT CASE (FIASP)
            CASE('019')
              BF=0.886
            CASE('351')
              BF=0.810
            CASE('081')
              BF=0.903
            CASE('108')
              BF=0.944
            CASE('093')
              BF=0.949
            CASE('117')
              BF=1.048
            CASE('119')
              BF=1.081
            CASE('122')
              BF=0.918
            CASE('264')
              BF=0.900
          END SELECT
        CASE(611)
          SELECT CASE (FIASP)
            CASE('351')
              BF=0.810
            CASE('081')
              BF=0.821
            CASE('108')
              BF=0.944
            CASE('122')
              BF=0.951
            CASE('202')
              BF=0.961
            CASE('242')
              BF=0.973
            CASE('263')
              BF=1.028
            CASE('264')
              BF=0.900
          END SELECT
        CASE(612)
          SELECT CASE (FIASP)
            CASE('202')
              BF=0.977
            CASE('242')
              BF=0.905
            CASE('263')
              BF=0.924
          END SELECT
        CASE(614)
          SELECT CASE (FIASP)
            CASE('017')
              BF=1.076
            CASE('019')
              BF=1.110
            CASE('073')
              BF=0.907
            CASE('108')
              BF=1.244
            CASE('093')
              BF=1.137
            CASE('117')
              BF=1.097
            CASE('119')
              BF=1.128
            CASE('122')
              BF=1.035
            CASE('202')
              BF=1.055
            CASE('242')
              BF=1.055
            CASE('263')
              BF=1.106
          END SELECT
        CASE(615)
          SELECT CASE (FIASP)
            CASE('011')
              BF=1.032
            CASE('015')
              BF=1.130
            CASE('022')
              BF=1.043
            CASE('042')
              BF=1.295
            CASE('108')
              BF=1.050
            CASE('093')
              BF=1.325
            CASE('117')
              BF=1.097
            CASE('119')
              BF=1.128
            CASE('122')
              BF=1.035
            CASE('202')
              BF=1.055
            CASE('242')
              BF=1.049
            CASE('263')
              BF=1.106
          END SELECT
        CASE (616)
           SELECT CASE (FIASP)
            CASE('073')
              BF=0.818
            CASE('108')
              BF=1.114
            CASE('093')
              BF=1.070
            CASE('264')
              BF=1.077
          END SELECT
        CASE(617)
          SELECT CASE (FIASP)
            CASE('017')
              BF=0.972
            CASE('019')
              BF=0.906
            CASE('073')
              BF=0.879
            CASE('108')
              BF=0.969
            CASE('093')
              BF=0.949
            CASE('117')
              BF=1.097
            CASE('122')
              BF=0.946
            CASE('202')
              BF=0.975
            CASE('242')
              BF=0.905
            CASE('263')
              BF=0.962
            CASE('264')
              BF=0.952
          END SELECT
        CASE(618)
          SELECT CASE (FIASP)
            CASE('017')
              BF=0.972
            CASE('019')
              BF=0.936
            CASE('042')
              BF=1.127
            CASE('108')
              BF=0.903
            CASE('093')
              BF=0.857
            CASE('117')
              BF=1.097
            CASE('119')
              BF=1.081
            CASE('122')
              BF=1.070
            CASE('263')
              BF=1.087
          END SELECT
        CASE(620)
          SELECT CASE (FIASP)
            CASE('015')
              BF=1.095
            CASE('022')
              BF=1.043
            CASE('108')
              BF=1.050
            CASE('117')
              BF=1.048
            CASE('119')
              BF=1.090
            CASE('122')
              BF=0.951
            CASE('202')
              BF=1.184
            CASE('264')
              BF=1.077
          END SELECT
        CASE(621)
          SELECT CASE (FIASP)
            CASE('017')
              BF=1.130
            CASE('019')
              BF=1.038
            CASE('108')
              BF=1.216
            CASE('093')
              BF=1.137
            CASE('119')
              BF=1.206
            CASE('122')
              BF=1.035
            CASE('202')
              BF=1.055
            CASE('242')
              BF=0.973
            CASE('263')
              BF=1.097
          END SELECT
      END SELECT
C----------
C  INITIALIZE RETURN VARIABLES.
C----------
   10 CONTINUE
      CW = 0.
C----------
C SET OTHER VARIABLES FOR CROWN MODELS.
C----------
      CL= CR*H*0.01
      BAREA=BA
      IF(BAREA .LE. 1.) BAREA=1.
      HILAT=TLAT
      HILONG = -1*ABS(TLONG)
      HIELEV=ELEV*100
      EL=ELEV
C  COMPUTE HOPKINS INDEX
      HI = ((HIELEV-5449.)/100.)*1.0 + (HILAT-42.16)*4.0 +
     &      (-116.39 - HILONG)*1.25
C  COMPUTE BF DEPENDING ON FOREST CODE IN R6
   20 CONTINUE
C      IF(DEBUG)WRITE(JOSTND,*)' CWCALC: ISPC,D,VVER,CWEQN= ',
C     &ISPC,D,VVER(:2),CWEQN
C----------
C  CALCULATE CROWN WIDTH
C----------
      SELECT CASE (CWEQN)
C-----------------------------------------------------------------------
C  CASE 01102 BECHTOLD 2004 MODEL 2
C  011          ABIES AMABILIS                     PACIFIC SILVER FIR   
      CASE('01102')
        IF (HI .LT.  -9.) HI= -9.
        IF (HI .GT.  26.) HI= 26.
        IF (D .GE. MIND) THEN
          CW= 7.7763 + (0.5960*D) + (-0.0705*HI)
        ELSE
          CW= (7.7763 + (0.5960*MIND) + (-0.0705*HI))*(D/MIND)
        ENDIF
        IF (CW .GT. 33.) CW=33.
C
C  CASE 01105 CROOKSTON (R6) MODEL 2
C  011          ABIES AMABILIS                     PACIFIC SILVER FIR   
      CASE('01105')
        IF (EL .LT.   4.) EL=  4.
        IF (EL .GT.  72.) EL= 72.
        IF (D .GE. OMIND) THEN
          CW= 4.4799*BF*(D**0.45976)*(H**(-0.10425))*(CL**0.11866)*
     &       ((BAREA+1.0)**0.06762)*(EXP(EL)**(-0.00715))
        ELSE
          CW= (4.4799*BF*(OMIND**0.45976)*(H**(-0.10425))*
     &       (CL**0.11866)*((BAREA+1.0)**0.06762)*(EXP(EL)**(-0.00715)))
     &       *(D/OMIND)
        ENDIF
        IF (CW .GT. 33.) CW=33.
C-----------------------------------------------------------------------
C  CASE 01502 BECHTOLD 2004 MODEL 2
C  015          ABIES CONCOLOR                     WHITE FIR            
      CASE('01502')
        IF (HI .LT. -40.) HI=-40.
        IF (HI .GT.  19.) HI= 19.
        IF (D .GE. MIND) THEN
          CW= 2.4789 + (0.9317*D) + (- 0.0128*D*D) + (0.0327*CR) +
     &    (-0.1178*HI)
        ELSE
          CW= (2.4789 + (0.9317*MIND) + (-0.0128*D*D) + (0.0327*CR) + 
     &   (-0.1178*HI))*(D/MIND)
        ENDIF
        IF (CW .GT. 35.) CW=35.
C
C  CASE 01505 CROOKSTON (R6) MODEL 2
C  015          ABIES CONCOLOR                     WHITE FIR            
      CASE('01505')
        IF (EL .LT.   2.) EL=  2.
        IF (EL .GT.  75.) EL= 75.
        IF (D .GE. OMIND) THEN
          CW= 5.0312*BF*(D**0.53680)*(H**(-0.18957))*(CL**0.16199)*
     &         ((BAREA+1.0)**0.04385)*(EXP(EL)**(-0.00651))
        ELSE
          CW= (5.0312*BF*(OMIND**0.53680)*(H**(-0.18957))*
     &       (CL**0.16199)*((BAREA+1.0)**0.04385)*(EXP(EL)**(-0.00651)))
     &       *(D/OMIND)
        ENDIF
        IF (CW .GT. 35.) CW=35.
C
C  CASE 01506 DONNELLY (R6)
C  015          ABIES CONCOLOR                     WHITE FIR            
      CASE('01506')
        IF (D .GE. OMIND) THEN
          CW= 3.8166*D**0.5229
        ELSE
          CW= (3.8166*OMIND**0.5229)*(D/OMIND)
        ENDIF
        IF (CW .GT. 35.) CW=35.
C-----------------------------------------------------------------------
C  CASE 01702 BECHTOLD 2004 MODEL 2
C  017          ABIES GRANDIS                      GRAND FIR            
      CASE('01702')
        IF (HI .LT. -48.) HI=-48.
        IF (HI .GT.  20.) HI= 20.
        IF (D .GE. MIND) THEN
          CW= 3.0335 + (0.9752*D) + (-0.0113*D*D) + (0.0548*CR) + 
     &       (-0.0597*HI)
        ELSE
          CW= (3.0335 + (0.9752*MIND) + (-0.0113*D*D) + (0.0548*CR) + 
     &       (-0.0597*HI))*(D/MIND)
        ENDIF
        IF (CW .GT. 40.) CW=40.
C
C  CASE 01703 CROOKSTON (R1)
C  017          ABIES GRANDIS                      GRAND FIR            
      CASE('01703')
        IF (D .GE. 1.0) THEN
          CW= 1.0303*EXP(1.14079 + 0.20904*ALOG(CL)+0.38787*ALOG(D))
        ELSE
          CW= (1.0303*EXP(1.14079 + 0.20904*ALOG(CL)+
     &        0.38787*ALOG(1.0))) * (D/1.0)
        ENDIF
        IF (CW .GT. 40.) CW=40.
C
C  CASE 01705 CROOKSTON (R6) MODEL 2
C  017          ABIES GRANDIS                      GRAND FIR            
      CASE('01705')
        IF (EL .LT.   3.) EL=  3.
        IF (EL .GT.  75.) EL= 75.
        IF (D .GE. OMIND) THEN
          CW= 6.0231*BF*(D**0.54674)*(H**(-0.19451))*(CL**0.15375)
     &       * ((BAREA+1.0)**0.02897)*(EXP(EL)**(-0.00512))
        ELSE
          CW= (6.0231*BF*(OMIND**0.54674)*(H**(-0.19451))*
     &       (CL**0.15375)*((BAREA+1.0)**0.02897)*(EXP(EL)**(-0.00512)))
     &        *(D/OMIND)
        ENDIF
        IF (CW .GT. 40.) CW=40.
C
C  CASE 01706 DONNELLY (R6)
C  017          ABIES GRANDIS                      GRAND FIR            
      CASE('01706')
        IF (D .GE. OMIND) THEN
          CW= 4.1870*D**0.5341
        ELSE
          CW= (4.1870*OMIND**0.5341)*(D/OMIND)
        ENDIF
        IF (CW .GT. 40.) CW=40.
C
C  CASE 01707 MOEUR
C  017          ABIES GRANDIS                      GRAND FIR            
      CASE('01707')
        CW= EXP(2.20611+ 1.08137*ALOG(D) + (-0.76936)*ALOG(H)
     &      + 0.29786*ALOG(CL))
        IF (CW .GT. 40.) CW=40.
C-----------------------------------------------------------------------
C  CASE 01801 BECHTOLD 2004 MODEL 1
C  018          ABIES LASIOCARPA var. ARIZONICA    CORKBARK FIR         
      CASE('01801')
        IF (D .GE. MIND) THEN
          CW= 6.073 + 0.3756*D
        ELSE
          CW= (6.073 + 0.3756*MIND)*(D/MIND)
        ENDIF
        IF (CW .GT. 15.) CW=15.
C-----------------------------------------------------------------------
C  CASE 01901 BECHTOLD 2004 MODEL 2
C  019          ABIES LASIOCARPA                   SUBALPINE FIR        
      CASE('01901')
        IF (HI .LT. -14.) HI=-14.
        IF (HI .GT.  44.) HI= 44.
        IF (D .GE. MIND) THEN
          CW= 2.6068 + 0.6145*D + 0.0417*CR + (-0.0698)*HI
        ELSE
          CW= (2.6068+0.6145*MIND + 0.0417*CR+(-0.0698*HI))*(D/MIND)
        ENDIF
        IF (CW .GT. 30.) CW=30.
C
C  CASE 01903 CROOKSTON (R1)
C  019          ABIES LASIOCARPA                   SUBALPINE FIR        
      CASE('01903')
        IF (D .GE. 0.1) THEN
          CW= 1.02886*EXP(1.01255 + 0.30374*ALOG(CL)+0.37093*ALOG(D)
     &        + (-0.13731*ALOG(H)))
        ELSE
          CW= (1.02886*EXP(1.01255 + 0.30374*ALOG(CL) +
     &         0.37093*ALOG(0.1) + (-0.13731*ALOG(H))))*(D/0.1)
        ENDIF
        IF (CW .GT. 30.) CW=30.
C
C  CASE 01905 CROOKSTON (R6) MODEL 2
C  019          ABIES LASIOCARPA                   SUBALPINE FIR        
      CASE('01905')
        IF (EL .LT.  10.) EL= 10.
        IF (EL .GT.  85.) EL= 85.
        IF (D .GE. OMIND) THEN
          CW= 5.8827*BF*(D**0.51479)*(H**(-0.21501))*(CL**0.17916)*
     &         ((BAREA+1.0)**0.03277)*(EXP(EL)**(-0.00828))
        ELSE
          CW= (5.8827*BF*(OMIND**0.51479)*(H**(-0.21501))*
     &       (CL**0.17916)*((BAREA+1.0)**0.03277)*(EXP(EL)**(-0.00828)))
     &        *(D/OMIND)
        ENDIF
        IF (CW .GT. 30.) CW=30.
C
C  CASE 01906 DONNELLY (R6)
C  019          ABIES LASIOCARPA                   SUBALPINE FIR        
      CASE('01906')
        IF (D .GE. OMIND) THEN
          CW= 3.2348*D**0.5179
        ELSE
          CW= (3.2348*OMIND**0.5179)*(D/OMIND)
        ENDIF
        IF (CW .GT. 30.) CW=30.
C
C  CASE 01907 MOEUR
C  019          ABIES LASIOCARPA                   SUBALPINE FIR        
      CASE('01907')
        CW= EXP(1.74558 + (1.08137*ALOG(D)) + (-0.73972*ALOG(H))
     &     + (0.29786*ALOG(CL)))
        IF (CW .GT. 30.) CW=30.
C-----------------------------------------------------------------------
C  CASE 02002 BECHTOLD 2004 MODEL 2
C  020          ABIES MAGNIFICA VAR. MAGNIFICA   CALIFORNIA RED FIR
      CASE('02002')
        IF (HI .LT. -14.) HI=-14.
        IF (HI .GT.  44.) HI= 44.
        IF (D .GE. MIND) THEN
          CW= 2.3660 + 0.5472*D + 0.0316*CR + (-0.0702)*HI
        ELSE
          CW= (2.3660+0.5472*MIND+0.0316*CR+(-0.0702*HI))*(D/MIND)
        ENDIF
        IF (CW .GT. 36.) CW=36.
C
C  CASE 02006 DONNELLY (R6)
C  020          ABIES MAGNIFICA VAR. MAGNIFICA   CALIFORNIA RED FIR
      CASE('02006')
        IF (D .GE. OMIND) THEN
          CW= 3.1146*D**0.5780
        ELSE
          CW= (3.1146*OMIND**0.5780)*(D/OMIND)
        ENDIF
        IF (CW .GT. 65.) CW=65.
C-----------------------------------------------------------------------
C  CASE 02101 BECHTOLD 2004 MODEL 2
C  021          ABIES MAGNIFICA VAR. SHASTENSIS    SHASTA RED FIR
      CASE('02101')
        IF (D .GE. MIND) THEN
          CW= 4.0524 + 0.6423*D
        ELSE
          CW= (4.0524 + 0.6423*MIND)*(D/MIND)
        ENDIF
        IF (CW .GT. 26.) CW=26.
C
C  CASE 02105 CROOKSTON (R6) MODEL 2
C  021          ABIES MAGNIFICA VAR. SHASTENSIS    SHASTA RED FIR
      CASE('02105')
        IF (D .GE. OMIND) THEN
          CW= 2.3170*BF*(D**0.47880)*(H**(-0.06093))*(CL**0.15482)*
     &        ((BAREA+1.0)**0.05182)
        ELSE
          CW= (2.3170*BF*(OMIND**0.47880)*(H**(-0.06093))
     &       *(CL**0.15482)*((BAREA+1.0)**0.05182))*(D/OMIND)
        ENDIF
        IF (CW .GT. 65.) CW=65.
C-----------------------------------------------------------------------
C  CASE 02201 BECHTOLD 2004 MODEL 2
C  022          ABIES PROCERA                      NOBLE FIR
      CASE('02201')
        IF (HI .LT. -11.) HI=-11.
        IF (HI .GT.  32.) HI= 32.
        IF (D .GE. MIND) THEN
          CW= 2.7761 + 0.7311*D + 0.0476*CR + (-0.0756*HI)
        ELSE
          CW= (2.7761 + 0.7311*MIND + 0.0476*CR + (-0.0756*HI))*
     &      (D/MIND)
        ENDIF
        IF (CW .GT. 29.) CW=29.
C
C  CASE 02206 DONNELLY (R6)
C  022          ABIES PROCERA                      NOBLE FIR
      CASE('02206')
        IF (D .GE. OMIND) THEN
          CW= 3.0614*D**0.6276
        ELSE
          CW= (3.0614*OMIND**0.6276)*(D/OMIND)
        ENDIF
        IF (CW .GT. 40.) CW=40.
C-----------------------------------------------------------------------
C  CASE 04102 BECHTOLD 2004 MODEL 2
C  041          CHAMAECYPARIS LAWSONIANA           PORT ORFORD CEDAR
      CASE('04102')
        IF (D .GE. MIND) THEN
          CW= 1.0365 + (0.7943*D) + (0.0399*CR)
        ELSE
          CW= (1.0365 + (0.7943*MIND) + (0.0399*CR))*(D/MIND)
        ENDIF
        IF (CW .GT. 22.) CW=22.
C
C  CASE 04105 CROOKSTON (R6) MODEL 2
C  041          CHAMAECYPARIS LAWSONIANA           PORT ORFORD CEDAR
      CASE('04105')
        IF (EL .LT.   2.) EL=  2.
        IF (EL .GT.  52.) EL= 52.
        IF (D .GE. OMIND) THEN
          CW= 4.6387*BF*(D**0.50874)*(H**(-0.22111))*(CL**0.1755)*
     &       ((BAREA+1.0)**0.06447)*(EXP(EL)**(-0.00602))
        ELSE
          CW= (4.6387*BF*(OMIND**0.50874)*(H**(-0.22111))*
     &       (CL**0.1755)*((BAREA+1.0)**0.06447)*(EXP(EL)**(-0.00602)))*
     &       (D/OMIND)
        ENDIF
        IF (CW .GT. 49.) CW=49.
C
C  CASE 04106 DONNELLY (R6)
C  041          CHAMAECYPARIS LAWSONIANA           PORT ORFORD CEDAR
      CASE('04106')
        IF (D .GE. OMIND) THEN
          CW= 5.3864*D**0.4213
        ELSE
          CW= (5.3864*OMIND**0.4213)*(D/OMIND)
        ENDIF
        IF (CW .GT. 35.) CW=35.
C-----------------------------------------------------------------------
C  CASE 04205 CROOKSTON (R6) MODEL 2
C  042          CHAMAECYPARIS NOOTKATENSIS          ALASKA YELLOW CEDAR
      CASE('04205')
        IF (EL .LT.  16.) EL= 16.
        IF (EL .GT.  62.) EL= 62.
        IF (D .GE. OMIND) THEN
          CW= 3.3756*BF*(D**0.45445)*(H**(-0.11523))*(CL**0.22547)*
     &     ((BAREA+1.0)**0.08756)*(EXP(EL)**(-0.00894))
        ELSE
          CW= (3.3756*BF*(OMIND**0.45445)*(H**(-0.11523))*
     &      (CL**0.22547)*((BAREA+1.0)**0.08756)*(EXP(EL)**(-0.00894)))*
     &      (D/OMIND)
        ENDIF
        IF (CW .GT. 59.) CW=59.
C
C  CASE 04206 DONNELLY (R6)
C  042          CHAMAECYPARIS NOOTKATENSIS          ALASKA YELLOW CEDAR
      CASE('04206')
        IF (D .GE. OMIND) THEN
          CW= 3.5341*D**0.5374
        ELSE
          CW= (3.5341*OMIND**0.5374)*(D/OMIND)
        ENDIF
        IF (CW .GT. 30.) CW=30.
C-----------------------------------------------------------------------
C  CASE 06402 BECHTOLD 2004 MODEL 2
C  064          JUNIPERUS OCCIDENTALIS              WESTERN JUNIPER
      CASE('06402')
        IF (D .GE. MIND) THEN
          CW= -0.0037 + (1.3526*D) + (-0.0165*D*D)
        ELSE
          CW= (-0.0037+(1.3526*MIND)+(-0.0165*MIND*MIND))*(D/MIND)
        ENDIF
        IF (CW .GT. 36.) CW=36.
C
C  CASE 06405 CROOKSTON (R6) MODEL 2
C  064          JUNIPERUS OCCIDENTALIS              WESTERN JUNIPER
      CASE('06405')
        IF (D .GE. OMIND) THEN
          CW= 5.1486*BF*(D**0.73636)*(H**(-0.46927))*(CL**0.39114)*
     &       ((BAREA+1.0)**(-0.05429))
        ELSE
          CW= (5.1486*BF*(OMIND**0.73636)*(H**(-0.46927))*
     &       (CL**0.39114)*((BAREA+1.0)**(-0.05429)))*(D/OMIND)
        ENDIF
        IF (CW .GT. 36.) CW=36.
C-----------------------------------------------------------------------
C  CASE 06601 BECHTOLD 2004 MODEL 1
C  066          JUNIPERUS SCOPULORUM              ROCKY MOUNTAIN JUNIPER
      CASE('06601')
        IF (D .GE. MIND) THEN
          CW= 2.1431 + (1.3447*D) + (-0.0228*D*D)
        ELSE
          CW= (2.1431 + (1.3447*MIND) + (-0.0228*MIND*MIND))*(D/MIND)
        ENDIF
        IF (CW .GT. 29.) CW=29.
C
C  CASE 06602 BECHTOLD 2004 MODEL 2
C  066          JUNIPERUS SCOPULORUM              ROCKY MOUNTAIN JUNIPER
      CASE('06602')
        IF (HI .LT. -37.) HI=-37.
        IF (HI .GT.  19.) HI= 19.
        IF (D .GE. MIND) THEN
          CW= -4.1599 +(1.3528*D) + (-0.0233*D*D) + (0.0633*CR)
     &        + (-0.0423*HI)
        ELSE
          CW= (-4.1599 + (1.3528*MIND)+(-0.0233*MIND*MIND)+
     &        (0.0633*CR) + (-0.0423*HI))*(D/MIND)
        ENDIF
        IF (D .GE. 25) THEN
          CW= -4.1599 +(1.3528*25) + (-0.0233*25*25) + (0.0633*CR)
     &       + (-0.0423*HI)
        ENDIF
        IF (CW .GT. 29.) CW=29.
C-----------------------------------------------------------------------
C  CASE 07204 CROOKSTON (R6) MODEL 1
C  072          LARIX LYALLII                     SUBALPINE LARCH
      CASE('07204')
        IF (D .GE. OMIND) THEN
          CW= 2.2586*D**0.68532
        ELSE
          CW= (2.2586*OMIND**0.68532)*(D/OMIND)
        ENDIF
        IF (CW .GT. 33.) CW=33.
C-----------------------------------------------------------------------
C  CASE 07302 BECHTOLD 2004 MODEL 2
C  073          LARIX OCCIDENTALIS                 WESTERN LARCH        
      CASE('07302')
        IF (D .GE. MIND) THEN
          CW= 1.5995 + 0.7675*D + 0.075*CR
        ELSE
          CW= (1.5995 + 0.7675*MIND + 0.075*CR)*(D/MIND)
        ENDIF
        IF (CW .GT. 30.) CW=30.
C
C  CASE 07303 CROOKSTON (R1)
C  073          LARIX OCCIDENTALIS                 WESTERN LARCH        
      CASE('07303')
        IF (D .GE. 1.0) THEN
          CW= 1.02478*EXP(0.99889 + 0.19422*ALOG(CL)+0.59423*ALOG(D)
     &       + (-0.09078*ALOG(H)) + (-0.02341*ALOG(BAREA)))
        ELSE
          CW= (1.02478*EXP(0.99889+0.19422*ALOG(CL)+0.59423*ALOG(1.0)
     &       + (-0.09078*ALOG(H)) + (-0.02341*ALOG(BAREA))))*(D/1.0)
        ENDIF
        IF (CW .GT. 40.) CW=40.
C
C  CASE 07305 CROOKSTON (R6) MODEL 2
C  073          LARIX OCCIDENTALIS                 WESTERN LARCH        
      CASE('07305')
        IF (EL .LT.  19.) EL= 19.
        IF (EL .GT.  72.) EL= 72.
        IF (D .GE. OMIND) THEN
          CW= 3.2548*BF*(D**0.60845)*(H**(-0.19146))*(CL**0.21051)*
     &        ((BAREA+1.0)**0.00972)*(EXP(EL)**(-0.00313))
        ELSE
          CW= (3.2548*BF*(OMIND**0.60845)*(H**(-0.19146))*
     &       (CL**0.21051)*((BAREA+1.0)**0.00972)*(EXP(EL)**(-0.00313)))
     &       *(D/OMIND)
        ENDIF
        IF (CW .GT. 40.) CW=40.
C
C  CASE 07306 DONNELLY (R6)
C  073          LARIX OCCIDENTALIS                 WESTERN LARCH        
      CASE('07306')
        IF (D .GE. OMIND) THEN
          CW= 2.9571*D**0.6081
        ELSE
          CW= (2.9571*D**0.6081)*(D/OMIND)
        ENDIF
        IF (CW .GT. 40.) CW=40.
C
C  CASE 07307 MOEUR
C  073          LARIX OCCIDENTALIS                 WESTERN LARCH        
      CASE('07307')
        CW= EXP(2.31359 + 1.08137*ALOG(D) + (-0.80919*ALOG(H))
     &      + 0.29786*ALOG(CL))
        IF (CW .GT. 40.) CW=40.
C-----------------------------------------------------------------------
C  CASE 08105 CROOKSTON (R6) MODEL 2
C  081          LIBOCEDRUS DECURRENS                INCENSE CEDAR     
      CASE('08105')
        IF (EL .LT.   5.) EL=  5.
        IF (EL .GT.  62.) EL= 62.
        IF (D .GE. OMIND) THEN
          CW= 5.0446*BF*(D**0.47419)*(H**(-0.13917))*(CL**0.14230)
     &       *((BAREA+1.0)**0.04838)*(EXP(EL)**(-0.00616))
        ELSE
          CW= (5.0446*BF*(OMIND**0.47419)*(H**(-0.13917))*
     &       (CL**0.14230)*((BAREA+1.0)**0.04838)*(EXP(EL)**(-0.00616)))
     &        *(D/OMIND)
        ENDIF
        IF (CW .GT. 78.) CW=78.
C
C  CASE 08106 DONNELLY (R6)
C  081          LIBOCEDRUS DECURRENS                INCENSE CEDAR        
      CASE('08106')
        IF (D .GE. OMIND) THEN
          CW= 4.0920*D**0.4912
        ELSE
          CW= (4.0920*OMIND**0.4912)*(D/OMIND)
        ENDIF
        IF (CW .GT. 40.) CW=40.
C-----------------------------------------------------------------------
C  CASE 09204 CROOKSTON (R6) MODEL 1
C  092          PICEA BREWERIANA                    BREWER SPRUCE
      CASE('09204')
        IF (D .GE. OMIND) THEN
          CW= 2.8232*D**0.66326
        ELSE
          CW= (2.8232*OMIND**0.66326)*(D/OMIND)
        ENDIF
        IF (CW .GT. 38.) CW=38.
C-----------------------------------------------------------------------
C  CASE 09302 BECHTOLD 2004 MODEL 2
C  093          PICEA ENGELMANNII                  ENGELMANN SPRUCE     
      CASE('09302')
        IF (HI .LT. -25.) HI=-25.
        IF (HI .GT.  44.) HI= 44.
        IF (D .GE. MIND) THEN
          CW= 4.1348 + 0.5694*D + 0.0403*CR + (-0.1014*HI)
        ELSE
          CW= (4.1348+0.5694*MIND+0.0403*CR +(-0.1014*HI))*(D/MIND)
        ENDIF
        IF (CW .GT. 40.) CW=40.
C
C  CASE 09303 CROOKSTON (R1)
C  093          PICEA ENGELMANNII                  ENGELMANN SPRUCE     
      CASE('09303')
        IF (D .GE. 0.1) THEN
          CW= 1.02687*EXP(1.28027 + 0.2249*ALOG(CL) + 0.47075*ALOG(D)
     &       + (-0.15911)*ALOG(H))
        ELSE
          CW= (1.02687*EXP(1.28027 + 0.2249*ALOG(CL) +
     &        0.47075*ALOG(0.1)+(-0.15911)*ALOG(H)))*(D/0.1)
        ENDIF
          IF (CW .GT. 40.) CW=40.
C
C  CASE 09305 CROOKSTON (R6) MODEL 2
C  093          PICEA ENGELMANNII                  ENGELMANN SPRUCE     
      CASE('09305')
        IF (EL .LT.   1.) EL=  1.
        IF (EL .GT.  85.) EL= 85.
        IF (D .GE. OMIND) THEN
          CW= 6.7575*BF*(D**0.55048)*(H**(-0.25204))*(CL**0.19002)
     &       *(EXP(EL)**(-0.00313))
        ELSE
          CW= (6.7575*BF*(OMIND**0.55048)*(H**(-0.25204))*
     &        (CL**0.19002)*(EXP(EL)**(-0.00313)))*(D/OMIND)
        ENDIF
        IF (CW .GT. 40.) CW=40.
C
C  CASE 09306 DONNELLY (R6)
C  093          PICEA ENGELMANNII                  ENGELMANN SPRUCE     
      CASE('09306')
        IF (D .GE. OMIND) THEN
          CW= 3.6802*D**0.4940
        ELSE
          CW= (3.6802*OMIND**0.4940)*(D/OMIND)
        ENDIF
        IF (CW .GT. 40.) CW=40.
C
C  CASE 09307 MOEUR
C  093          PICEA ENGELMANNII                  ENGELMANN SPRUCE     
      CASE('09307')
        CW= EXP(3.76535 + 1.08137*ALOG(D) + (-1.18257*ALOG(H))
     &       + 0.29786*ALOG(CL))
        IF (CW .GT. 40.) CW=40.
C-----------------------------------------------------------------------
C  CASE 09802 BECHTOLD 2004 MODEL 2
C  098          PICEA SITCHENSIS                  SITKA SPRUCE
      CASE('09802')
        IF (D .GE. MIND) THEN
          CW= 8.8087 + (0.7825*D)
        ELSE
          CW= (8.8087 + 0.7825*MIND)*(D/MIND)
        ENDIF
        IF (CW .GT. 43.) CW=43.
C
C  CASE 09805 CROOKSTON (R6) MODEL 2
C  098          PICEA SITCHENSIS                  SITKA SPRUCE
      CASE('09805')
        IF (D .GE. OMIND) THEN
          CW= 8.48*BF*(D**0.70692)*(H**(-0.38812))*(CL**0.17127)
        ELSE
          CW= (8.48*BF*(OMIND**0.70692)*(H**(-0.38812))
     &         *(CL**0.17127))*(D/OMIND)
        ENDIF
        IF (CW .GT. 50.) CW=50.
C
C  CASE 09806 DONNELLY (R6)
C  098          PICEA SITCHENSIS                  SITKA SPRUCE
      CASE('09806')
        IF (D .GE. OMIND) THEN
          CW= 4.2857*D**0.5940
        ELSE
          CW= (4.2857*OMIND**0.5940)*(D/OMIND)
        ENDIF
        IF (CW .GT. 60.) CW=60.
C-----------------------------------------------------------------------
C  CASE 10102 BECHTOLD 2004 MODEL 2
C  101          PINUS ALBICAULIS                   WHITEBARK PINE       
      CASE('010102')
        IF (HI .LT.   6.) HI=  6.
        IF (HI .GT.  44.) HI= 44.
        IF (D .GE. MIND) THEN
          CW= 0.5223 + 0.7432*D + (0.0829*HI)
        ELSE
          CW= (0.5223 + 0.7432*MIND + (0.0829*HI))*(D/MIND)
        ENDIF
        IF (CW .GT. 40.) CW=40.
C
C  CASE 10103 CROOKSTON (R1)
C  101          PINUS ALBICAULIS                   WHITEBARK PINE       
      CASE('10103')
      IF (D .GE. 1.1) THEN
        CW= 1.0697*EXP(0.3007 + 0.2400*ALOG(CL) + 0.5696*ALOG(D))
      ELSE
        CW= (1.0697*EXP(0.3007+0.2400*ALOG(CL)+0.5696*ALOG(1.1)))
     &     *(D/1.1)
      ENDIF
      IF (CW .GT. 40.) CW=40.
C
C  CASE 10105 CROOKSTON (R6) MODEL 2
C  101          PINUS ALBICAULIS                   WHITEBARK PINE       
      CASE('10105')
        IF (D .GE. OMIND) THEN
          CW= 2.2354*BF*(D**0.66680)*(H**(-0.11658))*(CL**0.16927)
        ELSE
          CW= (2.2354*BF*(OMIND**0.66680)*(H**(-0.11658))*
     &        (CL**0.16927))*(D/OMIND)
        ENDIF
        IF (CW .GT. 40.) CW=40.
C
C  CASE 10106 DONNELLY (R6)
C  101          PINUS ALBICAULIS                   WHITEBARK PINE       
      CASE('10106')
        IF (D .GE. OMIND) THEN
          CW= 2.1606*D**0.6897
        ELSE
          CW= (2.1606*OMIND**0.6897)*(D/OMIND)
        ENDIF
        IF (CW .GT. 40.) CW=40.
C
C  CASE 10107 MOEUR
C  101          PINUS ALBICAULIS                   WHITEBARK PINE       
      CASE('10107')
        CW= EXP(-.91984 + (1.08137*ALOG(D)) + (-0.07299*ALOG(H))
     &      + 0.29786*ALOG(CL))
        IF (CW .GT. 40.) CW=40.
C-----------------------------------------------------------------------
C  CASE 10201 BECHTOLD 2004 MODEL 1
C  102          PINUS ARTISTA                      BRISTLECONE PINE     
      CASE('10201')
        IF (D .GE. MIND) THEN
          CW= (7.4251 + 0.8991*D)
        ELSE
          CW= (7.4251 + 0.8991*MIND)*(D/MIND)
        ENDIF
        IF (CW .GT. 25.) CW=25.
C-----------------------------------------------------------------------
C  CASE 10305 CROOKSTON (R6) MODEL 2
C  103          PINUS ATTENUATA                     KNOBCONE PINE       
      CASE('10305')
        IF (EL .LT.  12.) EL= 12.
        IF (EL .GT.  49.) EL= 49.
        IF (D .GE. OMIND) THEN
          CW= 4.0069*BF*(D**0.84628)*(H**(-0.29035))*(CL**0.13143)*
     &       *(EXP(EL)**(-0.00842))
        ELSE
          CW= (4.0069*BF*(OMIND**0.84628)*(H**(-0.29035))*
     &        (CL**0.13143)*(EXP(EL)**(-0.00842)))*(D/OMIND)
        ENDIF
        IF (CW .GT. 46.) CW=46.
C-----------------------------------------------------------------------
C  CASE 10601 BECHTOLD 2004 MODEL 1
C  106          PINUS EDULIS                      PINYON PINE (EDULIS)  
      CASE('10601')
        IF (D .GE. MIND) THEN
          CW= -1.2638 + (1.9922*D) + (-0.0410*D*D)
        ELSE
          CW= (-1.2638+(1.9922*MIND)+(-0.0410*MIND*MIND))*(D/MIND)
        ENDIF
        IF (CW .GT. 25.) CW=25.
C
C  CASE 10602 BECHTOLD 2004 MODEL 2
C  106          PINUS EDULIS                      PINYON PINE (EDULIS)  
      CASE('10602')
        IF (HI .LT. -40.) HI=-40.
        IF (HI .GT.  11.) HI= 11.
        IF (D .GE. MIND) THEN
          CW= -5.4647 + (1.9660*D) + (-0.0395*D*D) + (0.0427*CR) + 
     &         (-0.0259*HI)
        ELSE
          CW= (-5.4647+(1.9660*MIND)+(-0.0395*MIND*MIND)+(0.0427*CR)+
     &        (-0.0259*HI))*(D/MIND)
        ENDIF
        IF (D .GE. 25) THEN
          CW= -5.4647 + (1.9660*25) + (-0.0395*25*25) + (0.0427*CR) +
     &       (-0.0259*HI)
        ENDIF
        IF (CW .GT. 25.) CW=25.
C-----------------------------------------------------------------------
C  CASE 10802 BECHTOLD 2004 MODEL 2
C  108          PINUS CONTORTA                     LODGEPOLE PINE       
      CASE('10202')
        IF (D .GE. MIND) THEN
          CW= -1.5440 + (1.3828*D) + (-0.0200*D*D) + (0.0396*CR) + 
     &        (-0.0083*BAREA)
        ELSE
          CW= (-1.5440 + 1.3828*MIND + (-0.0200*D*D) + 0.0396*CR + 
     &        (-0.0083*BAREA))*(D/MIND)
        ENDIF
        IF (CW .GT. 30.) CW=30.
C
C  CASE 10803 CROOKSTON (R1)
C  108          PINUS CONTORTA                     LODGEPOLE PINE       
      CASE('10803')
        IF (D .GE. 0.7) THEN
          CW= 1.03992*EXP(1.58777 + 0.30812*ALOG(CL)+0.64934*ALOG(D)
     &       + (-0.38964)*ALOG(H))
        ELSE
          CW= (1.03992*EXP(1.58777 + 0.30812*ALOG(CL)+
     &        0.64934*ALOG(0.7)+(-0.38964)*ALOG(H)))*(D/0.7)
        ENDIF
        IF (CW .GT. 40.) CW=40.
C
C  CASE 10805 CROOKSTON (R6) MODEL 2
C  108          PINUS CONTORTA                     LODGEPOLE PINE       
      CASE('10805')
        IF (EL .LT.   1.) EL=  1.
        IF (EL .GT.  79.) EL= 79.
        IF (D .GE. OMIND) THEN
          CW= 6.6941*BF*(D**0.81980)*(H**(-0.36992))*(CL**0.17722)*
     &       ((BAREA+1.0)**(-0.01202))*(EXP(EL)**(-0.00882))
        ELSE
          CW=(6.6941*BF*(OMIND**0.81980)*(H**(-0.36992))*
     &       (CL**0.17722)*((BAREA+1.0)**(-0.01202))*
     &       (EXP(EL)**(-0.00882)))*(D/OMIND)
        ENDIF
        IF (CW .GT. 40.) CW=40.
C
C  CASE 10806 DONNELLY (R6)
C  108          PINUS CONTORTA                     LODGEPOLE PINE       
      CASE('10806')
        IF (D .GE. OMIND) THEN
          CW= 2.4132*D**0.6403
        ELSE
          CW= (2.4132*OMIND**0.6403)*(D/OMIND)
        ENDIF
        IF (CW .GT. 40.) CW=40.
C
C  CASE 10807 MOEUR
C  108          PINUS CONTORTA                     LODGEPOLE PINE       
      CASE('10807')
        CW= EXP(1.06804 + 1.08137*ALOG(D) + (-0.55987)*ALOG(H)
     &      + 0.29786*ALOG(CL))
        IF (CW .GT. 40.) CW=40.
C-----------------------------------------------------------------------
C  CASE 11301 BECHTOLD 2004 MODEL 1
C  113          PINUS FLEXILIS                     LIMBER PINE          
      CASE('11301')
        IF (D .GE. MIND) THEN
          CW= 4.0181 + 0.8528*D
        ELSE
          CW= (4.0181 + 0.8528*MIND)*(D/MIND)
        ENDIF
        IF (CW .GT. 25.) CW=25.
C-----------------------------------------------------------------------
C  CASE 11602 BECHTOLD 2004 MODEL 2
C  116          PINUS JEFFREYI                    JEFFREY PINE        
      CASE…