debsce.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\debsce.f
00002 !
00081                      DOUBLE PRECISION FUNCTION DEBSCE
00082 !                    ********************************
00083 !
00084      &( TIME , I , DISCE )
00085 !
00086 !***********************************************************************
00087 ! TELEMAC2D   V6P2                                   07/10/2011
00088 !***********************************************************************
00089 !
00090 !
00091 !
00092 !
00093 !
00094 !
00095 !
00096 !
00097 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00098 !| DISCE          |-->| ARRAY OF DISCHARGES OF SOURCES.
00099 !|                |   | READ IN THE PARAMETER FILE.
00100 !|                |   | NAME OF DISCE IS DSCE IN TELEMAC-2D.
00101 !| I              |-->| NUMBER OF THE SOURCE
00102 !| TIME           |-->| TIME
00103 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00104 !
00105       USE BIEF
00106       USE DECLARATIONS_TELEMAC2D, ONLY: MAXSCE,AT,ENTET,NREJET,DT,
00107      &                                  T2D_FILES,T2DVEF
00108 !
00109       IMPLICIT NONE
00110       INTEGER LNG,LU
00111       COMMON/INFO/LNG,LU
00112 !
00113 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00114 !
00115       DOUBLE PRECISION, INTENT(IN) :: TIME,DISCE(*)
00116       INTEGER         , INTENT(IN) :: I
00117 !
00118 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00119 !
00120       CHARACTER*9 FCT
00121       INTEGER N
00122       LOGICAL, SAVE :: DEJA=.FALSE.
00123       LOGICAL, DIMENSION(MAXSCE), SAVE :: OK
00124       DOUBLE PRECISION DEBSCE1,DEBSCE2
00125 !
00126 !     FIRST CALL, OK INITIALISED TO .TRUE.
00127 !
00128       IF(.NOT.DEJA) THEN
00129         DO N=1,NREJET
00130           OK(N)=.TRUE.
00131         ENDDO
00132         DEJA=.TRUE.
00133       ENDIF
00134 !
00135 !     IF SOURCES FILE EXISTING, ATTEMPT TO FIND
00136 !     THE VALUE IN IT. IF YES, OK REMAINS TO .TRUE. FOR NEXT CALLS
00137 !                      IF  NO, OK SET     TO .FALSE.
00138 !
00139       IF(OK(I).AND.T2D_FILES(T2DVEF)%NAME(1:1).NE.' ') THEN
00140 !
00141 !       FCT WILL BE Q(1), Q(2), ETC, Q(99), DEPENDING ON I
00142         FCT='Q(       '
00143         IF(I.LT.10) THEN
00144           WRITE(FCT(3:3),FMT='(I1)') I
00145           FCT(4:4)=')'
00146         ELSEIF(I.LT.100) THEN
00147           WRITE(FCT(3:4),FMT='(I2)') I
00148           FCT(5:5)=')'
00149         ELSE
00150           WRITE(LU,*) 'DEBSCE NOT PROGRAMMED FOR MORE THAN 99 SOURCES'
00151           CALL PLANTE(1)
00152           STOP
00153         ENDIF
00154         CALL READ_FIC_SOURCES(DEBSCE1,FCT,AT-DT,T2D_FILES(T2DVEF)%LU,
00155      &                        ENTET,OK(I))
00156         CALL READ_FIC_SOURCES(DEBSCE2,FCT,AT   ,T2D_FILES(T2DVEF)%LU,
00157      &                        ENTET,OK(I))
00158         DEBSCE=(DEBSCE1+DEBSCE2)*0.5D0
00159 !
00160       ENDIF
00161 !
00162 !     BEWARE, AN ERROR IN THE SOURCES FILE MAY REMAIN UNNOTICED
00163 !     BECAUSE WE RESORT HERE TO THE PARAMETER FILE
00164 !
00165       IF(.NOT.OK(I).OR.T2D_FILES(T2DVEF)%NAME(1:1).EQ.' ') THEN
00166 !
00167 !       PROGRAMMABLE PART
00168 !       DISCE IS TAKEN IN THE PARAMETER FILE
00169 !
00170 !       GLOBAL NUMBER OF SOURCE I IS ISCE(I) IN TELEMAC-2D
00171         DEBSCE = DISCE(I)
00172 !
00173       ENDIF
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