dots.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\dots.f
00002 !
00064                      DOUBLE PRECISION FUNCTION DOTS
00065 !                    ******************************
00066 !
00067      &( X , Y )
00068 !
00069 !***********************************************************************
00070 ! BIEF   V6P1                                   21/08/2010
00071 !***********************************************************************
00072 !
00073 !
00074 !
00075 !
00076 !
00077 !
00078 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00079 !| X              |-->| FIRST VECTOR OR BLOCK
00080 !| Y              |-->| SECOND VECTOR OR BLOCK
00081 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00082 !
00083       USE BIEF, EX_DOTS => DOTS
00084 !
00085       IMPLICIT NONE
00086       INTEGER LNG,LU
00087       COMMON/INFO/LNG,LU
00088 !
00089 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00090 !
00091       TYPE(BIEF_OBJ), INTENT(IN) :: X,Y
00092 !
00093 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00094 !
00095       INTEGER IBL
00096 !
00097 !-----------------------------------------------------------------------
00098 !
00099 !     CASE WHERE THE STRUCTURES ARE BLOCKS
00100 !
00101       IF(X%TYPE.EQ.4) THEN
00102 !
00103         DOTS = 0.D0
00104         DO IBL = 1 , X%N
00105           DOTS=DOTS+DOT(X%ADR(IBL)%P%DIM1,X%ADR(IBL)%P%R,Y%ADR(IBL)%P%R)
00106         ENDDO
00107 !
00108 !-----------------------------------------------------------------------
00109 !
00110 !       CASE WHERE THE STRUCTURES ARE NOT BLOCKS
00111 !       IT ASSUMES THAT Y HAS THE SAME TYPE AS X
00112 !
00113       ELSEIF(X%TYPE.EQ.2) THEN
00114 !
00115         DOTS = DOT(X%DIM1,X%R,Y%R)
00116 !
00117 !-----------------------------------------------------------------------
00118 !
00119 !     ERROR
00120 !
00121       ELSE
00122 !
00123         IF(LNG.EQ.1) WRITE(LU,50) X%NAME,X%TYPE
00124         IF(LNG.EQ.1) WRITE(LU,51) Y%NAME,Y%TYPE
00125         IF(LNG.EQ.1) WRITE(LU,53)
00126         IF(LNG.EQ.2) WRITE(LU,60) X%NAME,X%TYPE
00127         IF(LNG.EQ.2) WRITE(LU,61) Y%NAME,Y%TYPE
00128         IF(LNG.EQ.2) WRITE(LU,63)
00129 50      FORMAT(1X,'DOTS (BIEF) : NOM DE X : ',A6,'  TYPE : ',1I6)
00130 51      FORMAT(1X,'              NOM DE Y : ',A6,'  TYPE : ',1I6)
00131 53      FORMAT(1X,'              CAS NON PREVU')
00132 60      FORMAT(1X,'DOTS (BIEF) : NAME OF X : ',A6,'  TYPE : ',1I6)
00133 61      FORMAT(1X,'              NAME OF Y : ',A6,'  TYPE : ',1I6)
00134 63      FORMAT(1X,'              NOT IMPLEMENTED')
00135         CALL PLANTE(1)
00136         STOP
00137 !
00138       ENDIF
00139 !
00140 !-----------------------------------------------------------------------
00141 !
00142       RETURN
00143       END

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