friction.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\friction.f
00002 !
00046                      SUBROUTINE FRICTION
00047 !                    *******************
00048 !
00049      &(NS,G,DT,UA,H,QU,QV,CF)
00050 !
00051 !***********************************************************************
00052 ! TELEMAC2D   V6P1                                   21/08/2010
00053 !***********************************************************************
00054 !
00055 !
00056 !
00057 !
00058 !
00059 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00060 !| CF             |-->| THE FRICTION COEFFICIENT
00061 !| DT             |-->| TIME STEP
00062 !| G              |-->| GRAVITY
00063 !| H              |-->| WATER DEPTH AT TN
00064 !| NS             |-->| TOTAL NUMBER OF NODES
00065 !| QU             |-->| HU AT TIME TN
00066 !| QV             |-->| HV AT TIME TN
00067 !| UA             |<->| (H,HU,HV) AT TN+1
00068 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00069 !
00070       IMPLICIT NONE
00071       INTEGER LNG,LU
00072       COMMON/INFO/LNG,LU
00073 !
00074 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00075 !
00076       INTEGER, INTENT(IN)             :: NS
00077       DOUBLE PRECISION, INTENT(IN)    :: G,DT
00078       DOUBLE PRECISION, INTENT(IN)    :: CF(NS)
00079       DOUBLE PRECISION, INTENT(IN)    :: H(NS),QU(NS),QV(NS)
00080       DOUBLE PRECISION, INTENT(INOUT) :: UA(3,NS)
00081 !
00082 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00083 !
00084       INTEGER IS
00085       DOUBLE PRECISION AKAP,AKAP1,STRIC2
00086 !
00087 !-----------------------------------------------------------------------
00088 !
00089       DO IS =1,NS
00090 !
00091         STRIC2=CF(IS)**2
00092 !
00093 ! FH-FRDATA
00094 !        IF(H(IS).LE.1.D-12.OR.UA(1,IS).LE.1.D-12)  THEN
00095         IF((H(IS)   .LE.1.D-12).OR.
00096      &     (UA(1,IS).LE.1.D-12).OR.
00097      &     (CF(IS)  .LE.1.D-12)    ) THEN
00098 ! FH-FRDATA
00099           AKAP=0.D0
00100         ELSE
00101           AKAP= G*DT*SQRT(QU(IS)**2+QV(IS)**2)/
00102      &         (STRIC2*H(IS)*UA(1,IS)**(4.D0/3.D0))
00103         ENDIF
00104 !
00105         AKAP1=1.D0/(1.D0+AKAP)
00106         UA(2,IS) = AKAP1*UA(2,IS)
00107         UA(3,IS) = AKAP1*UA(3,IS)
00108 !
00109       ENDDO
00110 !
00111 !-----------------------------------------------------------------------
00112 !
00113       RETURN
00114       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0