disimp.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\disimp.f
00002 !
00053                      SUBROUTINE DISIMP
00054 !                    *****************
00055 !
00056      &(Q,Q2BOR,NUMLIQ,IFRLIQ,NSOLDIS,WORK1,QBOR,NPTFR,MASK,MESH)
00057 !
00058 !***********************************************************************
00059 ! SISYPHE   V6P2                                   24/07/2012
00060 !***********************************************************************
00061 !
00062 !
00063 !
00064 !
00065 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00066 !| IFRLIQ         |-->| RANK OF LIQUID BOUNDARY
00067 !| MASK           |-->| BLOCK OF MASKS FOR BOUNDARY CONDITIONS
00068 !| MESH           |-->| MESH STRUCTURE
00069 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00070 !| NSOLDIS        |-->| NUMBER OF SOLID DISCHARGES GIVEN IN PARAMETER
00071 !|                |   | FILE
00072 !| NUMLIQ         |-->| LIQUID BOUNDARY NUMBER OF BOUNDARY POINTS
00073 !| Q              |-->| PRESCRIBED VALUE OF DISCHARGE
00074 !| Q2BOR          |<--| PRESCRIBED SOLID DISCHARGE
00075 !| RATIO          |<--| RATIO, QBOR WILL BE RATIO*Q2BOR
00076 !| WORK1          |<->| WORK BIEF_OBJ STRUCTURE
00077 !| QBOR           |<->| THE RESULTING DISCHARGE IN M3/S
00078 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00079 !
00080       USE BIEF
00081 !
00082       IMPLICIT NONE
00083       INTEGER LNG,LU
00084       COMMON/INFO/LNG,LU
00085 !
00086 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00087 !
00088       INTEGER, INTENT(IN)             :: NPTFR,IFRLIQ,NSOLDIS
00089       INTEGER, INTENT(IN)             :: NUMLIQ(NPTFR)
00090       DOUBLE PRECISION, INTENT(IN)    :: MASK(NPTFR),Q
00091       TYPE(BIEF_MESH), INTENT(INOUT)  :: MESH
00092       TYPE(BIEF_OBJ), INTENT(INOUT)   :: WORK1,QBOR
00093       TYPE(BIEF_OBJ), INTENT(IN)      :: Q2BOR
00094 !
00095 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00096 !
00097       INTEGER K,IELM
00098 !
00099       DOUBLE PRECISION Q1
00100 !
00101       INTRINSIC ABS
00102 !
00103       DOUBLE PRECISION P_DSUM
00104       EXTERNAL         P_DSUM
00105 !
00106 !=======================================================================
00107 !     COMPUTES FLUX
00108 !=======================================================================
00109 !
00110 !     IN THE FOLLOWING LOOP ONE RESTRICTS THE MASK OF DIRICHLETS SEGMENTS
00111 !     TO THOSE OF THE LIQUID BOUNDARY NUMBER IFRLIQ. AS NUMLIQ IS
00112 !     DEFINED AT NODES, ONE RISKS AN ERROR FOR THE SEGMENT FOLLOWING
00113 !     THE LAST NODE ON THE BOUNDARY. IN FACT THIS SEGMENT WILL BE SOLID
00114 !     AND WILL HAVE A MASK ALREADY SET TO ZERO.
00115 !
00116       DO K=1,NPTFR
00117         IF(NUMLIQ(K).EQ.IFRLIQ) THEN
00118           WORK1%R(K)=MASK(K)
00119         ELSE
00120           WORK1%R(K)=0.D0
00121         ENDIF
00122       ENDDO
00123 !
00124 !     Q2BOR IS INTEGRATED ALONG THE BOUNDARY
00125 !
00126       IELM=11
00127       CALL VECTOR(QBOR,'=','MASVEC          ',IELBOR(IELM,1),
00128 !                      USED  VOID  VOID  VOID  VOID  VOID
00129      &            1.D0,Q2BOR,Q2BOR,Q2BOR,Q2BOR,Q2BOR,Q2BOR,
00130      &            MESH,.TRUE.,WORK1)
00131 !
00132 !=======================================================================
00133 !     FINAL QBOR IF Q2BOR ONLY A PROFILE
00134 !=======================================================================
00135 !
00136       IF(NSOLDIS.GE.IFRLIQ) THEN
00137 !
00138 !       A VALUE OF DISCHARGE HAS BEEN GIVEN IN THE PARAMETER FILE
00139 !       FOR THIS BOUNDARY. Q2BOR IS CONSIDERED AS ONLY A PROFILE
00140 !
00141 !       FOR THE USER: POSITIVE DISCHARGE = ENTERING
00142         Q1 = BIEF_SUM(QBOR)
00143         IF(NCSIZE.GT.1) Q1 = P_DSUM(Q1)
00144 !
00145         IF(ABS(Q1).LT.1.D-10) THEN
00146 !         ZERO FLUX: WARNING MESSAGE
00147           IF(ABS(Q).GT.1.D-10) THEN
00148             IF(LNG.EQ.1) WRITE(LU,30) IFRLIQ
00149             IF(LNG.EQ.2) WRITE(LU,31) IFRLIQ
00150 30          FORMAT(1X,'DISIMP : PROBLEME SUR LA FRONTIERE ',1I6,/,1X,
00151      &     '           DONNER UN PROFIL DE DEBIT SOLIDE ',/,1X,
00152      &     '           DANS LE FICHIER DES CONDITIONS AUX LIMITES')
00153 31          FORMAT(1X,'DISIMP : PROBLEM ON BOUNDARY NUMBER ',1I6,/,1X,
00154      &     '           GIVE A SOLID DISCHARGE PROFILE  ',/,1X,
00155      &     '           IN THE BOUNDARY CONDITIONS FILE')
00156             CALL PLANTE(1)
00157             STOP
00158           ELSE
00159             Q1 = 1.D0
00160           ENDIF
00161         ENDIF
00162 !
00163         DO K=1,NPTFR
00164           IF(NUMLIQ(K).EQ.IFRLIQ) THEN
00165             QBOR%R(K) = QBOR%R(K) * Q / Q1
00166           ENDIF
00167         ENDDO
00168 !
00169       ENDIF
00170 !
00171 !-----------------------------------------------------------------------
00172 !
00173       RETURN
00174       END

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