lecsng.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\lecsng.f
00002 !
00117                      SUBROUTINE LECSNG
00118 !                    *****************
00119 !
00120      &(IOPTAN,IFIC)
00121 !
00122 !***********************************************************************
00123 ! TELEMAC2D   V7P0                                   21/08/2010
00124 !***********************************************************************
00125 !
00126 !
00127 !
00128 !
00129 !
00130 !
00131 !
00132 !
00133 !
00134 !
00135 !
00136 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00137 !| IFIC           |-->| LOGICAL UNIT OF FORMATED DATA FILE 1
00138 !| IOPTAN         |<--| OPTION FOR TANGENTIAL VELOCITIES
00139 !| TYPSEUIL       |<--| OPTION FOR TYPE OF WEIRS
00140 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00141 !
00142       USE BIEF
00143       USE DECLARATIONS_TELEMAC2D
00144 !
00145       IMPLICIT NONE
00146       INTEGER LNG,LU
00147       COMMON/INFO/LNG,LU
00148 !
00149 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00150 !
00151       INTEGER, INTENT(IN)    :: IFIC
00152       INTEGER, INTENT(INOUT) :: IOPTAN
00153 !
00154 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00155 !
00156       INTEGER N,I,IPTFR,NNWEIRS
00157       DOUBLE PRECISION XDIG1,XDIG2,YDIG1,YDIG2
00158 !
00159       CHARACTER(LEN=6) :: NOM
00160       CHARACTER*1 CHIFFRE(0:9)
00161       DATA CHIFFRE/'0','1','2','3','4','5','6','7','8','9'/
00162       SAVE CHIFFRE
00163 !
00164 !-----------------------------------------------------------------------
00165 !
00166       MAXNPS=0
00167 !     COMMENT LINE
00168       READ(IFIC,*,END=900,ERR=900)
00169 !     NUMBER OF WEIRS, OPTION FOR TANGENTIAL VELOCITY
00170       READ(IFIC,*,END=900,ERR=998) NNWEIRS,IOPTAN
00171 !
00172 !     COHERENCE WITH THE STEERING FILE
00173 !
00174       IF(NNWEIRS.NE.NWEIRS) THEN
00175         IF(LNG.EQ.1) THEN
00176           WRITE(LU,*) 'LECSNG : NOMBRE DE SEUILS : ',NNWEIRS
00177           WRITE(LU,*) '         DIFFERENT DE LA VALEUR DONNEE DANS LE'
00178           WRITE(LU,*) '         FICHIER DES PARAMETRES :',NWEIRS
00179         ELSEIF(LNG.EQ.2) THEN
00180           WRITE(LU,*) 'LECSNG : NUMBER OF WEIRS:',NNWEIRS
00181           WRITE(LU,*) '         DIFFERENT FROM THE ONE GIVEN IN THE'
00182           WRITE(LU,*) '         PARAMETER FILE: ',NWEIRS
00183         ENDIF
00184         CALL PLANTE(1)
00185         STOP
00186       ENDIF
00187 !
00188       IF(LNG.EQ.1) THEN
00189         WRITE(LU,*)'LECSNG : NOMBRE DE DIGUES :',NWEIRS
00190       ELSEIF(LNG.EQ.2) THEN
00191         WRITE(LU,*)'LECSNG : NUMBER OF WEIRS :',NWEIRS
00192       ENDIF
00193 !
00194 !     ALLOCATIONS OF BLOCKS
00195 !
00196 !     GENERAL
00197       IF(NWEIRS.GT.0) THEN
00198         CALL BIEF_ALLVEC(2,NPSING,'NPSING',NWEIRS,1,0,MESH)
00199       ELSE
00200         CALL BIEF_ALLVEC(2,NPSING,'NPSING',0,1,0,MESH)
00201       ENDIF
00202       CALL ALLBLO(NDGA1 ,'NDGA1 ')
00203       CALL ALLBLO(NDGB1 ,'NDGB1 ')
00204       CALL ALLBLO(ZDIG  ,'ZDIG  ')
00205 !     SPECIFIC
00206       IF(TYPSEUIL.EQ.1) THEN
00207         CALL ALLBLO(PHIDIG,'PHIDIG')
00208       ELSEIF(TYPSEUIL.EQ.2) THEN
00209         CALL ALLBLO(WDIG  ,'WDIG  ')
00210         CALL ALLBLO(NDGA2 ,'NDGA2 ')
00211         CALL ALLBLO(NDGB2 ,'NDGB2 ')
00212         CALL ALLBLO(QWA   ,'QWA   ')
00213         CALL ALLBLO(QWB   ,'QWB   ')
00214         CALL ALLBLO(UWEIRA,'UWEIRA')
00215         CALL ALLBLO(UWEIRB,'UWEIRB')
00216         CALL ALLBLO(VWEIRA,'VWEIRA')
00217         CALL ALLBLO(VWEIRB,'VWEIRB')
00218         CALL ALLBLO(QP0   ,'QP0   ')
00219       ELSE
00220         IF(LNG.EQ.1) THEN
00221           WRITE(LU,*)'LECSNG : TYPE DE SEUIL NON PROGRAMME '
00222         ELSEIF(LNG.EQ.2) THEN
00223           WRITE(LU,*)'LECSNG : TYPE OF WEIRS NOT IMPLEMENTED'
00224         ENDIF
00225       ENDIF
00226 !
00227       DO N=1,NWEIRS
00228         READ(IFIC,*,ERR=900,END=900)
00229         READ(IFIC,*,ERR=900,END=900)
00230         READ(IFIC,*,END=900,ERR=997) NPSING%I(N)
00231         MAXNPS = MAX(MAXNPS,NPSING%I(N))
00232 !
00233 !     ALLOCATIONS IN EACH BLOCK
00234 !
00235       IF(N.LE.NDGA1%MAXBLOCK) THEN
00236         NOM='      '
00237         IF(N.LT.10) THEN
00238           NOM(4:4) = CHIFFRE(N)
00239         ELSEIF(N.LT.100) THEN
00240           NOM(4:4) = CHIFFRE(N/10)
00241           NOM(5:5) = CHIFFRE(N-10*(N/10))
00242         ELSEIF(N.LT.1000) THEN
00243           NOM(4:4) = CHIFFRE(N/100)
00244           NOM(5:5) = CHIFFRE((N-100*(N/100))/10)
00245           NOM(6:6) = CHIFFRE((N-100*(N/100))-10*((N-100*(N/100))/10))
00246         ELSE
00247           IF(LNG.EQ.1) WRITE(LU,*) 
00248 'PLUS DE 999 BARRAGES DEMANDEES     &                              DANS LECBREACH'
00249           IF(LNG.EQ.2) WRITE(LU,*) 
00250 'MORE THAN 999 BREACHS ASKED     &                              IN LECBREACH'
00251           CALL PLANTE(1)
00252           STOP
00253         ENDIF
00254 !       GEENRAL
00255         NOM(1:3) = 'NA1'
00256         ALLOCATE(NDGA1%ADR(N)%P)
00257         CALL BIEF_ALLVEC(2,NDGA1%ADR(N)%P,NOM,NPSING%I(N),1,0,MESH)
00258         NOM(1:3) = 'NB1'
00259         ALLOCATE(NDGB1%ADR(N)%P)
00260         CALL BIEF_ALLVEC(2,NDGB1%ADR(N)%P,NOM,NPSING%I(N),1,0,MESH)
00261         NOM(1:3) = 'ZDG'
00262         ALLOCATE(ZDIG%ADR(N)%P)
00263         CALL BIEF_ALLVEC(1,ZDIG%ADR(N)%P,NOM,NPSING%I(N),1,0,MESH)
00264 !       SPECIFIC
00265         IF(TYPSEUIL.EQ.1) THEN
00266           NOM(1:3) = 'PDG'
00267           ALLOCATE(PHIDIG%ADR(N)%P)
00268           CALL BIEF_ALLVEC(1,PHIDIG%ADR(N)%P,NOM,NPSING%I(N),1,0,MESH)
00269         ELSEIF(TYPSEUIL.EQ.2) THEN
00270           NOM(1:3) = 'NA2'
00271           ALLOCATE(NDGA2%ADR(N)%P)
00272           CALL BIEF_ALLVEC(2,NDGA2%ADR(N)%P,NOM,NPSING%I(N),1,0,MESH)
00273           NOM(1:3) = 'NB2'
00274           ALLOCATE(NDGB2%ADR(N)%P)
00275           CALL BIEF_ALLVEC(2,NDGB2%ADR(N)%P,NOM,NPSING%I(N),1,0,MESH)
00276           NOM(1:3) = 'QWA'
00277           ALLOCATE(QWA%ADR(N)%P)
00278           CALL BIEF_ALLVEC(1,QWA%ADR(N)%P,NOM,NPSING%I(N),1,0,MESH)
00279           NOM(1:3) = 'QWB'
00280           ALLOCATE(QWB%ADR(N)%P)
00281           CALL BIEF_ALLVEC(1,QWB%ADR(N)%P,NOM,NPSING%I(N),1,0,MESH)
00282           NOM(1:3) = 'UWA'
00283           ALLOCATE(UWEIRA%ADR(N)%P)
00284           CALL BIEF_ALLVEC(1,UWEIRA%ADR(N)%P,NOM,NPSING%I(N),1,0,MESH)
00285           NOM(1:3) = 'UWB'
00286           ALLOCATE(UWEIRB%ADR(N)%P)
00287           CALL BIEF_ALLVEC(1,UWEIRB%ADR(N)%P,NOM,NPSING%I(N),1,0,MESH)
00288           NOM(1:3) = 'VWA'
00289           ALLOCATE(VWEIRA%ADR(N)%P)
00290           CALL BIEF_ALLVEC(1,VWEIRA%ADR(N)%P,NOM,NPSING%I(N),1,0,MESH)
00291           NOM(1:3) = 'VWB'
00292           ALLOCATE(VWEIRB%ADR(N)%P)
00293           CALL BIEF_ALLVEC(1,VWEIRB%ADR(N)%P,NOM,NPSING%I(N),1,0,MESH)
00294           NOM(1:3) = 'WDG'
00295           ALLOCATE(WDIG%ADR(N)%P)
00296           CALL BIEF_ALLVEC(1,WDIG%ADR(N)%P,NOM,NPSING%I(N)-1,1,0,MESH)
00297           NOM(1:3) = 'QP0'
00298 !         JMH 05/08/2013: IF NOT INCREMENTED, QP0%N WILL REMAIN 0
00299           QP0%N=QP0%N+1
00300           ALLOCATE(QP0%ADR(N)%P)
00301           CALL BIEF_ALLVEC(1,QP0%ADR(N)%P,NOM,NPSING%I(N)-1,1,0,MESH)
00302         ELSE
00303           IF(LNG.EQ.1) THEN
00304             WRITE(LU,*)'LECSNG : TYPE DE SEUIL NON PROGRAMME '
00305           ELSEIF(LNG.EQ.2) THEN
00306             WRITE(LU,*)'LECSNG : TYPE OF WEIRS NOT IMPLEMENTED'
00307           ENDIF
00308         ENDIF
00309       ELSE
00310         IF(LNG.EQ.1) THEN
00311           WRITE(LU,*) 'LECSNG :'
00312           WRITE(LU,*) 'PLUS DE ',NDGA1%MAXBLOCK,' (',N,')'
00313           WRITE(LU,*) 'VECTEURS DEMANDES,'
00314           WRITE(LU,*) 'CHANGER MAXBLOCK DANS ALLBLO.'
00315         ENDIF
00316         IF(LNG.EQ.2) THEN
00317           WRITE(LU,*) 'LECSNG:'
00318           WRITE(LU,*) 'MORE THAN ',NDGA1%MAXBLOCK,'(',N,')'
00319           WRITE(LU,*) 'VECTORS TO BE ALLOCATED'
00320           WRITE(LU,*) 'CHANGE MAXBLOCK IN ALLBLO.'
00321         ENDIF
00322         CALL PLANTE(1)
00323         STOP
00324       ENDIF
00325 !
00326       IF(TYPSEUIL.EQ.1) THEN
00327         READ(IFIC,*,END=900)
00328         READ(IFIC,*,ERR=996) (NDGA1%ADR(N)%P%I(I),I=1,NPSING%I(N))
00329         READ(IFIC,*,END=900)
00330         READ(IFIC,*,ERR=994) (NDGB1%ADR(N)%P%I(I),I=1,NPSING%I(N))
00331         READ(IFIC,*,END=900)
00332         READ(IFIC,*,ERR=992) (ZDIG%ADR(N)%P%R(I),I=1,NPSING%I(N))
00333         READ(IFIC,*,END=900)
00334         READ(IFIC,*,ERR=991) (PHIDIG%ADR(N)%P%R(I),I=1,NPSING%I(N))
00335       ELSEIF(TYPSEUIL.EQ.2) THEN
00336         DO I=1,NPSING%I(N)
00337           READ(IFIC,*,ERR=990) XDIG2,YDIG2,ZDIG%ADR(N)%P%R(I),
00338      &                         NDGA1%ADR(N)%P%I(I),NDGA2%ADR(N)%P%I(I),
00339      &                         NDGB1%ADR(N)%P%I(I),NDGB2%ADR(N)%P%I(I)
00340           IF(I.GT.1) THEN
00341             WDIG%ADR(N)%P%R(I-1)=DSQRT((XDIG2-XDIG1)**2+
00342      &                                 (YDIG2-YDIG1)**2)
00343           ENDIF
00344           XDIG1=XDIG2
00345           YDIG1=YDIG2
00346         ENDDO
00347       ELSE
00348         IF(LNG.EQ.1) THEN
00349           WRITE(LU,*)'LECSNG : TYPE DE SEUIL NON PROGRAMME '
00350         ELSEIF(LNG.EQ.2) THEN
00351           WRITE(LU,*)'LECSNG : TYPE OF WEIRS NOT IMPLEMENTED'
00352         ENDIF
00353       ENDIF
00354       ENDDO ! N
00355 !
00356 !     RETRIEVING BOUNDARY POINTS NUMBERS
00357 !     WITH MINUS SIGN TO TRACE POINTS WHICH ARE NOT IN THE DOMAIN
00358 !     SEE STEP 2.
00359 !
00360 !     1) SIDES 1 AND 2
00361 !
00362       IF(TYPSEUIL.EQ.1) THEN
00363         IF(NCSIZE.GT.1) THEN
00364 !
00365           DO N=1,NWEIRS
00366             DO I=1,NPSING%I(N)
00367               DO IPTFR=1,NPTFR
00368                 IF(NDGA1%ADR(N)%P%I(I).EQ.
00369      &             MESH%KNOLG%I(MESH%NBOR%I(IPTFR))) THEN
00370                   NDGA1%ADR(N)%P%I(I)=-IPTFR
00371                   EXIT
00372                 ENDIF
00373               ENDDO
00374               DO IPTFR=1,NPTFR
00375                 IF(NDGB1%ADR(N)%P%I(I).EQ.
00376      &             MESH%KNOLG%I(MESH%NBOR%I(IPTFR))) THEN
00377                   NDGB1%ADR(N)%P%I(I)=-IPTFR
00378                   EXIT
00379                 ENDIF
00380               ENDDO
00381             ENDDO
00382           ENDDO
00383 !
00384         ELSE
00385 !
00386           DO N=1,NWEIRS
00387             DO I=1,NPSING%I(N)
00388               DO IPTFR=1,NPTFR
00389                 IF(NDGA1%ADR(N)%P%I(I).EQ.MESH%NBOR%I(IPTFR)) THEN
00390                   NDGA1%ADR(N)%P%I(I)=-IPTFR
00391                   EXIT
00392                 ENDIF
00393               ENDDO
00394               DO IPTFR=1,NPTFR
00395                 IF(NDGB1%ADR(N)%P%I(I).EQ.MESH%NBOR%I(IPTFR)) THEN
00396                   NDGB1%ADR(N)%P%I(I)=-IPTFR
00397                   EXIT
00398                 ENDIF
00399               ENDDO
00400             ENDDO
00401           ENDDO
00402 !
00403         ENDIF
00404       ELSEIF(TYPSEUIL.EQ.2) THEN
00405         IF(NCSIZE.GT.1) THEN
00406 !
00407           DO N=1,NWEIRS
00408             DO I=1,NPSING%I(N)
00409               DO IPTFR=1,NPOIN
00410                 IF(NDGA1%ADR(N)%P%I(I).EQ.
00411      &             MESH%KNOLG%I(IPTFR)) THEN
00412                   NDGA1%ADR(N)%P%I(I)=-IPTFR
00413                   EXIT
00414                 ENDIF
00415               ENDDO
00416               DO IPTFR=1,NPOIN
00417                 IF(NDGA2%ADR(N)%P%I(I).EQ.
00418      &             MESH%KNOLG%I(IPTFR)) THEN
00419                   NDGA2%ADR(N)%P%I(I)=-IPTFR
00420                   EXIT
00421                 ENDIF
00422               ENDDO
00423               DO IPTFR=1,NPOIN
00424                 IF(NDGB1%ADR(N)%P%I(I).EQ.
00425      &             MESH%KNOLG%I(IPTFR)) THEN
00426                   NDGB1%ADR(N)%P%I(I)=-IPTFR
00427                   EXIT
00428                 ENDIF
00429               ENDDO
00430               DO IPTFR=1,NPOIN
00431                 IF(NDGB2%ADR(N)%P%I(I).EQ.
00432      &             MESH%KNOLG%I(IPTFR)) THEN
00433                   NDGB2%ADR(N)%P%I(I)=-IPTFR
00434                   EXIT
00435                 ENDIF
00436               ENDDO
00437             ENDDO
00438           ENDDO
00439 !
00440         ELSE
00441 !
00442           DO N=1,NWEIRS
00443             DO I=1,NPSING%I(N)
00444               DO IPTFR=1,NPOIN
00445                 IF(NDGA1%ADR(N)%P%I(I).EQ.IPTFR) THEN
00446                   NDGA1%ADR(N)%P%I(I)=-IPTFR
00447                   EXIT
00448                 ENDIF
00449               ENDDO
00450               DO IPTFR=1,NPOIN
00451                 IF(NDGA2%ADR(N)%P%I(I).EQ.IPTFR) THEN
00452                   NDGA2%ADR(N)%P%I(I)=-IPTFR
00453                   EXIT
00454                 ENDIF
00455               ENDDO
00456               DO IPTFR=1,NPOIN
00457                 IF(NDGB1%ADR(N)%P%I(I).EQ.IPTFR) THEN
00458                   NDGB1%ADR(N)%P%I(I)=-IPTFR
00459                   EXIT
00460                 ENDIF
00461               ENDDO
00462               DO IPTFR=1,NPOIN
00463                 IF(NDGB2%ADR(N)%P%I(I).EQ.IPTFR) THEN
00464                   NDGB2%ADR(N)%P%I(I)=-IPTFR
00465                   EXIT
00466                 ENDIF
00467               ENDDO
00468             ENDDO
00469           ENDDO
00470 !
00471         ENDIF
00472       ELSE
00473         IF(LNG.EQ.1) THEN
00474           WRITE(LU,*)'LECSNG : TYPE DE SEUIL NON PROGRAMME '
00475         ELSEIF(LNG.EQ.2) THEN
00476           WRITE(LU,*)'LECSNG : TYPE OF WEIRS NOT IMPLEMENTED'
00477         ENDIF
00478       ENDIF
00479 !
00480 !     2) NOW PUTTING A POSITIVE NUMBER IF POINT IN DOMAIN
00481 !                    AND ZERO IF POINT NOT IN DOMAIN (PARALLELISM)
00482 !
00483       DO N=1,NWEIRS
00484         DO I=1,NPSING%I(N)
00485           NDGA1%ADR(N)%P%I(I)=MAX(-NDGA1%ADR(N)%P%I(I),0)
00486           NDGB1%ADR(N)%P%I(I)=MAX(-NDGB1%ADR(N)%P%I(I),0)
00487           IF(TYPSEUIL.EQ.2) THEN
00488             NDGA2%ADR(N)%P%I(I)=MAX(-NDGA2%ADR(N)%P%I(I),0)
00489             NDGB2%ADR(N)%P%I(I)=MAX(-NDGB2%ADR(N)%P%I(I),0)
00490           ENDIF
00491         ENDDO
00492       ENDDO
00493 !
00494       GO TO 1000
00495 !
00496 !-----------------------------------------------------------------------
00497 !     ERROR MESSAGES
00498 !-----------------------------------------------------------------------
00499 !
00500 998   CONTINUE
00501       IF(LNG.EQ.1) THEN
00502         WRITE(LU,*) 'LECSNG : ERREUR DE LECTURE SUR LE'
00503         WRITE(LU,*) '         FICHIER DE DONNEES DES SEUILS'
00504         WRITE(LU,*) '         2EME LIGNE DU FICHIER NON CONFORME.'
00505       ELSEIF(LNG.EQ.2) THEN
00506         WRITE(LU,*) 'LECSNG : READ ERROR ON THE'
00507         WRITE(LU,*) '         WEIRS DATA FILE'
00508         WRITE(LU,*) '         AT LINE 2'
00509       ENDIF
00510       GO TO 2000
00511 !
00512 997   CONTINUE
00513       IF(LNG.EQ.1) THEN
00514         WRITE(LU,*) 'LECSNG : ERREUR DE LECTURE SUR LE'
00515         WRITE(LU,*) '         FICHIER DE DONNEES DES SEUILS'
00516         WRITE(LU,*) '         POUR LA SINGULARITE ',N
00517         WRITE(LU,*) '         NOMBRE DE POINTS ILLISIBLE'
00518       ELSEIF(LNG.EQ.2) THEN
00519         WRITE(LU,*) 'LECSNG : READ ERROR ON THE'
00520         WRITE(LU,*) '         WEIRS DATA FILE'
00521         WRITE(LU,*) '         FOR SINGULARITY NUMBER ',N
00522         WRITE(LU,*) '         THE NUMBER OF POINTS CANNOT BE READ'
00523       ENDIF
00524       GO TO 2000
00525 !
00526 996   CONTINUE
00527       IF(LNG.EQ.1) THEN
00528         WRITE(LU,*) 'LECSNG : ERREUR DE LECTURE SUR LE'
00529         WRITE(LU,*) '         FICHIER DE DONNEES DES SEUILS'
00530         WRITE(LU,*) '         POUR LA SINGULARITE ',N
00531         WRITE(LU,*) '         NUMDIGS DES POINTS ILLISIBLE'
00532         WRITE(LU,*) '         POUR LE COTE 1'
00533       ELSEIF(LNG.EQ.2) THEN
00534         WRITE(LU,*) 'LECSNG : READ ERROR ON THE'
00535         WRITE(LU,*) '         WEIRS DATA FILE'
00536         WRITE(LU,*) '         FOR SINGULARITY NUMBER ',N
00537         WRITE(LU,*) '         THE NUMBER OF THE POINTS CANNOT BE READ'
00538         WRITE(LU,*) '         FOR SIDE NUMBER 1'
00539       ENDIF
00540       GO TO 2000
00541 !
00542 994   CONTINUE
00543       IF(LNG.EQ.1) THEN
00544         WRITE(LU,*) 'LECSNG : ERREUR DE LECTURE SUR LE'
00545         WRITE(LU,*) '         FICHIER DE DONNEES DES SEUILS'
00546         WRITE(LU,*) '         POUR LA SINGULARITE ',N
00547         WRITE(LU,*) '         NUMDIGS DES POINTS ILLISIBLE'
00548         WRITE(LU,*) '         POUR LE COTE 2'
00549       ELSEIF(LNG.EQ.2) THEN
00550         WRITE(LU,*) 'LECSNG : READ ERROR ON THE'
00551         WRITE(LU,*) '         WEIRS DATA FILE'
00552         WRITE(LU,*) '         FOR SINGULARITY NUMBER ',N
00553         WRITE(LU,*) '         THE NUMBER OF THE POINTS CANNOT BE READ'
00554         WRITE(LU,*) '         FOR SIDE NUMBER 2'
00555       ENDIF
00556       GO TO 2000
00557 !
00558 992   CONTINUE
00559       IF(LNG.EQ.1) THEN
00560         WRITE(LU,*) 'LECSNG : ERREUR DE LECTURE SUR LE'
00561         WRITE(LU,*) '         FICHIER DE DONNEES DES SEUILS'
00562         WRITE(LU,*) '         POUR LA SINGULARITE ',N
00563         WRITE(LU,*) '         COTES SUR LA DIGUE ILLISIBLES'
00564       ELSEIF(LNG.EQ.2) THEN
00565         WRITE(LU,*) 'LECSNG : READ ERROR ON THE'
00566         WRITE(LU,*) '         WEIRS DATA FILE'
00567         WRITE(LU,*) '         FOR SINGULARITY NUMBER ',N
00568         WRITE(LU,*) '         ELEVATIONS ON THE WEIR CANNOT BE READ'
00569       ENDIF
00570       GO TO 1000
00571 !
00572 991   CONTINUE
00573       IF(LNG.EQ.1) THEN
00574         WRITE(LU,*) 'LECSNG : ERREUR DE LECTURE SUR LE'
00575         WRITE(LU,*) '         FICHIER DE DONNEES DES SEUILS'
00576         WRITE(LU,*) '         POUR LA SINGULARITE ',N
00577         WRITE(LU,*) '         COEFFICIENTS DE DEBIT ILLISIBLES'
00578       ELSEIF(LNG.EQ.2) THEN
00579         WRITE(LU,*) 'LECSNG : READ ERROR ON THE'
00580         WRITE(LU,*) '         WEIRS DATA FILE'
00581         WRITE(LU,*) '         FOR SINGULARITY NUMBER ',N
00582         WRITE(LU,*) '         DISCHARGE COEFFICIENTS CANNOT BE READ'
00583       ENDIF
00584       GO TO 2000
00585 !
00586 990   CONTINUE
00587       IF(LNG.EQ.1) THEN
00588         WRITE(LU,*) 'LECSNG : ERREUR DE LECTURE SUR LE'
00589         WRITE(LU,*) '         FICHIER DE DONNEES DES SEUILS'
00590         WRITE(LU,*) '         POUR LA SINGULARITE ',N
00591         WRITE(LU,*) '         DESCRIPTION DU SEUIL ILLISIBLE'
00592       ELSEIF(LNG.EQ.2) THEN
00593         WRITE(LU,*) 'LECSNG : READ ERROR ON THE'
00594         WRITE(LU,*) '         WEIRS DATA FILE'
00595         WRITE(LU,*) '         FOR SINGULARITY NUMBER ',N
00596         WRITE(LU,*) '         WEIR DESCRIPTION CANNOT BE READ'
00597       ENDIF
00598       GO TO 2000
00599 !
00600 900   CONTINUE
00601       IF(LNG.EQ.1) THEN
00602         WRITE(LU,*) 'LECSNG : ERREUR DE LECTURE SUR LE'
00603         WRITE(LU,*) '         FICHIER DE DONNEES DES SEUILS'
00604         WRITE(LU,*) '         FIN DE FICHIER PREMATUREE'
00605       ELSEIF(LNG.EQ.2) THEN
00606         WRITE(LU,*) 'LECSNG : READ ERROR ON THE'
00607         WRITE(LU,*) '         WEIRS DATA FILE'
00608         WRITE(LU,*) '         UNEXPECTED END OF FILE'
00609       ENDIF
00610 !
00611 2000  CONTINUE
00612 !
00613       NWEIRS = 0
00614 !
00615 1000  CONTINUE
00616 !
00617       IF(NWEIRS.EQ.0) THEN
00618         IF(LNG.EQ.1) THEN
00619           WRITE(LU,*)
00620           WRITE(LU,*)'LECSNG : ERREUR DE LECTURE'
00621           WRITE(LU,*)'         AUCUNE SINGULARITE NE SERA'
00622           WRITE(LU,*)'         PRISE EN COMPTE.'
00623           WRITE(LU,*)
00624         ELSEIF(LNG.EQ.2) THEN
00625           WRITE(LU,*)
00626           WRITE(LU,*)'LECSNG : READ ERROR'
00627           WRITE(LU,*)'         NO SINGULARITY WILL BE TAKEN'
00628           WRITE(LU,*)'         INTO ACCOUNT'
00629           WRITE(LU,*)
00630         ENDIF
00631       ENDIF
00632 !
00633       IF(TYPSEUIL.EQ.2) THEN
00634         DO N=1, NWEIRS
00635           CALL OS('X=0     ',X=QP0%ADR(N)%P)
00636         ENDDO
00637         CALL ALLBLO(TWEIRA,'TWEIRA')
00638         CALL ALLBLO(TWEIRB,'TWEIRA')
00639         IF(NTRAC.GT.0) THEN
00640           CALL BIEF_ALLVEC_IN_BLOCK(TWEIRA,NTRAC,1,'TWEIRA',
00641      &                              NWEIRS,MAXNPS,0,MESH)
00642           CALL BIEF_ALLVEC_IN_BLOCK(TWEIRB,NTRAC,1,'TWEIRB',
00643      &                              NWEIRS,MAXNPS,0,MESH)
00644         ELSE
00645           CALL BIEF_ALLVEC_IN_BLOCK(TWEIRA,1    ,1,'TWEIRA',
00646      &                              NWEIRS,MAXNPS,0,MESH)
00647           CALL BIEF_ALLVEC_IN_BLOCK(TWEIRB,1    ,1,'TWEIRB',
00648      &                              NWEIRS,MAXNPS,0,MESH)
00649         ENDIF
00650       ENDIF
00651 !
00652 !-----------------------------------------------------------------------
00653 !
00654       RETURN
00655       END

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