SUBROUTINE INTERPWLV(NODE1,H,ARIV,WRIV,DWRIV) USE BLK1MOD ! INCLUDE 'BLK1.COM' NLSEC11=NRIVCR1(node1) IF(NRIVL(NLSEC11) .EQ. 0) THEN IF(WTRIVCR1(node1) .gt. 0.) THEN ARIV=0. WRIV=0. RETURN ELSE A11=0. W11=0. DW11=0. GO TO 272 ENDIF ENDIF DO K=2,NRIVL(NLSEC11) DEPL=CRSDAT(NLSEC11,K,1)-CRSDAT(NLSEC11,1,1) IF(DEPL .GT. H) THEN FRAC= (H+CRSDAT(NLSEC11,1,1)-CRSDAT(NLSEC11,K-1,1))/& (CRSDAT(NLSEC11,K,1)-CRSDAT(NLSEC11,K-1,1)) A11=CRSDAT(NLSEC11,K-1,2)*(1.-FRAC) +& CRSDAT(NLSEC11,K,2)*FRAC W11=CRSDAT(NLSEC11,K-1,3)*(1.-FRAC) +& CRSDAT(NLSEC11,K,3)*FRAC DW11=(CRSDAT(NLSEC11,K,3)-CRSDAT(NLSEC11,K-1,3))/& (CRSDAT(NLSEC11,K,1)-CRSDAT(NLSEC11,K-1,1)) GO TO 272 ENDIF ENDDO !IPK MAY04 ALLOW FOR LEVEL ABOVE HIGHEST LAYER W11=CRSDAT(NLSEC11,NRIVL(NLSEC11),3) DW11=0. A11=CRSDAT(NLSEC11,NRIVL(NLSEC11),2)+W11*(H-DEPL) 272 CONTINUE NLSEC12=NRIVCR2(node1) IF(NRIVL(NLSEC12) .EQ. 0) THEN IF(WTRIVCR2(node1) .gt. 0.) THEN ARIV=0. WRIV=0. RETURN ELSE A12=0. W12=0. DW12=0. GO TO 274 ENDIF ENDIF DO K=2,NRIVL(NLSEC12) DEPL=CRSDAT(NLSEC12,K,1)-CRSDAT(NLSEC12,1,1) IF(DEPL .GT. H) THEN FRAC= (H+CRSDAT(NLSEC12,1,1)-CRSDAT(NLSEC12,K-1,1))/& (CRSDAT(NLSEC12,K,1)-CRSDAT(NLSEC12,K-1,1)) A12=CRSDAT(NLSEC12,K-1,2)*(1.-FRAC) +& CRSDAT(NLSEC12,K,2)*FRAC W12=CRSDAT(NLSEC12,K-1,3)*(1.-FRAC) +& CRSDAT(NLSEC12,K,3)*FRAC DW12=(CRSDAT(NLSEC12,K,3)-CRSDAT(NLSEC12,K-1,3))/& (CRSDAT(NLSEC12,K,1)-CRSDAT(NLSEC12,K-1,1)) GO TO 274 ENDIF ENDDO !IPK MAY04 ALLOW FOR LEVEL ABOVE HIGHEST LAYER W12=CRSDAT(NLSEC12,NRIVL(NLSEC12),3) DW12=0. A12=CRSDAT(NLSEC12,NRIVL(NLSEC12),2)+W12*(H-DEPL) 274 CONTINUE ARIV=WTRIVCR1(node1)*A11+WTRIVCR2(node1)*A12 WRIV=WTRIVCR1(node1)*W11+WTRIVCR2(node1)*W12 DWRIV=WTRIVCR1(node1)*DW11+WTRIVCR2(node1)*DW12 300 RETURN END