friction_choice.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\friction_choice.f
00002 !
00101                      SUBROUTINE FRICTION_CHOICE
00102 !                    **************************
00103 !
00104      &(FRICTION_PASS,KARMAN)
00105 !
00106 !***********************************************************************
00107 ! TELEMAC2D   V6P1                                   21/08/2010
00108 !***********************************************************************
00109 !
00110 !
00111 !
00112 !
00113 !
00114 !
00115 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00116 !| FRICTION_PASS  |-->| IF 0, INITIALISATION
00117 !| KARMAN         |-->| VON KARMAN CONSTANT
00118 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00119 !
00120       USE BIEF
00121       USE FRICTION_DEF
00122       USE DECLARATIONS_TELEMAC
00123       USE DECLARATIONS_TELEMAC2D
00124       USE INTERFACE_TELEMAC2D, EX_FRICTION_CHOICE => FRICTION_CHOICE
00125 !
00126       IMPLICIT NONE
00127       INTEGER LNG,LU
00128       COMMON/INFO/LNG,LU
00129 !
00130 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00131 !
00132       INTEGER,          INTENT(IN) :: FRICTION_PASS
00133       DOUBLE PRECISION, INTENT(IN) :: KARMAN
00134 !
00135 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00136 !
00137       INTEGER                     :: I
00138       DOUBLE PRECISION, PARAMETER :: VK = 1.D-6
00139 !
00140 !======================================================================!
00141 !======================================================================!
00142 !                               PROGRAMME                              !
00143 !======================================================================!
00144 !======================================================================!
00145 !
00146 ! INITIALIZATION
00147 ! --------------
00148 !
00149       IF(FRICTION_PASS == 0) THEN
00150 !
00151 ! ZONES INITIALIZATION
00152 ! --------------------
00153 !
00154         IF (FRICTB) THEN
00155           CALL FRICTION_INIT
00156           CALL STRCHE
00157 ! FH : FOR QUASI-BUBBLE
00158 ! FH : 2004/03/01
00159 !JAJ FOR QUADRATIC ELEMENTS
00160 ! =>
00161           IF (CF%ELM /= H%ELM) THEN
00162             IF(CF%ELM==12 .AND. H%ELM==11) THEN
00163               CALL FRICTION_BUBBLE
00164      &            (IKLE, NPOIN, NELEM, NELMAX, LINDNER, NKFROT,
00165      &             CHESTR, NDEFMA, LINDDP, LINDSP)
00166             ELSEIF (CF%ELM==13 .AND. H%ELM==11) THEN
00167               CALL FRICTION_QUAD
00168      &            (IKLE%I, NPOIN, NELEM, NELMAX, LINDNER, NKFROT,
00169      &             CHESTR, NDEFMA, LINDDP, LINDSP)
00170 !              WRITE (LU,*)
00171 !     &         'FRICTION_CHOICE::QUADRATIC ELEMENTS NOT IMPLEMENTED.'
00172 !              CALL PLANTE(1)
00173             ELSE
00174               WRITE (LU,*)
00175      &         'FRICTION_CHOICE::DISCRETISATION NOT IMPLEMENTED.'
00176               WRITE (LU,*)
00177      &         'CF%ELM, H%ELM: ',CF%ELM, H%ELM
00178               CALL PLANTE(1)
00179             ENDIF
00180           ENDIF
00181 ! <=
00182 !JAJ FOR QUADRATIC ELEMENTS
00183 ! FH : 2004/03/01
00184 ! FH : FOR QUASI-BUBBLE
00185 !
00186 !        UNIFORM CASE
00187 !        ------------
00188 !
00189         ELSE
00190           ! CHESTR FOR BOUNDARY CONDITIONS INITIALIZATION
00191           ! -----------------------------------------------
00192           IF(LISRUG.EQ.2) THEN
00193             IF(KFROTL.EQ.1) THEN
00194               DO I = 1, NPTFR
00195                 CHBORD%R(I) = CHESTR%R(MESH%NBOR%I(I))
00196               ENDDO
00197             ELSE
00198 !             JMH 21/12/2010
00199 !             BOUNDARY CONDITIONS FILE DATA IF ANY SUPERSEDE
00200 !             THE KEY-WORD ROUGHNESS COEFFICIENT OF BOUNDARIES
00201               IF(P_DOTS(CHBORD,CHBORD,MESH).EQ.0.D0) THEN
00202                 CALL OS('X=C     ', X=CHBORD, C=SB)
00203               ENDIF
00204             ENDIF
00205           ENDIF
00206           ! TYPE OF FRICTION LAW FOR EACH NODE
00207           ! ----------------------------------
00208           DO I=1, CF%DIM1
00209             NKFROT%I(I) = KFROT
00210           ENDDO
00211 !
00212         ENDIF
00213 !
00214 !     COMPUTATION
00215 !     -----------
00216 !
00217       ELSE
00218 !
00219         ! FRICTION BY ZONES
00220         ! -----------------
00221         IF (FRICTB) THEN
00222 ! FH : FOR QUASI-BUBBLE
00223 ! FH : 2004/03/01
00224 !JAJ FOR QUADRATIC ELEMENTS
00225 ! =>
00226           IF (CF%ELM /= H%ELM) THEN
00227             IF (CF%ELM==12 .AND. H%ELM==11) THEN
00228               CALL FRICTION_BUBBLE
00229      &            (IKLE, NPOIN, NELEM, NELMAX, LINDNER, NKFROT,
00230      &             CHESTR, NDEFMA, LINDDP, LINDSP)
00231             ELSE IF (CF%ELM==13 .AND. H%ELM==11) THEN
00232               CALL FRICTION_QUAD
00233      &            (IKLE%I, NPOIN, NELEM, NELMAX, LINDNER, NKFROT,
00234      &             CHESTR, NDEFMA, LINDDP, LINDSP)
00235             ELSE
00236               WRITE (LU,*)
00237      &         'FRICTION_CHOICE::DISCRETISATION NOT IMPLEMENTED.'
00238               WRITE (LU,*)
00239      &         'CF%ELM, H%ELM: ',CF%ELM, H%ELM
00240               CALL PLANTE(1)
00241               STOP
00242             ENDIF
00243           ENDIF
00244 !
00245           CALL FRICTION_ZONES
00246      &         (MESH, H, U, V, S, CHESTR, CHBORD, NKFROT, NDEFMA,
00247      &          LINDDP, LINDSP, KFRO_B, NDEF_B, ITURB, LISRUG,
00248      &          LINDNER, VK, KARMAN, GRAV, T1, T2, CF, CFBOR)
00249 ! <=
00250 !JAJ FOR QUADRATIC ELEMENTS
00251 ! FH : 2004/03/01
00252 ! FH : FOR QUASI-BUBBLE
00253 !
00254         ! UNIFORM FRICTION
00255         ! ----------------
00256         ELSE
00257           CALL FRICTION_UNIF
00258      &         (MESH,H,U,V,CHESTR,S,KFROT,KFROTL,ITURB, LISRUG,
00259      &          LINDNER, SB, NDEF, DP, SP, VK, KARMAN, GRAV, T1,
00260      &          T2, CHBORD, CF, CFBOR)
00261 !
00262         ENDIF
00263       ENDIF
00264 !
00265 !======================================================================!
00266 !======================================================================!
00267 !
00268       RETURN
00269       END

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