fluxpr_sisyphe.f

Go to the documentation of this file.

!                   *************************
                    SUBROUTINE fluxpr_sisyphe
!                   *************************
!
     &(nsec,ctrlsc,flx,volneg,volpos,info,tps,nseg,ncsize,
     & flxs,volnegs,volposs,susp,flxc,volnegc,volposc,charr)
!
!***********************************************************************
! SISYPHE   V7P0                                         21/07/2011
!***********************************************************************
!
!brief    COMPUTES FLUXES THROUGH CONTROL SECTIONS
!+                AND ADDS THEM UP TO OBTAIN OSCILLATING VOLUMES.
!
!note     THIS SUBROUTINE PRINTS OUT DISCHARGES THROUGH CONTROL
!+           SECTIONS. YOU CAN REWRITE IT TO DIVERT THESE PRINTOUTS
!+           TO A FILE OR TO CHANGE THE FORMAT.
!
!history  J-M HERVOUET (LNHE)
!+        27/12/2006
!+        V5P7
!+
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!history  C. VILLARET & J-M HERVOUET (EDF LAB, LNHE)
!+        18/04/2014
!+        V7P0
!+   Printing information on bedload and suspension, and writing the
!+   sections output file with both old and new methods.
!
!history  J-M HERVOUET (EDF LAB, LNHE)
!+        06/05/2014
!+        V7P0
!+   A use of P_DSUM removed in the scalar section (caused a stop with
!+   some compilers).
!
!history  J,RIEHME (ADJOINTWARE)
!+        November 2016
!+        V7P2
!+   Replaced EXTERNAL statements to parallel functions / subroutines
!+   by the INTERFACE_PARALLEL
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| CHARR          |-->| LOGICAL, BEDLOAD OR NOT
!| CTRLSC         |-->| NUMBERS OF POINTS IN THE CONTROL SECTIONS
!| FLX            |-->| FLUXES THROUGH CONTROL SECTIONS
!| FLXC           |-->| BEDLOAD DISCHARGE
!| FLXS           |-->| SUSPENDED LOAD DISCHARGE
!| INFO           |-->| IF YES : INFORMATION IS PRINTED
!| NCSIZE         |-->| NUMBER OF PROCESSORS (PARALLEL)
!| NSEC           |-->| NUMBER OF CONTROL SECTIONS
!| NSEG           |-->| NUMBER OF SEGMENTS PER CONTROL SECTION
!| SUSP           |-->| LOGICAL, SUSPENSION OR NOT
!| TPS            |-->| TIME
!| VOLNEG         |-->| CUMULATED NEGATIVE VOLUME THROUGH SECTIONS
!| VOLNEGC        |-->| CUMULATED NEGATIVE VOLUME FOR THE BEDLOAD
!| VOLNEGS        |-->| CUMULATED NEGATIVE VOLUME FOR THE SUSPENSION
!| VOLPOS         |-->| CUMULATED POSITIVE VOLUME THROUGH SECTIONS
!| VOLPOSC        |-->| CUMULATED POSITIVE VOLUME FOR THE BEDLOAD
!| VOLPOSS        |-->| CUMULATED POSITIVE VOLUME FOR THE SUSPENDED LOAD
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief_def, ONLY: ipid
      USE declarations_sisyphe, ONLY: sis_files,sisseo,chain,
     &                                init_fluxpr,work,workb
      USE declarations_special
      USE interface_parallel, ONLY : p_max,p_min,p_dsum
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN)          :: NSEC,NCSIZE
      INTEGER, INTENT(IN)          :: CTRLSC(*)
      INTEGER, INTENT(IN)          :: NSEG(nsec)
      LOGICAL, INTENT(IN)          :: INFO,SUSP,CHARR
      DOUBLE PRECISION, INTENT(IN) :: FLX(nsec),TPS
      DOUBLE PRECISION, INTENT(IN) :: VOLNEG(nsec),VOLPOS(nsec)
      DOUBLE PRECISION, INTENT(IN) :: FLXS(nsec),FLXC(nsec)
      DOUBLE PRECISION, INTENT(IN) :: VOLNEGS(nsec),VOLPOSS(nsec)
      DOUBLE PRECISION, INTENT(IN) :: VOLNEGC(nsec),VOLPOSC(nsec)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER ISEC,II,ERR,NSEO
      CHARACTER(LEN=16) :: FMTZON='(4(1X,1PG21.14))'
      LOGICAL :: OLD_METHOD=.false.
      DOUBLE PRECISION :: DTMP1,DTMP2,DTMP3,DTMP4
!
!-----------------------------------------------------------------------
!
      nseo=sis_files(sisseo)%LU
!
!-----------------------------------------------------------------------
!
      IF(.NOT.ALLOCATED(chain)) old_method=.true.
!
!     DONE ONCE FOR ALL
!
      IF(init_fluxpr.AND.(trim(sis_files(sisseo)%NAME).NE.'') ) THEN
!
        IF(ncsize.GT.1) THEN
          ALLOCATE (work(nsec), stat=err)
          IF(err.NE.0) THEN
            WRITE(lu,*) 'FLUXPR_SISYPHE: ERROR ALLOCATING WORK:',err
            CALL plante(1)
            stop
          ENDIF
          IF(charr.AND.susp) THEN
            ALLOCATE (workb(nsec), stat=err)
            IF(err.NE.0) THEN
              WRITE(lu,*) 'FLUXPR_SISYPHE: ERROR ALLOCATING WORK:',err
              CALL plante(1)
              stop
            ENDIF
          ENDIF
        ENDIF
!
        init_fluxpr=.false.
!
        IF(charr.AND..NOT.susp) THEN
          WRITE(nseo,*) ' INTEGRATED BEDLOAD DISCHARGES '
          WRITE(nseo,*) ' VARIABLES = TIME(S) QC(M3/S) FOR',
     &           (' '//trim(chain(isec)%DESCR), isec=1,nsec)
        ENDIF
!
        IF(susp.AND..NOT.charr) THEN
          WRITE(nseo,*) ' INTEGRATED SUSPENDED LOAD DISCHARGES '
          WRITE(nseo,*) ' VARIABLES = TIME   QS (M3/S) FOR SECTIONS '
     &           ,(ii,ii=1,nsec)
        ENDIF
!
        IF(charr.AND.susp) THEN
          WRITE(nseo,*) ' INTEGRATED BEDLOAD AND SUSPENDED LOAD '
          WRITE(nseo,*) 'VARIABLES = TIME , QC FOR ',
     &           (' '//trim(chain(isec)%DESCR), isec=1,nsec), ' QS FOR',
     &           (' '//trim(chain(isec)%DESCR), isec=1,nsec)
        ENDIF
!
        WRITE(nseo,100)(ii , ii= 1 ,nsec)
100     FORMAT(' TIME',' SECTION:',i2, 'SECTION: ',i2)
!
      ENDIF
!
      IF(info) THEN
!
      IF(old_method) THEN
!
        IF(ncsize.LE.1) THEN
!
!         SCALAR MODE
!
          DO isec = 1,nsec
!
            WRITE(lu,131) isec,ctrlsc(1+2*(isec-1)),
     &                                 ctrlsc(2+2*(isec-1)),
     &                                 flx(isec),volneg(isec),
     &                                 volpos(isec)
!
131         FORMAT(1x,/,1x,'CONTROL SECTION NUMBER ',1i2,
     &               ' (BETWEEN POINTS ',1i5,' AND ',1i5,')',//,5x,
     &               'DISCHARGE:                 ',g16.7,/,5x,
     &               'CUMULATED NEGATIVE VOLUME: ',g16.7,/,5x,
     &               'CUMULATED POSITIVE VOLUME: ',g16.7)
            IF(susp) THEN
              WRITE(lu,1302) flxs(isec),
     &                       volnegs(isec),
     &                       volposs(isec)
            ENDIF
!
1302        FORMAT(5x,'DISCHARGE IN SUSPENSION:   ',g16.7,/,5x,
     &                'CUMULATED NEGATIVE VOLUME: ',g16.7,/,5x,
     &                'CUMULATED POSITIVE VOLUME: ',g16.7)
            IF(charr) THEN
              WRITE(lu,1304) flxc(isec),
     &                       volnegc(isec),
     &                       volposc(isec)
1304          FORMAT(5x,'BEDLOAD DISCHARGE:         ',g16.7,/,5x,
     &                  'CUMULATED NEGATIVE VOLUME: ',g16.7,/,5x,
     &                  'CUMULATED POSITIVE VOLUME: ',g16.7)
            ENDIF
!
          ENDDO
!
        ELSE
!
!         PARALLEL MODE
!
          DO isec = 1,nsec
!
!           SECTIONS ACROSS 2 SUB-DOMAINS WILL HAVE NSEG=0 OR -1
!           AND -1 WANTED HERE FOR RELEVANT MESSAGE
!
            dtmp1 = p_min(flx(isec))
            dtmp2 = p_max(flx(isec))
            dtmp3 = p_min(volneg(isec))
            dtmp4 = p_max(volpos(isec))
            ii=p_min(nseg(isec))
            IF(ii.GE.0) THEN
!
              WRITE(lu,131) isec,ctrlsc(1+2*(isec-1)),
     &                      ctrlsc(2+2*(isec-1)),
     &                      dtmp1+dtmp2,dtmp3,dtmp4
!
              IF(susp) THEN
                dtmp1 = p_min(flxs(isec))
                dtmp2 = p_max(flxs(isec))
                dtmp3 = p_min(volnegs(isec))
                dtmp4 = p_max(volposs(isec))
                WRITE(lu,1302) dtmp1+dtmp2,dtmp3,dtmp4
              ENDIF
              IF(charr) THEN
                dtmp1 = p_min(flxc(isec))
                dtmp2 = p_max(flxc(isec))
                dtmp3 = p_min(volnegc(isec))
                dtmp4 = p_max(volposc(isec))
                WRITE(lu,1304) dtmp1+dtmp2,dtmp3,dtmp4
              ENDIF
!
!           OLD METHOD AND SECTION ON SEVERAL SUB-DOMAIN
!           IN THIS CASE NOTHING IS COMPUTED
!
            ELSE
!
              WRITE(lu,135) isec,ctrlsc(1+2*(isec-1)),
     &                      ctrlsc(2+2*(isec-1))
135           FORMAT(1x,/,1x,'CONTROL SECTION NUMBER ',1i2,
     &               ' (BETWEEN POINTS ',1i5,' AND ',1i5,')',//,5x,
     &               'ACROSS TWO SUB-DOMAINS, NO COMPUTATION')
!
            ENDIF
!
          ENDDO
!
        ENDIF
!
!-----------------------------------------------------------------------
!
      ELSE
!
!       NEW METHOD
!       CHAIN ALLOCATED, I.E. SERIAL OR PARALLEL CASE FROM SECTIONS INPUT FILE
!       WE CAN APPLY CO-ORDINATES INSTEAD AND/OR NAMES OF SECTIONS
!
        DO isec = 1,nsec
!
          IF(ncsize.GT.1) THEN
            dtmp1 = p_dsum(flx(isec))
            dtmp2 = p_dsum(volneg(isec))
            dtmp3 = p_dsum(volpos(isec))
            WRITE(lu,231) isec,trim(chain(isec)%DESCR),
     &                    dtmp1,dtmp2,dtmp3
          ELSE
            WRITE(lu,231) isec,trim(chain(isec)%DESCR),
     &                    flx(isec),volneg(isec),volpos(isec)
          ENDIF
231       FORMAT(1x,/,1x,'CONTROL SECTION NUMBER ',1i2,
     &               ' (NAME ',a,')',//,5x,
     &               'DISCHARGE:                 ',g16.7,/,5x,
     &               'CUMULATED NEGATIVE VOLUME: ',g16.7,/,5x,
     &               'CUMULATED POSITIVE VOLUME: ',g16.7)
          IF(susp) THEN
            IF(ncsize.GT.1) THEN
              dtmp1 = p_dsum(flxs(isec))
              dtmp2 = p_dsum(volnegs(isec))
              dtmp3 = p_dsum(volposs(isec))
              WRITE(lu,2302) dtmp1,dtmp2,dtmp3
            ELSE
              WRITE(lu,2302)
     &                flxs(isec),volnegs(isec),volposs(isec)
            ENDIF
2302        FORMAT(5x,'DISCHARGE IN SUSPENSION:   ',g16.7,/,5x,
     &            'CUMULATED NEGATIVE VOLUME: ',g16.7,/,5x,

     &            'CUMULATED POSITIVE VOLUME: ',g16.7)
          ENDIF
!
          IF(charr) THEN
            IF(ncsize.GT.1) THEN
              dtmp1 = p_dsum(flxc(isec))
              dtmp2 = p_dsum(volnegc(isec))
              dtmp3 = p_dsum(volposc(isec))
              WRITE(lu,2304) dtmp1,dtmp2,dtmp3
            ELSE
              WRITE(lu,2304)
     &                flxc(isec),volnegc(isec),volposc(isec)
            ENDIF
2304        FORMAT(5x,'BEDLOAD DISCHARGE:         ',g16.7,/,5x,
     &            'CUMULATED NEGATIVE VOLUME: ',g16.7,/,5x,
     &            'CUMULATED POSITIVE VOLUME: ',g16.7)
          ENDIF
!
        ENDDO
!
!
      ENDIF ! IF OLD_METHOD
!
!     A SECTIONS OUTPUT FILE HAS BEEN GIVEN, IT IS FILLED
!
      IF(trim(sis_files(sisseo)%NAME).NE.'') THEN
!
!       ONLY BEDLOAD
!
        IF(charr.AND..NOT.susp) THEN
          IF(ncsize.GT.1) THEN
            DO isec=1,nsec
              dtmp1 = p_dsum(flxc(isec))
              work(isec) = dtmp1
            ENDDO
!           IN // ONLY PROCESSOR 0 WRITES THE FILE
            IF(ipid.EQ.0) THEN
              WRITE(nseo,fmt=fmtzon) tps,(work(isec),isec=1,nsec)
            ENDIF
          ELSE
            WRITE(nseo,fmt=fmtzon) tps,(flxc(isec),isec=1,nsec)
          ENDIF
        ENDIF
!
!       ONLY SUSPENSION
!
        IF(susp.AND..NOT.charr) THEN
          IF(ncsize.GT.1) THEN
            DO isec=1,nsec
              dtmp1 = p_dsum(flxs(isec))
              work(isec) = dtmp1
            ENDDO
!           IN // ONLY PROCESSOR 0 WRITES THE FILE
            IF(ipid.EQ.0) THEN
              WRITE (nseo,fmt=fmtzon) tps,(work(isec),isec=1,nsec)
            ENDIF
          ELSE
            WRITE(nseo,fmt=fmtzon) tps,(flxs(isec),isec=1,nsec)
          ENDIF
        ENDIF
!
!       BOTH BEDLOAD AND SUSPENSION
!
        IF(susp.AND.charr) THEN
          IF(ncsize.GT.1) THEN
            DO isec=1,nsec
              dtmp1 = p_dsum(flxc(isec))
              work(isec) = dtmp1
              dtmp2 = p_dsum(flxs(isec))
              workb(isec)= dtmp2
            ENDDO
            IF(ipid.EQ.0) THEN
              WRITE (nseo,fmt=fmtzon) tps,(work(isec),isec=1,nsec),
     &                                    (workb(isec), isec=1,nsec)
            ENDIF
          ELSE
            WRITE (nseo,fmt=fmtzon) tps,(flxc(isec),isec=1,nsec),
     &                                  (flxs(isec),isec=1,nsec)
          ENDIF
        ENDIF
!
      ENDIF
!
!     IF(INFO)...
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END SUBROUTINE fluxpr_sisyphe