p_dots.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\p_dots.f
00002 !
00072                      DOUBLE PRECISION FUNCTION P_DOTS
00073 !                    ********************************
00074 !
00075      &( X , Y , MESH )
00076 !
00077 !***********************************************************************
00078 ! BIEF   V6P1                                   21/08/2010
00079 !***********************************************************************
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00087 !| MESH           |-->| MESH STRUCTURE
00088 !| X              |-->| BIEF_OBJ STRUCTURE (MAY BE A BLOCK)
00089 !| Y              |-->| BIEF_OBJ STRUCTURE (MAY BE A BLOCK)
00090 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00091 !
00092       USE BIEF, EX_P_DOTS => P_DOTS
00093 !
00094       IMPLICIT NONE
00095       INTEGER LNG,LU
00096       COMMON/INFO/LNG,LU
00097 !
00098 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00099 !
00100       TYPE(BIEF_MESH), INTENT(IN) :: MESH
00101       TYPE(BIEF_OBJ), INTENT(IN)  :: X,Y
00102 !
00103 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00104 !
00105       INTEGER NPX,IBL,TYPX
00106 !
00107       DOUBLE PRECISION P_DSUM
00108       EXTERNAL         P_DSUM
00109 !
00110 !-----------------------------------------------------------------------
00111 !
00112       TYPX = X%TYPE
00113 !
00114 !-----------------------------------------------------------------------
00115 !
00116 !  CASE WHERE THE STRUCTURES ARE BLOCKS
00117 !
00118       IF(TYPX.EQ.4) THEN
00119 !
00120         P_DOTS = 0.D0
00121 !
00122         IF(NCSIZE.LE.1.OR.NPTIR.EQ.0) THEN
00123           DO IBL = 1 , X%N
00124             P_DOTS=P_DOTS+DOT(X%ADR(IBL)%P%DIM1,X%ADR(IBL)%P%R,
00125      &                                          Y%ADR(IBL)%P%R)
00126           ENDDO
00127         ELSE
00128           DO IBL = 1 , X%N
00129             P_DOTS=P_DOTS+P_DOT(X%ADR(IBL)%P%DIM1,X%ADR(IBL)%P%R,
00130      &                                            Y%ADR(IBL)%P%R,
00131      &                                            MESH%FAC%R)
00132           ENDDO
00133         ENDIF
00134 !
00135 !-----------------------------------------------------------------------
00136 !
00137 !  CASE WHERE THE STRUCTURES ARE NOT BLOCKS
00138 !  (ASSUMES THAT Y HAS THE SAME TYPE AS X)
00139 !
00140       ELSEIF(TYPX.EQ.2) THEN
00141 !
00142         NPX = X%DIM1
00143 !
00144         IF(Y%DIM1.NE.NPX) THEN
00145           IF (LNG.EQ.1) WRITE(LU,50) X%NAME,X%TYPE
00146           IF (LNG.EQ.1) WRITE(LU,51) Y%NAME,Y%TYPE
00147           IF (LNG.EQ.1) WRITE(LU,52) X%DIM1,Y%DIM1
00148           IF (LNG.EQ.2) WRITE(LU,60) X%NAME,X%TYPE
00149           IF (LNG.EQ.2) WRITE(LU,61) Y%NAME,Y%TYPE
00150           IF (LNG.EQ.2) WRITE(LU,62) X%DIM1,Y%DIM1
00151 52        FORMAT(1X,'TAILLES DIFFERENTES : ',1I6,' ET ',1I6)
00152 62        FORMAT(1X,'DIFFERENT SIZES: ',1I6,' AND ',1I6)
00153           CALL PLANTE(1)
00154           STOP
00155         ENDIF
00156 !
00157         IF(NCSIZE.LE.1.OR.NPTIR.EQ.0) THEN
00158           P_DOTS=DOT(NPX,X%R,Y%R)
00159         ELSE
00160           P_DOTS=P_DOT(NPX,X%R,Y%R,MESH%FAC%R)
00161         ENDIF
00162 !
00163 !-----------------------------------------------------------------------
00164 !
00165 !  ERROR
00166 !
00167       ELSE
00168 !
00169         IF (LNG.EQ.1) WRITE(LU,50) X%NAME,X%TYPE
00170         IF (LNG.EQ.1) WRITE(LU,51) Y%NAME,Y%TYPE
00171         IF (LNG.EQ.1) WRITE(LU,53)
00172         IF (LNG.EQ.2) WRITE(LU,60) X%NAME,X%TYPE
00173         IF (LNG.EQ.2) WRITE(LU,61) Y%NAME,Y%TYPE
00174         IF (LNG.EQ.2) WRITE(LU,63)
00175 50      FORMAT(1X,'P_DOTS (BIEF) : NOM DE X : ',A6,'  TYPE : ',1I6)
00176 51      FORMAT(1X,'                NOM DE Y : ',A6,'  TYPE : ',1I6)
00177 53      FORMAT(1X,'                CAS NON PREVU')
00178 60      FORMAT(1X,'P_DOTS (BIEF) : NAME OF X : ',A6,'  TYPE : ',1I6)
00179 61      FORMAT(1X,'                NAME OF Y : ',A6,'  TYPE : ',1I6)
00180 63      FORMAT(1X,'                NOT IMPLEMENTED')
00181         CALL PLANTE(1)
00182         STOP
00183 !
00184       ENDIF
00185 !
00186 !-----------------------------------------------------------------------
00187 !
00188 ! FINAL SUM ON ALL THE SUB-DOMAINS
00189 !
00190       IF(NCSIZE.GT.1) P_DOTS = P_DSUM(P_DOTS)
00191 !
00192 !-----------------------------------------------------------------------
00193 !
00194       RETURN
00195       END

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