init_transport.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\init_transport.f
00002 !
00101                      SUBROUTINE INIT_TRANSPORT
00102 !                    *************************
00103 !
00104      &(TROUVE,DEBU,HIDING,NSICLA,NPOIN,
00105      & T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12,T14,
00106      & CHARR,QS_C,QSXC,QSYC,CALFA,SALFA,COEFPN,SLOPEFF,
00107      & SUSP,QS_S,QS,QSCL,QSCL_C,QSCL_S,QSCLXS,QSCLYS,
00108      & UNORM,U2D,V2D,HN,CF,MU,TOB,TOBW,UW,TW,THETAW,FW,HOULE,
00109      & AVAIL,ACLADM,UNLADM,KSP,KSR,KS,
00110      & ICF,HIDFAC,XMVS,XMVE,GRAV,VCE,HMIN,KARMAN,
00111      & ZERO,PI,AC,IMP_INFLOW_C,ZREF,ICQ,CSTAEQ,CSRATIO,
00112      & CMAX,CS,CS0,UCONV,VCONV,CORR_CONV,SECCURRENT,BIJK,
00113      & IELMT,MESH,FDM,XWC,FD90,SEDCO,VITCE,PARTHENIADES,VITCD,
00114      & U3D,V3D,CODE)
00115 !
00116 !***********************************************************************
00117 ! SISYPHE   V6P2                                   21/07/2011
00118 !***********************************************************************
00119 !
00120 !
00121 !
00122 !
00123 !
00124 !
00125 !
00126 !
00127 !
00128 !
00129 !
00130 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00131 !| AC             |<->| CRITICAL SHIELDS PARAMETER
00132 !| ACLADM         |-->| MEAN DIAMETER OF SEDIMENT
00133 !| AVAIL          |<->| VOLUME PERCENT OF EACH CLASS
00134 !| BIJK           |-->| COEFFICIENT OF THE BIJKER FORMULA
00135 !| CALFA          |<->| COSINUS OF THE ANGLE BETWEEN MEAN FLOW AND TRANSPORT
00136 !| CF             |-->| QUADRATIC FRICTION COEFFICIENT
00137 !| CHARR          |-->| BEDLOAD
00138 !| CMAX           |---| MAX(PARTHENIADES/SETTLING VELOCITY)
00139 !| COEFPN         |<->| CORRECTION OF TRANSORT FOR SLOPING BED EFFECT
00140 !| CORR_CONV      |-->| CORRECTION ON CONVECTION VELOCITY
00141 !| CS             |<->| CONCENTRATION AT TIME N
00142 !| CS0            |-->| CONCENTRATION AT TIME 0
00143 !| CSTAEQ         |<->| EQUILIBRIUM CONCENTRATION
00144 !| CSRATIO        |<->| EQUILIBRIUM CONCENTRATION FOR SOULSBY-VAN RIJN EQ.
00145 !| DEBUG          |-->| FLAG FOR DEBUGGING
00146 !| FD90           |-->| DIAMETER D90
00147 !| FDM            |-->| DIAMETER DM FOR EACH CLASS
00148 !| FW             |-->| WAVE FRICTION FACTOR
00149 !| GRAV           |-->| ACCELERATION OF GRAVITY
00150 !| HIDFAC         |-->| HIDING FACTOR FORMULAS
00151 !| HIDING         |-->| HIDING FACTOR CORRECTION
00152 !| HMIN           |-->| MINIMUM VALUE OF WATER DEPTH
00153 !| HN             |-->| WATER DEPTH
00154 !| HOULE          |-->| LOGICAL, FOR WAVE EFFECTS
00155 !| ICF            |-->| BED-LOAD OR TOTAL LOAD TRANSPORT FORMULAS
00156 !| ICQ            |-->| REFERENCE CONCENTRATION FORMULA
00157 !| IELMT          |-->| NUMBER OF ELEMENTS
00158 !| IMP_INFLOW_C   |-->| IMPOSED CONCENTRATION IN INFLOW
00159 !| KARMAN         |-->| VON KARMAN CONSTANT
00160 !| KS             |-->| BED ROUGHNESS
00161 !| KSP            |-->| BED SKIN ROUGHNESS
00162 !| KSR            |-->| RIPPLE BED ROUGHNESS
00163 !| MESH           |<->| MESH STRUCTURE
00164 !| MU             |<->| CORRECTION FACTOR FOR BED ROUGHNESS
00165 !| NPOIN          |-->| NUMBER OF POINTS
00166 !| NSICLA         |-->| NUMBER OF SEDIMENT CLASSES
00167 !| PARTHENIADES   |-->| CONSTANT OF THE KRONE AND PARTHENIADES EROSION LAW (KG/M2/S)
00168 !| PI             |-->| PI
00169 !| QS             |<->| BEDLOAD TRANSPORT RATE
00170 !| QSCL           |<->| SUSPENDED LOAD TRANSPORT RATE
00171 !| QSCLXS         |<->| SUSPENDED LOAD TRANSPORT RATE FOR EACH CLASS X-DIRECTION
00172 !| QSCLYS         |<->| SUSPENDED LOAD TRANSPORT RATE FOR EACH CLASS Y-DIRECTION
00173 !| QSCL_C         |<->| BEDLOAD TRANSPORT RATE
00174 !| QSCL_S         |<->| SUSPENDED LOAD TRANSPORT RATE
00175 !| QSXS           |<->| SOLID DISCHARGE X (SUSPENSION)
00176 !| QSYS           |<->| SOLID DISCHARGE Y (SUSPENSION)
00177 !| QS_C           |-->| BEDLOAD TRANSPORT RATE
00178 !| QS_S           |<->| SUSPENDED LOAD TRANSPORT RATE
00179 !| SALFA          |<->| SINUS OF THE ANGLE BETWEEN TRANSPORT RATE AND CURRENT
00180 !| SECCURRENT     |-->| LOGICAL, PARAMETRISATION FOR SECONDARY CURRENTS
00181 !| SEDCO          |-->| LOGICAL, SEDIMENT COHESIVE OR NOT
00182 !| SLOPEFF        |-->| LOGICAL, SLOPING BED EFFECT OR NOT
00183 !| SUSP           |-->| LOGICAL, SUSPENSION
00184 !| T1             |<->| WORK BIEF_OBJ STRUCTURE
00185 !| T10            |<->| WORK BIEF_OBJ STRUCTURE
00186 !| T11            |<->| WORK BIEF_OBJ STRUCTURE
00187 !| T12            |<->| WORK BIEF_OBJ STRUCTURE
00188 !| T13            |<->| WORK BIEF_OBJ STRUCTURE
00189 !| T2             |<->| WORK BIEF_OBJ STRUCTURE
00190 !| T3             |<->| WORK BIEF_OBJ STRUCTURE
00191 !| T4             |<->| WORK BIEF_OBJ STRUCTURE
00192 !| T5             |<->| WORK BIEF_OBJ STRUCTURE
00193 !| T6             |<->| WORK BIEF_OBJ STRUCTURE
00194 !| T7             |<->| WORK BIEF_OBJ STRUCTURE
00195 !| T8             |<->| WORK BIEF_OBJ STRUCTURE
00196 !| T9             |<->| WORK BIEF_OBJ STRUCTURE
00197 !| THETAW         |-->| ANGLE BETWEEN WAVE AND CURRENT
00198 !| TOB            |<->| BED SHEAR STRESS (TOTAL FRICTION)
00199 !| TOBW           |-->| WAVE INDUCED SHEAR STRESS
00200 !| TW             |-->| WAVE PERIOD
00201 !| U2D            |<->| MEAN FLOW VELOCITY X-DIRECTION
00202 !| UCONV          |<->| X-COMPONENT ADVECTION FIELD (TELEMAC)
00203 !| UNLADM         |-->| MEAN DIAMETER OF ACTIVE STRATUM LAYER
00204 !| UNORM          |<->| NORM OF THE MEAN FLOW VELOCITY
00205 !| UW             |-->| ORBITAL WAVE VELOCITY
00206 !| V2D            |<->| MEAN FLOW VELOCITY Y-DIRECTION
00207 !| VCE            |-->| WATER VISCOSITY
00208 !| VCONV          |<->| Y-COMPONENT ADVECTION FIELD
00209 !| VITCD          |-->| CRITICAL SHEAR VELOCITY FOR MUD DEPOSITION
00210 !| VITCE          |-->| CRITICAL EROSION SHEAR VELOCITY OF THE MUD
00211 !| XMVE           |-->| FLUID DENSITY
00212 !| XMVS           |-->| WATER DENSITY
00213 !| XWC            |-->| SETTLING VELOCITY
00214 !| ZERO           |-->| ZERO
00215 !| ZREF           |-->| REFERENCE ELEVATION
00216 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00217 !
00218       USE BIEF
00219       USE INTERFACE_SISYPHE, EX_INIT_TRANSPORT => INIT_TRANSPORT
00220 !
00221       USE DECLARATIONS_SISYPHE, ONLY : NOMBLAY,MPM_ARAY,MPM
00222 !
00223       IMPLICIT NONE
00224       INTEGER LNG,LU
00225       COMMON/INFO/LNG,LU
00226 !
00227 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00228 !
00229       INTEGER, INTENT(IN)              :: NSICLA,NPOIN,TROUVE(*),ICQ
00230       INTEGER, INTENT(IN)              :: ICF,HIDFAC,IELMT,SLOPEFF
00231       LOGICAL, INTENT(IN)              :: CHARR,DEBU,SUSP,IMP_INFLOW_C
00232       LOGICAL, INTENT(IN)              :: CORR_CONV,SECCURRENT,SEDCO(*)
00233       LOGICAL, INTENT(IN)              :: HOULE
00234       TYPE(BIEF_OBJ),    INTENT(IN)    :: U2D,V2D,UNORM,HN,CF
00235       TYPE(BIEF_OBJ),    INTENT(IN)    :: MU,TOB,TOBW,UW,TW,THETAW,FW
00236       TYPE(BIEF_OBJ),    INTENT(IN)    :: ACLADM,UNLADM,KSP,KSR,KS
00237       TYPE(BIEF_OBJ),    INTENT(INOUT) :: HIDING
00238       TYPE(BIEF_OBJ),    INTENT(INOUT) :: QS_C, QSXC, QSYC, CALFA,SALFA
00239       TYPE(BIEF_OBJ),    INTENT(INOUT) :: T1,T2,T3,T4,T5,T6,T7,T8
00240       TYPE(BIEF_OBJ),    INTENT(INOUT) :: T9,T10,T11,T12,T14
00241       TYPE(BIEF_OBJ),    INTENT(INOUT) :: ZREF,CSTAEQ,CSRATIO
00242       TYPE(BIEF_OBJ),    INTENT(INOUT) :: CS,UCONV,VCONV
00243       TYPE(BIEF_OBJ),    INTENT(INOUT) :: QS_S,QS,QSCL_C,QSCL_S
00244       TYPE(BIEF_OBJ),    INTENT(INOUT) :: COEFPN
00245       TYPE(BIEF_OBJ),    INTENT(INOUT) :: QSCLXS,QSCLYS,QSCL
00246       TYPE(BIEF_MESH),   INTENT(INOUT) :: MESH
00247       DOUBLE PRECISION,  INTENT(IN)    :: XMVS,XMVE,GRAV,VCE
00248       DOUBLE PRECISION,  INTENT(IN)    :: HMIN,KARMAN,ZERO,PI
00249       DOUBLE PRECISION,  INTENT(IN)    :: PARTHENIADES,BIJK,XWC(NSICLA)
00250       DOUBLE PRECISION,  INTENT(IN)    :: FD90(NSICLA),CS0(NSICLA)
00251       DOUBLE PRECISION,  INTENT(IN)    :: VITCE,VITCD
00252       DOUBLE PRECISION,  INTENT(INOUT) :: AC(NSICLA),CMAX,FDM(NSICLA)
00253       DOUBLE PRECISION,  INTENT(INOUT) :: AVAIL(NPOIN,NOMBLAY,NSICLA)
00254 !
00255       TYPE(BIEF_OBJ),    INTENT(IN)    :: U3D,V3D
00256       CHARACTER(LEN=24), INTENT(IN)    :: CODE
00257 !
00258 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00259 !
00260       INTEGER I,J
00261       DOUBLE PRECISION AT0,AAA,USTARP,U3DNORM
00262       LOGICAL NEED_CS
00263 !
00264 !======================================================================!
00265 !======================================================================!
00266 !                               PROGRAM                                !
00267 !======================================================================!
00268 !======================================================================!
00269 !
00270 ! --- START : INITIALISES RATE OF TRANSPORT AND SUSPENSION
00271 !
00272 !     FOR INITIALISATION : SLOPE EFFECT AND DEVIATION ARE CANCELLED
00273 !
00274 !     RK in case of coupling with T3D, the direction should
00275 !     come from the bottom velocity
00276 !
00277       IF(CODE(1:9).EQ.'TELEMAC3D') THEN
00278         DO I=1,NPOIN
00279           U3DNORM=SQRT(U3D%R(I)*U3D%R(I)+V3D%R(I)*V3D%R(I))
00280           IF(U3DNORM.GE.1.D-12) THEN
00281             CALFA%R(I)=U3D%R(I)/U3DNORM
00282             SALFA%R(I)=V3D%R(I)/U3DNORM
00283           ELSE
00284             CALFA%R(I)=1.D0
00285             SALFA%R(I)=0.D0
00286           ENDIF
00287         ENDDO
00288       ELSE
00289         CALL OS('X=Y/Z   ',CALFA, U2D, UNORM, 0.D0, 2, 1.D0, 1.D-12)
00290         CALL OS('X=Y/Z   ',SALFA, V2D, UNORM, 0.D0, 2, 0.D0, 1.D-12)
00291       ENDIF
00292 !
00293 !     appel a effpnt ?
00294 !
00295       CALL OS('X=C     ',X=COEFPN,C=1.D0)
00296 !
00297       IF(CHARR) THEN
00298 !
00299 !       MPM for each Layer
00300 !
00301         CALL OS('X=C     ', X=MPM_ARAY, C=MPM)
00302 !
00303         CALL OS('X=C     ',X=HIDING,C=1.D0)
00304 !
00305         DO I = 1, NSICLA
00306 !
00307           IF(SEDCO(I)) THEN
00308 !           IF COHESIVE: NO BEDLOAD TRANSPORT
00309             CALL OS('X=0     ', QSCL_C%ADR(I)%P)
00310           ELSE
00311 !           IF NON COHESIVE
00312             CALL BEDLOAD_FORMULA
00313      &        (U2D,V2D,UNORM,HN,CF,MU,TOB,TOBW,UW,TW,THETAW,FW,
00314      &        ACLADM, UNLADM,KSP,KSR,AVAIL(1:NPOIN,1,I),
00315      &        NPOIN,ICF,HIDFAC,XMVS,XMVE,
00316      &        FDM(I),GRAV,VCE,HMIN,XWC(I),FD90(I),KARMAN,ZERO,
00317      &        PI,SUSP,AC(I),HIDING,T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,
00318      &        T11,T12,QSCL_C%ADR(I)%P,QSCL_S%ADR(I)%P,
00319      &        IELMT,SECCURRENT,SLOPEFF,COEFPN,BIJK,HOULE)
00320 !
00321           ENDIF
00322 !         SUM ON ALL CLASSES
00323           DO J=1,NPOIN
00324             QS_C%R(J) = QS_C%R(J) + QSCL_C%ADR(I)%P%R(J)
00325           ENDDO
00326 !
00327         ENDDO
00328 !
00329 !       COMPUTES THE X AND Y COMPONENTS OF TRANSPORT
00330 !
00331         CALL OS('X=YZ    ', X=QSXC, Y=QS_C, Z=CALFA)
00332         CALL OS('X=YZ    ', X=QSYC, Y=QS_C, Z=SALFA)
00333 !
00334       ENDIF
00335 !
00336 !     START : COMPUTES THE SUSPENDED TRANSPORT
00337 !
00338       IF(SUSP) THEN
00339 !
00340 !       INITIALISES ZREF
00341 !
00342         IF(ICQ.EQ.1) THEN
00343           CALL OS('X=Y     ', X=ZREF, Y=KSP)
00344         ELSEIF(ICQ.EQ.2) THEN
00345           CALL OS('X=Y     ', X=ZREF, Y=KSR)
00346         ELSEIF(ICQ.EQ.3) THEN
00347           CALL OS('X=CY    ', X=ZREF, Y=KS,C=0.5D0)
00348         ENDIF
00349 !
00350 !       CORRECTION JMH 15/01/2013: 21 CHANGED INTO 22
00351 !
00352 !       FOR RANK OF CS IN TROUVE SEE POINT_SISYPHE, NOMVAR_SISYPHE
00353 !       22+I+(NOMBLAY+1)*NSICLA IS THE ADDRESS OF CONCENTRATIONS
00354 !
00355         NEED_CS=.FALSE.
00356         DO I=1,NSICLA
00357           IF(TROUVE(22+I+(NOMBLAY+1)*NSICLA).EQ.0) NEED_CS=.TRUE.
00358         ENDDO
00359 !
00360 !       COMPUTES THE INITIAL CONCENTRATIONS
00361 !
00362         IF(.NOT.DEBU.OR.NEED_CS) THEN
00363 !
00364           CALL CONDIM_SUSP(CS,CS0,NSICLA,MESH%X%R,MESH%Y%R,AT0,NPOIN)
00365 !
00366 !         END MODIFICATIONS (CV)
00367 !         OPTION: IMPOSED INFLOW CONCENTRATIONS ...
00368 !
00369           IF(IMP_INFLOW_C) THEN
00370 !
00371 !           TAUP IN T8
00372             CALL OS('X=CYZ   ', X=T8, Y=TOB, Z=MU, C=1.D0)
00373 !           USTAR (TOTAL) IN T9
00374             CALL OS('X=CY    ', X=T9, Y=TOB, C=1.D0/XMVE)
00375             CALL OS('X=SQR(Y)', X=T9, Y=T9)
00376 !
00377 !           START: LOOP ON THE CLASSES
00378 !
00379             DO I=1,NSICLA
00380 !
00381               IF(.NOT.SEDCO(I)) THEN
00382 !
00383 !               NON COHESIVE SED: INITIALISES CSTAEQ
00384 !
00385                 IF(ICQ.EQ.1) THEN
00386                   CALL SUSPENSION_FREDSOE( FDM(I) ,T8,NPOIN,
00387      &                GRAV, XMVE, XMVS, ZERO, AC(I),  CSTAEQ )
00388                 ELSEIF(ICQ.EQ.2) THEN
00389                   CALL SUSPENSION_BIJKER(T8,HN,NPOIN,CHARR,QS_C,ZREF,
00390      &                                   ZERO,HMIN,CSTAEQ,XMVE)
00391                 ELSEIF(ICQ.EQ.3) THEN
00392                   CALL SUSPENSION_VANRIJN(FDM(I),T8,NPOIN,
00393      &               GRAV,XMVE,XMVS,VCE,ZERO,AC(I), CSTAEQ,ZREF)
00394                 ELSEIF(ICQ.EQ.4) THEN
00395                   CSRATIO%R=1D0
00396                   CALL SUSPENSION_SANDFLOW(FDM(I),FD90(I),T8,NPOIN,
00397      &                                     GRAV,XMVE,XMVS,ZERO,AC(I),
00398      &                                     CSTAEQ,ZREF,HN,U2D,V2D,
00399      &                                     CSRATIO)
00400                 ENDIF
00401 !               ROUSE CONCENTRATION PROFILE IS ASSUMED BASED ON TOTAL FRICTION
00402 !               VELOCITY
00403 !
00404                 CALL SUSPENSION_ROUSE(T9,HN,NPOIN,
00405      &                             KARMAN,HMIN,ZERO,XWC(I),ZREF,T12)
00406 !
00407                 DO J=1,NPOIN
00408                   CSTAEQ%R(J)=CSTAEQ%R(J)*AVAIL(J,1,I)
00409                 ENDDO
00410 !               CALL OS( 'X=XY    ',X=CSTAEQ,Y=AVAI%ADR(I)%P)
00411                 CALL OS( 'X=Y/Z   ',X=CS%ADR(I)%P,Y=CSTAEQ,Z=T12)
00412 !
00413 !               END NON-COHESIVE
00414 !
00415               ELSE
00416 !
00417 !               FOR COHESIVE SEDIMENT
00418 !
00419 !               THIS VALUE CAN BE ALSO CHANGED BY THE USER
00420 !               IN SUBROUTINE USER_KRONE_PARTHENIADES
00421 !
00422                 CALL OS('X=Y     ', X=ZREF, Y=KSP)
00423 !
00424                 CMAX = MAX(CMAX,PARTHENIADES/XWC(I))
00425 !
00426                 IF(VITCE.GT.1.D-8.AND.VITCD.GT.1.D-8) THEN
00427                   DO J = 1, NPOIN
00428 !                 FLUER
00429                   USTARP= SQRT(T8%R(J)/XMVE)
00430                   AAA= PARTHENIADES*
00431      &                MAX(((USTARP/VITCE)**2-1.D0),ZERO)
00432 !                 FLUDPT
00433 !                 BBB=XWC(I)*MAX((1.D0-(USTARP/VITCD)**2),ZERO)
00434 !                 IF NO DEPOSITION, THE EQUILIBRIUM CONCENTRATION IS INFINITE!
00435                   CS%ADR(I)%P%R(J) = AAA/XWC(I)
00436 !
00437                   ENDDO
00438                 ELSE
00439                   CALL OS('X=0     ',X=CS%ADR(I)%P)
00440                 ENDIF
00441 !
00442                 DO J=1,NPOIN
00443                   CS%ADR(I)%P%R(J)=CS%ADR(I)%P%R(J)*AVAIL(J,1,I)
00444                 ENDDO
00445 !
00446 ! END COHESIVE
00447 !
00448               ENDIF
00449 !
00450 ! END OF LOOP ON THE CLASSES
00451 !
00452             ENDDO
00453 !
00454 ! END OF OPTION: IMPOSED INFLOW CONCENTRATION
00455 !
00456           ENDIF
00457 !
00458 ! END OF IF(.NOT.DEBU.OR.NEED_CS.EQ.0)) THEN
00459 !
00460         ENDIF
00461 !
00462 ! COMPUTES SUSPENDED TRANSPORT
00463 !
00464         DO I=1,NSICLA
00465 !                                    UCONV DONE IN SUSPENSION_COMPUTATION
00466 !                                    HERE WE USE
00467 !                                    U2D AS TENTATIVE VALUE OF UCONV
00468           CALL OS('X=YZ    ',X=T11,Y=U2D, Z=HN)
00469           CALL OS('X=YZ    ',X=T12,Y=V2D, Z=HN)
00470 !
00471           CALL OS('X=YZ    ',X=QSCLXS%ADR(I)%P,Y=CS%ADR(I)%P,Z=T11)
00472           CALL OS('X=YZ    ',X=QSCLYS%ADR(I)%P,Y=CS%ADR(I)%P,Z=T12)
00473 !
00474           CALL OS('X=N(Y,Z) ',X=QSCL_S%ADR(I)%P,
00475      &                        Y=QSCLXS%ADR(I)%P,Z=QSCLYS%ADR(I)%P)
00476 !
00477         ENDDO
00478 
00479           DO J=1,NPOIN
00480             DO I=1,NSICLA
00481             QS_S%R(J) = QS_S%R(J) + QSCL_S%ADR(I)%P%R(J)
00482             ENDDO
00483           ENDDO
00484       ENDIF
00485 !
00486 ! END OF SUSPENSION
00487 !
00488 !
00489 !     COMPUTES THE TRANSPORT FOR EACH CLASS (IF NOT RESTART OR IF
00490 !                                              DATA NOT FOUND)
00491       DO I=1, NSICLA
00492         IF(LNG.EQ.1) THEN
00493           WRITE(LU,*) 'QSCL REINITIALISE DANS INIT_TRANSPORT'
00494           WRITE(LU,*) 'POUR LA CLASSE ',I
00495         ENDIF
00496         IF(LNG.EQ.2) THEN
00497           WRITE(LU,*) 'QSCL REINITIALISED IN INIT_TRANSPORT'
00498           WRITE(LU,*) 'FOR CLASS ',I
00499         ENDIF
00500         IF(CHARR.AND.SUSP) THEN
00501           CALL OS('X=Y+Z   ', X=QSCL%ADR(I)%P,
00502      &            Y=QSCL_S%ADR(I)%P, Z=QSCL_C%ADR(I)%P)
00503         ELSEIF(CHARR) THEN
00504           CALL OS('X=Y     ',X=QSCL%ADR(I)%P,Y=QSCL_C%ADR(I)%P)
00505         ELSEIF(SUSP) THEN
00506           CALL OS('X=Y     ',X=QSCL%ADR(I)%P,Y=QSCL_S%ADR(I)%P)
00507         ENDIF
00508       ENDDO
00509 !
00510 !     COMPUTES TOTAL TRANSPORT QS
00511 !
00512       IF(LNG.EQ.1) THEN
00513         WRITE(LU,*) 'QS REINITIALISE DANS INIT_TRANSPORT'
00514       ENDIF
00515       IF(LNG.EQ.2) THEN
00516         WRITE(LU,*) 'QS REINITIALISED IN INIT_TRANSPORT'
00517       ENDIF
00518       IF(CHARR.AND.SUSP) THEN
00519         CALL OS('X=Y+Z   ',X=QS,Y=QS_C,Z=QS_S)
00520       ELSEIF(CHARR) THEN
00521         CALL OS('X=Y     ',X=QS,Y=QS_C)
00522       ELSEIF(SUSP) THEN
00523         CALL OS('X=Y     ',X=QS,Y=QS_S)
00524       ENDIF
00525 !
00526 !-----------------------------------------------------------------------
00527 !
00528       RETURN
00529       END

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