bissel.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\bissel.f
00002 !
00061                      SUBROUTINE BISSEL
00062 !                    *****************
00063 !
00064      &(IVIDE,TRA01,NPFMAX,IMAX,NDEB)
00065 !
00066 !***********************************************************************
00067 ! TELEMAC3D   V6P1                                   21/08/2010
00068 !***********************************************************************
00069 !
00070 !
00071 !
00072 !
00073 !
00074 !
00075 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00076 !| IMAX           |-->| NUMBER OF POINTS AT THE BOTTOM MESH
00077 !| IVIDE          |<->| INDEX OF EMPTY SPACES AT MESH POINTS
00078 !| NDEB           |-->| INDEX LIMITING THE RANGE OF THE RESOLUTION
00079 !| NPFMAX         |-->| MAXIMUM NUMBER OF HORIZONTAL PLANES THAT
00080 !|                |   | DISCRETISE MUDDY BOTTOM
00081 !| TRA01          |<->| WORKING ARRAY
00082 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00083 !
00084       IMPLICIT NONE
00085       INTEGER LNG,LU
00086       COMMON/INFO/LNG,LU
00087 !
00088       INTEGER, INTENT(IN) :: NPFMAX, IMAX
00089 !
00090       DOUBLE PRECISION, INTENT(INOUT) :: IVIDE(NPFMAX)
00091       DOUBLE PRECISION, INTENT(INOUT) :: TRA01(NPFMAX,6)
00092 !
00093       INTEGER K,NDEB
00094       DOUBLE PRECISION EPS
00095 !
00096 !======================================================================
00097 !
00098 !#####> NOE-CHANGES
00099 !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
00100 !
00101 !  THE FLOATING POINT EXCEPTIONS ARE NOW CHECKED BEFORE BEING USED
00102 !
00103 !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
00104 !#####
00105       EPS=1.D-8
00106       DO K=1+NDEB,IMAX-1
00107         IF( ABS(TRA01(K-1,4)).LT.EPS ) THEN
00108           WRITE(LU,*) 'FLOATING EXCEPTION IN BISSEL (CALLED BY TASSEM)'
00109           CALL PLANTE(1)
00110           STOP
00111         ENDIF
00112         TRA01(K,4) = TRA01(K,4)-(TRA01(K,3)*TRA01(K-1,5))/TRA01(K-1,4)
00113         TRA01(K,6) = TRA01(K,6)-(TRA01(K,3)*TRA01(K-1,6))/TRA01(K-1,4)
00114       ENDDO
00115 !
00116       IF(ABS(TRA01(IMAX,3)*TRA01(IMAX-1,5)
00117      &         -TRA01(IMAX-1,4)*TRA01(IMAX,4)).LT.EPS ) THEN
00118         WRITE(LU,*) 'DIVISION BY ZERO IN BISSEL (CALLED BY TASSEM)'
00119         CALL PLANTE(1)
00120         STOP
00121       ENDIF
00122       IVIDE(IMAX)=
00123      &  (TRA01(IMAX,6)*TRA01(IMAX-1,4)-TRA01(IMAX,3)*TRA01(IMAX-1,6))/
00124      &  (TRA01(IMAX,4)*TRA01(IMAX-1,4)-TRA01(IMAX,3)*TRA01(IMAX-1,5))
00125 !
00126 !#####> SEB-CHANGES
00127 ! SLIGHT MISTAKE IN THE LOOP INDEXING
00128 !       DO I=1,IMAX-NDEB+1
00129 !          K=IMAX+1-I
00130 !          IVIDE(K)=0.D0
00131 !          IVIDE(K)=(TRA01(K,6)-TRA01(K,5)*IVIDE(K+1))/TRA01(K,4)
00132       DO K = IMAX-1,NDEB,-1
00133         IF( ABS(TRA01(K,4)).LT.EPS ) THEN
00134           WRITE(LU,*) 'DIVISION BY ZERO IN BISSEL (CALLED BY TASSEM)'
00135           CALL PLANTE(1)
00136           STOP
00137         ENDIF
00138         IVIDE(K) = ( TRA01(K,6) - TRA01(K,5)*IVIDE(K+1) )/TRA01(K,4)
00139       ENDDO
00140 !#####
00141 !
00142 !-----------------------------------------------------------------------
00143 !
00144       RETURN
00145       END

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