Merge remote-tracking branch 'origin/volume-code-modifications'

USDAForestService · Oct 3, 2022 · 981c60a · 981c60a
2 parents 12658dc + 33d3f30
commit 981c60a
Show file tree

Hide file tree

Showing 245 changed files with 70,328 additions and 32,086 deletions.
diff --git a/.vscode/settings.json b/.vscode/settings.json
@@ -0,0 +1,3 @@
+{
+    "cmake.configureOnOpen": false
+}
diff --git a/README.md b/README.md
diff --git a/ak/grohed.f b/ak/grohed.f
@@ -23,7 +23,7 @@ SUBROUTINE GROHED (IUNIT)
 C  VARIABLE DECLARATIONS:
 C----------
 C
-      CHARACTER DAT*10,REV*10,SVN*4,TIM*8
+      CHARACTER DAT*10,REV*10,SVN*8,TIM*8
 C
       INTEGER IUNIT
 C
@@ -37,7 +37,7 @@ SUBROUTINE GROHED (IUNIT)
       CALL GRDTIM (DAT,TIM)
 C
       WRITE (IUNIT,40) SVN,REV,DAT,TIM
-   40 FORMAT (//T10,'FOREST VEGETATION SIMULATOR',
+   40 FORMAT (//T6,'FOREST VEGETATION SIMULATOR',
      >  5X,'VERSION ',A,' -- ALASKA ',
      >  T97,'RV:',A,T112,A,2X,A)
       RETURN

diff --git a/archive/ni/src/grohed.f b/archive/ni/src/grohed.f
@@ -23,7 +23,7 @@ SUBROUTINE GROHED (IUNIT)
       CALL PPCLOP (IUNIT)
 C
       WRITE (IUNIT,40) SVN,REV,DAT,TIM
-   40 FORMAT (//T10,'FOREST VEGETATION SIMULATOR',
+   40 FORMAT (//T6,'FOREST VEGETATION SIMULATOR',
      >  5X,'VERSION ',A,' -- INLAND EMPIRE PROGNOSIS',
      >  T97,'RV:',A,T112,A,2X,A)
       RETURN
@@ -36,4 +36,4 @@ SUBROUTINE GROHED (IUNIT)
       VVER=DVVER
       RETURN
       END
-
+
diff --git a/base/evldx.f b/base/evldx.f
@@ -101,11 +101,11 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
         XLDREG(1)=TSTV4(I)
         GOTO 1000
    15   CONTINUE   ! OPCODE 501 to 599
-        IF (.NOT.LTSTV5(I)) GOTO 1001  
+        IF (.NOT.LTSTV5(I)) GOTO 1001
         XLDREG(1)=TSTV5(I)
         GOTO 1000
    16   CONTINUE  ! OPCODE 600 to 699
-        IF (.NOT.LTSTV5(I+100)) GOTO 1001 
+        IF (.NOT.LTSTV5(I+100)) GOTO 1001
         XLDREG(1)=TSTV5(I+100)
         GOTO 1000
    17   CONTINUE  ! OPCODE 700 to 799
@@ -182,7 +182,7 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
         IF (J.GT.MAXSP) GOTO 1002
         IF (J.LT.0 .AND. NSPGRP.LT.-J) GOTO 1002
 C----------
-C       IF THE MANAGEMENT CODE (K) IS OUT OF RANGE, THEN: ISSUE ERROR 
+C       IF THE MANAGEMENT CODE (K) IS OUT OF RANGE, THEN: ISSUE ERROR
 C       CODE.
 C----------
         IF (K.LT.0 .OR. K.GT.3) GOTO 1002
@@ -321,7 +321,7 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
             SUMP=SUMP+TPA
             GOTO (111,112,113,114,115,116,117,118,119,120,121,122,123,
      &            124),L
-            
+
   111       CONTINUE
             XLDREG(1)=XLDREG(1)+TPA
             GOTO 190
@@ -643,7 +643,7 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
       ENDIF
 C----------
 C     DECODE INSTRUCTION AND EXECUTE.    POTFMORT:
-C----------     
+C----------
       IF (MYSTR.EQ.12100) THEN
 C----------
 C       RETURN IF FIRE MODEL IS INACTIVE
@@ -662,13 +662,13 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
 C
         CALL FMEVMRT(RVAL, J, I)
         IF (I.EQ.1) GOTO 1001
-        XLDREG(1) = RVAL        
-C        
+        XLDREG(1) = RVAL
+C
         GOTO 1000
       ENDIF
 C----------
 C     DECODE INSTRUCTION AND EXECUTE.    FUELMODS:
-C----------     
+C----------
       IF (MYSTR.EQ.12200) THEN
 C----------
 C       RETURN IF FIRE MODEL IS INACTIVE
@@ -688,13 +688,13 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
         IF (J .LT. 1 .OR. J .GT. 2) GOTO 1002
         CALL FMEVFMD(RVAL, L, J, I)
         IF (I.EQ.1) GOTO 1001
-        XLDREG(1) = RVAL        
-C        
+        XLDREG(1) = RVAL
+C
         GOTO 1000
       ENDIF
 C----------
 C     DECODE INSTRUCTION AND EXECUTE.    SALVVOL:
-C----------     
+C----------
       IF (MYSTR.EQ.12300) THEN
 C----------
 C       RETURN IF FIRE MODEL IS INACTIVE
@@ -717,12 +717,12 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
 C       FIND THE DBH RANGE
 C----------
         XLDBH = XLDREG(2)
-        XHDBH = XLDREG(3)      
-        
+        XHDBH = XLDREG(3)
+
         CALL FMEVSAL(RVAL, J, XLDBH, XHDBH, I)
         IF ((I.EQ.1) .OR. (IPHASE.LT.2)) GOTO 1001
-        XLDREG(1) = RVAL        
-C        
+        XLDREG(1) = RVAL
+C
         GOTO 1000
       ENDIF
 C----------
@@ -751,14 +751,14 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
 C       CHECK RANGE AND VALUES: ARG1 MUST BE 1-33, ARG2 MUST BE 0-1
 C----------
         IF (L .LT. 1 .OR. L .GT. 33) GOTO 1002
-        IF (J .LT. 0 .OR. J .GT. 1) GOTO 1002  
-        IF (J.EQ.1 .AND. IPHASE.LT.2) GO TO 1001        
-        XLDREG(1)=OSTRST(L,J+1)     
-        GOTO 1000 
+        IF (J .LT. 0 .OR. J .GT. 1) GOTO 1002
+        IF (J.EQ.1 .AND. IPHASE.LT.2) GO TO 1001
+        XLDREG(1)=OSTRST(L,J+1)
+        GOTO 1000
       ENDIF
 C----------
 C     DECODE INSTRUCTION AND EXECUTE.    POTFTYPE:
-C----------     
+C----------
       IF (MYSTR.EQ.12600) THEN
 C----------
 C       RETURN IF FIRE MODEL IS INACTIVE
@@ -777,13 +777,13 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
 C
         CALL FMEVTYP(RVAL, J, I)
         IF (I.EQ.1) GOTO 1001
-        XLDREG(1) = RVAL        
-C        
+        XLDREG(1) = RVAL
+C
         GOTO 1000
-      ENDIF         
+      ENDIF
 C----------
 C     DECODE INSTRUCTION AND EXECUTE.    POTSRATE:
-C----------     
+C----------
       IF (MYSTR.EQ.12700) THEN
 C----------
 C       RETURN IF FIRE MODEL IS INACTIVE
@@ -802,13 +802,13 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
 C
         CALL FMEVSRT(RVAL, J, I)
         IF (I.EQ.1) GOTO 1001
-        XLDREG(1) = RVAL        
-C        
+        XLDREG(1) = RVAL
+C
         GOTO 1000
-      ENDIF  
+      ENDIF
 C----------
 C     DECODE INSTRUCTION AND EXECUTE.    POTREINT:
-C----------     
+C----------
       IF (MYSTR.EQ.12800) THEN
 C----------
 C       RETURN IF FIRE MODEL IS INACTIVE
@@ -827,13 +827,13 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
 C
         CALL FMEVRIN(RVAL, J, I)
         IF (I.EQ.1) GOTO 1001
-        XLDREG(1) = RVAL        
-C        
+        XLDREG(1) = RVAL
+C
         GOTO 1000
-      ENDIF        
+      ENDIF
 C----------
 C     DECODE INSTRUCTION AND EXECUTE.    TREEBIO:
-C     NO ARGUMENTS ARE REQUIRED  
+C     NO ARGUMENTS ARE REQUIRED
 C----------
       IF (MYSTR.EQ.12900) THEN
 C----------
@@ -858,7 +858,7 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
           I1=IFIX(XLDREG(1))
         ELSE
           I1=IFIX(XLDREG(1)-.5)
-        ENDIF              
+        ENDIF
 C----------
 C  ARG2-FIND TREE TYPE -  DEAD(<0), LIVE(0),OR BOTH(>0)
 C----------
@@ -868,7 +868,7 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
           I2=IFIX(XLDREG(2))
         ELSE
           I2=IFIX(XLDREG(2)-.5)
-        ENDIF              
+        ENDIF
 C----------
 C  ARG3-FIND TREE PART -  STEM(<0), CROWN(0),OR BOTH-WHOLE TREE(>0)
 C----------
@@ -878,7 +878,7 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
           I3=IFIX(XLDREG(3))
         ELSE
           I3=IFIX(XLDREG(3)-.5)
-        ENDIF              
+        ENDIF
 C----------
 C  ARG4-FIND SPECIES
 C       (J=0:MAXSP) ALL,SPP
@@ -911,7 +911,7 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
       ENDIF
 C----------
 C     DECODE INSTRUCTION AND EXECUTE.    CARBSTAT:
-C----------     
+C----------
       IF (MYSTR.EQ.13000) THEN
 C----------
 C       RETURN IF FIRE MODEL IS INACTIVE
@@ -930,13 +930,13 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
 C
         CALL FMEVCARB(RVAL, J, I)
         IF (I.EQ.1) GOTO 1001
-        XLDREG(1) = RVAL        
-C        
+        XLDREG(1) = RVAL
+C
         GOTO 1000
-      ENDIF        
-C----------X
+      ENDIF
+C----------
 C     DECODE INSTRUCTION AND EXECUTE.    HTDIST:
-C----------     
+C----------
       IF (MYSTR.EQ.13100) THEN
         IF (JARGS.LT.1 .OR. JARGS.GT.1) GOTO 1002
 C----------
@@ -1024,7 +1024,7 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
         IF (K.LT.1 .OR. K.GT.7) GOTO 1002
         IF (M.LT.1 .OR. M.GT.7) GOTO 1002
         IF (K.GT.M) GOTO 1002
-        
+
         CALL FMDWD(RVAL, L, J, K, M, I)
         IF (I.EQ.1) GOTO 1001
         XLDREG(1) = RVAL
@@ -1034,7 +1034,7 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
 C----------
 C     DECODE INSTRUCTION AND EXECUTE.    ACORNS:
 C----------
-C      1ST ARUGMENT: 
+C      1ST ARUGMENT:
 C         1 = NUMBER OF ACORNS PER ACRE
 C         2 = LBS OF ACORNS PER ACRE
 C      2ND ARGUMENT: SPECIES
@@ -1066,17 +1066,16 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
         IF (J.GT.MAXSP) GOTO 1002
         IF (J.LT.0 .AND. NSPGRP.LT.-J) GOTO 1002
 C----------
-C----------
 C       COMPUTE ACORNS
-C---------- 
+C----------
         ACRN=0.
         XLDREG(1)=0.
         ILIM=ITRN
         IF (ILIM.GT.0) THEN
           DO 450 I=1,ILIM
           LINCL = .FALSE.
-          IF(FIAJSP(ISP(I)).EQ."802" .OR. FIAJSP(ISP(I)).EQ."806" .OR. 
-     >       FIAJSP(ISP(I)).EQ."832" .OR. FIAJSP(ISP(I)).EQ."833" .OR. 
+          IF(FIAJSP(ISP(I)).EQ."802" .OR. FIAJSP(ISP(I)).EQ."806" .OR.
+     >       FIAJSP(ISP(I)).EQ."832" .OR. FIAJSP(ISP(I)).EQ."833" .OR.
      >       FIAJSP(ISP(I)).EQ."837") THEN
             IF(J.EQ.0 .OR. J.EQ.ISP(I))THEN
               LINCL = .TRUE.
@@ -1092,8 +1091,7 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
             ENDIF
   452       CONTINUE
           ENDIF
-          IF(LINCL .AND. 
-     >      (DBH(I).GE.5.0)) THEN
+          IF(LINCL .AND. (DBH(I).GE.5.0)) THEN
             DCM = DBH(I)*2.54
             TPA3 = PROB(I)
             ACRN = 0.
@@ -1102,40 +1100,40 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
 C----------
             SELECT CASE (L)
             CASE(1)
-              ADIV = 1.  
+              ADIV = 1.
             CASE(2)
               SELECT CASE (FIAJSP(ISP(I)))
               CASE("802")
                 ADIV = 140.
               CASE("806")
                 ADIV = 180.
               CASE("832")
-                ADIV = 115.                              
+                ADIV = 115.
               CASE("833")
-                ADIV = 100.              
+                ADIV = 100.
               CASE("837")
                 ADIV = 160.
-              END SELECT 
+              END SELECT
             END SELECT
             SELECT CASE (FIAJSP(ISP(I)))
               CASE("802")
-                BADJ = 0.6**2*(1-0.6**2)/2 
-                ACRN = (0.71155+0.06346*DCM -0.00034290*DCM*DCM) 
+                BADJ = 0.6**2*(1-0.6**2)/2
+                ACRN = (0.71155+0.06346*DCM -0.00034290*DCM*DCM)
                 ACRN = (TPA3*(10**(ACRN+BADJ)-1))/ADIV
               CASE("806")
                 BADJ = 0.5**2*(1-0.5**2)/2
-                ACRN = (1.16744+0.05158*DCM -0.00026797*DCM*DCM) 
+                ACRN = (1.16744+0.05158*DCM -0.00026797*DCM*DCM)
                 ACRN = (TPA3*(10**(ACRN+BADJ)-1))/ADIV
               CASE("832")
-                BADJ = 0.6**2*(1-0.6**2)/2 
+                BADJ = 0.6**2*(1-0.6**2)/2
                 ACRN = (0.20984+0.06029*DCM-0.00039431*DCM*DCM)
                 ACRN = (TPA3*(10**(ACRN+BADJ)-1))/ADIV
               CASE("833")
                 BADJ = 0.6**2*(1-0.6**2)/2
-                ACRN = (-0.14836+0.07539*DCM-0.00039950*DCM*DCM) 
+                ACRN = (-0.14836+0.07539*DCM-0.00039950*DCM*DCM)
                 ACRN = (TPA3*(10**(ACRN+BADJ)-1))/ADIV
               CASE("837")
-                BADJ = 0.4**2*(1-0.4**2)/2              
+                BADJ = 0.4**2*(1-0.4**2)/2
                 ACRN = (TPA3*(10**(1.06367+0.03123*DCM+BADJ)-1))/ADIV
             END SELECT
             XLDREG(1)=XLDREG(1)+(ACRN)
@@ -1147,7 +1145,7 @@ SUBROUTINE EVLDX (XLDREG,NXLDX,INSTR,IRC)
       ENDIF
 C----------
 C     DECODE INSTRUCTION AND EXECUTE.    CLSPVIAB
-C----------	  
+C----------
       IF (MYSTR.EQ.13500) THEN
 C----------
 C       RETURN IF CLIMATE MODEL IS INACTIVE, ALSO RETURN IF THE NUMBER