maskto.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\maskto.f
00002 !
00074                      SUBROUTINE MASKTO
00075 !                    *****************
00076 !
00077      &(MASKEL,MASKPT,IFAMAS,IKLE,IFABOR,ELTSEG,NSEG,
00078      & NELEM,NPOIN,IELM,MESH)
00079 !
00080 !***********************************************************************
00081 ! BIEF   V6P1                                   21/08/2010
00082 !***********************************************************************
00083 !
00084 !
00085 !
00086 !
00087 !
00088 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00089 !| ELTSEG         |-->| SEGMENTS GIVEN PER ELEMENT
00090 !| IELM           |-->| TYPE OF ELEMENT.
00091 !| IFABOR         |-->| ELEMENTS BEHIND THE EDGES OF A TRIANGLE
00092 !|                |   | IF NEGATIVE OR ZERO, THE EDGE IS A LIQUID
00093 !|                |   | BOUNDARY
00094 !| IFAMAS         |<--| LIKE IFABOR BUT WITH MASK
00095 !| IKLE           |-->| CONNECTIVITY TABLE.
00096 !| MASKEL         |-->| MASKING OF ELEMENTS
00097 !|                |   | =1. : NORMAL   =0. : MASKED ELEMENT
00098 !| MASKPT         |-->| MASKING PER POINT.
00099 !|                |   | =1. : NORMAL   =0. : MASKED
00100 !| MESH           |-->| MESH STRUCTURE
00101 !| NELEM          |-->| NUMBER OF ELEMENTS
00102 !| NPOIN          |-->| NUMBER OF POINTS
00103 !| NSEG           |-->| NUMBER OF SEGMENTS
00104 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00105 !
00106       USE BIEF, EX_MASKTO => MASKTO
00107 !
00108       IMPLICIT NONE
00109       INTEGER LNG,LU
00110       COMMON/INFO/LNG,LU
00111 !
00112 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00113 !
00114       INTEGER, INTENT(IN)    :: NELEM,NPOIN,IELM,NSEG
00115       INTEGER, INTENT(IN)    :: IKLE(NELEM,3),IFABOR(NELEM,3)
00116       INTEGER, INTENT(IN)    :: ELTSEG(NELEM,3)
00117       INTEGER, INTENT(INOUT) :: IFAMAS(NELEM,3)
00118 !
00119       DOUBLE PRECISION, INTENT(IN)    :: MASKEL(NELEM)
00120       TYPE(BIEF_OBJ), INTENT(INOUT)   :: MASKPT
00121       TYPE(BIEF_MESH), INTENT(INOUT)  :: MESH
00122 !
00123 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00124 !
00125       INTEGER IELEM,N,I1,I2,I3
00126       DOUBLE PRECISION, POINTER, DIMENSION(:) :: WSEG
00127 !
00128       INTRINSIC MAX
00129 !
00130 !-----------------------------------------------------------------------
00131 !
00132       WSEG => MESH%MSEG%X%R
00133 !
00134       CALL OS('X=0     ',X=MASKPT)
00135 !
00136       IF(IELM.EQ.11.OR.IELM.EQ.41) THEN
00137 !
00138 ! 1) MASKS THE POINTS WHICH DO NOT BELONG TO NON-FROZEN ELEMENTS
00139 !    (THOSE WHICH BELONG TO A 'NORMAL' ELEMENT ARE SET BACK TO 1)
00140 !
00141         DO IELEM = 1,NELEM
00142           I1 = IKLE(IELEM,1)
00143           I2 = IKLE(IELEM,2)
00144           I3 = IKLE(IELEM,3)
00145           MASKPT%R(I1) = MAX(MASKPT%R(I1),MASKEL(IELEM))
00146           MASKPT%R(I2) = MAX(MASKPT%R(I2),MASKEL(IELEM))
00147           MASKPT%R(I3) = MAX(MASKPT%R(I3),MASKEL(IELEM))
00148         ENDDO
00149 !
00150 !       IN PARALLEL MODE FOR INTERFACE POINTS, MAXIMUM RETAINED
00151 !
00152         IF(NCSIZE.GT.1) CALL PARCOM(MASKPT,3,MESH)
00153 !
00154 ! 2) COPIES IFABOR IN IFAMAS
00155 !
00156         DO IELEM = 1,NELEM
00157           IFAMAS(IELEM,1) = IFABOR(IELEM,1)
00158           IFAMAS(IELEM,2) = IFABOR(IELEM,2)
00159           IFAMAS(IELEM,3) = IFABOR(IELEM,3)
00160         ENDDO
00161 !
00162 ! 3) IDENTIFIES THE EDGES OF FROZEN ELEMENTS WITH 0 (LIQUID BOUNDARY)
00163 !    TO STOP THE CHARACTERISTIC CURVES
00164 !
00165 !    USES AN ARRAY DEFINED BY SEGMENT TO COMMUNICATE IN PARALLEL MODE
00166 !
00167 !       WSEG SET TO 1
00168 !
00169         DO N=1,NSEG
00170           WSEG(N)=1.D0
00171         ENDDO
00172 !
00173 !       THEN WSEG PUT TO 0 FOR DRY ELEMENTS
00174 !
00175         DO IELEM=1,NELEM
00176           IF(MASKEL(IELEM).LT.0.5D0) THEN
00177             WSEG(ELTSEG(IELEM,1))=0.D0
00178             WSEG(ELTSEG(IELEM,2))=0.D0
00179             WSEG(ELTSEG(IELEM,3))=0.D0
00180           ENDIF
00181         ENDDO
00182 !
00183 !       IN PARALLEL MODE FOR INTERFACE EDGES, MINIMUM RETAINED
00184 !
00185         IF(NCSIZE.GT.1) THEN
00186           CALL PARCOM2_SEG(WSEG,WSEG,WSEG,NSEG,1,4,1,MESH,1,11)
00187         ENDIF
00188 !
00189 !       WSEG = 0.D0 TRANSLATED INTO IFAMAS = 0
00190 !
00191         DO IELEM=1,NELEM
00192           IF(WSEG(ELTSEG(IELEM,1)).LT.0.5D0) IFAMAS(IELEM,1)=0
00193           IF(WSEG(ELTSEG(IELEM,2)).LT.0.5D0) IFAMAS(IELEM,2)=0
00194           IF(WSEG(ELTSEG(IELEM,3)).LT.0.5D0) IFAMAS(IELEM,3)=0
00195         ENDDO
00196 !
00197       ELSE
00198 !
00199         IF(LNG.EQ.1) WRITE(LU,1000) IELM
00200         IF(LNG.EQ.2) WRITE(LU,1100) IELM
00201 1000    FORMAT(1X,'MASKTO: TYPE D''ELEMENT INCONNU :',1I6)
00202 1100    FORMAT(1X,'MASKTO: UNKNOWN TYPE OF ELEMENT :',1I6)
00203         CALL PLANTE(1)
00204         STOP
00205 !
00206       ENDIF
00207 !
00208 !-----------------------------------------------------------------------
00209 !
00210       RETURN
00211       END

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