lecbus.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\lecbus.f
00002 !
00056                      SUBROUTINE LECBUS
00057 !                    *****************
00058 !
00059      &(RELAXB,NBUSE,ENTBUS,SORBUS,LRGBUS,HAUBUS,CLPBUS,
00060      & ALTBUS,CSBUS,CEBUS,ANGBUS,LBUS,IFIC,MESH)
00061 !
00062 !***********************************************************************
00063 ! TELEMAC2D   V6P2                                   23/05/2012
00064 !***********************************************************************
00065 !
00066 !
00067 !
00068 !
00069 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00070 !| ALTBUS         |<--| ELEVATION OF ENTRY AND EXIT OF TUBES
00071 !| ANGBUS         |<--| ANGLE OF TUBES WITH AXIS OX
00072 !|                |   |   AUTOMATICALLY COMPUTED BY DEFAULT
00073 !| CEBUS          |<--| HEAD LOSS COEFFICIENT WHEN WORKING AS AN INFLOW
00074 !| CLPBUS         |<--| INTEGER FLAG FOR FLOW DIRECTION (VALVE)
00075 !|                |   |   0 - BOTH DIRECTIONS
00076 !|                |   |   1 - ONLY FROM ENTRY TO EXIT
00077 !|                |   |   2 - ONLY FROM EXIT TO ENTRY
00078 !|                |   |   3 - NO FLOW
00079 !| CSBUS          |<--| HEAD LOSS COEFFICIENT WHEN WORKING AS AN OUTFLOW
00080 !| ENTBUS         |<--| INDICES OF ENTRY OF TUBES IN GLOBAL NUMBERING
00081 !| HAUBUS         |<--| HEIGHT OF TUBES
00082 !| IFIC           |-->| LOGICAL UNIT OF TUBES DATA FILE
00083 !| LBUS           |<--| LINEAR HEAD LOSS OF TUBES
00084 !| LRGBUS         |<--| WIDTH OF TUBES
00085 !| NBUSE          |<--| NUMBER OF TUBES
00086 !| RELAXB         |<--| RELAXATION COEFFICIENT.
00087 !| SORBUS         |<--| INDICES OF TUBES EXITS IN GLOBAL MESH NUMBERING
00088 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00089 !
00090       USE BIEF
00091       IMPLICIT NONE
00092       INTEGER LNG,LU
00093       COMMON/INFO/LNG,LU
00094 !
00095 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00096 !
00097       INTEGER          , INTENT(IN)    :: IFIC,NBUSE
00098       INTEGER          , INTENT(INOUT) :: ENTBUS(NBUSE),SORBUS(NBUSE)
00099       DOUBLE PRECISION , INTENT(INOUT) :: RELAXB
00100       DOUBLE PRECISION , INTENT(INOUT) :: HAUBUS(NBUSE),LRGBUS(NBUSE)
00101       DOUBLE PRECISION , INTENT(INOUT) :: ALTBUS(NBUSE,2)
00102       DOUBLE PRECISION , INTENT(INOUT) :: ANGBUS(NBUSE,2)
00103       DOUBLE PRECISION , INTENT(INOUT) :: CEBUS(NBUSE,2),CSBUS(NBUSE,2)
00104       DOUBLE PRECISION , INTENT(INOUT) :: LBUS(NBUSE)
00105       INTEGER          , INTENT(INOUT) :: CLPBUS(NBUSE)
00106       TYPE(BIEF_MESH)  , INTENT(IN)    :: MESH
00107 !
00108 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00109 !
00110       INTEGER N
00111 !
00112       DOUBLE PRECISION XSOR,YSOR,XENT,YENT
00113 !     DOUBLE PRECISION ANG1,ANG2
00114       DOUBLE PRECISION DX,DY,ANG
00115 !
00116       DOUBLE PRECISION PI
00117       PARAMETER(PI=3.14159265358979323846D0)
00118 !
00119       DOUBLE PRECISION, EXTERNAL :: P_DMAX,P_DMIN
00120 !
00121 !-----------------------------------------------------------------------
00122 !
00123       READ(IFIC,*,END=900)
00124       READ(IFIC,*,ERR=998) RELAXB
00125       READ(IFIC,*,END=900)
00126 !
00127       DO N=1,NBUSE
00128         READ(IFIC,*,ERR=997) ENTBUS(N),SORBUS(N),
00129      &                       CEBUS(N,1),CEBUS(N,2),
00130      &                       CSBUS(N,1),CSBUS(N,2),
00131      &                       LRGBUS(N),HAUBUS(N),
00132      &                       CLPBUS(N),LBUS(N),
00133      &                       ALTBUS(N,1),ALTBUS(N,2)
00134 ! UNCOMMENT THE FOLLOWING LINE TO IMPOSE THE DIRECTION OF FLOW FROM THE DATA FILE
00135 !     &                      ,ANG1,ANG2
00136 !
00137 !       IN // GLOBAL VALUES REPLACED BY THE LOCAL VALUES FOR FURTHER USE
00138 !
00139         ENTBUS(N)=GLOBAL_TO_LOCAL_POINT(ENTBUS(N),MESH)
00140         SORBUS(N)=GLOBAL_TO_LOCAL_POINT(SORBUS(N),MESH)
00141 !
00142         IF(ENTBUS(N).GT.0) THEN
00143           XENT=MESH%X%R(ENTBUS(N))
00144           YENT=MESH%Y%R(ENTBUS(N))
00145         ELSE
00146           XENT=0.D0
00147           YENT=0.D0
00148         ENDIF
00149         IF(SORBUS(N).GT.0) THEN
00150           XSOR=MESH%X%R(SORBUS(N))
00151           YSOR=MESH%Y%R(SORBUS(N))
00152         ELSE
00153           XSOR=0.D0
00154           YSOR=0.D0
00155         ENDIF
00156         IF(NCSIZE.GT.1) THEN
00157           XENT=P_DMAX(XENT)+P_DMIN(XENT)
00158           YENT=P_DMAX(YENT)+P_DMIN(YENT)
00159           XSOR=P_DMAX(XSOR)+P_DMIN(XSOR)
00160           YSOR=P_DMAX(YSOR)+P_DMIN(YSOR)
00161         ENDIF
00162         DX  = XSOR-XENT
00163         DY  = YSOR-YENT
00164         ANG = DATAN(DY/DX)
00165         ANGBUS(N,1) = ANG
00166         ANGBUS(N,2) = ANG
00167 ! UNCOMMENT THE FOLLOWING LINE TO IMPOSE THE DIRECTION OF FLOW FROM THE DATA FILE
00168 !        ANGBUS(N,1) = ANG1*PI/180.D0
00169 !        ANGBUS(N,2) = ANG2*PI/180.D0
00170       ENDDO !  N
00171 !
00172       GO TO 1000
00173 !
00174 !-----------------------------------------------------------------------
00175 !     ERROR MESSAGES
00176 !-----------------------------------------------------------------------
00177 !
00178 998   CONTINUE
00179       IF(LNG.EQ.1) THEN
00180         WRITE(LU,*) 'LECBUS : ERREUR DE LECTURE SUR LE'
00181         WRITE(LU,*) '         FICHIER DE DONNEES DES BUSES'
00182         WRITE(LU,*) '         2EME LIGNE DU FICHIER NON CONFORME.'
00183       ELSEIF(LNG.EQ.2) THEN
00184         WRITE(LU,*) 'LECBUS : READ ERROR ON THE'
00185         WRITE(LU,*) '         TUBES DATA FILE'
00186         WRITE(LU,*) '         AT LINE 2'
00187       ENDIF
00188       CALL PLANTE(1)
00189       STOP
00190 !
00191 997   CONTINUE
00192       IF(LNG.EQ.1) THEN
00193         WRITE(LU,*) 'LECBUS : ERREUR DE LECTURE SUR LE'
00194         WRITE(LU,*) '         FICHIER DE DONNEES DES BUSES'
00195         WRITE(LU,*) '         POUR LA BUSE ',N
00196         WRITE(LU,*) '         DONNEES ILLISIBLES'
00197       ELSEIF(LNG.EQ.2) THEN
00198         WRITE(LU,*) 'LECBUS : READ ERROR ON THE'
00199         WRITE(LU,*) '         TUBES DATA FILE'
00200         WRITE(LU,*) '         FOR TUBE NUMBER ',N
00201         WRITE(LU,*) '         THE DATA CANNOT BE READ'
00202       ENDIF
00203       CALL PLANTE(1)
00204       STOP
00205 !
00206 900   CONTINUE
00207       IF(LNG.EQ.1) THEN
00208         WRITE(LU,*) 'LECBUS : ERREUR DE LECTURE SUR LE'
00209         WRITE(LU,*) '         FICHIER DE DONNEES DES BUSES'
00210         WRITE(LU,*) '         FIN DE FICHIER PREMATUREE'
00211       ELSEIF(LNG.EQ.2) THEN
00212         WRITE(LU,*) 'LECBUS : READ ERROR ON THE'
00213         WRITE(LU,*) '         TUBES DATA FILE'
00214         WRITE(LU,*) '         UNEXPECTED END OF FILE'
00215       ENDIF
00216       CALL PLANTE(1)
00217       STOP
00218 !
00219 1000  CONTINUE
00220 !
00221 !-----------------------------------------------------------------------
00222 !
00223       RETURN
00224       END

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