Merge branch 'main' of https://code.fs.usda.gov/forest-service/Forest…

…VegetationSimulator into FMSCrelease
USDAForestService · Feb 24, 2023 · 97f48ce · 97f48ce
2 parents 4b7a365 + 229d13f
commit 97f48ce
Show file tree

Hide file tree

Showing 26 changed files with 2,093 additions and 1,006 deletions.
diff --git a/ak/estab.f b/ak/estab.f
diff --git a/base/apisubs.f b/base/apisubs.f
@@ -228,6 +228,12 @@ subroutine fvsTreeAttr(name,nch,action,ntrees,attr,rtnCode)
       case ("special")
         if (action=="get") attr = ispecl(:ntrees)
         if (action=="set") ispecl(:ntrees) = int(attr,4)     
+      case ("kutkod")
+        if (action=="get") attr = kutkod(:ntrees)
+        if (action=="set") kutkod(:ntrees) = int(attr,4)     
+      case ("wk6")
+        if (action=="get") attr = wk6(:ntrees)
+        if (action=="set") wk6(:ntrees) = real(attr,4)   
       case default
         rtnCode = 1
         attr = 0

diff --git a/cr/forkod.f b/cr/forkod.f
@@ -152,7 +152,7 @@ SUBROUTINE FORKOD
           WRITE(JOSTND,61)
    61     FORMAT(/,'********',T12, 'PINE RIDGE RES. (7104) BEING ',
      &    'MAPPED TO BLACK HILLS NF (203) FOR FURTHER PROCESSING.')
-          I =2
+          IFOR = 2
 
         CASE (7105)
           WRITE(JOSTND,62)

diff --git a/sn/sitset.f b/sn/sitset.f
@@ -9,6 +9,11 @@ SUBROUTINE SITSET
 C  CODE TRANSLATION TABLE
 C  THIS SUBROUTINE FOLLOWS SE-TWIGS SUBROUTINES BLOCK1, CONV1, AND
 C  CONV2.
+C
+C Note: This version of sitset.f has been revised Q2 2023 to update
+C       Merchantability specifications for National Forests in NC, 
+C       per FSH 2409.18 Ch 50 Supplement R8_NC_2409.18-2022-1
+C
 C----------
 COMMONS
 C
@@ -381,22 +386,44 @@ SUBROUTINE SITSET
       IF(IREGN.EQ.8)THEN
         IF(DBHMIN(ISPC).LE.0.)THEN                 !SET **DBHMIN** DEFAULT
           IF((ISPC.LE.17).OR.(ISPC.EQ.88))THEN   !SOFTWOODS
-            IF((ISPC.EQ.7).OR.(ISPC.EQ.13))THEN
-              DBHMIN(ISPC)=6.
-            ELSE
-              DBHMIN(ISPC)=4.
+            IF(IFOR.EQ.11)THEN
+              IF((KODIST.EQ.3).OR.(KODIST.EQ.10))THEN
+                DBHMIN(ISPC)=5.6
+              ELSE 
+                DBHMIN(ISPC)=8.0
+              ENDIF
+            ELSE  
+              IF((ISPC.EQ.7).OR.(ISPC.EQ.13))THEN
+                DBHMIN(ISPC)=6.
+              ELSE
+                DBHMIN(ISPC)=4.
+              ENDIF
             ENDIF
           ELSE                                   !HARDWOODS
-            IF((ISPC.EQ.39).OR.(ISPC.EQ.43).OR.(ISPC.EQ.44).OR.
-     &         (ISPC.EQ.52).OR.(ISPC.EQ.53).OR.(ISPC.EQ.55).OR.
-     &         (ISPC.EQ.63))THEN
-              DBHMIN(ISPC)=6.
-            ELSE
-              DBHMIN(ISPC)=4.
+            IF(IFOR.EQ.11)THEN
+              IF((KODIST.EQ.3).OR.(KODIST.EQ.10))THEN
+                DBHMIN(ISPC)=6.
+              ELSE
+                DBHMIN(ISPC)=8.
+              ENDIF
+            ELSE  
+              IF((ISPC.EQ.39).OR.(ISPC.EQ.43).OR.(ISPC.EQ.44).OR.
+     &           (ISPC.EQ.52).OR.(ISPC.EQ.53).OR.(ISPC.EQ.55).OR.
+     &           (ISPC.EQ.63))THEN
+                DBHMIN(ISPC)=6.
+              ELSE
+                DBHMIN(ISPC)=4.
+              ENDIF
             ENDIF
           ENDIF
         ENDIF
-        IF(TOPD(ISPC).LE.0.)TOPD(ISPC)=4.        !SET **TOPD** DEFAULT
+        IF(TOPD(ISPC).LE.0.)THEN              !SET **TOPD** DEFAULT
+          IF(IFOR.EQ.11)THEN
+            TOPD(ISPC)=3.5
+          ELSE
+            TOPD(ISPC)=4.
+          ENDIF
+        ENDIF
         IF(BFMIND(ISPC).LE.0.)THEN                 !SET **BFMIND** DEFAULT
           IF((ISPC.LE.17).OR.(ISPC.EQ.88))THEN   !SOFTWOODS
             SELECT CASE(IFOR)
@@ -406,18 +433,54 @@ SUBROUTINE SITSET
               ELSE
                 BFMIND(ISPC)=10.
               ENDIF
+            CASE(11)
+              IF((KODIST.EQ.3).OR.(KODIST.EQ.10))THEN
+                BFMIND(ISPC)=11.0
+              ELSEIF((ISPC.EQ.2).OR.(ISPC.EQ.12).OR. ! SYP, SPRUCE, FIR GROUP
+     &               (ISPC.EQ.15).OR.(ISPC.EQ.16).OR.(ISPC.EQ.17))THEN
+                BFMIND(ISPC)=12.
+              ELSE
+                BFMIND(ISPC)=10.
+              ENDIF
             CASE DEFAULT
               BFMIND(ISPC)=10.
             END SELECT
           ELSE                                   !HARDWOODS
-            BFMIND(ISPC)=12.
+            IF(IFOR.EQ.11)THEN
+              IF((KODIST.EQ.3).OR.(KODIST.EQ.10))THEN
+                BFMIND(ISPC)=13.
+              ELSE
+                BFMIND(ISPC)=15.
+              ENDIF
+            ELSE
+              BFMIND(ISPC)=12.
+            ENDIF
           ENDIF
         ENDIF
         IF(BFTOPD(ISPC).LE.0.)THEN                 !SET **BFTOPD** DEFAULT
           IF((ISPC.LE.17).OR.(JSP(ISPC)(1:2).EQ.'OS'))THEN
-            BFTOPD(ISPC)=7.
-          ELSE
-            BFTOPD(ISPC)=9.
+            IF(IFOR.EQ.11)THEN
+              IF((KODIST.EQ.3).OR.(KODIST.EQ.10))THEN
+                BFTOPD(ISPC)=6.3
+              ELSEIF((ISPC.EQ.2).OR.(ISPC.EQ.12).OR. ! SYP, SPRUCE, FIR GROUP
+     &               (ISPC.EQ.15).OR.(ISPC.EQ.16).OR.(ISPC.EQ.17))THEN
+                BFTOPD(ISPC)=9.
+              ELSE
+                BFTOPD(ISPC)=6.3
+              ENDIF
+            ELSE
+              BFTOPD(ISPC)=7.
+            ENDIF
+          ELSE                                       !HARDWOODS
+            IF(IFOR.EQ.11)THEN
+              IF((KODIST.EQ.3).OR.(KODIST.EQ.10))THEN
+                BFTOPD(ISPC)=8.
+              ELSE
+                BFTOPD(ISPC)=11.
+              ENDIF
+            ELSE
+              BFTOPD(ISPC)=9.
+            ENDIF
           ENDIF
         ENDIF
       ELSE                                     !REGION 9