lichek.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\lichek.f
00002 !
00109                      SUBROUTINE LICHEK
00110 !                    *****************
00111 !
00112      &(LIMPRP,NPTFR,IKLBOR,NELEB2,NELEBX2)
00113 !
00114 !***********************************************************************
00115 ! TELEMAC3D   V7P0                                   21/08/2010
00116 !***********************************************************************
00117 !
00118 !
00119 !
00120 !
00121 !
00122 !
00123 !
00124 !
00125 !
00126 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00127 !| IKLBOR         |-->| CONNECTIVITY OF BOUNDARY SEGMENTS IN D
00128 !| LIMPRP         |<->| TYPES OF BOUNDARY CONDITIONS FOR PROPAGATION
00129 !|                |   | BY  POINTS   :    .1:H  .2:U  .3:V
00130 !|                |   | BY  EDGES    :    .4:H  .5:U  .6:V
00131 !| NELEB2         |-->| NUMBER OF BOUNDARY ELEMENTS IN 2D.
00132 !| NELEBX2        |-->| MAXIMUM NUMBER OF BOUNDARY ELEMENTS IN 2D.
00133 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS IN 2D
00134 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00135 !
00136       USE BIEF
00137       USE DECLARATIONS_TELEMAC
00138       USE DECLARATIONS_TELEMAC3D
00139 !
00140       IMPLICIT NONE
00141       INTEGER LNG,LU
00142       COMMON/INFO/LNG,LU
00143 !
00144 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00145 !
00146       INTEGER, INTENT(IN)    :: NPTFR,NELEB2,NELEBX2
00147       INTEGER, INTENT(INOUT) :: IKLBOR(NELEBX2,2),LIMPRP(NELEBX2,6)
00148 !
00149 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00150 !
00151       INTEGER IPOIN2, IPTFR, IPTFR3, IPTFRX,I,IELEB
00152       DOUBLE PRECISION C
00153 !
00154 !***********************************************************************
00155 !
00156 ! HARMONISES THE BOUNDARY CONDITIONS
00157 !
00158 !=======================================================================
00159 !
00160       IF (.NOT.NONHYD) THEN
00161 !
00162         DO IPOIN2 = 1,NPOIN2
00163           IF(LIUBOF%I(IPOIN2).EQ.KLOG.OR.
00164      &       LIVBOF%I(IPOIN2).EQ.KLOG.OR.
00165      &       LIWBOF%I(IPOIN2).EQ.KLOG) THEN
00166              LIUBOF%I(IPOIN2) = KLOG
00167              LIVBOF%I(IPOIN2) = KLOG
00168              LIWBOF%I(IPOIN2) = KLOG
00169           ENDIF
00170           IF(LIUBOS%I(IPOIN2).EQ.KLOG.OR.
00171      &       LIVBOS%I(IPOIN2).EQ.KLOG.OR.
00172      &       LIWBOS%I(IPOIN2).EQ.KLOG) THEN
00173              LIUBOS%I(IPOIN2) = KLOG
00174              LIVBOS%I(IPOIN2) = KLOG
00175              LIWBOS%I(IPOIN2) = KLOG
00176           ENDIF
00177         ENDDO
00178 !
00179         DO IPTFR3 = 1,NPTFR3
00180           IF(LIUBOL%I(IPTFR3).EQ.KLOG .OR.
00181      &       LIVBOL%I(IPTFR3).EQ.KLOG .OR.
00182      &       LIWBOL%I(IPTFR3).EQ.KLOG) THEN
00183              LIUBOL%I(IPTFR3) = KLOG
00184              LIVBOL%I(IPTFR3) = KLOG
00185              LIWBOL%I(IPTFR3) = KLOG
00186           ENDIF
00187         ENDDO
00188 !
00189       ENDIF  ! (IF .NOT.NONHYD)
00190 !
00191 !=======================================================================
00192 !
00193 ! INITIALISES THE BOUNDARY CONDITIONS FOR PROPAGATION IN 2D:
00194 !
00195 !=======================================================================
00196 !
00197 !     NODAL VALUES
00198 !
00199       DO IPTFR = 1,NPTFR
00200 !
00201 !   BOUNDARY CONDITIONS ON H
00202 !
00203       IF(LIHBOR%I(IPTFR).EQ.KENT ) THEN
00204         LIMPRP(IPTFR,1) = KDIR
00205       ELSEIF(LIHBOR%I(IPTFR).EQ.KSORT) THEN
00206         LIMPRP(IPTFR,1) = KDDL
00207       ELSEIF(LIHBOR%I(IPTFR).EQ.KLOG ) THEN
00208         LIMPRP(IPTFR,1) = KDDL
00209       ELSE
00210         IF(LNG.EQ.1) WRITE(LU,101) IPTFR,LIHBOR%I(IPTFR)
00211         IF(LNG.EQ.2) WRITE(LU,102) IPTFR,LIHBOR%I(IPTFR)
00212         CALL PLANTE(1)
00213         STOP
00214       ENDIF
00215 !
00216 !   BOUNDARY CONDITIONS ON U
00217 !  (TAKES THE BOUNDARY CONDITIONS DEFINED ON THE SECOND PLANE
00218 !   AS MEAN 2D VELOCITY)
00219 !
00220       IPTFR3 = NPTFR + IPTFR
00221       IPTFRX = NPTFR + MESH2D%KP1BOR%I(IPTFR)
00222       IF(LIUBOL%I(IPTFR3).EQ.KENT.OR.
00223      &  LIUBOL%I(IPTFR3).EQ.KENTU.OR.
00224      &  LIUBOL%I(IPTFR3).EQ.KADH) THEN
00225         LIMPRP(IPTFR,2) = KDIR
00226       ELSEIF(LIUBOL%I(IPTFR3).EQ.KSORT) THEN
00227         LIMPRP(IPTFR,2) = KDDL
00228       ELSEIF(LIUBOL%I(IPTFR3).EQ.KLOG ) THEN
00229         LIMPRP(IPTFR,2) = KDDL
00230       ELSE
00231         IF(LNG.EQ.1) WRITE(LU,201) IPTFR3,LIUBOL%I(IPTFR3)
00232         IF(LNG.EQ.2) WRITE(LU,202) IPTFR3,LIUBOL%I(IPTFR3)
00233         CALL PLANTE(1)
00234         STOP
00235       ENDIF
00236 !
00237 !   BOUNDARY CONDITIONS ON V
00238 !  (TAKES THE BOUNDARY CONDITIONS DEFINED ON THE SECOND PLANE
00239 !   AS MEAN 2D VELOCITY)
00240 !
00241       IF(LIVBOL%I(IPTFR3).EQ.KENT.OR.
00242      &  LIVBOL%I(IPTFR3).EQ.KENTU.OR.
00243      &  LIVBOL%I(IPTFR3).EQ.KADH) THEN
00244         LIMPRP(IPTFR,3) = KDIR
00245       ELSEIF(LIVBOL%I(IPTFR3).EQ.KSORT) THEN
00246         LIMPRP(IPTFR,3) = KDDL
00247       ELSEIF(LIVBOL%I(IPTFR3).EQ.KLOG ) THEN
00248         LIMPRP(IPTFR,3) = KDDL
00249       ELSE
00250         IF(LNG.EQ.1) WRITE(LU,301) IPTFR3,LIVBOL%I(IPTFR3)
00251         IF(LNG.EQ.2) WRITE(LU,302) IPTFR3,LIVBOL%I(IPTFR3)
00252         CALL PLANTE(1)
00253         STOP
00254       ENDIF
00255 !
00256       ENDDO
00257 !
00258 !-----------------------------------------------------------------------
00259 !
00260 !     SEGMENT VALUES
00261 !
00262       DO IELEB = 1,NELEB2
00263 !
00264       IPTFR =IKLBOR(IELEB,1)
00265       IPTFRX=IKLBOR(IELEB,2)
00266 !
00267 !   BOUNDARY CONDITIONS ON H
00268 !
00269       IF(LIHBOR%I(IPTFR).EQ.KENT ) THEN
00270         LIMPRP(IELEB,4) = KDDL
00271         IF(LIHBOR%I(IPTFRX).EQ.KENT) LIMPRP(IELEB,4) = KDIR
00272         IF(LIHBOR%I(IPTFRX).EQ.KLOG) LIMPRP(IELEB,4) = KNEU
00273       ELSEIF(LIHBOR%I(IPTFR).EQ.KSORT) THEN
00274         LIMPRP(IELEB,4) = KDDL
00275         IF(LIHBOR%I(IPTFRX).EQ.KLOG) LIMPRP(IELEB,4) = KNEU
00276       ELSEIF(LIHBOR%I(IPTFR).EQ.KLOG ) THEN
00277         LIMPRP(IELEB,4) = KNEU
00278       ELSE
00279         IF(LNG.EQ.1) WRITE(LU,101) IPTFR,LIHBOR%I(IPTFR)
00280         IF(LNG.EQ.2) WRITE(LU,102) IPTFR,LIHBOR%I(IPTFR)
00281         CALL PLANTE(1)
00282         STOP
00283       ENDIF
00284 !
00285 !   BOUNDARY CONDITIONS ON U
00286 !  (TAKES THE BOUNDARY CONDITIONS DEFINED ON THE SECOND PLANE
00287 !   AS MEAN 2D VELOCITY)
00288 !
00289       IPTFR3 = NPTFR + IPTFR
00290       IPTFRX = NPTFR + IPTFRX
00291       IF(LIUBOL%I(IPTFR3).EQ.KENT.OR.
00292      &  LIUBOL%I(IPTFR3).EQ.KENTU.OR.
00293      &  LIUBOL%I(IPTFR3).EQ.KADH) THEN
00294         LIMPRP(IELEB,5) = KDDL
00295         IF(LIUBOL%I(IPTFRX).EQ.KENT.OR.
00296      &    LIUBOL%I(IPTFRX).EQ.KENTU) LIMPRP(IELEB,5) = KDIR
00297         IF(LIUBOL%I(IPTFRX).EQ.KADH) LIMPRP(IELEB,5) = KDIR
00298         IF(LIUBOL%I(IPTFRX).EQ.KLOG) LIMPRP(IELEB,5) = KNEU
00299       ELSEIF(LIUBOL%I(IPTFR3).EQ.KSORT) THEN
00300         LIMPRP(IELEB,5) = KDDL
00301         IF(LIUBOL%I(IPTFRX).EQ.KLOG) LIMPRP(IELEB,5) = KNEU
00302       ELSEIF(LIUBOL%I(IPTFR3).EQ.KLOG ) THEN
00303         LIMPRP(IELEB,5) = KNEU
00304       ELSE
00305         IF(LNG.EQ.1) WRITE(LU,201) IPTFR3,LIUBOL%I(IPTFR3)
00306         IF(LNG.EQ.2) WRITE(LU,202) IPTFR3,LIUBOL%I(IPTFR3)
00307         CALL PLANTE(1)
00308         STOP
00309       ENDIF
00310 !
00311 !   BOUNDARY CONDITIONS ON V
00312 !  (TAKES THE BOUNDARY CONDITIONS DEFINED ON THE SECOND PLANE
00313 !   AS MEAN 2D VELOCITY)
00314 !
00315       IF(LIVBOL%I(IPTFR3).EQ.KENT.OR.
00316      &  LIVBOL%I(IPTFR3).EQ.KENTU.OR.
00317      &  LIVBOL%I(IPTFR3).EQ.KADH) THEN
00318         LIMPRP(IELEB,6) = KDDL
00319         IF(LIVBOL%I(IPTFRX).EQ.KENT.OR.
00320      &     LIVBOL%I(IPTFRX).EQ.KENTU) LIMPRP(IELEB,6) = KDIR
00321         IF(LIVBOL%I(IPTFRX).EQ.KADH) LIMPRP(IELEB,6) = KDIR
00322         IF(LIVBOL%I(IPTFRX).EQ.KLOG) LIMPRP(IELEB,6) = KNEU
00323       ELSEIF(LIVBOL%I(IPTFR3).EQ.KSORT) THEN
00324         LIMPRP(IELEB,6) = KDDL
00325         IF(LIVBOL%I(IPTFRX).EQ.KLOG) LIMPRP(IELEB,6) = KNEU
00326       ELSEIF(LIVBOL%I(IPTFR3).EQ.KLOG ) THEN
00327         LIMPRP(IELEB,6) = KNEU
00328       ELSE
00329         IF(LNG.EQ.1) WRITE(LU,301) IPTFR3,LIVBOL%I(IPTFR3)
00330         IF(LNG.EQ.2) WRITE(LU,302) IPTFR3,LIVBOL%I(IPTFR3)
00331         CALL PLANTE(1)
00332         STOP
00333       ENDIF
00334 !
00335       ENDDO
00336 !
00337 !=======================================================================
00338 ! FILLS MASK
00339 !=======================================================================
00340 !
00341       CALL OS('X=0     ',X=MASK)
00342 !
00343       IF (.NOT. MSK) THEN
00344 !
00345         DO IELEB = 1,NELEB2
00346           IF(LIMPRP(IELEB,5).EQ.KDIR) MASK%ADR(1)%P%R(IELEB) = 1.D0
00347           IF(LIMPRP(IELEB,6).EQ.KDIR) MASK%ADR(2)%P%R(IELEB) = 1.D0
00348           IF(LIMPRP(IELEB,5).EQ.KDDL) MASK%ADR(3)%P%R(IELEB) = 1.D0
00349           IF(LIMPRP(IELEB,6).EQ.KDDL) MASK%ADR(4)%P%R(IELEB) = 1.D0
00350           IF(LIMPRP(IELEB,5).EQ.KNEU) MASK%ADR(5)%P%R(IELEB) = 1.D0
00351           IF(LIMPRP(IELEB,6).EQ.KNEU) MASK%ADR(6)%P%R(IELEB) = 1.D0
00352           MASK%ADR(7)%P%R(IELEB) = 0.D0
00353           MASK%ADR(8)%P%R(IELEB) = 1.D0 - MASK%ADR(5)%P%R(IELEB)
00354         ENDDO
00355 !
00356       ELSE
00357 !
00358         DO IELEB = 1,NELEB2
00359           IPTFR=IKLBOR(IELEB,1)
00360 !         MASKEL, BD ELEMENT FROM THE *FIRST* ETAGE
00361           C = MASKEL%R(MESH2D%NELBOR%I(IPTFR))
00362           IF(LIMPRP(IELEB,5).EQ.KDIR) MASK%ADR(1)%P%R(IELEB) = C
00363           IF(LIMPRP(IELEB,6).EQ.KDIR) MASK%ADR(2)%P%R(IELEB) = C
00364           IF(LIMPRP(IELEB,5).EQ.KDDL) MASK%ADR(3)%P%R(IELEB) = C
00365           IF(LIMPRP(IELEB,6).EQ.KDDL) MASK%ADR(4)%P%R(IELEB) = C
00366           IF(LIMPRP(IELEB,5).EQ.KNEU) MASK%ADR(5)%P%R(IELEB) = C
00367           IF(LIMPRP(IELEB,6).EQ.KNEU) MASK%ADR(6)%P%R(IELEB) = C
00368           MASK%ADR(7)%P%R(IELEB) = 0.D0
00369           MASK%ADR(8)%P%R(IELEB) = (1.D0 - MASK%ADR(5)%P%R(IELEB)) * C
00370         ENDDO
00371 !
00372       ENDIF
00373 !
00374 !-----------------------------------------------------------------------
00375 !
00376 !     EXTENDING TO 3D
00377 !
00378       DO I=1,9
00379         CALL EXTMSK(MASK_3D%ADR(I)%P,MASK%ADR(I)%P%R,NPLAN-1,NELEB2)
00380       ENDDO
00381 !
00382 !-----------------------------------------------------------------------
00383 !
00384 101   FORMAT(' LICHEK: POINT DE BORD',I5,'LIHBOR = ',1I6)
00385 102   FORMAT(' LICHEK: BOUNDARY NODE',I5,'LIHBOR = ',1I6)
00386 201   FORMAT(' LICHEK: POINT DE BORD',I5,'LIUBOL = ',1I6)
00387 202   FORMAT(' LICHEK: BOUNDARY NODE',I5,'LIUBOL = ',1I6)
00388 301   FORMAT(' LICHEK: POINT DE BORD',I5,'LIVBOL = ',1I6)
00389 302   FORMAT(' LICHEK: BOUNDARY NODE',I5,'LIVBOL = ',1I6)
00390 !
00391 !-----------------------------------------------------------------------
00392 !
00393       RETURN
00394       END

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