hloc.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\hloc.f
00002 !
00069                      SUBROUTINE HLOC
00070 !                    ***************
00071 !
00072      &(NPOIN,NSEG,NELEM,NUBO,VNOCL,AIRS,DTHAUT,MESH,ELTSEG,IFABOR)
00073 !
00074 !***********************************************************************
00075 ! BIEF   V6P3                                   25/05/2013
00076 !***********************************************************************
00077 !
00078 !
00079 !
00080 !
00081 !
00082 ! history R. ATA
00083 !+         25/02/2012
00084 !+         V6P3
00085 !+   remove nubo and change by gloseg
00086 !+   parallelization
00087 !+
00088 !
00089 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00090 !| AIRS           |-->| AREAS OF CELLS IN THE MESH.
00091 !| DTHAUT         |<--| SPACE STEP
00092 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
00093 !| NPOIN          |-->| NUMBER OF POINTS
00094 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00095 !| NSEG           |-->| NUMBER OF SEGMENTS
00096 !| NUBO           |-->| FIRST AND SECOND POINT OF SEGMENTS
00097 !| VNOCL          |-->| NORMAL VECTOR TO INTERFACE
00098 !|                |   | (2 FIRST COMPONENTS) AND
00099 !|                |   | SEGMENT LENGTH (3RD COMPONENT)
00100 !| XNEBOR         |-->| X-COMPONENT OF NORMAL VECTOR AT BOUNDARY POINT
00101 !| YNEBOR         |-->| Y-COMPONENT OF NORMAL VECTOR AT BOUNDARY POINT
00102 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00103 !
00104       USE BIEF_DEF
00105       USE BIEF, EX_HLOC => HLOC
00106       IMPLICIT NONE
00107       INTEGER LNG,LU
00108       COMMON/INFO/LNG,LU
00109 !
00110 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00111 !
00112       INTEGER, INTENT(IN)            :: NSEG,NPOIN
00113       INTEGER, INTENT(IN)            :: NUBO(2,*)
00114       INTEGER, INTENT(IN)            :: NELEM
00115       INTEGER, INTENT(IN)            :: ELTSEG(NELEM,3)
00116       DOUBLE PRECISION, INTENT(IN)   :: VNOCL(3,*)
00117       DOUBLE PRECISION, INTENT(IN)   :: AIRS(NPOIN)
00118       DOUBLE PRECISION, INTENT(OUT)  :: DTHAUT(NPOIN)
00119       TYPE(BIEF_MESH), INTENT(INOUT) :: MESH
00120       INTEGER, INTENT(IN)            :: IFABOR(NELEM,3)
00121 !
00122 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00123 !
00124       INTEGER I,NSG,NUBO1,NUBO2,IELEM,IER
00125       LOGICAL, ALLOCATABLE :: YESNO(:)
00126       ALLOCATE(YESNO(NSEG),STAT=IER)
00127       IF(IER.NE.0) THEN
00128         IF(LNG.EQ.1) WRITE(LU,*) 'HLOC: ERREUR D''ALLOCATION DE YESNO'
00129         IF(LNG.EQ.2) WRITE(LU,*) 'HLOC: ALLOCATION ERROR OF YESNO'
00130         CALL PLANTE(1)
00131         STOP
00132       ENDIF
00133 !
00134 !-----------------------------------------------------------------------
00135 !
00136 !     INITIALISES
00137 !
00138       DO I=1,NPOIN
00139         DTHAUT(I) = 0.D0
00140       ENDDO
00141 !     INITIALIZATION OF YESNO
00142       DO I=1,NSEG
00143         YESNO(I)=.FALSE.
00144       ENDDO
00145 !
00146       DO IELEM=1, NELEM
00147         DO I = 1,3
00148           IF(.NOT.YESNO(ELTSEG(IELEM,I)))THEN
00149             NSG = ELTSEG(IELEM,I)
00150             NUBO1 = NUBO(1,NSG)
00151             NUBO2 = NUBO(2,NSG)
00152 !           NUBO OR GLOSEG ARE THE SAME .. TO REMOVE NUBO (REDUNDANCE)
00153             IF(NCSIZE.GT.1.AND.IFABOR(IELEM,I).EQ.-2)THEN !THIS IS AN INTERFACE EDGE
00154               DTHAUT(NUBO1)=DTHAUT(NUBO1) + 0.5D0*VNOCL(3,NSG)
00155               DTHAUT(NUBO2)=DTHAUT(NUBO2) + 0.5D0*VNOCL(3,NSG)
00156             ELSE
00157               DTHAUT(NUBO1)=DTHAUT(NUBO1) + VNOCL(3,NSG)
00158               DTHAUT(NUBO2)=DTHAUT(NUBO2) + VNOCL(3,NSG)
00159             ENDIF
00160             YESNO(NSG)=.TRUE.
00161           ENDIF
00162         ENDDO
00163       ENDDO
00164 !
00165       IF(NCSIZE.GT.1) THEN
00166         CALL PARCOM2(DTHAUT,DTHAUT,DTHAUT,NPOIN,1,2,1,MESH)
00167       ENDIF
00168 !
00169       DO I=1,NPOIN
00170         DTHAUT(I) = AIRS(I)/ DTHAUT(I)
00171       ENDDO
00172 !
00173       DEALLOCATE(YESNO)
00174 !
00175 !-----------------------------------------------------------------------
00176 !
00177       RETURN
00178       END

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