C ********************************************************************** C * * C * SOFTWARE LICENSING * C * * C * This program is free software; you can redistribute * C * it and/or modify it under the terms of the GNU * C * General Public License as published by the Free * C * Software Foundation, either Version 2 of the * C * license, or (at your option) any later version. * C * * C * This program is distributed in the hope that it * C * will be useful, but without any warranty; without * C * even the implied warranty of merchantability or * C * fitness for a particular purpose. See the GNU * C * General Public License for more details. * C * * C * A copy of the GNU General Public License is * C * available at http://www.gnu.org/copyleft/gpl.html * C * or by writing to the Free Software Foundation, Inc.,* C * 59 Temple Place - Suite 330, Boston, MA 02111, USA. * C * * C ********************************************************************** SUBROUTINE BOTTAU C C CALCULATES BOTTOM SHEAR STRESSES FOR USE IN SEDIMENT TRANSPORT C (SUBROUTINES sedflx AND suslod) C C REVISION DATE : AUGUST 6, 1996 C C********************************************************************** C INCLUDE 'comdeck' SAVE C C CALC. BOTTOM SHEAR STRESS C IF(TOR.EQ.'BAROTROPIC') THEN DO 10 J=2,JMM1 DO 10 I=2,IMM1 ! UBAR(I,J,KBM1)=(DUMWAD(I,J)*UA(I,J)+DUMWAD(I+1,J)*UA(I+1,J))/ ! + (DUMWAD(I,J)+DUMWAD(I+1,J)+1.0E-30) ! VBAR(I,J,KBM1)=(DVMWAD(I,J)*VA(I,J)+DVMWAD(I,J+1)*VA(I,J+1))/ ! + (DVMWAD(I,J)+DVMWAD(I,J+1)+1.0E-30) UBAR(I,J,KBM1)=0.5*(UA(I,J)+UA(I+1,J)) VBAR(I,J,KBM1)=0.5*(VA(I,J)+VA(I,J+1)) DT(I,J)=D(I,J) ! NG11012013, for stress that needs DT, use D. 10 CONTINUE ELSE DO 11 K=1,KBM1 DO 11 J=2,JMM1 DO 11 I=2,IMM1 ! UBAR(I,J,K)=(DUMWAD(I,J)*U(I,J,K)+DUMWAD(I+1,J)*U(I+1,J,K))/ ! + (DUMWAD(I,J)+DUMWAD(I+1,J)+1.0E-30) ! VBAR(I,J,K)=(DVMWAD(I,J)*V(I,J,K)+DVMWAD(I,J+1)*V(I,J+1,K))/ ! + (DVMWAD(I,J)+DVMWAD(I,J+1)+1.0E-30) UBAR(I,J,K)=0.5*(U(I,J,K)+U(I+1,J,K)) VBAR(I,J,K)=0.5*(V(I,J,K)+V(I,J+1,K)) 11 CONTINUE ENDIF C C DO 20 J=2,JMM1 DO 20 I=2,IMM1 QBAR(I,J)=SQRT(UBAR(I,J,KBM1)*UBAR(I,J,KBM1)+ + VBAR(I,J,KBM1)*VBAR(I,J,KBM1)) 20 CONTINUE C C-------- VELOCITY BOUNDARY CONDITION ---------------------------------- C cqa Do 21 N = 1, NUMQBC cqa ID = IQD(N) cqa JD = JQD(N) cqa IC = IQC(N) cqa JC = JQC(N) C cqa Do 22 K = 1, KBM1 cqa FRESH = QDIS(N) * RAMP * VQDIST(N,K) / 100. cqa If (JD.EQ.JC) Then cqa If (ID.LT.IC) Then cqa UBAR(IC,JC,K) = U(ID,JD,K) cqa Else cqa UBAR(ID,JD,K) = U(ID+1,JD,K) cqa End If cqa Else cqa If (JD.LT.JC) Then cqa VBAR(IC,JC,K) = -FRESH/(DZ(K)*DT(I,J)*H1(ID,JD)) cqa Else cqa VBAR(ID,JD,K) = FRESH/(DZ(K)*DT(I,J)*H1(ID,JD)) cqa End If cqa End If cqa 22 Continue cqa 21 Continue C cqa IF (HYDTYPE.EQ.'INTERNAL') THEN cqa DO 30 K=1,KB cqa DO 30 J=2,JMM1 cqa DO 30 I=2,IMM1 cqa TAU(I,J,K)=0.0 cqa 30 CONTINUE cqa ELSE cqa DO 35 J=2,JMM1 cqa DO 35 I=2,IMM1 cqa TAU(I,J,KB)=0.0 cqa 35 CONTINUE cqa ENDIF C C NO WIND WAVES C CNG02222007 IF (WAVEDYN.EQ.'DONONLY ') THEN CNG02222007 CNG12222010 ! INCORPORATED NWAVE AND BCOND CALL HERE LIKE FOR DONMODEL NWAVECNT=NWAVECNT+1 IF (NWAVECNT.EQ.1) THEN CALL BCOND(11,DTI2,0) CALL WAVEDON ENDIF IF (NWAVECNT.EQ.NWAVE) NWAVECNT=0 CNG12222010 ELSEIF (WAVEDYN.EQ.'NEGLECT ') THEN DO 40 J=2,JMM1 DO 40 I=2,IMM1 IF (FSM(I,J).GT.0.0) THEN C C BOTTOM STRESS (AT K= KB) C C IN SED TRANSPORT, THE CBC DOES NOT NEED TO BE SCALED. OTHERWISE, IT WOULD C RESUSPEND EXCESSIVE SEDIMENT (PER PRAVI, NKIM 10.23.02) c TAU(I,J,KB)=10000.*CBC(I,J)*QBAR(I,J)*QBAR(I,J) TAU(I,J,KB)=10000.*CBC(I,J)/VARBF(I,J)*QBAR(I,J)*QBAR(I,J) ENDIF 40 CONTINUE C C FORCING TAU VALUE = 0 AT CELLS CONNECTED BY RIVERS (IC,JC) C By Quamrul QA 10/28/98 C DO 120 N=1,NUMQBC IC=IQC(N) JC=JQC(N) TAU(IC,JC,KB) = 0.0 120 CONTINUE ELSE C C INCLUDE WIND WAVE EFFECTS C CNKIM11232010 IF (WAVEDYN.EQ.'SMBMODEL') CALL WAVESMB CNKIM11232010 IF (WAVEDYN.EQ.'DONMODEL') CALL WAVEDON CNKIM11232010 BRING NWAVECNT BELOW HERE CNG12022010 NEED TO BE CALLED IN INITIAL POINT CNG12022010 IF (WAVEDYN.EQ.'SMBMODEL'.OR. CNG12022010 + WAVEDYN.EQ.'DONMODEL'.OR. CNG12022010 + WAVEDYN.EQ.'EXTERNAL') THEN CNG12022010 NWAVECNT=NWAVECNT+1 CNG12022010 IF (NWAVECNT.EQ.NWAVE) THEN CNG12022010 NWAVECNT=0 CNG12022010 CALL BCOND(11,DTI2,0) ! UPDATE WAVE BC (NKIM 11.23.2010) CNG12022010 IF (WAVEDYN.EQ.'SMBMODEL') CALL WAVESMB CNG12022010 IF (WAVEDYN.EQ.'DONMODEL') CALL WAVEDON CNG12022010 ENDIF CNG12022010 ENDIF IF (WAVEDYN.EQ.'SMBMODEL'.OR. + WAVEDYN.EQ.'DONMODEL'.OR. + WAVEDYN.EQ.'EXTERNAL') THEN NWAVECNT=NWAVECNT+1 IF (NWAVECNT.EQ.1) THEN CALL BCOND(11,DTI2,0) ! UPDATE WAVE BC (NKIM 11.23.2010) IF (WAVEDYN.EQ.'SMBMODEL') CALL WAVESMB IF (WAVEDYN.EQ.'DONMODEL') CALL WAVEDON ENDIF IF (NWAVECNT.EQ.NWAVE) NWAVECNT=0 ENDIF CNKIM11232010 BRING NWAVECNT ABOVE HERE CALL STRESS ENDIF C RETURN END