crsl11.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\crsl11.f
00002 !
00047                      SUBROUTINE CRSL11
00048 !                    *****************
00049 !
00050      &(NEWSL,OLDSL,ZF,IKLE,NELEM,NELMAX)
00051 !
00052 !***********************************************************************
00053 ! BIEF   V6P1                                   21/08/2010
00054 !***********************************************************************
00055 !
00056 !
00057 !
00058 !
00059 !
00060 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00061 !| IKLE           |-->| CONNECTIVITY TABLE
00062 !| NELEM          |-->| NUMBER OF ELEMENTS
00063 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00064 !| NEWSL          |<->| MODIFIED FREE SURFACE, PER ELEMENT
00065 !| OLDSL          |-->| REAL FREE SURFACE, PER POINT
00066 !| ZF             |-->| BATHYMETRY
00067 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00068 !
00069       IMPLICIT NONE
00070       INTEGER LNG,LU
00071       COMMON/INFO/LNG,LU
00072 !
00073 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00074 !
00075       INTEGER, INTENT(IN)             :: NELEM,NELMAX
00076       DOUBLE PRECISION, INTENT(INOUT) :: NEWSL(NELMAX,3)
00077       DOUBLE PRECISION, INTENT(IN)    :: OLDSL(*),ZF(*)
00078       INTEGER, INTENT(IN)             :: IKLE(NELMAX,3)
00079 !
00080 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00081 !
00082       INTEGER IELEM,IK(3),J(3)
00083 !
00084 !-----------------------------------------------------------------------
00085 !
00086       INTRINSIC MAX
00087 !
00088 !-----------------------------------------------------------------------
00089 !
00090 !  1) SORTS (ASCENDING ORDER) THE BOTTOM ELEVATIONS AND POTENTIALLY
00091 !     CORRECTS THE FREE SURFACE ELEVATION FOR DRYING ELEMENTS
00092 !
00093 !-----------------------------------------------------------------------
00094 !
00095       DO IELEM = 1 , NELEM
00096 !
00097         IK(1) = IKLE(IELEM,1)
00098         IK(2) = IKLE(IELEM,2)
00099         IK(3) = IKLE(IELEM,3)
00100         J(1) = 1
00101         J(2) = 2
00102         J(3) = 3
00103 !
00104 !       SORTS THE 3 POINTS
00105 !
00106         IF(ZF(IK(2)).LT.ZF(IK(1)))  THEN
00107           J(2)=1
00108           J(1)=2
00109         ENDIF
00110         IF(ZF(IK(3)).LT.ZF(IK(J(2)))) THEN
00111           J(3)=J(2)
00112           J(2)=3
00113           IF(ZF(IK(3)).LT.ZF(IK(J(1)))) THEN
00114             J(2)=J(1)
00115             J(1)=3
00116           ENDIF
00117         ENDIF
00118 !
00119 !       CORRECTS
00120 !
00121         NEWSL(IELEM,J(1))=MAX(ZF(IK(J(2))),OLDSL(IK(J(1))))
00122         NEWSL(IELEM,J(2))=OLDSL(IK(J(2)))
00123         NEWSL(IELEM,J(3))=
00124      &  OLDSL(IK(J(3)))-MAX(0.D0,ZF(IK(J(3)))-OLDSL(IK(J(2))))
00125 !
00126       ENDDO ! IELEM
00127 !
00128 !-----------------------------------------------------------------------
00129 !
00130       RETURN
00131       END

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