suspension_computation.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\suspension_computation.f
00002 !
00166                      SUBROUTINE SUSPENSION_COMPUTATION
00167 !                    *********************************
00168 !
00169      &(SLVTRA, HN,HN_TEL,UCONV, VCONV, MU,TOB,FDM, FD90, KSP,KSR,KS,
00170      & ELAY, AVA, AFBOR, BFBOR, LIMDIF, CLT, MASKEL, MASKTR,
00171      & MASKPT, IFAMAS, NPOIN, IELM, NPTFR, ITRA, LT, NIT, RESOL,
00172      & OPTBAN, KENT,KDDL,KDIR,KSORT,KLOG,KINC,KNEU,
00173      & OPTADV, OPDTRA, DEBUG,CSF_SABLE,
00174      & TETA_SUSP, DT, MASED0, ZERO, XWC, KARMAN, XMVE, XMVS, VCE,GRAV,
00175      & HMIN, VITCD, VITCE,PARTHENIADES, ENTETS,
00176      & BILMA,MSK,CHARR,IMP_INFLOW_C,MESH,ZF,CS,
00177      & CST,CTILD,CBOR,DISP,IT1,IT2,IT3,IT4,TB,T1,T2,T3,
00178      & T4, T5, T6, T7, T8, T9, T10, T11, T12, T14, W1, TE1, TE2, TE3, S,
00179      & AM1_S, AM2_S, MBOR,MASTEN, MASTOU, MASINI, AC,
00180      & ZFCL_S, FLUDPT, FLUDP, FLUER, HPROP, DISP_C, CSTAEQ, CSRATIO,
00181      & MASFIN, MASDEPT, MASDEP, MASSOU,QS_C,ICQ, ZREF,
00182      & CORR_CONV,U2D,V2D,SEDCO,DIFT,DM1,ZCONV,UCONV_TEL,VCONV_TEL,
00183      & SOLSYS,FLBOR_TEL,FLBOR_SIS,FLBORTRA,CODE,
00184      & VOLU2D,V2DPAR,UNSV2D,NUMLIQ,NFRLIQ,LICBOR,MIXTE,AVAIL,NSICLA,
00185      & ES,ES_SABLE,ES_VASE,NOMBLAY,CONC,TOCE_VASE,TOCE_SABLE,
00186      & FLUER_VASE,TOCE_MIXTE,MS_SABLE,MS_VASE,TASS,DIRFLU,QSCLXS,QSCLYS,
00187      & MAXADV)
00188 !
00189 !***********************************************************************
00190 ! SISYPHE   V7P0                                   18/06/2012
00191 !***********************************************************************
00192 !
00193 !
00194 !
00195 !
00196 !
00197 !
00198 !
00199 !
00200 !
00201 !
00202 !
00203 !
00204 !
00205 !
00206 !
00207 !
00208 !
00209 !
00210 !
00211 !
00212 !
00213 !
00214 !
00215 !
00216 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00217 !| AC             |<->| CRITICAL SHIELDS PARAMETER
00218 !| ACLADM         |-->| MEAN DIAMETER OF SEDIMENT
00219 !| AFBOR          |-->| BOUNDARY CONDITION ON F: NU*DF/DN=AFBOR*F+BFBOR
00220 !| AM1_S          |<->| MATRIX OBJECT
00221 !| AM2_S          |<->| MATRIX OBJECT
00222 !| AVAIL          |<->| VOLUME PERCENT OF EACH CLASS
00223 !| BFBOR          |-->| BOUNDARY CONDITION ON F: NU*DF/DN=AFBOR*F+BFBOR
00224 !| BILMA          |-->| MASS BALANCE
00225 !| CBOR           |<->| IMPOSED SUSPENDED SAND CONCENTRATION AT THE BOUNDARY
00226 !| CF             |-->| QUADRATIC FRICTION COEFFICIENT
00227 !| CHARR          |-->| LOGICAL, BEDLOAD OR NOT
00228 !| CLT            |<->| BOUNDARY CONDITIONS FOR TRACER (MODIFIED LITBOR)
00229 !| CODE           |-->| HYDRODYNAMIC CODE IN CASE OF COUPLING
00230 !| CONC_VASE      |<->| MUD CONCENTRATION FOR EACH LAYER
00231 !| CORR_CONV      |-->| CORRECTION ON CONVECTION VELOCITY
00232 !| CS             |<->| CONCENTRATION AT TIME N
00233 !| CSF_SABLE      |-->| VOLUME CONCENTRATION OF THE SAND BED
00234 !!| CSRATIO        |<->| EQUILIBRIUM CONCENTRATION FOR SOULSBY-VAN RIJN EQ.
00235 !| CST            |<->| CONCENTRATION AT TIME T(N+1)
00236 !| CSTAEQ         |<->| EQUILIBRIUM CONCENTRATION
00237 !| CTILD          |<->| CONCENTRATION AFTER ADVECTION
00238 !| DEBUG          |-->| FLAG FOR DEBUGGING
00239 !| DIFT           |-->| DIFFUSION OF SUSPENDED SEDIMENT CONCENTRATION
00240 !| DISP           |-->| VISCOSITY COEFFICIENTS ALONG X,Y AND Z .
00241 !|                |   | IF P0 : PER ELEMENT
00242 !|                |   | IF P1 : PERR POINT
00243 !| DISP_S         |<->| WORK ARRAY FOR SAVING DISPC
00244 !| DM1            |-->| THE PIECE-WISE CONSTANT PART OF ADVECTION FIELD
00245 !|                |   | IS DM1*GRAD(ZCONV)
00246 !| DTS            |-->| TIME STEP FOR SUSPENSION
00247 !| ELAY           |<->| THICKNESS OF EACH LAYER
00248 !| ENTET          |<->| LOGICAL, IF YES INFORMATION IS GIVEN ON MASS CONSERVATION
00249 !| ENTETS         |-->| LOGICAL, IF YES INFORMATION IS GIVEN ON MASS CONSERVATION FOR SUSPENSION
00250 !| ES             |<->| LAYER THICKNESSES AS DOUBLE PRECISION
00251 !| FLBORTRA       |<->| FLUXES AT BOUNDARIES TRACER
00252 !| FLBOR_SIS      |<->| FLUXES AT BOUNDARIES SISYPHE
00253 !| FLBOR_TEL      |-->| FLUXES AT BOUNDARIES TELEMAC
00254 !| FLUDP          |<->| DEPOSITION FLUX
00255 !| FLUDPT         |<->| DEPOSITION FLUX (IMPLICIT)
00256 !| FLUER          |<->| EROSION FLUX
00257 !| FLUER_VASE     |<->| FOR MIXED SEDIMENTS
00258 !| GRAV           |-->| ACCELERATION OF GRAVITY
00259 !| HMIN           |-->| MINIMUM VALUE OF WATER DEPTH
00260 !| HN             |-->| WATER DEPTH
00261 !| HN_TEL         |-->| WATER DEPTH AS SENT BY TELEMAC OR CALLING CODE
00262 !| HPROP          |<->| PROPAGATION DEPTH (DONE IN CVDFTR)
00263 !| ICQ            |-->| REFERENCE CONCENTRATION FORMULA
00264 !| IELM           |-->| TYPE OF ELEMENT
00265 !| IFAMAS         |-->| A MODIFIED IFABOR WHEN ELEMENTS ARE MASKED
00266 !| IMP_INFLOW_C   |-->| IMPOSED CONCENTRATION IN INFLOW
00267 !| IT1            |<->| INTEGER WORK ARRAY IN A BIEF_OBJ STRUCTURE
00268 !| IT2            |<->| INTEGER WORK ARRAY IN A BIEF_OBJ STRUCTURE
00269 !| IT3            |<->| INTEGER WORK ARRAY IN A BIEF_OBJ STRUCTURE
00270 !| IT4            |<->| INTEGER WORK ARRAY IN A BIEF_OBJ STRUCTURE
00271 !| KARMAN         |-->| VON KARMAN CONSTANT
00272 !| KDDL           |-->| CONVENTION FOR DEGREE OF FREEDOM
00273 !| KDIR           |-->| CONVENTION FOR DIRICHLET POINT
00274 !| KENT           |-->| CONVENTION FOR LIQUID INPUT WITH PRESCRIBED VALUE
00275 !| KINC           |-->| CONVENTION FOR INCIDENT WAVE BOUNDARY CONDITION
00276 !| KLOG           |-->| CONVENTION FOR SOLID BOUNDARY
00277 !| KNEU           |-->| CONVENTION FOR NEUMANN CONDITION
00278 !| KS             |-->| TOTAL BED ROUGHNESS
00279 !| KSORT          |-->| CONVENTION FOR FREE OUTPUT
00280 !| KSP            |-->| SKIN BED ROUGHNESS
00281 !| KSR            |-->| RIPPLE BED ROUGHNESS
00282 !| KX             |<->| COEFFICIENTS OF THE DISPERSION TENSOR (DIM. NPOIN)
00283 !| KY             |<->| COEFFICIENTS OF THE DISPERSION TENSOR (DIM. NPOIN)
00284 !| KZ             |<->| COEFFICIENTS OF THE DISPERSION TENSOR (DIM. NPOIN)
00285 !| LICBOR         |-->| BOUNDARY CONDITIONS FOR SEDIMENT
00286 !| LIMDIF         |<->| BOUNDARY CONDITIONS FOR DIFFUSION
00287 !| LT             |-->| ITERATION
00288 !| MASDEP         |<--| TOTAL DEPOSITED MASS
00289 !| MASDEPT        |<--| DEPOSITED MASS DURING THE TIME STEP
00290 !| MASED0         |<->| SUSPENDED MASS BALANCE
00291 !| MASFIN         |<--| MASS AT THE END
00292 !| MASINI         |<->| INITIAL MASS
00293 !| MASKEL         |-->| MASKING OF ELEMENTS
00294 !| MASKPT         |-->| MASKING PER POINT
00295 !| MASKTR         |<->| MASKING FOR TRACERS, PER POINT
00296 !| MASSOU         |<--| MASS OF TRACER ADDED BY SOURCE TERM
00297 !|                |   | SEE DIFSOU
00298 !| MASTCP         |<--| ??? NE SERT A RIEN, A SUPPRIMER
00299 !| MASTEN         |<->| MASS ENTERED THROUGH LIQUID BOUNDARY
00300 !| MASTOU         |<->| MASS CREATED BY SOURCE TERM
00301 !| MAXADV         |<->| MAXIMUM NUMBER OF ITERATIONS OF ADVECTION SCHEMES
00302 !| MBOR           |<->| MATRIX OBJECT
00303 !| MESH           |<->| MESH STRUCTURE
00304 !| MIXTE          |-->| MIXTURE OF COHESIVE AND NON COHESIVE SEDIMENT
00305 !| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS
00306 !| MS_SABLE       |<->| MASS OF SAND PER LAYER (KG/M2)
00307 !| MS_VASE        |<->| MASS OF MUD PER LAYER (KG/M2)
00308 !| MU             |-->| CORRECTION FACTOR FOR BED ROUGHNESS
00309 !| NOMBLAY        |-->| NUMBER OF LAYERS
00310 !| NFRLIQ         |-->| NUMBER OF LIQUID BOUNDARIES
00311 !| NIT            |-->| TOTAL NUMBER OF ITERATIONS
00312 !| NPOIN          |-->| NUMBER OF POINTS
00313 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00314 !| NSICLA         |-->| NUMBER OF SIZE CLASSES FOR BED MATERIALS
00315 !| NUMLIQ         |-->| LIQUID BOUNDARY NUMBER OF BOUNDARY POINTS
00316 !| OPDTRA         |-->| OPTION FOR THE DIFFUSION OF TRACERS
00317 !| OPTBAN         |-->| OPTION FOR THE TREATMENT OF TIDAL FLATS
00318 !| OPTDIF         |-->| OPTION FOR THE DISPERSION
00319 !| OPTADV         |-->| SCHEME OPTION FOR ADVECTION
00320 !| PARTHENIADES   |-->| CONSTANT OF THE KRONE AND PARTHENIADES EROSION LAW (M/S)
00321 !| PASS           |<->| IN FACT PASS_SUSP IN SISYPHE.F, ARRIVES AS .TRUE.
00322 !|                |   | AT FIRST CALL AND IS CHANGED INTO .FALSE. BELOW
00323 !| QSCLXS         |<->| TRANSPORT RATE FOR EACH CLASS X-DIRECTION
00324 !| QSCLYS         |<->| TRANSPORT RATE FOR EACH CLASS Y-DIRECTION
00325 !| QSCL_S         |<->| SUSPENDED LOAD TRANSPORT RATE
00326 !| QSXS           |<->| SOLID DISCHARGE X (SUSPENSION)
00327 !| QSYS           |<->| SOLID DISCHARGE Y (SUSPENSION)
00328 !| QS_C           |-->| BEDLOAD TRANSPORT RATE
00329 !| QS_S           |<->| SUSPENDED TRANSPORT RATE
00330 !| RESOL          |-->| CHOICE OF ADVECTION SCHEME
00331 !| S              |<->| VOID STRUCTURE
00332 !| SEDCO          |-->| LOGICAL, SEDIMENT COHESIVE OR NOT
00333 !| SLVTRA         |<->| SLVCFG STRUCTURE
00334 !| SOLSYS         |-->| SLVCFG STRUCTURE
00335 !| T1             |<->| WORK BIEF_OBJ STRUCTURE
00336 !| T10            |<->| WORK BIEF_OBJ STRUCTURE
00337 !| T11            |<->| WORK BIEF_OBJ STRUCTURE
00338 !| T12            |<->| WORK BIEF_OBJ STRUCTURE
00339 !| T2             |<->| WORK BIEF_OBJ STRUCTURE
00340 !| T3             |<->| WORK BIEF_OBJ STRUCTURE
00341 !| T4             |<->| WORK BIEF_OBJ STRUCTURE
00342 !| T5             |<->| WORK BIEF_OBJ STRUCTURE
00343 !| T6             |<->| WORK BIEF_OBJ STRUCTURE
00344 !| T7             |<->| WORK BIEF_OBJ STRUCTURE
00345 !| T8             |<->| WORK BIEF_OBJ STRUCTURE
00346 !| T9             |<->| WORK BIEF_OBJ STRUCTURE
00347 !| TASS           |-->| CONSOLIDATION TAKEN INTO ACCOUNT
00348 !| TB             |-->| BLOCK OF WORKING ARRAYS
00349 !| TE1            |<->| WORKING ARRAY FOR ELEMENTS
00350 !| TE2            |<->| WORKING ARRAY FOR ELEMENTS
00351 !| TE3            |<->| WORKING ARRAY FOR ELEMENTS
00352 !| TETA_SUSP      |<->| IMPLICITATION FACTOR FOR THE DEPOSITION FLUX AND DIFFUSION
00353 !| TOB            |-->| BED SHEAR STRESS (TOTAL FRICTION)
00354 !| TOCE_SABLE     |<->| CRITICAL BED SHEAR STRESS OF SAND
00355 !| TOCE_MIXTE     |<->| CRITICAL BED SHEAR STRESS OF THE MIXED SEDUIMENT PER LAYER
00356 !| TOCE_VASE      |<->| CRITICAL EROSION SHEAR STRESS OF THE MUD PER LAYER (N/M2)
00357 !| U2D            |-->| MEAN FLOW VELOCITY X-DIRECTION
00358 !| UCONV          |<->| X-COMPONENT ADVECTION FIELD (SISYPHE)
00359 !| UCONV_TEL      |-->| X-COMPONENT ADVECTION FIELD (TELEMAC)
00360 !| UNSV2D         |-->| INVERSE OF INTEGRALS OF TEST FUNCTIONS
00361 !| V2D            |-->| MEAN FLOW VELOCITY Y-DIRECTION
00362 !| V2DPAR         |-->| INTEGRAL OF TEST FUNCTIONS, ASSEMBLED IN PARALLEL
00363 !| VCE            |-->| FLOW VISCOSITY
00364 !| VCONV          |<->| Y-COMPONENT ADVECTION FIELD (SISYPHE)
00365 !| VCONV_TEL      |-->| Y-COMPONENT ADVECTION FIELD (TELEMAC)
00366 !| VISC_TEL       |-->| VELOCITY DIFFUSIVITY (TELEMAC)
00367 !| VITCD          |-->| CRITICAL SHEAR VELOCITY FOR MUD DEPOSITION
00368 !| VITCE          |-->| CRITICAL EROSION SHEAR VELOCITY OF THE MUD
00369 !| VOLU2D         |-->| INTEGRAL OF BASES
00370 !| W1             |<->| WORKING ARRAY
00371 !| XKX            |-->| COEFFICIENT USED FOR COMPUTING THE DISPERSION
00372 !|                |   | DEPENDS OF OPTIONS
00373 !| XKY            |-->| COEFFICIENT USED FOR COMPUTING THE DISPERSION
00374 !|                |   | DEPENDS OF OPTIONS
00375 !| XMVE           |-->| FLUID DENSITY
00376 !| XMVS           |-->| SEDIMENT DENSITY
00377 !| XWC            |-->| SETTLING VELOCITIES
00378 !| ZCONV          |-->| THE PIECE-WISE CONSTANT PART OF ADVECTION FIELD
00379 !|                |   | IS DM1*GRAD(ZCONV)
00380 !| ZERO           |-->| ZERO
00381 !| ZF             |-->| ELEVATION OF BOTTOM
00382 !| ZFCL_S         |<->| BED EVOLUTION PER CLASS, DUE TO SUSPENDED SEDIMENT
00383 !| ZF_S           |<->| ACCUMULATED BED EVOLUTION DUE TO SUSPENDED SEDIMENT
00384 !| ZREF           |<->| REFERENCE ELEVATION
00385 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00386 !
00387       USE INTERFACE_SISYPHE,
00388      &    EX_SUSPENSION_COMPUTATION => SUSPENSION_COMPUTATION
00389       USE BIEF
00390       USE DECLARATIONS_SISYPHE, ONLY : FLULIM
00391       IMPLICIT NONE
00392       INTEGER LNG,LU
00393       COMMON/INFO/LNG,LU
00394 !
00395 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00396 !
00397       TYPE (SLVCFG),    INTENT(INOUT) :: SLVTRA
00398       TYPE (BIEF_OBJ),  INTENT(IN)    :: ZF,VOLU2D,V2DPAR,UNSV2D
00399       TYPE (BIEF_OBJ),  INTENT(IN), TARGET    :: HN,HN_TEL
00400       TYPE (BIEF_OBJ),  INTENT(INOUT) :: UCONV,VCONV
00401       TYPE (BIEF_OBJ),  INTENT(IN)    :: MU,KSP,KSR,KS
00402       TYPE (BIEF_OBJ),  INTENT(IN)    :: TOB,LICBOR
00403       TYPE (BIEF_OBJ),  INTENT(INOUT) :: ELAY
00404       TYPE (BIEF_OBJ),  INTENT(IN)    :: AFBOR,BFBOR
00405       TYPE (BIEF_OBJ),  INTENT(IN)    :: MASKEL,MASKPT,IFAMAS
00406       TYPE (BIEF_OBJ),  INTENT(INOUT) :: MASKTR,LIMDIF,CLT
00407       INTEGER,          INTENT(IN)    :: NPOIN,IELM,NPTFR,ITRA,LT
00408       INTEGER,          INTENT(IN)    :: NIT,RESOL,OPTBAN,KENT,KDDL
00409       INTEGER,          INTENT(IN)    :: KDIR,OPTADV,OPDTRA,SOLSYS
00410       INTEGER,          INTENT(IN)    :: KSORT,KLOG,KINC,KNEU
00411       INTEGER,          INTENT(IN)    :: NFRLIQ,NSICLA,NOMBLAY
00412       INTEGER,          INTENT(IN)    :: DEBUG,DIRFLU,MAXADV
00413       INTEGER,          INTENT(IN)    :: NUMLIQ(NPTFR)
00414       DOUBLE PRECISION, INTENT(IN)    :: TETA_SUSP, DT, MASED0
00415       DOUBLE PRECISION, INTENT(IN)    :: XWC,FDM,FD90
00416       DOUBLE PRECISION, INTENT(IN)    :: CSF_SABLE,AVA(NPOIN)
00417       DOUBLE PRECISION, INTENT(IN)    :: KARMAN, XMVE, XMVS,VCE, GRAV
00418       DOUBLE PRECISION, INTENT(IN)    :: VITCD,VITCE,PARTHENIADES,HMIN
00419       LOGICAL,          INTENT(IN)    :: ENTETS,BILMA,MSK,SEDCO
00420       LOGICAL,          INTENT(IN)    :: CHARR, IMP_INFLOW_C,CORR_CONV
00421       LOGICAL,          INTENT(IN)    :: DIFT,MIXTE, TASS
00422       TYPE (BIEF_MESH), INTENT(INOUT) :: MESH
00423       TYPE (BIEF_OBJ),  INTENT(INOUT) :: CS,CST,CTILD,CBOR,FLBOR_SIS
00424       TYPE (BIEF_OBJ),  INTENT(INOUT) :: DISP,IT1,IT2,IT3,IT4,TB
00425       TYPE (BIEF_OBJ),  INTENT(INOUT) :: T2, T3, T4, T5, T6, T7, T8
00426       TYPE (BIEF_OBJ),  INTENT(INOUT), TARGET :: T1
00427       TYPE (BIEF_OBJ),  INTENT(INOUT) :: T9, T10, T11, T12, T14, W1, TE1
00428       TYPE (BIEF_OBJ),  INTENT(INOUT) :: TE2, TE3, S, AM1_S, AM2_S
00429       TYPE (BIEF_OBJ),  INTENT(INOUT) :: MBOR,ZREF
00430       DOUBLE PRECISION, INTENT(INOUT) :: MASTEN, MASTOU, MASINI, AC
00431       TYPE (BIEF_OBJ),  INTENT(INOUT) :: ZFCL_S
00432       TYPE (BIEF_OBJ),  INTENT(IN)    :: UCONV_TEL,VCONV_TEL
00433       TYPE (BIEF_OBJ),  INTENT(INOUT) :: FLUDPT,FLUDP,FLUER,FLBORTRA
00434       TYPE (BIEF_OBJ),  INTENT(INOUT) :: HPROP, DISP_C, CSTAEQ,CSRATIO
00435       TYPE (BIEF_OBJ),  INTENT(INOUT) :: FLUER_VASE,TOCE_MIXTE
00436       TYPE (BIEF_OBJ),  INTENT(INOUT) :: QSCLXS,QSCLYS
00437       DOUBLE PRECISION, INTENT(INOUT) :: MS_SABLE(NPOIN, NOMBLAY)
00438       DOUBLE PRECISION, INTENT(INOUT) :: MS_VASE(NPOIN, NOMBLAY)
00439       DOUBLE PRECISION, INTENT(INOUT) :: ES_SABLE(NPOIN,NOMBLAY)
00440       DOUBLE PRECISION, INTENT(INOUT) :: ES_VASE(NPOIN,NOMBLAY)
00441       DOUBLE PRECISION, INTENT(INOUT) :: MASFIN,MASDEPT,MASDEP
00442       DOUBLE PRECISION, INTENT(IN)    :: ZERO
00443       DOUBLE PRECISION, INTENT(INOUT) :: MASSOU
00444       DOUBLE PRECISION, INTENT(INOUT) :: AVAIL(NPOIN,NOMBLAY,NSICLA)
00445       DOUBLE PRECISION, INTENT(INOUT) :: ES(NPOIN,NOMBLAY),TOCE_SABLE
00446       DOUBLE PRECISION, INTENT(INOUT) :: CONC(NPOIN,NOMBLAY)
00447       DOUBLE PRECISION, INTENT(INOUT) :: TOCE_VASE(NOMBLAY)
00448       TYPE (BIEF_OBJ),  INTENT(IN)    :: QS_C,U2D,V2D,DM1,ZCONV
00449       TYPE (BIEF_OBJ),  INTENT(IN)    :: FLBOR_TEL
00450       INTEGER,          INTENT(IN)    :: ICQ
00451       CHARACTER(LEN=24), INTENT(IN)   :: CODE
00452 !
00453 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00454 !
00455       INTEGER          :: I,K,SOLSYS_SIS,OPTVF,BID(1),RESOL_MOD,IELMT
00456       DOUBLE PRECISION :: TETAH,AGGLOT
00457       LOGICAL          :: YASMI2,YAFLULIM
00458       TYPE (BIEF_OBJ),  POINTER :: HOLD
00459       DOUBLE PRECISION, POINTER, DIMENSION(:) :: SAVE_UCONV,SAVE_VCONV
00460       DOUBLE PRECISION :: MSTOT
00461       DOUBLE PRECISION :: CONC_SABLE(NPOIN, NOMBLAY)
00462       INTEGER          :: J
00463 !
00464       INTEGER, POINTER, DIMENSION(:) :: GLOSEG1,GLOSEG2
00465 !
00466 !-----------------------------------------------------------------------
00467 !
00468 !     IN CHARAC IELMT IS INTENT(INOUT)
00469       IELMT=IELM
00470 !
00471 !     UCONV POINTER SAVED BEFORE PLAYING WITH IT
00472 !
00473       SAVE_UCONV=>UCONV%R
00474       SAVE_VCONV=>VCONV%R
00475       GLOSEG1=>MESH%GLOSEG%I(1:MESH%GLOSEG%DIM1)
00476       GLOSEG2=>MESH%GLOSEG%I(MESH%GLOSEG%DIM1+1:2*MESH%GLOSEG%DIM1)
00477 !
00478 !======================================================================!
00479 !======================================================================!
00480 !                               PROGRAM                                !
00481 !======================================================================!
00482 !======================================================================!
00483 !
00484 !     TAKES DETAILS OF THE CONTINUITY EQUATION INTO ACCOUNT
00485 !     IN TELEMAC-2D OR 3D, WITH SOLSYS=2, DM1 AND ZCONV ARE USED.
00486 !
00487       IF(CODE(1:9).EQ.'TELEMAC2D') THEN
00488         SOLSYS_SIS=SOLSYS
00489       ELSEIF(LT.GT.1.AND.CODE(1:9).EQ.'TELEMAC3D') THEN
00490 !       CALL TO SISYPHE TO BE MOVED IN THE TELEMAC-3D TIME LOOP
00491         SOLSYS_SIS=SOLSYS
00492       ELSE
00493         SOLSYS_SIS=1
00494       ENDIF
00495 !
00496 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00497 ! 1.  COMPUTES THE REFERENCE ELEVATION  -->  ZREF
00498 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00499 !
00500 !     THREE OPTIONS : ICQ=1: FREDSOE REFERENCE CONC. ZREF = 2.D50
00501 !                     ICQ=2: BIJKER METHOD ZREF = MAX(KSP,KS)
00502 !                     ICQ=3: VAN RIJN ZREF= 0.5 KS
00503 !
00504       IF(ICQ.EQ.1) THEN
00505         CALL OS('X=Y     ', X=ZREF, Y=KSP)
00506       ELSEIF(ICQ.EQ.2) THEN
00507         CALL OS('X=Y     ', X=ZREF, Y=KSR)
00508       ELSEIF(ICQ.EQ.3) THEN
00509         CALL OS('X=CY    ', X=ZREF, Y=KS,C=0.5D0)
00510       ELSEIF(ICQ.EQ.4) THEN
00511         CALL OS('X=CY    ', X=ZREF, Y=KS,C=0.5D0)
00512       ELSE
00513         IF(LNG.EQ.1) WRITE(LU,200) ICQ
00514         IF(LNG.EQ.2) WRITE(LU,201) ICQ
00515 200     FORMAT(1X,'SUSPENSION_COMPUTATION :',/,1X,
00516      &            'FORMULE POUR LA CONCENTRATION DE REFERENCE',/,1X,
00517      &            'VALEUR NON PREVUE : ',1I6)
00518 201     FORMAT(1X,'SUSPENSION_COMPUTATION:',/,1X,
00519      &            'REFERENCE CONCENTRATION FORMULA',/,1X,
00520      &            'UNEXPECTED VALUE:',1I6)
00521         CALL PLANTE(1)
00522         STOP
00523       ENDIF
00524 !
00525 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00526 ! 2.  ADVECTION VELOCITY -->  UCONV, VCONV
00527 !     TAKING INTO ACCOUNT THE VERTICAL PROFILE
00528 !     OF CONCENTRATIONS AND VELOCITIES
00529 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00530 !
00531 !     OPTVF : TENS                  0 : NORMAL
00532 !                                   1 : ADVECTION FIELD DOES NOT SATISFY
00533 !                                       CONTINUITY
00534 !
00535 !     OPTVF : UNITS                 0 : CONSTANT = 0
00536 !                                   1 : CHI-TUAN CONSTANT
00537 !                                   2 : LEO POSTMA CONSTANT
00538 !                                   SEE CVTRVF IN BIEF AND
00539 !                                   V5.7 RELEASE NOTES
00540 !
00541       YAFLULIM=.FALSE.
00542 !
00543       IF(CORR_CONV.AND.(.NOT.SEDCO)) THEN
00544 !
00545         CALL CPSTVC(U2D,T12)
00546         CALL SUSPENSION_CONV(TOB,XMVE, KSR,NPOIN,ZREF,U2D,V2D,HN,HMIN,
00547      &                       UCONV,VCONV,KARMAN,ZERO,XWC,T1,T12,RESOL,
00548      &                       GLOSEG1,GLOSEG2,MESH%NSEG,FLULIM,
00549      &                       YAFLULIM,SOLSYS_SIS,SOLSYS,
00550      &                       UCONV_TEL,VCONV_TEL)
00551 !
00552 !       ADVECTION FORM WHICH ACCEPTS AN ADVECTION FIELD
00553 !       THAT DOES NOT SATISFY CONTINUITY + LEO-POSTMA CONSTANT
00554 !
00555 !       WITH 12: MASS CONSERVATION BUT NO MONOTONICITY
00556 !                THE CORRECT THEORY
00557         OPTVF=12
00558 !
00559 !       WITH 2: MONOTONICITY BUT NO MASS CONSERVATION
00560 !               WRONG THEORY
00561 !       OPTVF=2
00562 !
00563 !       OPTVF=2 IS POSSIBLE BUT WITH MASS CONSERVATION SPOILED
00564 !       THE UNIT (HERE 2) IS REDONE IN CVDFTR ACCORDING TO THE
00565 !       VALUE OF RESOL, SO IT IS NOT IMPORTANT HERE.
00566 !
00567       ELSE
00568 !
00569 !       POINTERS ARE USED TO AVOID COPY
00570 !
00571         IF(SOLSYS_SIS.EQ.1) THEN
00572           UCONV%R=>U2D%R
00573           VCONV%R=>V2D%R
00574         ELSE
00575 !         HERE UCONV_TEL IS PASSED ON
00576           UCONV%R=>UCONV_TEL%R
00577           VCONV%R=>VCONV_TEL%R
00578         ENDIF
00579 !       ADVECTION FORM THAT REQUIRES AN ADVECTION FIELD
00580 !       THAT SATISFIES CONTINUITY + LEO-POSTMA CONSTANT
00581         OPTVF=2
00582 !
00583       ENDIF
00584 !
00585 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00586 ! 3.  EROSION FLUX   : FLUER
00587 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00588 !
00589 !
00590 !     SKIN FRICTION TAUP  --> T4
00591 !
00592       CALL OS('X=CYZ   ', X= T4, Y= TOB, Z= MU, C=1.D0)
00593       CALL OS('X=+(Y,C)', X=T4, Y=T4, C=ZERO)
00594 !
00595 !     SAND ONLY
00596 !
00597       IF(.NOT.MIXTE) THEN
00598         IF(.NOT.SEDCO) THEN
00599           IF (DEBUG > 0) WRITE(LU,*) 'SUSPENSION_EROSION'
00600           CALL SUSPENSION_EROSION(T4,HN,FDM,FD90,AVA,NPOIN,CHARR,XMVE,
00601      &                            XMVS,VCE,GRAV,HMIN,XWC,ZERO,
00602      &                            ZREF,AC,FLUER,CSTAEQ,QS_C,ICQ,U2D,V2D,
00603      &                            CSRATIO,T14,DEBUG)
00604           IF (DEBUG > 0) WRITE(LU,*) 'END_SUSPENSION_EROSION'
00605 !
00606 !         NOTE JMH : THIS SHOULD BE INCLUDED IN SUSPENSION_EROSION
00607 !
00608           DO I=1,NPOIN
00609             FLUER%R(I)=MIN(FLUER%R(I),ELAY%R(I)*AVA(I)/DT*CSF_SABLE)
00610           ENDDO
00611 !
00612 !       MUD ONLY
00613 !
00614         ELSE
00615 !  CV : debut modifs
00616 !        CALL SUSPENSION_EROSION_COH(T4,NPOIN,XMVE,XMVS,GRAV,
00617 !     &                                PARTHENIADES,ZERO, DEBUG,
00618 !     &                                FLUER,ES,TOCE_VASE,NOMBLAY,
00619 !     &                                DT,MS_VASE%R,TASS)
00620 !        IF(NOMBLAY.EQ.1) THEN
00621 !             DO I=1,NPOIN
00622 !              FLUER%R(I)=MIN(FLUER%R(I),MS_VASE(I,1)/DT/XMVS)
00623 !            ENDDO
00624 !        ENDDO
00625            CALL SUSPENSION_EROSION_COH(T4,NPOIN,XMVS,
00626      &                      PARTHENIADES,ZERO,FLUER,
00627      &                      TOCE_VASE,NOMBLAY,DT,MS_VASE)
00628 !
00629           IF(NOMBLAY.EQ.1) THEN
00630             DO I=1,NPOIN
00631               FLUER%R(I)=MIN(FLUER%R(I),MS_VASE(I,1)/DT/XMVS)
00632             ENDDO
00633           ELSE
00634             DO I=1,NPOIN
00635               MSTOT=0.D0
00636               DO J=1,NOMBLAY
00637                 MSTOT=MSTOT+MS_VASE(I,J)
00638               ENDDO
00639               FLUER%R(I)=MIN(FLUER%R(I),MSTOT/DT/XMVS)
00640             ENDDO
00641           ENDIF
00642         ENDIF
00643 !
00644 !       MIXED SEDIMENT
00645 !       FIRST CLASS= SAND, SECOND CLASS = MUD
00646 !
00647       ELSE
00648         IF(.NOT.SEDCO) THEN
00649           IF(DEBUG > 0) WRITE(LU,*) 'SUSPENSION_FLUX_MIXTE'
00650           CALL SUSPENSION_FLUX_MIXTE(T4,HN,FDM,NPOIN,CHARR,XMVE,XMVS,
00651      &                               VCE,GRAV,HMIN,XWC,ZERO,
00652      &                               PARTHENIADES,FLUER,FLUER_VASE,
00653      &                               ZREF,AC,CSTAEQ,QS_C,ICQ,DEBUG,
00654      &                               AVAIL,NSICLA,ES,TOCE_VASE,
00655      &                               TOCE_SABLE,NOMBLAY,
00656      &                               DT,TOCE_MIXTE%R,MS_SABLE,
00657      &                               MS_VASE)
00658           IF (DEBUG > 0) WRITE(LU,*) 'END_SUSPENSION_FLUX_MOY'
00659         ENDIF
00660         IF(SEDCO) CALL OS('X=Y     ',X=FLUER, Y=FLUER_VASE)
00661       ENDIF
00662 !
00663 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00664 !  4. DEPOSITION FLUX   : FLUDPT =WC*T2
00665 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00666 !
00667 !---> FLUDPT: IMPLICIT TERM
00668 ! TO ADD ? mak change ---> T2    : RATIO BETWEEN BOTTOM CONCENTRATION AND AVERAGE
00669 !--->  CSRATIO   : RATIO BETWEEN BOTTOM CONCENTRATION AND AVERAGE
00670 !             CONCENTRATION
00671 !
00672       IF (DEBUG > 0) WRITE(LU,*) 'SUSPENSION_DEPOT'
00673       CALL SUSPENSION_DEPOT(TOB,HN,NPOIN,HMIN,XWC,VITCD,ZERO,KARMAN,
00674      &    FDM,FD90,XMVE,T1,T2,ZREF,FLUDPT,DEBUG,SEDCO,CSTAEQ)
00675 ! TO ADD? mak   &    FDM,FD90,XMVE,T1,CSRATIO,T14,ZREF,FLUDPT,DEBUG,SEDCO,U2D,V2D,
00676 ! TO ADD? mak   &    CSTAEQ,DT)
00677 !     &                      XMVE,T1,T2,ZREF,FLUDPT,DEBUG,SEDCO)
00678 !
00679 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00680 !  5. DIFFIN A SPECIFIC TREATMENT IS DONE IF THE ADVECTION METHOD
00681 !     IS THE CHARACTERISTICS: FREE OUTPUTS ARE TREATED LIKE DIRICHLET.
00682 !     THIS SPECIFIC TREATMENT IS CANCELLED HERE BY SENDING A MODIFIED
00683 !     VALUE FOR RESOL : RESOL_MOD (IN DIFFIN THE ONLY TEST IS:
00684 !     IF(RESOL.EQ.1) THEN .... ELSE ....  ENDIF)
00685 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00686 !
00687       RESOL_MOD=RESOL
00688       IF(RESOL_MOD.EQ.1) RESOL_MOD=2
00689       IF (DEBUG > 0) WRITE(LU,*) 'DIFFIN'
00690       CALL DIFFIN(MASKTR,LIMDIF%I,LICBOR%I,CLT%I,U2D%R,V2D%R,
00691      &            MESH%XNEBOR%R,MESH%YNEBOR%R,
00692      &            MESH%NBOR%I,NPTFR,
00693      &            KENT,KSORT,KLOG,KNEU,KDIR,KDDL,RESOL_MOD,
00694      &            MESH%NELBOR%I,NPOIN,MESH%NELMAX,
00695 !                              NFRLIQ
00696      &            MSK,MASKEL%R,0,
00697 !                  THOMFR FRTYPE
00698      &            .FALSE.,BID,    CS,CBOR,MESH,NUMLIQ,
00699      &            MESH%IKLBOR%I,MESH%NELEB,MESH%NELEBX)
00700       IF (DEBUG > 0) WRITE(LU,*) 'END DIFFIN'
00701 !
00702 !+++++++++++++++++++++++++++++++++++ELEVATION OF BOTTOM++++++++++++++++++++++++++++++++++++
00703 !  6. BOUNDARY CONDITIONS : CBORCONC_V
00704 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00705 !
00706 !     IMPOSES THE EQUILIBRIUM CONCENTRATION FOR THE INFLOW NODES  !
00707 !     HERE CBOR FROM BOUNDARY CONDITIONS FILE OR SUBROUTINE CONLIT
00708 !     OVERWRITTEN
00709 !
00710 !     T2 = RATIO BETWEEN BOTTOM CONC.
00711 !     AND AVERAGE CONC. MUST BE KEPT UNTIL THIS STAGE
00712 !
00713       IF (DEBUG > 0) WRITE(LU,*) 'IMP_INFLOW_C'
00714       IF(IMP_INFLOW_C) THEN
00715 !
00716         DO K = 1, NPTFR
00717           IF(CLT%I(K).EQ.KENT) THEN
00718             I = MESH%NBOR%I(K)
00719             IF(.NOT.SEDCO) THEN
00720               CBOR%R(K) = CSTAEQ%R(I)/T2%R(I)
00721               IF(MIXTE) CBOR%R(K) = FLUER%R(I)/T2%R(I)/XWC
00722             ELSE
00723               CBOR%R(K) = FLUER%R(I)/XWC
00724             ENDIF
00725 !           THIS IS THE CONDITION TO HAVE NO EVOLUTION
00726 !           CS%R(I) MAY BE DIFFERENT FROM CBOR%R(K) IF UNSTEADY FLOW
00727 !           OR IF DIRFLU.EQ.2 (CASE OF PRIORITY TO FLUXES)
00728             FLUER%R(I)=FLUDPT%R(I)*CS%R(I)
00729           ENDIF
00730         ENDDO
00731 !
00732       ENDIF
00733       IF (DEBUG > 0) WRITE(LU,*) 'FIN IMP_INFLOW_C'
00734 !
00735 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00736 !  7. SOLVING TRANSPORT EQUATION IF METHOD OF CHARACTERISTICS
00737 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00738 !
00739       IF(RESOL == 1) THEN
00740         IF (DEBUG > 0) WRITE(LU,*) 'CHARAC'
00741         CALL CHARAC(CS,CTILD,1,UCONV,VCONV,S,S,S,S,DT,IFAMAS,
00742      &              IELMT,NPOIN,1,1,1,
00743      &              MSK,MASKEL,AM1_S%X,AM1_S%D,AM1_S%D,
00744      &              TB,IT1%I,IT2%I,IT2%I,IT3%I,IT4%I,IT2%I,
00745      &              MESH,MESH%NELEM,MESH%NELMAX,MESH%IKLE,MESH%SURDET,
00746      &              AM2_S,T14,SLVTRA,1.D0,ENTETS,3,UNSV2D,1)
00747         IF (DEBUG > 0) WRITE(LU,*) 'END_CHARAC'
00748       ENDIF
00749 !
00750 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00751 !  8. SOURCE AND SINKS
00752 !     IMPLICIT SOURCE TERM FOR THE DEPOSITION       : T9
00753 !     EXPLICIT SOURCE TERM WITHOUT PUNCTUAL SOURCES : T11
00754 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00755 !
00756       IF(OPTBAN.EQ.2) THEN
00757         CALL OS('X=XY    ',X=FLUER ,Y=MASKPT)
00758 !       JMH 27/04/2011 FLUDPT HELPS TO DECREASE C
00759 !       CALL OS('X=XY    ',X=FLUDPT,Y=MASKPT)
00760       ENDIF
00761 !
00762       CALL OS('X=-Y    ',X=T9,Y=FLUDPT)
00763       CALL OS('X=Y     ',X=T11,Y=FLUER)
00764 !
00765       DO I=1,NPOIN
00766         IF(HN%R(I).GT.HMIN) THEN
00767           T11%R(I)=T11%R(I)/HN%R(I)
00768         ELSE
00769           T11%R(I)=0.D0
00770 !         FLUER WILL BE USED AS T11*HN, SO IT MUST BE
00771 !         CANCELLED ACCORDINGLY, OTHERWISE MASS BALANCE WRONG
00772           FLUER%R(I)=0.D0
00773         ENDIF
00774       ENDDO
00775 !
00776 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00777 !  9. ADVECTION-DISPERSION STEP
00778 !     CONFIGURATION OF ADVECTION
00779 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00780 !
00781       TETAH  = 1.D0 - TETA_SUSP
00782       MASSOU = 0.D0
00783       AGGLOT=1.D0
00784       YASMI2 = .TRUE.
00785 !
00786 !     BOUNDARY FLUXES MUST BE SPECIFIED TO CVDFTR (FINITE VOLUMES CASE)
00787 !     AND TO SUSPENSION_BILAN
00788 !     SISYPHE ALONE     : THEY MUST BE COMPUTED
00789 !     WHEN COUPLING     : THEY ARE GIVEN BY THE CALLING SUBROUTINE
00790 !                         EXCEPT AT THE 1ST ITERATION
00791 !
00792 !     IF(CODE(1:7).NE.'TELEMAC'.OR.LT.EQ.1) THEN
00793       IF(CODE(1:7).NE.'TELEMAC'.OR.
00794      &  (CODE(1:9).EQ.'TELEMAC3D'.AND.LT.EQ.1)) THEN
00795         IF (DEBUG > 0) WRITE(LU,*) 'VECTOR'
00796         CALL VECTOR(FLBOR_SIS,'=','FLUBDF          ',IELBOR(IELMT,1),
00797 !                        HPROP (HERE HPROP=HN, INVESTIGATE)
00798      &              1.D0,HN   ,HN,HN,UCONV,VCONV,VCONV,
00799      &              MESH,.TRUE.,MASKTR%ADR(5)%P)
00800 !                                          5: MASK OF LIQUID BOUNDARIES
00801 !                                             SEE DIFFIN IN BIEF 6.1
00802         IF (DEBUG > 0) WRITE(LU,*) 'FIN VECTOR'
00803       ELSE
00804         CALL OS('X=Y     ',X=FLBOR_SIS,Y=FLBOR_TEL)
00805 !       MUST ALSO CHANGE BOUNDARY FLUXES IF THE ADVECTION
00806 !       FIELD IS CORRECTED (T12 MUST HAVE BEEN KEPT SINCE
00807 !                           CALL TO SUSPENSION_CONV)
00808         IF(CORR_CONV.AND..NOT.SEDCO) THEN
00809           CALL OSBD('X=CXY   ',FLBOR_SIS,T12,T12,1.D0,MESH)
00810         ENDIF
00811       ENDIF
00812 !
00813 !     FINITE VOLUMES ADVECTION USES THE TRUE H FROM THE PREVIOUS STEP
00814       IF(CODE(1:7).EQ.'TELEMAC') THEN
00815         IF(OPTBAN.NE.0) THEN
00816           CALL CPSTVC(CST,T1)
00817 !         HN_TEL IS NOT CLIPPED
00818           DO I=1,NPOIN
00819             T1%R(I)=MAX(HN_TEL%R(I),HMIN)
00820           ENDDO
00821           HOLD=>T1
00822         ELSE
00823           HOLD=>HN_TEL
00824         ENDIF
00825       ELSE
00826 !       IN THIS CASE H AND HN ARE CONFUNDED
00827         HOLD=>HN
00828       ENDIF
00829 !
00830       IF(DEBUG > 0) WRITE(LU,*) 'APPEL DE CVDFTR'
00831 !
00832       CALL CVDFTR
00833      & (CST, CTILD, CS, T2,
00834 !                            H         HTILD
00835      &  DIFT, RESOL, .TRUE., HN, HOLD, HPROP, TETAH,
00836      &  UCONV,VCONV,DM1,ZCONV,SOLSYS_SIS,
00837 !                     TEXP SMH  YASMH   TIMP
00838      &  DISP, DISP_C, T11, T2, .FALSE., T9,  YASMI2,AM1_S,AM2_S,
00839      &  ZF, CBOR, AFBOR, BFBOR, LIMDIF, MASKTR, MESH,
00840      &  W1, TB, T8, T12, T3, T4, T5, T6, T7, T10, TE1, TE2, TE3,
00841      &  KDIR,KDDL,KENT,DT,ENTETS,TETA_SUSP,
00842 !                      BILAN
00843      &  AGGLOT,ENTETS,.FALSE.,OPTADV,
00844      &  1, LT, NIT, OPDTRA, OPTBAN, MSK, MASKEL, MASKPT, MBOR, S,
00845 !               OPTSOU
00846      &  MASSOU, 1,     SLVTRA,FLBOR_SIS,VOLU2D,V2DPAR,UNSV2D,
00847      &  OPTVF,FLBORTRA,
00848      &  FLULIM,YAFLULIM,DIRFLU,.FALSE.,T8    ,0.D0,
00849 !                               RAIN  ,PLUIE ,TRAIN
00850      &  FLULIM     ,.FALSE.,MAXADV)
00851 !       GIVEN_FLUX   FLUX_GIVEN (NOW THE FLUX CAN BE GIVEN, THIS COULD
00852 !       BE AN OPTIMISATION, AS HERE IT IS RECOMPUTED FOR EVERY CLASS...)
00853 !
00854       IF(DEBUG > 0) WRITE(LU,*) 'END_CVDFTR'
00855 !
00856 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00857 ! 10. BED EVOLUTION DUE TO NET EROSION/DEPOSITUON FLUX
00858 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00859 !
00860       DO I=1,NPOIN
00861         FLUDP%R(I)=FLUDPT%R(I)*CST%R(I)
00862       ENDDO
00863 !
00864 !     COMPUTES EVOLUTION AND UPDATES DATA
00865 !     TASS TO BE PASSED IN ARGUMENT
00866 !
00867 !
00868       IF(.NOT.SEDCO) THEN
00869         IF(.NOT.MIXTE) THEN
00870           CALL OS('X=Y-Z   ', X=ZFCL_S, Y=FLUDP, Z=FLUER)
00871           CALL OS('X=CX    ', X=ZFCL_S, C=DT/CSF_SABLE)
00872         ELSE
00873           DO I=1, NPOIN
00874             DO J= 1, NOMBLAY
00875               CONC_SABLE(I,J)=XMVS
00876             ENDDO
00877           ENDDO
00878           CALL SUSPENSION_EVOL(ZFCL_S,FLUDP,FLUER,DT,
00879      &                NPOIN,XMVS,T3,MS_SABLE,ES_SABLE,
00880      &                   CONC_SABLE,NOMBLAY)
00881         ENDIF
00882       ELSE
00883         CALL SUSPENSION_EVOL(ZFCL_S,FLUDP,FLUER,DT,
00884      &      NPOIN,XMVS,T3,MS_VASE,ES_VASE,
00885      &      CONC,NOMBLAY)
00886       ENDIF
00887 !
00888 !     WRITES OUT THE MIN/MAX VALUES TO THE LISTING
00889 !
00890       IF(ENTETS) THEN
00891         IF (DEBUG > 0) WRITE(LU,*) 'SUSPENSION_LISTING'
00892         CALL SUSPENSION_LISTING(MESH,CST,ZFCL_S,UCONV,VCONV,
00893      &                          MASKEL,IELMT,DT,MSK,T1)
00894         IF(DEBUG > 0) WRITE(LU,*) 'END_SUSPENSION_LISTING'
00895       ENDIF
00896 !
00897 !     MASS-BALANCE FOR THE SUSPENSION
00898 !
00899       IF(BILMA) THEN
00900         IF(SEDCO) THEN
00901           IF (DEBUG > 0) WRITE(LU,*) 'SUSPENSION_BILAN_COH'
00902           CALL SUSPENSION_BILAN_COH
00903      &         (MESH,CST,HN,ZFCL_S,MASKEL,IELMT,ITRA,LT,NIT,DT,XMVS,
00904      &         MS_VASE,NOMBLAY,NPOIN,
00905      &         MASSOU,MASED0,MSK,ENTETS,MASTEN,MASTOU,
00906      &         MASINI,T1,T2,T3,MASFIN,MASDEPT,MASDEP,AGGLOT,VOLU2D,
00907      &         NUMLIQ,NFRLIQ,NPTFR,FLBORTRA,SEDCO)
00908           IF(DEBUG > 0) WRITE(LU,*) 'END_SUSPENSION_BILAN_COH'
00909         ELSE
00910 !Modifs CVL
00911           IF(MIXTE) THEN
00912             IF (DEBUG > 0) WRITE(LU,*) 'SUSPENSION_BILAN_COH'
00913             CALL SUSPENSION_BILAN_COH
00914      &           (MESH,CST,HN,ZFCL_S,MASKEL,IELMT,ITRA,LT,NIT,DT,XMVS,
00915      &           MS_SABLE,NOMBLAY,NPOIN,
00916      &           MASSOU,MASED0,MSK,ENTETS,MASTEN,MASTOU,
00917      &           MASINI,T1,T2,T3,MASFIN,MASDEPT,MASDEP,AGGLOT,VOLU2D,
00918      &           NUMLIQ,NFRLIQ,NPTFR,FLBORTRA,SEDCO)
00919             IF(DEBUG > 0) WRITE(LU,*) 'END_SUSPENSION_BILAN_COH'
00920           ELSE
00921 ! fin modifs CVL
00922             IF (DEBUG > 0) WRITE(LU,*) 'SUSPENSION_BILAN'
00923             CALL SUSPENSION_BILAN
00924      &          (MESH,CST,HN,ZFCL_S,MASKEL,IELMT,ITRA,LT,NIT,
00925      &           DT,CSF_SABLE,MASSOU,MASED0,MSK,ENTETS,MASTEN,MASTOU,
00926      &           MASINI,T2,T3,MASFIN,MASDEPT,MASDEP,AGGLOT,VOLU2D,
00927      &           NUMLIQ,NFRLIQ,NPTFR,FLBORTRA)
00928             IF(DEBUG > 0) WRITE(LU,*) 'END_SUSPENSION_BILAN'
00929           ENDIF
00930         ENDIF
00931       ENDIF
00932 !
00933 !
00934       CALL OS('X=Y     ', X=CS, Y=CST)
00935 !
00936 !     NOTE: ARE QSCLXS AND QSCLYS USEFUL ????????
00937 !
00938       CALL OS('X=YZ    ', X=T1, Y=UCONV, Z=HN)
00939       CALL OS('X=YZ    ', X=T2, Y=VCONV, Z=HN)
00940       CALL OS('X=YZ    ', X=QSCLXS, Y=CS, Z=T1)
00941       CALL OS('X=YZ    ', X=QSCLYS, Y=CS, Z=T2)
00942 !
00943 !     RESTORING UCONV POINTERS
00944 !
00945       UCONV%R=>SAVE_UCONV
00946       VCONV%R=>SAVE_VCONV
00947 !
00948 !======================================================================!
00949 !======================================================================!
00950 !
00951       RETURN
00952       END

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