init_mixte.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\init_mixte.f
00002 !
00083                      SUBROUTINE INIT_MIXTE
00084 !                    *********************
00085 !
00086      &(XMVS,NPOIN,AVAIL,NSICLA,ES,ES_SABLE, ES_VASE,ELAY,NOMBLAY,
00087      & CONC_VASE,MS_SABLE,MS_VASE,ZF,ZR,AVA0,CONC,DEBU,MIXTE)
00088 !
00089 !***********************************************************************
00090 ! SISYPHE   V6P2                                   21/07/2011
00091 !***********************************************************************
00092 !
00093 !
00094 !
00095 !
00096 !
00097 !
00098 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00099 !| AVA0           |-->| VOLUME PERCENT
00100 !| AVAIL          |<->| VOLUME PERCENT OF EACH CLASS
00101 !| CONC           |<->| CONC OF EACH BED LAYER (KG/M3)
00102 !| CONC_VASE      |<->| MUD CONCENTRATION FOR EACH LAYER
00103 !| DEBU           |-->| FLAG, FOR PREVIOUS SEDIMENTOLOGICAL FILE
00104 !| ELAY           |<->| THICKNESS OF TOTAL LAYER
00105 !| ES             |<->| LAYER THICKNESSES AS DOUBLE PRECISION
00106 !| ES_SABLE       |<->| THICKNESS OF SAND LAYER (M)
00107 !| ES_VASE        |<->| THICKNESS OF MUD LAYER (M)
00108 !| MIXTE          |-->| SEDIMENT MIXTE (SABLE + VASE)
00109 !| MS_SABLE       |<->| MASS OF SAND PER LAYER (KG/M2)
00110 !| MS_VASE        |<->| MASS OF MUD PER LAYER (KG/M2)
00111 !| NOMBLAY        |-->| NUMBER OF LAYERS FOR CONSOLIDATION
00112 !| NPOIN          |-->| NUMBER OF POINTS
00113 !| NSICLA         |-->| NUMBER OF SIZE CLASSES FOR BED MATERIALS
00114 !| XMVS           |-->| WATER DENSITY
00115 !| ZF             |-->| ELEVATION OF BOTTOM
00116 !| ZR             |-->| NON ERODABLE BED
00117 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00118 !
00119       USE BIEF
00120       USE INTERFACE_SISYPHE, EX_INIT_MIXTE=> INIT_MIXTE
00121       USE DECLARATIONS_SISYPHE, ONLY :MASVT,MASV0,T1,BILMA,VOLU2D
00122       USE DECLARATIONS_SISYPHE, ONLY :MASST,MASS0,T2
00123 !
00124       IMPLICIT NONE
00125       INTEGER LNG,LU
00126       COMMON/INFO/LNG,LU
00127 !
00128 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00129 !
00130       INTEGER, INTENT(IN)              :: NPOIN,NSICLA,NOMBLAY
00131       DOUBLE PRECISION, INTENT(IN)     :: XMVS
00132       DOUBLE PRECISION, INTENT(INOUT)  :: AVAIL(NPOIN,NOMBLAY,NSICLA)
00133       DOUBLE PRECISION, INTENT(INOUT)  :: ES(NPOIN,NOMBLAY)
00134       DOUBLE PRECISION, INTENT(INOUT)  :: ELAY(NPOIN)
00135       DOUBLE PRECISION, INTENT(IN)     :: ZR(NPOIN),ZF(NPOIN)
00136       DOUBLE PRECISION,  INTENT(INOUT) :: MS_SABLE(NPOIN,NOMBLAY)
00137       DOUBLE PRECISION,  INTENT(INOUT) :: MS_VASE(NPOIN,NOMBLAY)
00138 !
00139       DOUBLE PRECISION,  INTENT(INOUT) :: ES_SABLE(NPOIN,NOMBLAY)
00140       DOUBLE PRECISION,  INTENT(INOUT) :: ES_VASE(NPOIN,NOMBLAY)
00141 !
00142       DOUBLE PRECISION, INTENT(IN)     :: CONC_VASE(NOMBLAY)
00143       DOUBLE PRECISION,  INTENT(INOUT) :: CONC(NPOIN,NOMBLAY)
00144       DOUBLE PRECISION, INTENT(IN)     :: AVA0(NSICLA)
00145       LOGICAL, INTENT (IN)             :: DEBU, MIXTE
00146 !
00147 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00148 !
00149 !     LOCAL VARIABLES
00150 !
00151       INTEGER I,J,K,NK
00152       DOUBLE PRECISION HAUTSED
00153       DOUBLE PRECISION DIFF,EST
00154       DOUBLE PRECISION, EXTERNAL :: P_DSUM
00155 !
00156 !-----------------------------------------------------------------------
00157 !
00158 !*******INITIAL SEDIMENT COMPOSITION IS IDENTICAL AT EACH NODE
00159 ! DEFAULT INITIALISATION: ALL LAYERS ARE EMPTY EXCEPT BED LAYER
00160 ! OTHERWISE SET THICKNESS OF THE MUD LAYERS IN EPAI_VASE(I= 1, NCOUCH_TASS-1)
00161 !
00162 !CV V6P2 ..
00163 
00164 !  INITIALISATION OF ES : THICKNESS OF EACH LAYERS
00165 !  INIT_COMPO_COH : composition of the sediment bed : thickness of layers
00166 !                  and concentrations The number of sediment bed layers is fixed
00167 
00168       IF(.NOT.DEBU) THEN
00169 !
00170         CALL INIT_COMPO_COH(ES,CONC_VASE,CONC,NPOIN,
00171      &     NOMBLAY,NSICLA,AVAIL,AVA0)
00172 !
00173 !       Recalcul des epaisseurs pour satisfaire : Sum (ES)=ZF-ZR
00174 !
00175         DO I=1,NPOIN
00176 !
00177           ELAY(I)=ZF(I)-ZR(I)
00178 !
00179 !
00180 !         THE HEIGHT OF SEDIMENT (SUM OF ES) MUST BE EQUAL TO ZF-ZR
00181 !         IF SO, THE HEIGHT OF THE LAST LAYER IS REDUCED
00182 !         IF THERE ARE LAYERS UNDER ZR, THEY ARE NOT TAKEN INTO ACCOUNT
00183 !
00184           HAUTSED = 0.D0
00185 !
00186           NK=NOMBLAY
00187           DO K=1,NOMBLAY
00188 !
00189             IF(HAUTSED + ES(I,K) .GE. ELAY(I)) THEN
00190               ES(I,K) = ELAY(I) -  HAUTSED
00191               NK=K
00192               HAUTSED = HAUTSED + ES(I,K)
00193               GOTO 144
00194             ENDIF
00195             HAUTSED = HAUTSED + ES(I,K)
00196 !
00197           ENDDO
00198 !
00199 144       CONTINUE
00200 !
00201 !         FOR CLEAN OUTPUTS
00202 !
00203           IF(NK.LT.NOMBLAY) THEN
00204             DO K=NK+1,NOMBLAY
00205               ES(I,K) = 0.D0
00206             ENDDO
00207           ENDIF
00208 !
00209 !         THE THICKNESS OF THE LAST LAYER IS ENLARGED SO THAT
00210 !         THE HEIGHT OF SEDIMENT (SUM OF ES) IS EQUAL TO ZF-ZR
00211 !
00212           IF(HAUTSED.LT.ELAY(I)) THEN
00213             ES(I,NOMBLAY)=ES(I,NOMBLAY)+ELAY(I)-HAUTSED
00214           ENDIF
00215 !
00216         ENDDO
00217 !
00218       ELSE
00219 !
00220 !      En cas de suite de calcul
00221 !      Check that sum of layers (simple precision) is equal to ZF-ZR
00222 !
00223         DO I=1,NPOIN
00224 !
00225           ELAY(I)=ZF(I)-ZR(I)
00226 !
00227           EST=0.D0
00228 !
00229 !          IF(NOMBLAY.GT.1) THEN
00230 !
00231            DO J=1,NOMBLAY
00232               EST=EST+ES(I,J)
00233            ENDDO
00234 !          ELSE
00235 !            EST=ES(I,1)
00236 !          ENDIF
00237 !
00238           DIFF= ELAY(I) - EST
00239 !
00240           IF(ABS(DIFF).GE.1.D-4) THEN
00241             WRITE(LU,*) 'ERROR IN INIT-MIXTE:'
00242             WRITE(LU,*) 
00243 'THE SUM OF THICKNESS OF BED LAYERS     &     IS DIFFERENT FROM ERODIBLE BED THICKNESS'
00244             CALL PLANTE(1)
00245             STOP
00246           ELSE
00247             ES(I,NOMBLAY) = MAX(ES(I,NOMBLAY)+ DIFF,0.D0)
00248           ENDIF
00249 !
00250         ENDDO
00251 !
00252       ENDIF
00253 !
00254 ! END LOOP  (initialization of layers)
00255 !
00256 ! Check sum ELAY = ZF-ZR
00257 !                = SUM (ES)
00258       DO I = 1, NPOIN
00259         EST=0.D0
00260         DO J= 1, NOMBLAY
00261           EST=EST+ES(I,J)
00262         ENDDO
00263         DIFF=ABS(EST-ELAY(I))
00264         IF(DIFF.GT.1.D-08) THEN
00265           WRITE(LU,*) 'ERREUR POINT I'
00266      &     , I, 'ELAY=',ELAY(I), 'EST=', EST
00267           CALL PLANTE(1)
00268           STOP
00269         ENDIF
00270       ENDDO
00271 !
00272 
00273 !  COMPUTING THE INITIAL MASSES OF MUD AND SAND
00274 !
00275       DO I=1,NPOIN
00276         T1%R(I)=0.D0
00277         T2%R(I)=0.D0
00278         DO J=1,NOMBLAY
00279           IF(NSICLA.EQ.1) THEN
00280             ES_VASE(I,J) = ES(I,J)
00281             MS_VASE(I,J) = ES(I,J)*CONC(I,J)
00282           ELSE
00283 ! FOR MIXTE SEDIMENTS : (MUD, second class )
00284 !....         FILLING VOIDS BETWEEN SAND GRAINS ....(XKV=1)
00285 !
00286             ES_SABLE(I,J)=ES(I,J)*AVAIL(I,J,1)
00287             ES_VASE(I,J)= ES(I,J)*AVAIL(I,J,2)
00288 !
00289             MS_VASE(I,J) = ES_VASE(I,J)*CONC(I,J)
00290             MS_SABLE(I,J)= ES_SABLE(I,J)*XMVS
00291           ENDIF
00292           T1%R(I)= T1%R(I)+MS_VASE(I,J)
00293           IF(MIXTE) T2%R(I)=T2%R(I) + MS_SABLE(I,J)
00294         ENDDO
00295       ENDDO
00296 !
00297 !
00298 ! FOR MASS BALANCE
00299 !
00300       IF(BILMA) THEN
00301         MASV0=DOTS(T1,VOLU2D)
00302         IF(MIXTE) MASS0= DOTS(T2,VOLU2D)
00303         IF(NCSIZE.GT.1) THEN
00304           MASV0=P_DSUM(MASV0)
00305           IF(MIXTE) MASS0=P_DSUM(MASS0)
00306         ENDIF
00307 !
00308         MASVT=MASV0
00309         IF(MIXTE) MASST=MASS0
00310         IF (.NOT.MIXTE) THEN
00311           IF(LNG.EQ.1) WRITE(LU,1) MASV0
00312           IF(LNG.EQ.2) WRITE(LU,2) MASV0
00313         ELSE
00314           IF(LNG.EQ.1) WRITE(LU,10) MASV0, MASS0
00315           IF(LNG.EQ.2) WRITE(LU,20) MASV0, MASS0
00316         ENDIF
00317       ENDIF
00318 !
00319 001   FORMAT(1X,'MASSE INITIALE DU LIT DE VASE  : ', G20.11, ' KG')
00320 002   FORMAT(1X,'INITIAL MASS OF THE MUD BED: ', G20.11, ' KG')
00321 010   FORMAT(1X,'MASSE INITIALE DU LIT DE VASE  : ', G20.11, ' KG',
00322      &     /,1X,'MASSE INITIALE DU LIT DE SABLE : ', G20.11, ' KG')
00323 020   FORMAT(1X,'INITIAL MASS OF THE MUD BED: ', G20.11, ' KG',
00324      &     /,1X,'INITIAL MASS OF THE SAND BED: ', G20.11, ' KG')
00325 !
00326 !-----------------------------------------------------------------------
00327 !
00328 !1800  FORMAT(1X,'IL Y A PLUS DE ',1I6,' COUCHES DANS LA STRATIFICATION')
00329 !1815  FORMAT(1X,'THERE ARE MORE THAN ',1I6,' LAYERS IN STRATIFICATION')
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