extmsk.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\extmsk.f
00002 !
00062                      SUBROUTINE EXTMSK
00063 !                    *****************
00064 !
00065      &(MASKBR,MASK,NETAGE,NELEB)
00066 !
00067 !***********************************************************************
00068 ! TELEMAC3D   V7P0                                   21/08/2010
00069 !***********************************************************************
00070 !
00071 !
00072 !
00073 !
00074 !
00075 !
00076 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00077 !| MASK           |-->| 2D MASK
00078 !| MASKBR         |<->| 3D MASK ON LATERAL BOUNDARIES
00079 !| NELEB          |-->| NUMBER OF BOUNDARY ELEMENTS
00080 !| NETAGE         |-->| NUMBER OF PLANES - 1
00081 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00082 !
00083       USE BIEF
00084 !
00085       IMPLICIT NONE
00086       INTEGER LNG,LU
00087       COMMON/INFO/LNG,LU
00088 !
00089 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00090 !
00091       INTEGER, INTENT(IN)           :: NETAGE,NELEB
00092       DOUBLE PRECISION, INTENT(IN)  :: MASK(*)
00093       TYPE(BIEF_OBJ), INTENT(INOUT) :: MASKBR
00094 !
00095 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00096 !
00097       INTEGER IETAGE,IELEB
00098 !
00099 !=======================================================================
00100 !
00101 !=======================================================================
00102 !
00103       IF(MASKBR%ELM.EQ.70) THEN
00104 !
00105 !       QUADRILATERAL ON THE LATERAL BOUNDARIES
00106 !
00107         DO IELEB = 1,NELEB
00108           DO IETAGE = 1,NETAGE
00109             MASKBR%R((IETAGE-1)*NELEB+IELEB)=MASK(IELEB)
00110           ENDDO
00111         ENDDO
00112 !
00113       ELSEIF(MASKBR%ELM.EQ.60) THEN
00114 !
00115 !       TRIANGLES ON THE LATERAL BOUNDARIES
00116 !
00117         DO IELEB = 1,NELEB
00118           DO IETAGE = 1,NETAGE
00119             MASKBR%R((IETAGE-1)*2*NELEB+IELEB      )=MASK(IELEB)
00120             MASKBR%R((IETAGE-1)*2*NELEB+IELEB+NELEB)=MASK(IELEB)
00121           ENDDO
00122         ENDDO
00123 !
00124       ELSE
00125 !
00126         WRITE(LU,*) 'UNKNOWN ELEMENT FOR MASKBR IN EXTMSK'
00127         CALL PLANTE(1)
00128         STOP
00129 !
00130       ENDIF
00131 !
00132 !-----------------------------------------------------------------------
00133 !
00134       RETURN
00135       END

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