lecbreach.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\lecbreach.f
00002 !
00051                         SUBROUTINE LECBREACH
00052 !                       ********************
00053 !
00054      &(IFIC)
00055 !
00056 !***********************************************************************
00057 ! TELEMAC2D   V6P2                                   03/08/2012
00058 !***********************************************************************
00059 !
00060 !BRIEF    READ THE BREACHES DATA FILE, ALLOCATE THE DEDICATED ARRAY
00061 !+        AND IDENTIFY THE NODES
00062 !
00063 !
00064 !HISTORY  P. CHASSE (CETMEF) / C.COULET (ARTELIA)
00065 !+        03/08/2012
00066 !+        V6P2
00067 !+        CREATION
00068 !
00069 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00070 !| IFIC           |-->| LOGICAL UNIT OF BREACHES DATA FILE
00071 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00072 !
00073       USE BIEF
00074       USE DECLARATIONS_TELEMAC2D
00075 !
00076       IMPLICIT NONE
00077       INTEGER LNG,LU
00078       COMMON/INFO/LNG,LU
00079 !
00080 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00081 !
00082       INTEGER          , INTENT(IN)    :: IFIC
00083 !
00084 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00085 !
00086       INTEGER N, M, NUM, NBL, ISTAT
00087       INTEGER ITMP(NPOIN)
00088       DOUBLE PRECISION LEMPRISE
00089       DOUBLE PRECISION X1, X2, Y1, Y2, DX, DY
00090       DOUBLE PRECISION U1, U2, V1, V2, DS
00091       DOUBLE PRECISION, DIMENSION (:), ALLOCATABLE :: XL, YL, XP, YP
00092 !
00093       CHARACTER(LEN=6) :: NOM
00094       CHARACTER*1 CHIFFRE(0:9)
00095       DATA CHIFFRE/'0','1','2','3','4','5','6','7','8','9'/
00096       SAVE CHIFFRE
00097 !
00098 !-----------------------------------------------------------------------
00099 !-----------------------------------------------------------------------
00100 !
00101       READ(IFIC,*,END=900) ! COMMENT LINE
00102       READ(IFIC,*,ERR=999) NBRECH
00103 !
00104 !     ALLOCATION OF SPECIFIC ARRAYS
00105 !
00106       IF(NBRECH.GT.0) THEN
00107         CALL BIEF_ALLVEC(2,OPTNBR,'OPTNBR',NBRECH,1,0,MESH)
00108         CALL BIEF_ALLVEC(1,TDECBR,'TDECBR',NBRECH,1,0,MESH)
00109         CALL BIEF_ALLVEC(1,DURBR ,'DURBR ',NBRECH,1,0,MESH)
00110         CALL BIEF_ALLVEC(1,ZFINBR,'ZFINBR',NBRECH,1,0,MESH)
00111         CALL BIEF_ALLVEC(1,ZDECBR,'ZDECBR',NBRECH,1,0,MESH)
00112         CALL BIEF_ALLVEC(1,ZCRBR ,'ZCRBR ',NBRECH,1,0,MESH)
00113         CALL BIEF_ALLVEC(2,NUMPSD,'NUMPSD',NBRECH,1,0,MESH)
00114         CALL BIEF_ALLVEC(2,NBNDBR,'NBNDBR',NBRECH,1,0,MESH)
00115       ELSE
00116         CALL BIEF_ALLVEC(2,OPTNBR,'OPTNBR',0,1,0,MESH)
00117         CALL BIEF_ALLVEC(1,TDECBR,'TDECBR',0,1,0,MESH)
00118         CALL BIEF_ALLVEC(1,DURBR ,'DURBR ',0,1,0,MESH)
00119         CALL BIEF_ALLVEC(1,ZFINBR,'ZFINBR',0,1,0,MESH)
00120         CALL BIEF_ALLVEC(1,ZDECBR,'ZDECBR',0,1,0,MESH)
00121         CALL BIEF_ALLVEC(1,ZCRBR ,'ZCRBR ',0,1,0,MESH)
00122         CALL BIEF_ALLVEC(2,NUMPSD,'NUMPSD',0,1,0,MESH)
00123         CALL BIEF_ALLVEC(2,NBNDBR,'NBNDBR',0,1,0,MESH)
00124       ENDIF
00125       CALL ALLBLO(INDBR ,'INDBR ')
00126 !
00127       READ(IFIC,*,END=900) ! COMMENT LINE
00128       READ(IFIC,*,ERR=998) LEMPRISE
00129 !
00130       DO N = 1, NBRECH
00131         READ(IFIC,*,END=900) ! COMMENT LINE
00132         READ(IFIC,*,END=900) ! COMMENT LINE
00133         READ(IFIC,*,ERR=997) OPTNBR%I(N)
00134         READ(IFIC,*,END=900) ! COMMENT LINE
00135         IF(OPTNBR%I(N).EQ.1) THEN
00136           READ(IFIC,*,ERR=996) TDECBR%R(N)
00137           READ(IFIC,*,END=900) ! COMMENT LINE
00138         ELSE
00139           TDECBR%R(N) = -9999.D0
00140         ENDIF
00141         READ(IFIC,*,ERR=995) DURBR%R(N)
00142         READ(IFIC,*,END=900) ! COMMENT LINE
00143         READ(IFIC,*,ERR=994) ZFINBR%R(N)
00144         READ(IFIC,*,END=900) ! COMMENT LINE
00145         IF(OPTNBR%I(N).EQ.3) THEN
00146           READ(IFIC,*,ERR=993) NUMPSD%I(N)
00147           READ(IFIC,*,END=900) ! COMMENT LINE
00148           IF(NCSIZE.GT.1) THEN
00149             NUM = NUMPSD%I(N)
00150             NUMPSD%I(N) = 0
00151             DO M=1,MESH%NPOIN
00152               IF(NUM.EQ.MESH%KNOLG%I(M)) THEN
00153                 NUMPSD%I(N) = M
00154               ENDIF
00155             ENDDO
00156           ENDIF
00157         ENDIF
00158         IF(OPTNBR%I(N).NE.1) THEN
00159           READ(IFIC,*,ERR=992) ZDECBR%R(N)
00160           READ(IFIC,*,END=900) ! COMMENT LINE
00161         ENDIF
00162         READ(IFIC,*,ERR=991) NBL
00163         READ(IFIC,*,END=900) ! COMMENT LINE
00164 !
00165 !       ALLOCATION OF LOCAL VARIABLE TO READ BREACH DEFINITION
00166         ISTAT = 0
00167         ALLOCATE(XL(NBL), STAT=ISTAT)
00168         IF(ISTAT.NE.0) THEN
00169           IF(LNG.EQ.1) WRITE(LU,10) NOM,ISTAT
00170           IF(LNG.EQ.2) WRITE(LU,20) NOM,ISTAT
00171           CALL PLANTE(1)
00172           STOP
00173         ENDIF
00174         ALLOCATE(YL(NBL), STAT=ISTAT)
00175         IF(ISTAT.NE.0) THEN
00176           IF(LNG.EQ.1) WRITE(LU,10) NOM,ISTAT
00177           IF(LNG.EQ.2) WRITE(LU,20) NOM,ISTAT
00178           CALL PLANTE(1)
00179           STOP
00180         ENDIF
00181 !
00182 10      FORMAT(1X,'ERREUR A L''ALLOCATION DU VECTEUR : ',A6,/,1X,
00183      &            'CODE D''ERREUR : ',1I6)
00184 20      FORMAT(1X,'ERROR DURING ALLOCATION OF VECTOR: ',A6,/,1X,
00185      &            'ERROR CODE: ',1I6)
00186 !
00187         DO M = 1, NBL
00188            READ(IFIC,*,ERR=990) XL(M), YL(M)
00189         ENDDO
00190 !       SEARCH MESH POINTS INSIDE THE BREACH DOMAIN
00191         ISTAT = 0
00192         ALLOCATE(XP(2*NBL), STAT=ISTAT)
00193         IF(ISTAT.NE.0) THEN
00194           IF(LNG.EQ.1) WRITE(LU,10) NOM,ISTAT
00195           IF(LNG.EQ.2) WRITE(LU,20) NOM,ISTAT
00196           CALL PLANTE(1)
00197           STOP
00198         ENDIF
00199         ALLOCATE(YP(2*NBL), STAT=ISTAT)
00200         IF(ISTAT.NE.0) THEN
00201           IF(LNG.EQ.1) WRITE(LU,10) NOM,ISTAT
00202           IF(LNG.EQ.2) WRITE(LU,20) NOM,ISTAT
00203           CALL PLANTE(1)
00204           STOP
00205         ENDIF
00206 !
00207         X1 = XL(1)
00208         Y1 = YL(1)
00209         X2 = XL(2)
00210         Y2 = YL(2)
00211         DX = X2 - X1
00212         DY = Y2 - Y1
00213         DS=DSQRT(DX*DX+DY*DY)
00214         IF(DS.GT.0.D0) THEN
00215           U1 = DX/DS
00216           U2 = DY/DS
00217         ELSE
00218           IF(LNG.EQ.1)
00219      &      WRITE(LU,*) 'PROBLEME DANS LA DEFINITION DE LA BRECHE :',N
00220           IF(LNG.EQ.2)
00221      &      WRITE(LU,*) 'PROBLEM IN DEFINITION OF BREACH :',N
00222           CALL PLANTE(1)
00223         ENDIF
00224         V1 = -U2
00225         V2 = U1
00226         XP(1)     = X1 + V1*LEMPRISE/2.0
00227         YP(1)     = Y1 + V2*LEMPRISE/2.0
00228         XP(2*NBL) = X1 - V1*LEMPRISE/2.0
00229         YP(2*NBL) = Y1 - V2*LEMPRISE/2.0
00230 !
00231         DO M = 2,NBL
00232            X2 = XL(M)
00233            Y2 = YL(M)
00234            DX = X2 - X1
00235            DY = Y2 - Y1
00236            DS=DSQRT(DX*DX+DY*DY)
00237            IF(DS.GT.0.D0) THEN
00238              U1 = DX/DS
00239              U2 = DY/DS
00240            ELSE
00241              IF(LNG.EQ.1)
00242      &         WRITE(LU,*) 'PROBLEME DANS LA DEFINITION DE LA BRECHE :',
00243      &                     N
00244              IF(LNG.EQ.2)
00245      &         WRITE(LU,*) 'PROBLEM IN DEFINITION OF BREACH :',N
00246              CALL PLANTE(1)
00247            ENDIF
00248            V1 = -U2
00249            V2 = U1
00250            XP(M)         = X2 + V1*LEMPRISE/2.0
00251            YP(M)         = Y2 + V2*LEMPRISE/2.0
00252            XP(2*NBL-M+1) = X2 - V1*LEMPRISE/2.0
00253            YP(2*NBL-M+1) = Y2 - V2*LEMPRISE/2.0
00254            X1=X2
00255            Y1=Y2
00256         ENDDO
00257 !
00258         NBNDBR%I(N) = 0
00259         DO M = 1, NPOIN
00260            IF(INPOLY(MESH%X%R(M), MESH%Y%R(M), XP, YP, 2*NBL)) THEN
00261              NBNDBR%I(N) = NBNDBR%I(N)+1
00262              ITMP(NBNDBR%I(N)) = M
00263            ENDIF
00264         ENDDO
00265 !
00266         IF(N.LE.INDBR%MAXBLOCK) THEN
00267           NOM='NBR   '
00268           IF(N.LT.10) THEN
00269             NOM(4:4) = CHIFFRE(N)
00270           ELSEIF(N.LT.100) THEN
00271             NOM(4:4) = CHIFFRE(N/10)
00272             NOM(5:5) = CHIFFRE(N-10*(N/10))
00273           ELSEIF(N.LT.1000) THEN
00274             NOM(4:4) = CHIFFRE(N/100)
00275             NOM(5:5) = CHIFFRE((N-100*(N/100))/10)
00276             NOM(6:6) = CHIFFRE((N-100*(N/100))-10*((N-100*(N/100))/10))
00277           ELSE
00278             IF(LNG.EQ.1) WRITE(LU,*) 
00279 'PLUS DE 999 BRECHES DEMANDEES     &                                DANS LECBREACH'
00280             IF(LNG.EQ.2) WRITE(LU,*) 
00281 'MORE THAN 999 BREACHS ASKED     &                                IN LECBREACH'
00282             CALL PLANTE(1)
00283             STOP
00284           ENDIF
00285           ALLOCATE(INDBR%ADR(N)%P)
00286           CALL BIEF_ALLVEC(2,INDBR%ADR(N)%P,NOM,NBNDBR%I(N),1,0,MESH)
00287         ELSE
00288           IF(LNG.EQ.1) THEN
00289             WRITE(LU,*) 'LECBREACH :'
00290             WRITE(LU,*) 'PLUS DE ',INDBR%MAXBLOCK,' (',N,')'
00291             WRITE(LU,*) 'VECTEURS DEMANDES,'
00292             WRITE(LU,*) 'CHANGER MAXBLOCK DANS ALLBLO.'
00293           ENDIF
00294           IF(LNG.EQ.2) THEN
00295             WRITE(LU,*) 'LECBREACH:'
00296             WRITE(LU,*) 'MORE THAN ',INDBR%MAXBLOCK,'(',N,')'
00297             WRITE(LU,*) 'VECTORS TO BE ALLOCATED'
00298             WRITE(LU,*) 'CHANGE MAXBLOCK IN ALLBLO.'
00299           ENDIF
00300           CALL PLANTE(1)
00301           STOP
00302         ENDIF
00303         DO M=1, NBNDBR%I(N)
00304            INDBR%ADR(N)%P%I(M) = ITMP(M)
00305         ENDDO
00306 !
00307         DEALLOCATE(XL)
00308         DEALLOCATE(YL)
00309         DEALLOCATE(XP)
00310         DEALLOCATE(YP)
00311 !
00312       ENDDO
00313 !
00314       INDBR%N = NBRECH
00315       GOTO 1000
00316 !
00317 !-----------------------------------------------------------------------
00318 !     MESSAGES D'ERREURS
00319 !-----------------------------------------------------------------------
00320 !
00321 999   CONTINUE
00322       IF(LNG.EQ.1) THEN
00323         WRITE(LU,*) 'BRECHE : ERREUR DE LECTURE SUR LE'
00324         WRITE(LU,*) '         FICHIER DE DONNEES DES BRECHES'
00325         WRITE(LU,*) '         2EME LIGNE DU FICHIER NON CONFORME.'
00326       ELSEIF(LNG.EQ.2) THEN
00327         WRITE(LU,*) 'BRECHE : READ ERROR ON THE'
00328         WRITE(LU,*) '         BREACHES DATA FILE'
00329         WRITE(LU,*) '         AT LINE 2'
00330       ENDIF
00331       GO TO 2000
00332 !
00333 998   CONTINUE
00334       IF(LNG.EQ.1) THEN
00335         WRITE(LU,*) 'BRECHE : ERREUR DE LECTURE SUR LE'
00336         WRITE(LU,*) '         FICHIER DE DONNEES DES BRECHES'
00337         WRITE(LU,*) '         4EME LIGNE DU FICHIER NON CONFORME.'
00338       ELSEIF(LNG.EQ.2) THEN
00339         WRITE(LU,*) 'BRECHE : READ ERROR ON THE'
00340         WRITE(LU,*) '         BREACHES DATA FILE'
00341         WRITE(LU,*) '         AT LINE 4'
00342       ENDIF
00343       GO TO 2000
00344 !
00345 997   CONTINUE
00346       IF(LNG.EQ.1) THEN
00347         WRITE(LU,*) 'BRECHE : ERREUR DE LECTURE SUR LE'
00348         WRITE(LU,*) '         FICHIER DE DONNEES DES BRECHES'
00349         WRITE(LU,*) '         POUR LA BRECHE ',N
00350         WRITE(LU,*) '         OPTION ILLISIBLE'
00351       ELSEIF(LNG.EQ.2) THEN
00352         WRITE(LU,*) 'BRECHE : READ ERROR ON THE'
00353         WRITE(LU,*) '         BREACHES DATA FILE'
00354         WRITE(LU,*) '         FOR THE BREACH ',N
00355         WRITE(LU,*) '         OPTION CANNOT BE READ'
00356       ENDIF
00357       GO TO 2000
00358 !
00359 996   CONTINUE
00360       IF(LNG.EQ.1) THEN
00361         WRITE(LU,*) 'BRECHE : ERREUR DE LECTURE SUR LE'
00362         WRITE(LU,*) '         FICHIER DE DONNEES DES BRECHES'
00363         WRITE(LU,*) '         POUR  LA BRECHE ',N
00364         WRITE(LU,*) '         LE TEMPS DE DECLENCHEMENT EST ILLISIBLE'
00365       ELSEIF(LNG.EQ.2) THEN
00366         WRITE(LU,*) 'BRECHE : READ ERROR ON THE'
00367         WRITE(LU,*) '         BREACHES DATA FILE'
00368         WRITE(LU,*) '         FOR THE BREACH ',N
00369         WRITE(LU,*) '         THE STARTING TIME CANNOT BE READ'
00370       ENDIF
00371       GO TO 2000
00372 !
00373 995   CONTINUE
00374       IF(LNG.EQ.1) THEN
00375         WRITE(LU,*) 'BRECHE : ERREUR DE LECTURE SUR LE'
00376         WRITE(LU,*) '         FICHIER DE DONNEES DES BRECHES'
00377         WRITE(LU,*) '         POUR  LA BRECHE ',N
00378         WRITE(LU,*) '         LA DUREE DE FORMATION EST ILLISIBLE'
00379       ELSEIF(LNG.EQ.2) THEN
00380         WRITE(LU,*) 'BRECHE : READ ERROR ON THE'
00381         WRITE(LU,*) '         BREACHES DATA FILE'
00382         WRITE(LU,*) '         FOR THE BREACH ',N
00383         WRITE(LU,*) '         THE OPENNING DURATION CANNOT BE READ'
00384       ENDIF
00385       GO TO 2000
00386 !
00387 994   CONTINUE
00388       IF(LNG.EQ.1) THEN
00389         WRITE(LU,*) 'BRECHE : ERREUR DE LECTURE SUR LE'
00390         WRITE(LU,*) '         FICHIER DE DONNEES DES BRECHES'
00391         WRITE(LU,*) '         POUR LA BRECHE ',N
00392         WRITE(LU,*) '         LA COTE FINALE EST ILLISIBLE'
00393       ELSEIF(LNG.EQ.2) THEN
00394         WRITE(LU,*) 'BRECHE : READ ERROR ON THE'
00395         WRITE(LU,*) '         BREACHES DATA FILE'
00396         WRITE(LU,*) '         FOR THE BREACH ',N
00397         WRITE(LU,*) '         THE FINAL LEVEL CANNOT BE READ'
00398       ENDIF
00399       GO TO 2000
00400 !
00401 993   CONTINUE
00402       IF(LNG.EQ.1) THEN
00403         WRITE(LU,*) 'BRECHE : ERREUR DE LECTURE SUR LE'
00404         WRITE(LU,*) '         FICHIER DE DONNEES DES BRECHES'
00405         WRITE(LU,*) '         POUR LA BRECHE ',N
00406         WRITE(LU,*) '         LE NUMERO DU POINT DE SONDE EST ILLISIBLE'
00407       ELSEIF(LNG.EQ.2) THEN
00408         WRITE(LU,*) 'BRECHE : READ ERROR ON THE'
00409         WRITE(LU,*) '         BREACHES DATA FILE'
00410         WRITE(LU,*) '         FOR THE BREACH ',N
00411         WRITE(LU,*) '         THE NUMBER OF TEST POINT CANNOT BE READ'
00412       ENDIF
00413       GO TO 2000
00414 !
00415 992   CONTINUE
00416       IF(LNG.EQ.1) THEN
00417         WRITE(LU,*) 'BRECHE : ERREUR DE LECTURE SUR LE'
00418         WRITE(LU,*) '         FICHIER DE DONNEES DES BRECHES'
00419         WRITE(LU,*) '         POUR LA BRECHE ',N
00420         WRITE(LU,*) '         LE NIVEAU DE DECLENCHEMENT EST ILLISIBLE'
00421       ELSEIF(LNG.EQ.2) THEN
00422         WRITE(LU,*) 'BRECHE : READ ERROR ON THE'
00423         WRITE(LU,*) '         BREACHES DATA FILE'
00424         WRITE(LU,*) '         FOR THE BREACH ',N
00425         WRITE(LU,*) '         THE STARTING LEVEL CANNOT BE READ'
00426       ENDIF
00427       GO TO 2000
00428 !
00429 991   CONTINUE
00430       IF(LNG.EQ.1) THEN
00431         WRITE(LU,*) 'BRECHE : ERREUR DE LECTURE SUR LE'
00432         WRITE(LU,*) '         FICHIER DE DONNEES DES BRECHES'
00433         WRITE(LU,*) '         POUR LA BRECHE ',N
00434         WRITE(LU,*) '         LE NOMBRE DE POINTS DE LA LIGNE EST'
00435         WRITE(LU,*) '         ILLISIBLE'
00436       ELSEIF(LNG.EQ.2) THEN
00437         WRITE(LU,*) 'BRECHE : READ ERROR ON THE'
00438         WRITE(LU,*) '         BREACHES DATA FILE'
00439         WRITE(LU,*) '         FOR THE BREACH ',N
00440         WRITE(LU,*) '         THE POINT NUMBER OF LINE CANNOT BE READ'
00441       ENDIF
00442       GO TO 2000
00443 !
00444 990   CONTINUE
00445       IF(LNG.EQ.1) THEN
00446         WRITE(LU,*) 'BRECHE : ERREUR DE LECTURE SUR LE'
00447         WRITE(LU,*) '         FICHIER DE DONNEES DES BRECHES'
00448         WRITE(LU,*) '         POUR LA BRECHE ',N
00449         WRITE(LU,*) '         LES COORDONNEES DU POINT ',M
00450         WRITE(LU,*) '         SONT ILLISIBLE'
00451       ELSEIF(LNG.EQ.2) THEN
00452         WRITE(LU,*) 'BRECHE : READ ERROR ON THE'
00453         WRITE(LU,*) '         BREACHES DATA FILE'
00454         WRITE(LU,*) '         FOR THE BREACH ',N
00455         WRITE(LU,*) '         THE COORDINATE OF POINT ',M
00456         WRITE(LU,*) '         CANNOT BE READ'
00457       ENDIF
00458       GO TO 2000
00459 !
00460 900   CONTINUE
00461       IF(LNG.EQ.1) THEN
00462         WRITE(LU,*) 'BRECHE : ERREUR DE LECTURE SUR LE'
00463         WRITE(LU,*) '         FICHIER DE DONNEES DES BRECHES'
00464         WRITE(LU,*) '         FIN DE FICHIER PREMATUREE'
00465       ELSEIF(LNG.EQ.2) THEN
00466         WRITE(LU,*) 'BRECHE : READ ERROR ON THE'
00467         WRITE(LU,*) '         BREACHES DATA FILE'
00468         WRITE(LU,*) '         UNEXPECTED END OF FILE'
00469       ENDIF
00470 !
00471 2000  CONTINUE
00472 !
00473       CALL PLANTE(1)
00474       STOP
00475 !
00476 1000  CONTINUE
00477       RETURN
00478       END

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