diffin.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\diffin.f
00002 !
00069                      SUBROUTINE DIFFIN
00070 !                    *****************
00071 !
00072      &(MASKTR,LIMTRA,LITBOR,CLT,U,V,XNEBOR,YNEBOR,NBOR,
00073      & NPTFR,KENT,KSORT,KLOG,KNEU,KDIR,KDDL,
00074      & ICONV,NELBOR,NPOIN,NELMAX,MSK,MASKEL,
00075      & NFRLIQ,THOMFR,FRTYPE,TN,TBOR,MESH,NUMLIQ,IKLBOR,NELEB,NELEBX)
00076 !
00077 !***********************************************************************
00078 ! BIEF   V7P0                                   21/08/2010
00079 !***********************************************************************
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !
00087 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00088 !| CLT            |<--| A MODIFIED COPY OF LITBOR.
00089 !| FRTYPE         |-->| TYPE OF BOUNDARY CONDITIONS
00090 !|                |   | 1: NORMAL   2: THOMPSON
00091 !| ICONV          |-->| OPTION FOR ADVECTION : 1) CHARACTERISTICS
00092 !|                |   |                        2) SUPG, ETC.
00093 !| IKLBOR         |-->| CONNECTIVITY TABLE FOR BOUNDARY ELEMENTS
00094 !| KDDL           |-->| CONVENTION FOR DEGREE OF FREEDOM
00095 !| KDIR           |-->| CONVENTION FOR DIRICHLET POINT
00096 !| KENT           |-->| CONVENTION FOR LIQUID INPUT WITH PRESCRIBED VALUE
00097 !| KLOG           |-->| CONVENTION FOR SOLID BOUNDARY
00098 !| KNEU           |-->| CONVENTION FOR NEUMANN CONDITION
00099 !| KSORT          |-->| CONVENTION FOR LIQUID OUTPUT WITH FREE VALUE
00100 !| LIMTRA         |<--| TECHNICAL BOUNDARY CONDITIONS FOR TRACERS
00101 !| LITBOR         |-->| PHYSICAL BOUNDARY CONDITIONS FOR TRACERS
00102 !| MASKEL         |-->| MASKING OF ELEMENTS
00103 !|                |   | =1. : NORMAL   =0. : MASKED ELEMENT
00104 !| MESH           |-->| MESH STRUCTURE
00105 !| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS.
00106 !| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS.
00107 !| NELBOR         |-->| FOR THE KTH BOUNDARY EDGE, GIVES THE CORRESPONDING
00108 !|                |   | ELEMENT.
00109 !| NELEB          |-->| NUMBER OF BOUNDARY ELEMENTS
00110 !| NELEBX         |-->| MAXIMUM NUMBER OF BOUNDARY ELEMENTS
00111 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00112 !| NFRLIQ         |-->| NUMBER OF LIQUID BOUNDARIES
00113 !| NPOIN          |-->| NUMBER OF POINTS
00114 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00115 !| TBOR           |-->| DIRICHLET BOUNDARY CONDITIONS ON TRACERS
00116 !| THOMFR         |-->| IF YES, THERE ARE THOMPSON BOUNDARY CONDITIONS
00117 !| TN             |-->| TRACERS AT OLD TIME STEP
00118 !| U              |-->| X-COMPONENT OF VELOCITY
00119 !| V              |-->| Y-COMPONENT OF VELOCITY
00120 !| XNEBOR         |-->| X-COMPONENT OF EXTERNAL NORMAL BOUNDARY VECTOR
00121 !| YNEBOR         |-->| Y-COMPONENT OF EXTERNAL NORMAL BOUNDARY VECTOR
00122 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00123 !
00124       USE BIEF, EX_DIFFIN => DIFFIN
00125 !
00126       IMPLICIT NONE
00127       INTEGER LNG,LU
00128       COMMON/INFO/LNG,LU
00129 !
00130 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00131 !
00132       TYPE(BIEF_OBJ), INTENT(INOUT) :: MASKTR,TBOR
00133       TYPE(BIEF_OBJ), INTENT(IN)    :: TN
00134       INTEGER, INTENT(IN)    :: NELEB,NELEBX
00135       INTEGER, INTENT(IN)    :: NPOIN,NPTFR,NELMAX,ICONV,NFRLIQ
00136       INTEGER, INTENT(IN)    :: LITBOR(NPTFR),NBOR(NPTFR)
00137       INTEGER, INTENT(INOUT) :: LIMTRA(NPTFR),CLT(NPTFR)
00138       INTEGER, INTENT(IN)    :: IKLBOR(NELEBX,2)
00139       INTEGER, INTENT(IN)    :: KENT,KSORT,KLOG,KDIR,KDDL,KNEU
00140       INTEGER, INTENT(IN)    :: NELBOR(NELEBX),NUMLIQ(NPTFR)
00141       INTEGER, INTENT(IN)    :: FRTYPE(NFRLIQ)
00142 !
00143       DOUBLE PRECISION, INTENT(IN) :: U(NPOIN), V(NPOIN)
00144       DOUBLE PRECISION, INTENT(IN) :: XNEBOR(NPTFR), YNEBOR(NPTFR)
00145       DOUBLE PRECISION, INTENT(IN) :: MASKEL(NELMAX)
00146 !
00147       LOGICAL, INTENT(IN) :: MSK,THOMFR
00148 !
00149       TYPE(BIEF_MESH), INTENT(INOUT) :: MESH
00150 !
00151 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00152 !
00153       INTEGER K,K1,K2,IELEM,DIR,DDL,NEU,OND,NONEU,IFRLIQ,IELEB
00154       DOUBLE PRECISION USCALN
00155 !
00156 !-----------------------------------------------------------------------
00157 !
00158       DIR=1
00159       DDL=2
00160       NEU=3
00161       OND=4
00162       NONEU=5
00163 !
00164 !     CLT CONTAINS ARRAY LITBOR, POSSIBLY MODIFIED ACCORDING TO THE SIGN
00165 !     OF U.N ON THE LIQUID BOUNDARIES, WHERE N IS THE OUTGOING NORMAL.
00166 !
00167       DO K=1,NPTFR
00168         CLT(K) = LITBOR(K)
00169 !       LOCATES THE LIQUID BOUNDARIES:
00170         IF(CLT(K).EQ.KENT) THEN
00171           USCALN = U(NBOR(K))*XNEBOR(K) + V(NBOR(K))*YNEBOR(K)
00172 !         OUTGOING VELOCITY, FREE TRACER
00173           IF(USCALN.GT.0.D0) CLT(K) = KSORT
00174         ELSEIF(CLT(K).EQ.KSORT) THEN
00175           USCALN = U(NBOR(K))*XNEBOR(K) + V(NBOR(K))*YNEBOR(K)
00176 !
00177 !         INCOMING VELOCITY, TRACER IMPOSED AT THE LAST VALUE
00178           IF(USCALN.LT.0.D0) THEN
00179             TBOR%R(K)=TN%R(NBOR(K))
00180             CLT(K) = KENT
00181           ENDIF
00182         ENDIF
00183       ENDDO
00184 !
00185 !     BUILDS ARRAY MASKTR ACCORDING TO CLT
00186 !
00187 !     MASKTR EQUALS 1 FOR A SEGMENT OF TYPE NEUMANN, 0 OTHERWISE
00188 !
00189 !     A SEGMENT IS OF TYPE NEUMANN IF AT LEAST ONE OF ITS POINTS
00190 !     IS SPECIFIED AS NEUMANN BY THE USER.
00191 !
00192 !
00193 !     INITIALISES THE MASKS TO 0
00194 !
00195       CALL OS('X=0     ',MASKTR)
00196       DO IELEB = 1 , NELEB
00197         K1=IKLBOR(IELEB,1)
00198         K2=IKLBOR(IELEB,2)
00199         IF(CLT(K1).EQ.KLOG.OR.CLT(K2).EQ.KLOG) THEN
00200 !         SEGMENTS OF TYPE NEUMANN
00201           MASKTR%ADR(NEU)%P%R(IELEB)=1.D0
00202         ELSEIF(CLT(K1).EQ.KENT.AND.CLT(K2).EQ.KSORT) THEN
00203 !         SEGMENTS OF TYPE EXIT
00204           MASKTR%ADR(DDL)%P%R(IELEB)=1.D0
00205         ELSEIF(CLT(K1).EQ.KSORT.OR.CLT(K2).EQ.KSORT) THEN
00206           MASKTR%ADR(DDL)%P%R(IELEB)=1.D0
00207         ELSEIF(CLT(K1).EQ.KSORT.AND.CLT(K2).EQ.KENT) THEN
00208 !         SEGMENTS OF TYPE EXIT
00209           MASKTR%ADR(DDL)%P%R(IELEB)=1.D0
00210         ELSEIF(CLT(K1).EQ.KENT.OR.CLT(K2).EQ.KENT) THEN
00211           MASKTR%ADR(DIR)%P%R(IELEB)=1.D0
00212         ELSE
00213           IF(LNG.EQ.1) WRITE(LU,100)
00214           IF(LNG.EQ.2) WRITE(LU,101)
00215 100       FORMAT(1X,'DIFFIN : CAS NON PREVU')
00216 101       FORMAT(1X,'DIFFIN : UNEXPECTED CASE')
00217           CALL PLANTE(1)
00218           STOP
00219         ENDIF
00220       ENDDO
00221 !
00222 !  POSSIBLE MASKING
00223 !
00224       IF(MSK) THEN
00225         DO IELEB = 1 , NELEB
00226           K1=IKLBOR(IELEB,1)
00227           IELEM=NELBOR(IELEB)
00228           MASKTR%ADR(DIR)%P%R(IELEB) = MASKTR%ADR(DIR)%P%R(IELEB) *
00229      &                                                   MASKEL(IELEM)
00230           MASKTR%ADR(DDL)%P%R(IELEB) = MASKTR%ADR(DDL)%P%R(IELEB) *
00231      &                                                   MASKEL(IELEM)
00232           MASKTR%ADR(NEU)%P%R(IELEB) = MASKTR%ADR(NEU)%P%R(IELEB) *
00233      &                                                   MASKEL(IELEM)
00234           MASKTR%ADR(OND)%P%R(IELEB) = MASKTR%ADR(OND)%P%R(IELEB) *
00235      &                                                   MASKEL(IELEM)
00236         ENDDO
00237       ENDIF
00238 !
00239 !-----------------------------------------------------------------------
00240 !
00241 !     LIQUID BOUNDARIES MASK
00242 !
00243       DO IELEB=1,NELEB
00244         MASKTR%ADR(NONEU)%P%R(IELEB)=1.D0-MASKTR%ADR(NEU)%P%R(IELEB)
00245       ENDDO
00246 !
00247 !-----------------------------------------------------------------------
00248 !
00249 ! FROM PHYSICAL TO TECHNICAL CONDITIONS
00250 !
00251       DO K=1,NPTFR
00252 !
00253         IF(CLT(K).EQ.KENT ) THEN
00254 !
00255 !         ENTERING THE DOMAIN: IMPOSED TRACER
00256 !
00257           LIMTRA(K) = KDIR
00258 !
00259         ELSEIF(CLT(K).EQ.KSORT) THEN
00260 !
00261 !         LEAVING THE DOMAIN : FREE IF SUPG OR PSI SCHEME,
00262 !                              RESULT OF IMPOSED ADVECTION OTHERWISE
00263 !
00264           IF(ICONV.EQ.1) THEN
00265 !           SEE DIFFCL : TTILD PUT IN TBOR
00266             LIMTRA(K) = KDIR
00267           ELSE
00268             LIMTRA(K) = KDDL
00269           ENDIF
00270 !
00271         ELSEIF(CLT(K).EQ.KLOG ) THEN
00272 !
00273 !         WALL: NEUMANN CONDITIONS (IT'S NOT ACTUALLY USED)
00274 !
00275           LIMTRA(K) = KNEU
00276 !
00277         ELSE
00278 !
00279 !         ERROR, UNKNOWN VALUE OF LITBOR
00280 !
00281           IF(LNG.EQ.1) WRITE(LU,10) K,LITBOR(K)
00282           IF(LNG.EQ.2) WRITE(LU,12) K,LITBOR(K)
00283 10        FORMAT(1X,'DIFFIN: POINT ',1I6,' LITBOR= ',1I6,' ?????')
00284 12        FORMAT(1X,'DIFFIN: POINT ',1I6,' LITBOR= ',1I6,' ?????')
00285           CALL PLANTE(1)
00286           STOP
00287 !
00288         ENDIF
00289 !
00290       ENDDO
00291 !
00292 !----------------------------------------------------------------------
00293 !
00294 !     POST-TREATMENT FOR LIQUID BOUNDARY CONDITIONS (THOMPSON METHOD)
00295 !     THE TRACER BOUNDARY CONDITION THEN IS OF TYPE DIRICHLET
00296 !
00297       IF(NFRLIQ.GT.0.AND.THOMFR) THEN
00298 !
00299         DO K= 1 , NPTFR
00300           IFRLIQ=NUMLIQ(K)
00301           IF(IFRLIQ.GT.0) THEN
00302             IF(FRTYPE(IFRLIQ).EQ.2) LIMTRA(K) = KDIR
00303           ENDIF
00304         ENDDO
00305 !
00306       ENDIF
00307 !
00308 !-----------------------------------------------------------------------
00309 !
00310       RETURN
00311       END

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