C
C External:
C MRMULT Soil motion coefficient multiplier for thawing soils
C TRMULT Soil traction coefficient multiplier for thawing soils
C
C Internal:
C I
Suspension assembly index
C STATOK Temporary status flag
C
IMPLICIT NONE
INCLUDE `nrmmdefs.inc'
INCLUDE `nrmmdrvc.inc'
INCLUDE `nrmmcntc.inc'
INCLUDE `nrmmvehc.inc'
INCLUDE `nrmmvppc.inc'
INCLUDE `nrmmterc.inc'
INCLUDE `nrmmtppc.inc'
C
LOGICAL STATOK
INTEGER I
REAL MRMULT, TRMULT
EXTERNAL MRMULT, TRMULT
C
C Diagnostic printout of input data:
IF( KIV(3) .GT. YES )THEN
CALL DIAGIN(`!0***Routine THAW(IV3) `//
& `CRREL Thawing soil traction model')
CALL DIAG( `DOWPB DTHAW DSNOW LAYER NAMBLY' )
CALL DIAG( `RTOWPB RTOWT' )
END IF
C
STATOK=.TRUE.
DO 10 I=1, NAMBLY
TFMUL(I) = TRMULT()
IF(STATOK)STATOK = TFMUL(I).GT.0
TFOW(I) = (DOWPB(I)+RTOWPB(I))*TFMUL(I)
MRMUL(I) = MRMULT(I)
IF(STATOK)STATOK = MRMUL(I).LT.999.
RTOWPB(I) = RTOWPB(I)*MRMUL(I)
RTOWT(I) = RTOWT(I)*MRMUL(I)
DOWPB(I) = TFOW(I) - RTOWPB(I)
10 CONTINUE
THAW = STATOK
C
C Check for validity
IF( LAYER .EQ. 2 )
& CALL ERROR( `THAW','Critical depth > 6"' )
IF( DSNOW .GT. 1./XCM2IN)
& CALL ERROR( `THAW','Snow cover > 1 cm.' )
C
RETURN
END
C TRMULT Traction multiplier for thawing soils 6 Jan 94
C*********************************************
49