friction_init.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\friction_init.f
00002 !
00084                      SUBROUTINE FRICTION_INIT
00085 !                    ************************
00086 !
00087 !
00088 !***********************************************************************
00089 ! TELEMAC2D   V6P1                                   21/08/2010
00090 !***********************************************************************
00091 !
00092 !
00093 !
00094 !
00095 !
00096 !
00097 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00098 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00099 !
00100       USE BIEF
00101       USE FRICTION_DEF
00102       USE DECLARATIONS_TELEMAC
00103       USE DECLARATIONS_TELEMAC2D
00104       USE INTERFACE_TELEMAC2D
00105 !
00106       IMPLICIT NONE
00107       INTEGER LNG,LU
00108       COMMON/INFO/LNG,LU
00109 !
00110       !2/ LOCAL VARIABLES
00111       !------------------
00112       INTEGER :: I, J, K
00113       LOGICAL :: FRICTION_ERR
00114 !
00115 !=======================================================================!
00116 !=======================================================================!
00117 !                               PROGRAMME                               !
00118 !=======================================================================!
00119 !=======================================================================!
00120 !
00121       CALL FRICTION_READ(T2D_FILES(T2DCOF)%LU,
00122      &                   NZONMX,ITURB,LISRUG,LINDNER,
00123      &                   T2D_FILES(T2DCOF)%NAME,NZONES,FRTAB)
00124 !
00125       ! INITIALIZATION (ALL ELEMENTS WITH -1
00126       ! IN ORDER TO CHECK AFTER USER INITIALIZATION)
00127       ! --------------------------------------------
00128       DO I = 1, CF%DIM1
00129         KFROPT%I(I) = -1
00130       ENDDO
00131 !
00132       ! USER INITIALIZATION
00133       ! -------------------
00134       CALL FRICTION_USER
00135 !
00136       FRICTION_ERR = .FALSE.
00137 !
00138       ! CHECK VALUE
00139       ! -----------
00140 ! FH : FOR QUASI-BUBBLE
00141 ! FH : 2004/03/01
00142 ! =>
00143       DO I=1, NPOIN
00144 ! <=
00145 ! FH : 2004/03/01
00146 ! FH : FOR QUASI-BUBBLE
00147         ! NO FRICTION ZONE DEFINED
00148         ! ------------------------
00149         IF (KFROPT%I(I) == -1) THEN
00150           FRICTION_ERR = .TRUE.
00151           IF(NCSIZE>1) THEN
00152             K = MESH%KNOLG%I(I)
00153           ELSE
00154             K = I
00155           ENDIF
00156           IF(LNG == 1) WRITE(LU,10) K
00157           IF(LNG == 2) WRITE(LU,11) K
00158 !
00159         ! LOCAL NUMBERING OF THE ZONE
00160         ! ---------------------------
00161         ELSE
00162           DO J = 1, NZONES
00163             IF(KFROPT%I(I) == FRTAB%ADR(J)%P%GNUMB(1)) THEN
00164               KFROPT%I(I) = J
00165               EXIT
00166             ENDIF
00167             IF(J==NZONES) THEN
00168               FRICTION_ERR = .TRUE.
00169               IF (NCSIZE>1) THEN
00170                 K = MESH%KNOLG%I(I)
00171               ELSE
00172                 K=I
00173               ENDIF
00174               IF (LNG==1) WRITE(LU,20) K,KFROPT%I(I)
00175               IF (LNG==2) WRITE(LU,21) K,KFROPT%I(I)
00176             ENDIF
00177           ENDDO
00178         ENDIF
00179 !
00180       ENDDO
00181 !
00182 10    FORMAT('AUCUNE ZONE DE FROTTEMENT DEFINI POUR LE NOEUD : ',I5)
00183 11    FORMAT('NO FRICTION ZONE DEFINED FOR THE NODE : ',I5)
00184 !
00185 20    FORMAT('MAUVAISE INITIALISATION DE LA ZONE DE FROTTEMENT DU ',
00186      &       'NOEUD :',I5
00187      &     ,/' ZONE : ',I9,' INCONNUE')
00188 21    FORMAT('WRONG INITIALIZATION OF THE FRICTION ZONE FOR THE NODE :'
00189      &     ,  I5
00190      &     ,/' ZONE : ',I9,' UNKNOWN')
00191 !
00192       IF(FRICTION_ERR) THEN
00193         CALL PLANTE(1)
00194         STOP
00195       ENDIF
00196 !
00197 ! FH : FOR QUASI-BUBBLE
00198 ! FH : 2004/03/01
00199 ! =>
00200       ! VECTOR INITIALIZATION : WHOLE DOMAIN
00201       ! (FOR QUASI_BUBBLE, SEE FRICTION_CHOICE.F : CALL FRICTION_BUBBLE)
00202       ! ----------------------------------------------------------------
00203       IF (LINDNER) THEN
00204         DO I = 1, NPOIN
00205           CHESTR%R(I) = FRTAB%ADR(KFROPT%I(I))%P%RCOEF(1)
00206           NDEFMA%R(I) = FRTAB%ADR(KFROPT%I(I))%P%NDEF (1)
00207           NKFROT%I(I) = FRTAB%ADR(KFROPT%I(I))%P%RTYPE(1)
00208           LINDDP%R(I) = FRTAB%ADR(KFROPT%I(I))%P%DP
00209           LINDSP%R(I) = FRTAB%ADR(KFROPT%I(I))%P%SP
00210         ENDDO
00211       ELSE
00212         DO I = 1, NPOIN
00213           CHESTR%R(I) = FRTAB%ADR(KFROPT%I(I))%P%RCOEF(1)
00214           NDEFMA%R(I) = FRTAB%ADR(KFROPT%I(I))%P%NDEF (1)
00215           NKFROT%I(I) = FRTAB%ADR(KFROPT%I(I))%P%RTYPE(1)
00216         ENDDO
00217       ENDIF
00218 !
00219       ! VECTOR INITIALIZATION : BOUNDARY CONDITIONS
00220       ! -------------------------------------------
00221       IF(LISRUG.EQ.2) THEN
00222         DO J = 1, MESH%NPTFR
00223           I = MESH%NBOR%I(J)
00224           CHBORD%R(J) = FRTAB%ADR(KFROPT%I(I))%P%RCOEF(2)
00225           NDEF_B%R(J) = FRTAB%ADR(KFROPT%I(I))%P%NDEF (2)
00226           KFRO_B%I(J) = FRTAB%ADR(KFROPT%I(I))%P%RTYPE(2)
00227         ENDDO
00228       ENDIF
00229 !
00230 ! <=
00231 ! FH : 2004/03/01
00232 ! FH : FOR QUASI-BUBBLE
00233       ! KFROT IS USED IN ORDER TO KNOW
00234       ! HOW MANY ZONE HAVES A FRICTION COEFFCIENT
00235       ! -----------------------------------------
00236       KFROT = 0
00237       DO I =1, NZONES
00238         IF(FRTAB%ADR(I)%P%RTYPE(1).NE.0) KFROT = KFROT + 1
00239       ENDDO
00240 !
00241 !=======================================================================!
00242 !=======================================================================!
00243 !
00244       RETURN
00245       END SUBROUTINE FRICTION_INIT

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