fluxpr_sisyphe.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\fluxpr_sisyphe.f
00002 !
00081                      SUBROUTINE FLUXPR_SISYPHE
00082 !                    *************************
00083 !
00084      &(NSEC,CTRLSC,FLX,VOLNEG,VOLPOS,INFO,TPS,NSEG,NCSIZE,
00085      & FLXS,VOLNEGS,VOLPOSS,SUSP,FLXC,VOLNEGC,VOLPOSC,CHARR)
00086 !
00087 !***********************************************************************
00088 ! SISYPHE   V7P0                                         21/07/2011
00089 !***********************************************************************
00090 !
00091 !
00092 !
00093 !
00094 !
00095 !
00096 !
00097 !
00098 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00099 !| CHARR          |-->| LOGICAL, BEDLOAD OR NOT
00100 !| CTRLSC         |-->| NUMBERS OF POINTS IN THE CONTROL SECTIONS
00101 !| FLX            |-->| FLUXES THROUGH CONTROL SECTIONS
00102 !| FLXC           |-->| BEDLOAD DISCHARGE
00103 !| FLXS           |-->| SUSPENDED LOAD DISCHARGE
00104 !| INFO           |-->| IF YES : INFORMATION IS PRINTED
00105 !| NCSIZE         |-->| NUMBER OF PROCESSORS (PARALLEL)
00106 !| NSEC           |-->| NUMBER OF CONTROL SECTIONS
00107 !| NSEG           |-->| NUMBER OF SEGMENTS PER CONTROL SECTION
00108 !| SUSP           |-->| LOGICAL, SUSPENSION OR NOT
00109 !| TPS            |-->| TIME
00110 !| VOLNEG         |-->| CUMULATED NEGATIVE VOLUME THROUGH SECTIONS
00111 !| VOLNEGC        |-->| CUMULATED NEGATIVE VOLUME FOR THE BEDLOAD
00112 !| VOLNEGS        |-->| CUMULATED NEGATIVE VOLUME FOR THE SUSPENSION
00113 !| VOLPOS         |-->| CUMULATED POSITIVE VOLUME THROUGH SECTIONS
00114 !| VOLPOSC        |-->| CUMULATED POSITIVE VOLUME FOR THE BEDLOAD
00115 !| VOLPOSS        |-->| CUMULATED POSITIVE VOLUME FOR THE SUSPENDED LOAD
00116 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00117 !
00118       USE BIEF_DEF, ONLY: IPID
00119       USE DECLARATIONS_SISYPHE, ONLY: SIS_FILES,SISSEO,CHAIN
00120       IMPLICIT NONE
00121       INTEGER LNG,LU
00122       COMMON/INFO/LNG,LU
00123 !
00124 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00125 !
00126       INTEGER, INTENT(IN)          :: NSEC,NCSIZE
00127       INTEGER, INTENT(IN)          :: CTRLSC(*)
00128       INTEGER, INTENT(IN)          :: NSEG(NSEC)
00129       LOGICAL, INTENT(IN)          :: INFO,SUSP,CHARR
00130       DOUBLE PRECISION, INTENT(IN) :: FLX(NSEC),TPS
00131       DOUBLE PRECISION, INTENT(IN) :: VOLNEG(NSEC),VOLPOS(NSEC)
00132       DOUBLE PRECISION, INTENT(IN) :: FLXS(NSEC),FLXC(NSEC)
00133       DOUBLE PRECISION, INTENT(IN) :: VOLNEGS(NSEC),VOLPOSS(NSEC)
00134       DOUBLE PRECISION, INTENT(IN) :: VOLNEGC(NSEC),VOLPOSC(NSEC)
00135 !
00136 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00137 !
00138       DOUBLE PRECISION, ALLOCATABLE, SAVE :: WORK(:),WORKB(:)
00139       DOUBLE PRECISION P_DMAX,P_DMIN,P_DSUM
00140 
00141       INTEGER                        P_IMIN
00142       EXTERNAL         P_DMAX,P_DMIN,P_DSUM,P_IMIN
00143 !
00144       INTEGER ISEC,II,ERR,NSEO
00145       CHARACTER(LEN=16) :: FMTZON='(4(1X,1PG21.14))'
00146       LOGICAL :: OLD_METHOD=.FALSE.
00147       LOGICAL, SAVE :: INIT=.TRUE.
00148 !
00149 !-----------------------------------------------------------------------
00150 !
00151       NSEO=SIS_FILES(SISSEO)%LU
00152 !
00153 !-----------------------------------------------------------------------
00154 !
00155       IF(.NOT.ALLOCATED(CHAIN)) OLD_METHOD=.TRUE.
00156 !
00157 !     DONE ONCE FOR ALL
00158 !
00159       IF(INIT.AND.(TRIM(SIS_FILES(SISSEO)%NAME).NE.'') ) THEN
00160 !
00161         IF(NCSIZE.GT.1) THEN
00162           ALLOCATE (WORK(NSEC), STAT=ERR)
00163           IF(ERR.NE.0) THEN
00164             WRITE(LU,*) 'FLUXPR_SISYPHE: ERROR ALLOCATING WORK:',ERR
00165             CALL PLANTE(1)
00166             STOP
00167           ENDIF
00168           IF(CHARR.AND.SUSP) THEN
00169             ALLOCATE (WORKB(NSEC), STAT=ERR)
00170             IF(ERR.NE.0) THEN
00171               WRITE(LU,*) 'FLUXPR_SISYPHE: ERROR ALLOCATING WORK:',ERR
00172               CALL PLANTE(1)
00173               STOP
00174             ENDIF
00175           ENDIF
00176         ENDIF
00177 !
00178         INIT=.FALSE.
00179 !
00180         IF(CHARR.AND..NOT.SUSP) THEN
00181           WRITE(NSEO,*) ' INTEGRATED BEDLOAD DISCHARGES '
00182           WRITE(NSEO,*) ' VARIABLES = TIME(S) QC(M3/S) FOR',
00183      &           (' '//TRIM(CHAIN(ISEC)%DESCR), ISEC=1,NSEC)
00184         ENDIF
00185 !
00186         IF(SUSP.AND..NOT.CHARR) THEN
00187           WRITE(NSEO,*) ' INTEGRATED SUSPENDED LOAD DISCHARGES '
00188           WRITE(NSEO,*) ' VARIABLES = TIME   QS (M3/S) FOR SECTIONS '
00189      &           ,(II,II=1,NSEC)
00190         ENDIF
00191 !
00192         IF(CHARR.AND.SUSP) THEN
00193           WRITE(NSEO,*) ' INTEGRATED BEDLOAD AND SUSPENDED LOAD '
00194           WRITE(NSEO,*) 'VARIABLES = TIME , QC FOR ',
00195      &           (' '//TRIM(CHAIN(ISEC)%DESCR), ISEC=1,NSEC), ' QS FOR',
00196      &           (' '//TRIM(CHAIN(ISEC)%DESCR), ISEC=1,NSEC)
00197         ENDIF
00198 !
00199         WRITE(NSEO,100)(II , II= 1 ,NSEC)
00200 100     FORMAT(' TIME',' SECTION:',I2, 'SECTION: ',I2)
00201 !
00202       ENDIF
00203 !
00204       IF(INFO) THEN
00205 !
00206       IF(OLD_METHOD) THEN
00207 !
00208         IF(NCSIZE.LE.1) THEN
00209 !
00210 !         SCALAR MODE
00211 !
00212           DO ISEC = 1,NSEC
00213 !
00214             IF(LNG.EQ.1) WRITE(LU,130) ISEC,CTRLSC(1+2*(ISEC-1)),
00215      &                                 CTRLSC(2+2*(ISEC-1)),
00216      &                                 FLX(ISEC),VOLNEG(ISEC),
00217      &                                 VOLPOS(ISEC)
00218             IF(LNG.EQ.2) WRITE(LU,131) ISEC,CTRLSC(1+2*(ISEC-1)),
00219      &                                 CTRLSC(2+2*(ISEC-1)),
00220      &                                 FLX(ISEC),VOLNEG(ISEC),
00221      &                                 VOLPOS(ISEC)
00222 !
00223 130         FORMAT(1X,/,1X,'SECTION DE CONTROLE ',1I2,
00224      &               ' (ENTRE LES POINTS ',1I5,' ET ',1I5,')',//,5X,
00225      &               'DEBIT :                     ',G16.7,/,5X,
00226      &               'CUMUL DES DEBITS NEGATIFS : ',G16.7,/,5X,
00227      &               'CUMUL DES DEBITS POSITIFS : ',G16.7)
00228 131         FORMAT(1X,/,1X,'CONTROL SECTION NUMBER ',1I2,
00229      &               ' (BETWEEN POINTS ',1I5,' AND ',1I5,')',//,5X,
00230      &               'DISCHARGE:                 ',G16.7,/,5X,
00231      &               'CUMULATED NEGATIVE VOLUME: ',G16.7,/,5X,
00232      &               'CUMULATED POSITIVE VOLUME: ',G16.7)
00233             IF(SUSP) THEN
00234               IF(LNG.EQ.1) WRITE(LU,1301) FLXS(ISEC),
00235      &                                    VOLNEGS(ISEC),
00236      &                                    VOLPOSS(ISEC)
00237               IF(LNG.EQ.2) WRITE(LU,1302) FLXS(ISEC),
00238      &                                    VOLNEGS(ISEC),
00239      &                                    VOLPOSS(ISEC)
00240             ENDIF
00241 !
00242 1301        FORMAT(5X,'DEBIT EN SUSPENSION :       ',G16.7,/,5X,
00243      &                'CUMUL DES DEBITS NEGATIFS : ',G16.7,/,5X,
00244      &                'CUMUL DES DEBITS POSITIFS : ',G16.7)
00245 1302        FORMAT(5X,'DISCHARGE IN SUSPENSION:   ',G16.7,/,5X,
00246      &                'CUMULATED NEGATIVE VOLUME: ',G16.7,/,5X,
00247      &                'CUMULATED POSITIVE VOLUME: ',G16.7)
00248             IF(CHARR) THEN
00249               IF(LNG.EQ.1) WRITE(LU,1303) FLXC(ISEC),
00250      &                                    VOLNEGC(ISEC),
00251      &                                    VOLPOSC(ISEC)
00252               IF(LNG.EQ.2) WRITE(LU,1304) FLXC(ISEC),
00253      &                                    VOLNEGC(ISEC),
00254      &                                    VOLPOSC(ISEC)
00255 1303          FORMAT(5X,'DEBIT EN CHARRIAGE :        ',G16.7,/,5X,
00256      &                  'CUMUL DES DEBITS NEGATIFS : ',G16.7,/,5X,
00257      &                  'CUMUL DES DEBITS POSITIFS : ',G16.7)
00258 1304          FORMAT(5X,'BEDLOAD DISCHARGE:         ',G16.7,/,5X,
00259      &                  'CUMULATED NEGATIVE VOLUME: ',G16.7,/,5X,
00260      &                  'CUMULATED POSITIVE VOLUME: ',G16.7)
00261             ENDIF
00262 !
00263           ENDDO
00264 !
00265         ELSE
00266 !
00267 !         PARALLEL MODE
00268 !
00269           DO ISEC = 1,NSEC
00270 !
00271 !           SECTIONS ACROSS 2 SUB-DOMAINS WILL HAVE NSEG=0 OR -1
00272 !           AND -1 WANTED HERE FOR RELEVANT MESSAGE
00273 !
00274             II=P_IMIN(NSEG(ISEC))
00275             IF(II.GE.0) THEN
00276 !
00277               IF(LNG.EQ.1) WRITE(LU,130) ISEC,CTRLSC(1+2*(ISEC-1)),
00278      &                                   CTRLSC(2+2*(ISEC-1)),
00279      &                 P_DMIN(FLX(ISEC))+P_DMAX(FLX(ISEC)),
00280      &                                   P_DMIN(VOLNEG(ISEC)),
00281      &                                   P_DMAX(VOLPOS(ISEC))
00282               IF(LNG.EQ.2) WRITE(LU,131) ISEC,CTRLSC(1+2*(ISEC-1)),
00283      &                                   CTRLSC(2+2*(ISEC-1)),
00284      &                 P_DMIN(FLX(ISEC))+P_DMAX(FLX(ISEC)),
00285      &                                   P_DMIN(VOLNEG(ISEC)),
00286      &                                   P_DMAX(VOLPOS(ISEC))
00287 !
00288               IF(SUSP) THEN
00289                 IF(LNG.EQ.1) WRITE(LU,1301)
00290      &              P_DMIN(FLXS(ISEC))+P_DMAX(FLXS(ISEC)),
00291      &                                 P_DMIN(VOLNEGS(ISEC)),
00292      &                                 P_DMAX(VOLPOSS(ISEC))
00293                 IF(LNG.EQ.2) WRITE(LU,1302)
00294      &              P_DMIN(FLXS(ISEC))+P_DMAX(FLXS(ISEC)),
00295      &                                 P_DMIN(VOLNEGS(ISEC)),
00296      &                                 P_DMAX(VOLPOSS(ISEC))
00297               ENDIF
00298               IF(CHARR) THEN
00299                 IF(LNG.EQ.1) WRITE(LU,1303)
00300      &               P_DMIN(FLXC(ISEC))+P_DMAX(FLXC(ISEC)),
00301      &                                  P_DMIN(VOLNEGC(ISEC)),
00302      &                                  P_DMAX(VOLPOSC(ISEC))
00303                 IF(LNG.EQ.2) WRITE(LU,1304)
00304      &               P_DMIN(FLXC(ISEC))+P_DMAX(FLXC(ISEC)),
00305      &                                  P_DMIN(VOLNEGC(ISEC)),
00306      &                                  P_DMAX(VOLPOSC(ISEC))
00307               ENDIF
00308 !
00309 !           OLD METHOD AND SECTION ON SEVERAL SUB-DOMAIN
00310 !           IN THIS CASE NOTHING IS COMPUTED
00311 !
00312             ELSE
00313 !
00314               IF(LNG.EQ.1) WRITE(LU,134) ISEC,CTRLSC(1+2*(ISEC-1)),
00315      &                                        CTRLSC(2+2*(ISEC-1))
00316               IF(LNG.EQ.2) WRITE(LU,135) ISEC,CTRLSC(1+2*(ISEC-1)),
00317      &                                        CTRLSC(2+2*(ISEC-1))
00318 134           FORMAT(1X,/,1X,'SECTION DE CONTROLE ',1I2,
00319      &               ' (ENTRE LES POINTS ',1I5,' ET ',1I5,')',//,5X,
00320      &               'A CHEVAL SUR DEUX SOUS-DOMAINES, PAS DE CALCUL')
00321 135           FORMAT(1X,/,1X,'CONTROL SECTION NUMBER ',1I2,
00322      &               ' (BETWEEN POINTS ',1I5,' AND ',1I5,')',//,5X,
00323      &               'ACROSS TWO SUB-DOMAINS, NO COMPUTATION')
00324 !
00325             ENDIF
00326 !
00327           ENDDO
00328 !
00329         ENDIF
00330 !
00331 !-----------------------------------------------------------------------
00332 !
00333       ELSE
00334 !
00335 !       NEW METHOD
00336 !       CHAIN ALLOCATED, I.E. SERIAL OR PARALLEL CASE FROM SECTIONS INPUT FILE
00337 !       WE CAN APPLY CO-ORDINATES INSTEAD AND/OR NAMES OF SECTIONS
00338 !
00339         DO ISEC = 1,NSEC
00340 !
00341           IF(NCSIZE.GT.1) THEN
00342             IF(LNG.EQ.1) WRITE(LU,230) ISEC,TRIM(CHAIN(ISEC)%DESCR),
00343      &                   P_DSUM(FLX(ISEC)),P_DSUM(VOLNEG(ISEC)),
00344      &                                     P_DSUM(VOLPOS(ISEC))
00345             IF(LNG.EQ.2) WRITE(LU,231) ISEC,TRIM(CHAIN(ISEC)%DESCR),
00346      &                   P_DSUM(FLX(ISEC)),P_DSUM(VOLNEG(ISEC)),
00347      &                                     P_DSUM(VOLPOS(ISEC))
00348           ELSE
00349             IF(LNG.EQ.1) WRITE(LU,230) ISEC,TRIM(CHAIN(ISEC)%DESCR),
00350      &                   FLX(ISEC),VOLNEG(ISEC),VOLPOS(ISEC)
00351             IF(LNG.EQ.2) WRITE(LU,231) ISEC,TRIM(CHAIN(ISEC)%DESCR),
00352      &                   FLX(ISEC),VOLNEG(ISEC),VOLPOS(ISEC)
00353           ENDIF
00354 230       FORMAT(1X,/,1X,'SECTION DE CONTROLE ',1I2,
00355      &               ' (NOM ',A,')',//,5X,
00356      &               'DEBIT :                     ',G16.7,/,5X,
00357      &               'CUMUL DES DEBITS NEGATIFS : ',G16.7,/,5X,
00358      &               'CUMUL DES DEBITS POSITIFS : ',G16.7)
00359 231       FORMAT(1X,/,1X,'CONTROL SECTION NUMBER ',1I2,
00360      &               ' (NAME ',A,')',//,5X,
00361      &               'DISCHARGE:                 ',G16.7,/,5X,
00362      &               'CUMULATED NEGATIVE VOLUME: ',G16.7,/,5X,
00363      &               'CUMULATED POSITIVE VOLUME: ',G16.7)
00364           IF(SUSP) THEN
00365             IF(NCSIZE.GT.1) THEN
00366               IF(LNG.EQ.1) WRITE(LU,2301)
00367      &                P_DSUM(FLXS(ISEC)),P_DSUM(VOLNEGS(ISEC)),
00368      &                                   P_DSUM(VOLPOSS(ISEC))
00369               IF(LNG.EQ.2) WRITE(LU,2302)
00370      &                P_DSUM(FLXS(ISEC)),P_DSUM(VOLNEGS(ISEC)),
00371      &                                   P_DSUM(VOLPOSS(ISEC))
00372             ELSE
00373               IF(LNG.EQ.1) WRITE(LU,2301)
00374      &                FLXS(ISEC),VOLNEGS(ISEC),VOLPOSS(ISEC)
00375               IF(LNG.EQ.2) WRITE(LU,2302)
00376      &                FLXS(ISEC),VOLNEGS(ISEC),VOLPOSS(ISEC)
00377             ENDIF
00378 2301        FORMAT(5X,'DEBIT EN SUSPENSION :       ',G16.7,/,5X,
00379      &            'CUMUL DES DEBITS NEGATIFS : ',G16.7,/,5X,
00380      &            'CUMUL DES DEBITS POSITIFS : ',G16.7)
00381 2302        FORMAT(5X,'DISCHARGE IN SUSPENSION:   ',G16.7,/,5X,
00382      &            'CUMULATED NEGATIVE VOLUME: ',G16.7,/,5X,
00383 
00384      &            'CUMULATED POSITIVE VOLUME: ',G16.7)
00385           ENDIF
00386 !
00387           IF(CHARR) THEN
00388             IF(NCSIZE.GT.1) THEN
00389               IF(LNG.EQ.1) WRITE(LU,2303)
00390      &                P_DSUM(FLXC(ISEC)),P_DSUM(VOLNEGC(ISEC)),
00391      &                                   P_DSUM(VOLPOSC(ISEC))
00392               IF(LNG.EQ.2) WRITE(LU,2304)
00393      &                P_DSUM(FLXC(ISEC)),P_DSUM(VOLNEGC(ISEC)),
00394      &                                   P_DSUM(VOLPOSC(ISEC))
00395             ELSE
00396               IF(LNG.EQ.1) WRITE(LU,2303)
00397      &                FLXC(ISEC),VOLNEGC(ISEC),VOLPOSC(ISEC)
00398               IF(LNG.EQ.2) WRITE(LU,2304)
00399      &                FLXC(ISEC),VOLNEGC(ISEC),VOLPOSC(ISEC)
00400             ENDIF
00401 2303        FORMAT(5X,'DEBIT EN CHARRIAGE :        ',G16.7,/,5X,
00402      &            'CUMUL DES DEBITS NEGATIFS : ',G16.7,/,5X,
00403      &            'CUMUL DES DEBITS POSITIFS : ',G16.7)
00404 2304        FORMAT(5X,'BEDLOAD DISCHARGE:         ',G16.7,/,5X,
00405      &            'CUMULATED NEGATIVE VOLUME: ',G16.7,/,5X,
00406      &            'CUMULATED POSITIVE VOLUME: ',G16.7)
00407           ENDIF
00408 !
00409         ENDDO
00410 !
00411 !
00412       ENDIF ! IF OLD_METHOD
00413 !
00414 !     A SECTIONS OUTPUT FILE HAS BEEN GIVEN, IT IS FILLED
00415 !
00416       IF(TRIM(SIS_FILES(SISSEO)%NAME).NE.'') THEN
00417 !
00418 !       ONLY BEDLOAD
00419 !
00420         IF(CHARR.AND..NOT.SUSP) THEN
00421           IF(NCSIZE.GT.1) THEN
00422             DO ISEC=1,NSEC
00423               WORK(ISEC)=P_DSUM(FLXC(ISEC))
00424             ENDDO
00425 !           IN // ONLY PROCESSOR 0 WRITES THE FILE
00426             IF(IPID.EQ.0) THEN
00427               WRITE(NSEO,FMT=FMTZON) TPS,(WORK(ISEC),ISEC=1,NSEC)
00428             ENDIF
00429           ELSE
00430             WRITE(NSEO,FMT=FMTZON) TPS,(FLXC(ISEC),ISEC=1,NSEC)
00431           ENDIF
00432         ENDIF
00433 !
00434 !       ONLY SUSPENSION
00435 !
00436         IF(SUSP.AND..NOT.CHARR) THEN
00437           IF(NCSIZE.GT.1) THEN
00438             DO ISEC=1,NSEC
00439               WORK(ISEC)=P_DSUM(FLXS(ISEC))
00440             ENDDO
00441 !           IN // ONLY PROCESSOR 0 WRITES THE FILE
00442             IF(IPID.EQ.0) THEN
00443               WRITE (NSEO,FMT=FMTZON) TPS,(WORK(ISEC),ISEC=1,NSEC)
00444             ENDIF
00445           ELSE
00446             WRITE(NSEO,FMT=FMTZON) TPS,(FLXS(ISEC),ISEC=1,NSEC)
00447           ENDIF
00448         ENDIF
00449 !
00450 !       BOTH BEDLOAD AND SUSPENSION
00451 !
00452         IF(SUSP.AND.CHARR) THEN
00453           IF(NCSIZE.GT.1) THEN
00454             DO ISEC=1,NSEC
00455               WORK(ISEC) = P_DSUM(FLXC(ISEC))
00456               WORKB(ISEC)= P_DSUM(FLXS(ISEC))
00457             ENDDO
00458             IF(IPID.EQ.0) THEN
00459               WRITE (NSEO,FMT=FMTZON) TPS,(WORK(ISEC),ISEC=1,NSEC),
00460      &                                    (WORKB(ISEC), ISEC=1,NSEC)
00461             ENDIF
00462           ELSE
00463             WRITE (NSEO,FMT=FMTZON) TPS,(FLXC(ISEC),ISEC=1,NSEC),
00464      &                                  (FLXS(ISEC),ISEC=1,NSEC)
00465           ENDIF
00466         ENDIF
00467 !
00468       ENDIF
00469 !
00470 !     IF(INFO)...
00471       ENDIF
00472 !
00473 !-----------------------------------------------------------------------
00474 !
00475       RETURN
00476       END SUBROUTINE FLUXPR_SISYPHE

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