fluxpr_telemac2d.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\fluxpr_telemac2d.f
00002 !
00072                      SUBROUTINE FLUXPR_TELEMAC2D
00073 !                    ***************************
00074 !
00075      &(NSEC,CTRLSC,FLX,VOLNEG,VOLPOS,INFO,TPS,NSEG,NCSIZE,CUMFLO)
00076 !
00077 !***********************************************************************
00078 ! TELEMAC2D   V6P1                                   21/08/2010
00079 !***********************************************************************
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00087 !| CTRLSC         |-->| NUMBERS OF POINTS IN THE CONTROL SECTIONS
00088 !| CUMFLO         |-->| KEYWORD: PRINTING CUMULATED FLOWRATES
00089 !| FLX            |-->| FLUXES THROUGH CONTROL SECTIONS
00090 !| INFO           |-->| IF YES : INFORMATION IS PRINTED
00091 !| NCSIZE         |-->| NUMBER OF PROCESSORS
00092 !| NSEC           |-->| NUMBER OF CONTROL SECTIONS
00093 !| NSEG           |-->| NUMBER OF SEGMENTS
00094 !| TPS            |-->| TIME IN SECONDS
00095 !| VOLNEG         |-->| CUMULATED NEGATIVE VOLUME THROUGH SECTIONS
00096 !| VOLPOS         |-->| CUMULATED POSITIVE VOLUME THROUGH SECTIONS
00097 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00098 !
00099       USE BIEF_DEF, ONLY: IPID
00100       USE DECLARATIONS_TELEMAC2D, ONLY: T2D_FILES,T2DSEO,CHAIN,TITCAS
00101       IMPLICIT NONE
00102       INTEGER LNG,LU
00103       COMMON/INFO/LNG,LU
00104 !
00105 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00106 !
00107       INTEGER, INTENT(IN)          :: NSEC,NCSIZE
00108       INTEGER, INTENT(IN)          :: CTRLSC(*)
00109       INTEGER, INTENT(IN)          :: NSEG(NSEC)
00110       LOGICAL, INTENT(IN)          :: INFO,CUMFLO
00111       DOUBLE PRECISION, INTENT(IN) :: FLX(NSEC)
00112       DOUBLE PRECISION, INTENT(IN) :: VOLNEG(NSEC),VOLPOS(NSEC)
00113       DOUBLE PRECISION, INTENT(IN) :: TPS
00114 !
00115 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00116 !
00117       DOUBLE PRECISION, ALLOCATABLE, SAVE :: WORK(:)
00118       DOUBLE PRECISION P_DMAX,P_DMIN, P_DSUM
00119       INTEGER                        P_IMIN
00120       EXTERNAL         P_DMAX,P_DMIN,P_DSUM,P_IMIN
00121 !
00122       INTEGER ISEC,II,ERR
00123       CHARACTER(LEN=16) :: FMTZON='(4(1X,1PG21.14))'
00124       LOGICAL :: OLD_METHOD=.FALSE.
00125       LOGICAL, SAVE :: INIT=.TRUE.
00126       INTEGER, SAVE :: NSEO
00127 !
00128 !-----------------------------------------------------------------------
00129 !
00130       IF (.NOT.ALLOCATED(CHAIN)) OLD_METHOD=.TRUE.
00131 !
00132       IF(INFO) THEN
00133 !
00134       IF (OLD_METHOD) THEN ! FOLLOW FLUXPR.F OF BIEF BLINDLY
00135 !
00136       IF(NCSIZE.LE.1) THEN
00137 !
00138       DO ISEC = 1,NSEC
00139 !
00140       IF(CUMFLO) THEN
00141       IF(LNG.EQ.1) WRITE(LU,130) ISEC,CTRLSC(1+2*(ISEC-1)),
00142      &                                CTRLSC(2+2*(ISEC-1)),
00143      &                                FLX(ISEC),
00144      &                                VOLNEG(ISEC),
00145      &                                VOLPOS(ISEC)
00146       IF(LNG.EQ.2) WRITE(LU,131) ISEC,CTRLSC(1+2*(ISEC-1)),
00147      &                                CTRLSC(2+2*(ISEC-1)),
00148      &                                FLX(ISEC),
00149      &                                VOLNEG(ISEC),
00150      &                                VOLPOS(ISEC)
00151       ELSE
00152       IF(LNG.EQ.1) WRITE(LU,136) ISEC,CTRLSC(1+2*(ISEC-1)),
00153      &                                CTRLSC(2+2*(ISEC-1)),
00154      &                                FLX(ISEC)
00155       IF(LNG.EQ.2) WRITE(LU,137) ISEC,CTRLSC(1+2*(ISEC-1)),
00156      &                                CTRLSC(2+2*(ISEC-1)),
00157      &                                FLX(ISEC)
00158       ENDIF
00159 130   FORMAT(1X,/,1X,'SECTION DE CONTROLE ',1I2,
00160      &               ' (ENTRE LES POINTS ',1I5,' ET ',1I5,')',//,5X,
00161      &               'DEBIT : '                    ,G16.7,/,5X,
00162      &               'CUMUL DES DEBITS NEGATIFS : ',G16.7,/,5X,
00163      &               'CUMUL DES DEBITS POSITIFS : ',G16.7)
00164 131   FORMAT(1X,/,1X,'CONTROL SECTION NUMBER ',1I2,
00165      &               ' (BETWEEN POINTS ',1I5,' AND ',1I5,')',//,5X,
00166      &               'DISCHARGE: '                 ,G16.7,/,5X,
00167      &               'NEGATIVE VOLUME THROUGH THE SECTION: ',G16.7,/,5X,
00168      &               'POSITIVE VOLUME THROUGH THE SECTION: ',G16.7)
00169 136   FORMAT(1X,/,1X,'SECTION DE CONTROLE ',1I2,
00170      &               ' (ENTRE LES POINTS ',1I5,' ET ',1I5,')',//,5X,
00171      &               'DEBIT : '                    ,G16.7)
00172 137   FORMAT(1X,/,1X,'CONTROL SECTION NUMBER ',1I2,
00173      &               ' (BETWEEN POINTS ',1I5,' AND ',1I5,')',//,5X,
00174      &               'DISCHARGE: '                 ,G16.7)
00175 !
00176       ENDDO
00177 !
00178       ELSE
00179 !
00180       DO ISEC = 1,NSEC
00181 !     SECTIONS ACROSS 2 SUB-DOMAINS WILL HAVE NSEG=0 OR -1
00182 !     AND -1 WANTED HERE FOR RELEVANT MESSAGE.
00183       II=P_IMIN(NSEG(ISEC))
00184 !
00185       IF(II.GE.0) THEN
00186 !
00187       IF(LNG.EQ.1) WRITE(LU,132) ISEC,CTRLSC(1+2*(ISEC-1)),
00188      &                                CTRLSC(2+2*(ISEC-1)),
00189      &              P_DMIN(FLX(ISEC))+P_DMAX(FLX(ISEC)),
00190      &                                P_DMIN(VOLNEG(ISEC)),
00191      &                                P_DMAX(VOLPOS(ISEC))
00192       IF(LNG.EQ.2) WRITE(LU,133) ISEC,CTRLSC(1+2*(ISEC-1)),
00193      &                                CTRLSC(2+2*(ISEC-1)),
00194      &              P_DMIN(FLX(ISEC))+P_DMAX(FLX(ISEC)),
00195      &                                P_DMIN(VOLNEG(ISEC)),
00196      &                                P_DMAX(VOLPOS(ISEC))
00197 132   FORMAT(1X,/,1X,'SECTION DE CONTROLE ',1I2,
00198      &               ' (ENTRE LES POINTS ',1I5,' ET ',1I5,')',//,5X,
00199      &               'DEBIT : '                    ,G16.7,/,5X,
00200      &               'CUMUL DES DEBITS NEGATIFS : ',G16.7,/,5X,
00201      &               'CUMUL DES DEBITS POSITIFS : ',G16.7)
00202 133   FORMAT(1X,/,1X,'CONTROL SECTION NUMBER ',1I2,
00203      &               ' (BETWEEN POINTS ',1I5,' AND ',1I5,')',//,5X,
00204      &               'DISCHARGE: '                 ,G16.7,/,5X,
00205      &               'NEGATIVE VOLUME THROUGH THE SECTION: ',G16.7,/,5X,
00206      &               'POSITIVE VOLUME THROUGH THE SECTION: ',G16.7)
00207 !
00208       ELSE
00209 !
00210       IF(LNG.EQ.1) WRITE(LU,134) ISEC,CTRLSC(1+2*(ISEC-1)),
00211      &                                CTRLSC(2+2*(ISEC-1))
00212       IF(LNG.EQ.2) WRITE(LU,135) ISEC,CTRLSC(1+2*(ISEC-1)),
00213      &                                CTRLSC(2+2*(ISEC-1))
00214 134   FORMAT(1X,/,1X,'SECTION DE CONTROLE ',1I2,
00215      &               ' (ENTRE LES POINTS ',1I5,' ET ',1I5,')',//,5X,
00216      &               'A CHEVAL SUR DEUX SOUS-DOMAINES, PAS DE CALCUL')
00217 135   FORMAT(1X,/,1X,'CONTROL SECTION NUMBER ',1I2,
00218      &               ' (BETWEEN POINTS ',1I5,' AND ',1I5,')',//,5X,
00219      &               'ACROSS TWO SUB-DOMAINS, NO COMPUTATION')
00220       ENDIF
00221 !
00222       ENDDO
00223 !
00224       ENDIF
00225 !
00226 !-----------------------------------------------------------------------
00227 ! CHAIN ALLOCATED, I.E. SERIAL OR PARALLEL CASE FROM SECTIONS INPUT FILE
00228 !       WE CAN APPLY CO-ORDINATES INSTEAD AND/OR NAMES OF SECTIONS
00229 !
00230       ELSE
00231         IF(NCSIZE.LE.1) THEN ! SERIAL
00232           DO ISEC = 1,NSEC
00233             IF(CUMFLO) THEN
00234               IF(LNG.EQ.1) WRITE(LU,230) ISEC,TRIM(CHAIN(ISEC)%DESCR),
00235      &                           FLX(ISEC),VOLNEG(ISEC),VOLPOS(ISEC)
00236               IF(LNG.EQ.2) WRITE(LU,231) ISEC,TRIM(CHAIN(ISEC)%DESCR),
00237      &                           FLX(ISEC),VOLNEG(ISEC),VOLPOS(ISEC)
00238             ELSE
00239               IF(LNG.EQ.1) WRITE(LU,236) ISEC,TRIM(CHAIN(ISEC)%DESCR),
00240      &                           FLX(ISEC)
00241               IF(LNG.EQ.2) WRITE(LU,237) ISEC,TRIM(CHAIN(ISEC)%DESCR),
00242      &                           FLX(ISEC)
00243             ENDIF
00244 230   FORMAT(1X,/,1X,'SECTION DE CONTROLE ',1I2,
00245      &               ' (NOM ',A,')',//,5X,
00246      &               'DEBIT : '                    ,G16.7,/,5X,
00247      &               'CUMUL DES DEBITS NEGATIFS : ',G16.7,/,5X,
00248      &               'CUMUL DES DEBITS POSITIFS : ',G16.7)
00249 231   FORMAT(1X,/,1X,'CONTROL SECTION NUMBER ',1I2,
00250      &               ' (NAME ',A,')',//,5X,
00251      &               'DISCHARGE: '                 ,G16.7,/,5X,
00252      &               'NEGATIVE VOLUME THROUGH THE SECTION: ',G16.7,/,5X,
00253      &               'POSITIVE VOLUME THROUGH THE SECTION: ',G16.7)
00254 236   FORMAT(1X,/,1X,'SECTION DE CONTROLE ',1I2,
00255      &               ' (NOM ',A,')',//,5X,
00256      &               'DEBIT : '                    ,G16.7)
00257 237   FORMAT(1X,/,1X,'CONTROL SECTION NUMBER ',1I2,
00258      &               ' (NAME ',A,')',//,5X,
00259      &               'DISCHARGE: '                 ,G16.7)
00260           ENDDO
00261 !
00262         ELSE
00263 !
00264           DO ISEC = 1,NSEC
00265 !
00266             IF(LNG.EQ.1) WRITE(LU,232) ISEC,TRIM(CHAIN(ISEC)%DESCR),
00267      &                                P_DSUM(FLX(ISEC)),
00268      &                                P_DSUM(VOLNEG(ISEC)),
00269      &                                P_DSUM(VOLPOS(ISEC))
00270             IF(LNG.EQ.2) WRITE(LU,233) ISEC,TRIM(CHAIN(ISEC)%DESCR),
00271      &                                P_DSUM(FLX(ISEC)),
00272      &                                P_DSUM(VOLNEG(ISEC)),
00273      &                                P_DSUM(VOLPOS(ISEC))
00274 232         FORMAT(1X,/,1X,'SECTION DE CONTROLE ',1I2,
00275      &               ' (NOM ',A,')',//,5X,
00276      &               'DEBIT : '                    ,G16.7,/,5X,
00277      &               'CUMUL DES DEBITS NEGATIFS : ',G16.7,/,5X,
00278      &               'CUMUL DES DEBITS POSITIFS : ',G16.7)
00279 233         FORMAT(1X,/,1X,'CONTROL SECTION NUMBER ',1I2,
00280      &               ' (NAME ',A,')',//,5X,
00281      &               'DISCHARGE: '                 ,G16.7,/,5X,
00282      &               'NEGATIVE VOLUME THROUGH THE SECTION: ',G16.7,/,5X,
00283      &               'POSITIVE VOLUME THROUGH THE SECTION: ',G16.7)
00284 !
00285           ENDDO
00286         ENDIF
00287 !
00288       ENDIF
00289       ENDIF
00290 !
00291 !-----------------------------------------------------------------------
00292 ! MASTER WRITES A NICE SECTIONS OUTPUT FILE, THE HEADER ONLY ONCE
00293 !
00294       IF ( (.NOT.OLD_METHOD) .AND.
00295      &      (TRIM(T2D_FILES(T2DSEO)%NAME).NE.'') ) THEN
00296         IF (INIT) THEN
00297           INIT=.FALSE.
00298           IF ((NCSIZE.GT.1 .AND. IPID.EQ.0).OR.(NCSIZE.LE.1)) THEN
00299             NSEO=T2D_FILES(T2DSEO)%LU
00300             IF(LNG.EQ.1) THEN
00301               WRITE(NSEO,*) 'TITRE = "FLUX POUR ',TRIM(TITCAS),'"'
00302             ELSEIF(LNG.EQ.2) THEN
00303               WRITE(NSEO,*) 'TITLE = "FLUXES FOR ',TRIM(TITCAS),'"'
00304             ENDIF
00305             WRITE(NSEO,*) 'VARIABLES = TIME',
00306      &         (' '//TRIM(CHAIN(ISEC)%DESCR),ISEC=1,NSEC)
00307           ENDIF
00308           IF (NCSIZE.GT.1) THEN
00309             ALLOCATE (WORK(NSEC), STAT=ERR)
00310             IF (ERR.NE.0) THEN
00311               WRITE(LU,*)
00312      &          'FLUXPR_TELEMAC2D: ERROR ALLOCATING WORK:',ERR
00313               CALL PLANTE(1)
00314               STOP
00315             ENDIF
00316           ENDIF
00317         ENDIF
00318         ! DEADLOCK WITH WRITE AND P_DSUM IN AN IMPLIED WRITE LOOP
00319         ! BECAUSE IT IS ONLY MASTER TO WRITE THE MESSAGE...
00320         IF (NCSIZE.GT.1) THEN
00321           DO ISEC=1,NSEC
00322             WORK(ISEC) = P_DSUM(FLX(ISEC))
00323           END DO
00324           IF (IPID.EQ.0)
00325      &      WRITE (NSEO, FMT=FMTZON) TPS, (WORK(ISEC), ISEC=1,NSEC)
00326         ELSE
00327           WRITE (NSEO, FMT=FMTZON) TPS, (FLX(ISEC), ISEC=1,NSEC)
00328         ENDIF
00329       ENDIF
00330 !
00331 !-----------------------------------------------------------------------
00332 !
00333       RETURN
00334       END

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