assignstr.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\assignstr.f
00002 !
00061                      SUBROUTINE ASSIGNSTR
00062 !                    ********************
00063 !
00064      &(CHESTR,SETSTR,PZONE,NZONE,NPOIN)
00065 !
00066 !***********************************************************************
00067 ! TELEMAC2D   V6P1                                   21/08/2010
00068 !***********************************************************************
00069 !
00070 !
00071 !
00072 !
00073 !
00074 !
00075 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00076 !| CHESTR         |<--| FRICTION COEFFICIENT
00077 !| NPOIN          |-->| NUMBER OF POINTS
00078 !| NZONE          |-->| NUMBER OF ZONES
00079 !| PZONE          |-->| TABLE OF ZONES
00080 !| SETSTR         |-->| SET OF STRICKLERS' (ZONES)
00081 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00082 !
00083       USE BIEF
00084       IMPLICIT NONE
00085 !
00086 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00087 !
00088       TYPE(BIEF_OBJ), INTENT(INOUT)   :: CHESTR
00089       TYPE(BIEF_OBJ), INTENT(IN)      :: SETSTR
00090       INTEGER, INTENT(IN)             :: PZONE(*)
00091       INTEGER, INTENT(IN)             :: NZONE
00092       INTEGER, INTENT(IN)             :: NPOIN
00093 !
00094 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00095 !
00096       INTEGER LNG,LU
00097       COMMON/INFO/LNG,LU
00098       INTEGER I,J
00099 !
00100 !---------------------------------------------------------------------
00101 !
00102       IF(NZONE.GT.0) THEN
00103         DO J=1,NZONE
00104            DO I=1,NPOIN
00105               IF (PZONE(I).EQ.J) CHESTR%R(I)=SETSTR%R(J)
00106            ENDDO
00107         ENDDO
00108       ELSE
00109         CALL OS('X=Y     ',X=CHESTR,Y=SETSTR)
00110       ENDIF
00111 !
00112 !-----------------------------------------------------------------------
00113 !
00114       RETURN
00115       END

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