complim.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\complim.f
00002 !
00062                      SUBROUTINE COMPLIM
00063 !                    ******************
00064 !
00065      &(LIUBOR,LIVBOR,LITBOR,UBOR,VBOR,TBOR,
00066      & AUBOR,ATBOR,BTBOR,NBOR,NPTFR,NPOIN,TRAC,
00067      & KENT,KENTU,KSORT,KADH,KLOG,IELMU,IELMV,IELMT,MESH,
00068      & IKLBOR,NELEB,NELEBX)
00069 !
00070 !***********************************************************************
00071 ! TELEMAC2D   V7P0                                   27/03/2014
00072 !***********************************************************************
00073 !
00074 !
00075 !
00076 !
00077 !
00078 !
00079 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00080 !| ATBOR          |<->| BOUNDARY CONDITIONS FOR TRACERS
00081 !|                |   | NU*DT/DN=ATBOR*T+BTBOR
00082 !| BTBOR          |<->| BOUNDARY CONDITIONS FOR TRACERS
00083 !|                |   | NU*DT/DN=ATBOR*T+BTBOR
00084 !| AUBOR          |<->| COEFFICIENT DE FROTTEMENT AU BORD
00085 !| IELMT          |-->| TYPE OF ELEMENT OF TRACERS
00086 !| IELMU          |-->| TYPE OF ELEMENT OF VELOCITY U
00087 !| IELMV          |-->| TYPE OF ELEMENT OF VELOCITY V
00088 !| IKLBOR         |-->| CONNECTIVITY OF BOUNDARY SEGMENTS
00089 !| KADH           |-->| CONVENTION FOR NO SLIP BOUNDARY CONDITION
00090 !| KENT           |-->| CONVENTION FOR LIQUID INPUT WITH PRESCRIBED VALUE
00091 !| KENTU          |-->| CONVENTION FOR LIQUID INPUT WITH PRESCRIBED VELOCITY
00092 !| KLOG           |-->| CONVENTION FOR SOLID BOUNDARY
00093 !| KSORT          |-->| CONVENTION FOR FREE OUTPUT
00094 !| LIUBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON VELOCITY U
00095 !| LIVBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON VELOCITY V
00096 !| LITBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON TRACERS
00097 !| MESH           |-->| MESH STRUCTURE
00098 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
00099 !| NELEB          |-->| NUMBER OF BOUNDARY SEGMENTS
00100 !| NELEBX         |-->| MAXIMUM NUMBER OF BOUNDARY SEGMENTS
00101 !| NPOIN          |-->| NUMBER OF POINTS
00102 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00103 !| TBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON TRACER
00104 !| TRAC           |-->| LOGICAL SAYING IF THERE ARE TRACERS
00105 !| UBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON VELOCITY U
00106 !| VBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON VELOCITY V
00107 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00108 !
00109       USE BIEF
00110 !
00111       IMPLICIT NONE
00112       INTEGER LNG,LU
00113       COMMON/INFO/LNG,LU
00114 !
00115 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00116 !
00117       INTEGER, INTENT(IN) :: NPTFR,NPOIN,KENT,KSORT,KADH,KLOG,KENTU
00118       INTEGER, INTENT(IN) :: IELMU,IELMV,IELMT,NELEB,NELEBX
00119       LOGICAL, INTENT(IN) :: TRAC
00120       INTEGER, INTENT(INOUT) :: LIUBOR(*),LIVBOR(*)
00121       INTEGER, INTENT(INOUT) :: LITBOR(*)
00122       INTEGER, INTENT(IN)    :: IKLBOR(NELEBX,2)
00123       INTEGER, INTENT(INOUT) :: NBOR(2*NPTFR)
00124       DOUBLE PRECISION, INTENT(INOUT) :: UBOR(2*NPTFR,2),VBOR(2*NPTFR,2)
00125       DOUBLE PRECISION, INTENT(INOUT) :: AUBOR(*)
00126       DOUBLE PRECISION, INTENT(INOUT) :: TBOR(*),ATBOR(*)
00127       DOUBLE PRECISION, INTENT(INOUT) :: BTBOR(*)
00128       TYPE(BIEF_MESH),INTENT(INOUT)   :: MESH
00129 !
00130 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00131 !
00132       INTEGER K,KP1,IELEB
00133 !
00134 !----------------------------------------------------------------------
00135 !
00136 !     VELOCITY WITH QUADRATIC U-COMPONENT
00137 !
00138       IF(IELMU.EQ.13) THEN
00139 !
00140         DO IELEB=1,NELEB
00141 !
00142         K  =IKLBOR(IELEB,1)
00143         KP1=IKLBOR(IELEB,2)
00144 !
00145         IF(KP1.NE.K) THEN
00146         IF(LIUBOR(K).EQ.LIUBOR(KP1)) THEN
00147           LIUBOR(K+NPTFR) = LIUBOR(K)
00148         ELSEIF( LIUBOR(K  ).EQ.KLOG .OR.
00149      &          LIUBOR(KP1).EQ.KLOG       ) THEN
00150           LIUBOR(K+NPTFR) = KLOG
00151         ELSEIF( LIUBOR(K  ).EQ.KADH .OR.
00152      &          LIUBOR(KP1).EQ.KADH       ) THEN
00153           LIUBOR(K+NPTFR) = KADH
00154         ELSEIF( LIUBOR(K  ).EQ.KENTU .OR.
00155      &          LIUBOR(KP1).EQ.KENTU      ) THEN
00156           LIUBOR(K+NPTFR) = KENTU
00157         ELSEIF( LIUBOR(K  ).EQ.KSORT .OR.
00158      &          LIUBOR(KP1).EQ.KSORT      ) THEN
00159           LIUBOR(K+NPTFR) = KSORT
00160         ELSE
00161           WRITE(LU,*) 'CONDITION INITIALE QUADRATIQUE DE U ','K ',K,
00162      &                ' NON PREVUE POUR LIUBOR = ',LIUBOR(K),
00163      &                ' ET LIUBOR(K+1) = ',LIUBOR(KP1)
00164           CALL PLANTE(1)
00165           STOP
00166         ENDIF
00167         UBOR(K+NPTFR,1) = (UBOR(K,1)+UBOR(KP1,1))*0.5D0
00168 !
00169         ENDIF
00170 !
00171         ENDDO
00172 !
00173       ENDIF
00174 !
00175 !     VELOCITY WITH QUADRATIC V-COMPONENT
00176 !
00177       IF(IELMV.EQ.13) THEN
00178 !
00179         DO IELEB=1,NELEB
00180 !
00181         K  =IKLBOR(IELEB,1)
00182         KP1=IKLBOR(IELEB,2)
00183 !
00184         IF(KP1.NE.K) THEN
00185         IF(LIVBOR(K).EQ.LIVBOR(KP1)) THEN
00186           LIVBOR(K+NPTFR) = LIVBOR(K)
00187         ELSEIF( LIVBOR(K  ).EQ.KLOG .OR.
00188      &          LIVBOR(KP1).EQ.KLOG       ) THEN
00189           LIVBOR(K+NPTFR) = KLOG
00190         ELSEIF( LIVBOR(K  ).EQ.KADH .OR.
00191      &          LIVBOR(KP1).EQ.KADH       ) THEN
00192           LIVBOR(K+NPTFR) = KADH
00193         ELSEIF( LIVBOR(K  ).EQ.KENTU .OR.
00194      &          LIVBOR(KP1).EQ.KENTU      ) THEN
00195           LIVBOR(K+NPTFR) = KENTU
00196         ELSEIF( LIVBOR(K  ).EQ.KSORT .OR.
00197      &          LIVBOR(KP1).EQ.KSORT      ) THEN
00198           LIVBOR(K+NPTFR) = KSORT
00199         ELSE
00200           WRITE(LU,*) 'CONDITION INITIALE QUADRATIQUE DE U ','K ',K,
00201      &                ' NON PREVUE POUR LIUBOR = ',LIUBOR(K),
00202      &                ' ET LIUBOR(K+1) = ',LIUBOR(KP1)
00203           CALL PLANTE(1)
00204           STOP
00205         ENDIF
00206         VBOR(K+NPTFR,1) = (VBOR(K,1)+VBOR(KP1,1))*0.5D0
00207         ENDIF
00208 !
00209         ENDDO
00210 !
00211       ENDIF
00212 !
00213       IF(IELMV.EQ.13.OR.IELMU.EQ.13) THEN
00214         DO IELEB=1,NELEB
00215           K  =IKLBOR(IELEB,1)
00216           KP1=IKLBOR(IELEB,2)
00217           AUBOR(K+NPTFR) = (AUBOR(K)+AUBOR(KP1))*0.5D0
00218         ENDDO
00219       ENDIF
00220 !
00221 !     WITH QUADRATIC TRACER T
00222 !
00223       IF(TRAC.AND.IELMT.EQ.13) THEN
00224 !
00225         DO IELEB=1,NELEB
00226 !
00227         K  =IKLBOR(IELEB,1)
00228         KP1=IKLBOR(IELEB,2)
00229 !
00230         IF(KP1.NE.K) THEN
00231         IF(LITBOR(K).EQ.LITBOR(KP1)) THEN
00232           LITBOR(K+NPTFR) = LITBOR(K)
00233         ELSEIF( LITBOR(K  ).EQ.KLOG .OR.
00234      &          LITBOR(KP1).EQ.KLOG       ) THEN
00235           LITBOR(K+NPTFR) = KLOG
00236         ELSEIF( LITBOR(K  ).EQ.KADH .OR.
00237      &          LITBOR(KP1).EQ.KADH       ) THEN
00238           LITBOR(K+NPTFR) = KADH
00239         ELSEIF( LITBOR(K  ).EQ.KENTU .OR.
00240      &          LITBOR(KP1).EQ.KENTU      ) THEN
00241           LITBOR(K+NPTFR) = KENTU
00242         ELSEIF( LITBOR(K  ).EQ.KSORT .OR.
00243      &          LITBOR(KP1).EQ.KSORT      ) THEN
00244           LITBOR(K+NPTFR) = KSORT
00245         ELSE
00246           WRITE(LU,*) 'CONDITION INITIALE QUADRATIQUE DE U ','K ',K,
00247      &                ' NON PREVUE POUR LIUBOR = ',LIUBOR(K),
00248      &                ' ET LIUBOR(K+1) = ',LIUBOR(KP1)
00249           CALL PLANTE(1)
00250           STOP
00251         ENDIF
00252         TBOR(K+NPTFR)  = (TBOR(K)+TBOR(KP1))  *0.5D0
00253         ATBOR(K+NPTFR) = (ATBOR(K)+ATBOR(KP1))*0.5D0
00254         BTBOR(K+NPTFR) = (BTBOR(K)+BTBOR(KP1))*0.5D0
00255         ENDIF
00256 !
00257         ENDDO
00258 !
00259       ENDIF
00260 !
00261 !-----------------------------------------------------------------------
00262 !
00263 !  CHECKS, CORRECTS AND SAVES:
00264 !
00265       IF(IELMU.EQ.13.OR.IELMV.EQ.13) THEN
00266 !
00267       DO K=NPTFR+1,2*NPTFR
00268 !
00269 !     FRICTION COEFFICIENT SET TO 0 WHEN NOT NEEDED
00270 !
00271       IF(LIUBOR(K).NE.KLOG.AND.LIVBOR(K).NE.KLOG) AUBOR(K) = 0.D0
00272 !
00273 !     WALL ADHERENCE MODIFIED FOR H
00274 !
00275       IF(AUBOR(K).GT.0.D0) THEN
00276         IF(LNG.EQ.1) WRITE(LU,48) K
00277         IF(LNG.EQ.2) WRITE(LU,49) K
00278 48      FORMAT(1X,'COMPLIM : AUBOR DOIT ETRE NEGATIF OU NUL',/,1X,
00279      &            '         IL VAUT ',F10.3,' AU POINT DE BORD ',1I6)
00280 49      FORMAT(1X,'COMPLIM : AUBOR MUST BE NEGATIVE',/,1X,
00281      &            '         IT IS ',F10.3,' AT BOUNDARY POINT ',1I6)
00282         CALL PLANTE(1)
00283         STOP
00284       ENDIF
00285 !
00286 !     DIRICHLET VALUES SET TO 0 WHEN THE POINT IS NOT A DIRICHLET
00287 !     FOR THE NODES WITH WALL ADHERENCE, UBOR OR VBOR =0 IS REQUIRED
00288 !
00289       IF(LIUBOR(K).NE.KENT.AND.LIUBOR(K).NE.KENTU) UBOR(K,1)=0.D0
00290       IF(LIVBOR(K).NE.KENT.AND.LIVBOR(K).NE.KENTU) VBOR(K,1)=0.D0
00291 !
00292 !     SAVES UBOR AND VBOR ON THEIR SECOND DIMENSION
00293 !
00294       UBOR(K,2) = UBOR(K,1)
00295       VBOR(K,2) = VBOR(K,1)
00296 !
00297       ENDDO
00298 !
00299       IF(TRAC) THEN
00300         DO K=1,NPTFR
00301           IF(LITBOR(K).NE.KENT) TBOR(K)=0.D0
00302         ENDDO
00303       ENDIF
00304 !
00305       ENDIF
00306 !
00307 !-----------------------------------------------------------------------
00308 !
00309       RETURN
00310       END

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