calcul_q_weir.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\calcul_q_weir.f
00002 !
00070                         SUBROUTINE CALCUL_Q_WEIR
00071 !                       ************************
00072 !
00073      &    (NWEIRS,X,Y,ZF,HN,CHESTR,NKFROT,KARMAN,IOPTAN,NTRAC,T)
00074 !
00075 !***********************************************************************
00076 ! TELEMAC2D   V6P3                                   22/03/2013
00077 !***********************************************************************
00078 !
00079 !
00080 !+
00081 !
00082 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00083 !| CHESTR         |-->| FRICTION COEFFICIENT
00084 !| HN             |-->| DEPTH AT TIME T(N)
00085 !| IOPTAN         |-->| OPTION FOR TANGENTIAL VELOCITIES.
00086 !| KARMAN         |-->| VON KARMAN CONSTANT.
00087 !| NKFROT         |-->| FRICTION LAW, PER POINT
00088 !| NTRAC          |-->| NUMBER OF TRACERS
00089 !| NWEIRS         |-->| NUMBER OF WEIRS
00090 !| T              |-->| BLOCK OF TRACERS
00091 !| X              |-->| ABSCISSAE OF NODES
00092 !| Y              |-->| ORDINATES OF NODES
00093 !| ZF             |-->| BOTTOM
00094 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00095 !
00096       USE BIEF
00097       USE DECLARATIONS_TELEMAC2D, ONLY: NPSING,NDGA1,NDGA2,NDGB1,NDGB2,
00098      &                                  QWA,QWB,QP0,ZDIG,WDIG,
00099      &                                  UWEIRA,UWEIRB,VWEIRA,VWEIRB,
00100      &                                  TWEIRA,TWEIRB,MAXNPS
00101 !
00102       IMPLICIT NONE
00103       INTEGER LNG,LU
00104       COMMON/INFO/LNG,LU
00105 !
00106       INTEGER, INTENT(IN)           :: NWEIRS,IOPTAN,NTRAC
00107       INTEGER, INTENT(IN)           :: NKFROT(*)
00108       DOUBLE PRECISION, INTENT(IN)  :: X(*),Y(*),ZF(*),HN(*),CHESTR(*)
00109       DOUBLE PRECISION, INTENT(IN)  :: KARMAN
00110       TYPE(BIEF_OBJ)  , INTENT(IN)  :: T
00111 !
00112       INTEGER          I, N, ITRAC, INDIC
00113       INTEGER          IA1, IB1, IA2, IB2
00114       INTEGER          IC1, ID1, IC2, ID2
00115 !
00116       DOUBLE PRECISION PHI, GRAV, RELAX
00117       DOUBLE PRECISION YS1, YS2
00118       DOUBLE PRECISION SL_A1, SL_B1, SL_A2, SL_B2
00119       DOUBLE PRECISION SL_C1, SL_D1, SL_C2, SL_D2
00120       DOUBLE PRECISION ZF_A1, ZF_B1, ZF_A2, ZF_B2
00121       DOUBLE PRECISION ZF_C1, ZF_D1, ZF_C2, ZF_D2
00122       DOUBLE PRECISION H_A1, H_B1, H_A2, H_B2
00123       DOUBLE PRECISION H_C1, H_D1, H_C2, H_D2
00124       DOUBLE PRECISION SLA, SLB
00125       DOUBLE PRECISION ZFA, ZFB
00126       DOUBLE PRECISION HSA, HSB
00127       DOUBLE PRECISION HA, HB, HMIN
00128       DOUBLE PRECISION QELEM
00129       DOUBLE PRECISION TXA,TYA,DLA,NXA,NYA
00130       DOUBLE PRECISION TXB,TYB,DLB,NXB,NYB
00131       DOUBLE PRECISION UTANA, UTANB, UTANC, UTAND
00132       DOUBLE PRECISION PENTA,PENTB
00133       DOUBLE PRECISION DENOM
00134 !
00135       DOUBLE PRECISION XP_A1,XP_B1,XP_A2,XP_B2
00136       DOUBLE PRECISION XP_C1,XP_D1,XP_C2,XP_D2
00137       DOUBLE PRECISION YP_A1,YP_B1,YP_A2,YP_B2
00138       DOUBLE PRECISION YP_C1,YP_D1,YP_C2,YP_D2
00139 !
00140       DOUBLE PRECISION TRAC_A1(NTRAC),TRAC_B1(NTRAC)
00141       DOUBLE PRECISION TRAC_A2(NTRAC),TRAC_B2(NTRAC)
00142       DOUBLE PRECISION TRAC_C1(NTRAC),TRAC_D1(NTRAC)
00143       DOUBLE PRECISION TRAC_C2(NTRAC),TRAC_D2(NTRAC)
00144       DOUBLE PRECISION TRAC_A(NTRAC) ,TRAC_B(NTRAC)
00145       DOUBLE PRECISION TRAC_C(NTRAC) ,TRAC_D(NTRAC)
00146 !
00147       DOUBLE PRECISION P_DMAX,P_DMIN
00148       EXTERNAL         P_DMAX,P_DMIN
00149 !
00150 !-----------------------------------------------------------------------
00151 !
00152 !
00153       HMIN = 1.D-3
00154       PHI = 0.4
00155       GRAV = 9.81D0
00156       RELAX = 0.5D0 ! eventuellement à rendre paramétrable dans le fichier des seuils
00157 !
00158       DO N = 1, NWEIRS
00159         CALL OS('X=0     ',X=QWA%ADR(N)%P)
00160         CALL OS('X=0     ',X=QWB%ADR(N)%P)
00161         CALL OS('X=0     ',X=UWEIRA%ADR(N)%P)
00162         CALL OS('X=0     ',X=UWEIRB%ADR(N)%P)
00163         CALL OS('X=0     ',X=VWEIRA%ADR(N)%P)
00164         CALL OS('X=0     ',X=VWEIRB%ADR(N)%P)
00165       ENDDO
00166 !
00167       DO ITRAC = 1, NTRAC
00168         CALL OS('X=0     ',X=TWEIRA%ADR(ITRAC)%P)
00169         CALL OS('X=0     ',X=TWEIRB%ADR(ITRAC)%P)
00170       ENDDO
00171 !
00172       DO N = 1, NWEIRS
00173         DO I = 1 ,NPSING%I(N)-1   !LOOP ON ELEMENTARY PEACE OF WEIRS
00174 !         FIND THE NODES OF MESH AROUND THE NODE COMPOSING THE WEIR
00175           IA1 = NDGA1%ADR(N)%P%I(I)
00176           IB1 = NDGB1%ADR(N)%P%I(I)
00177           IA2 = NDGA2%ADR(N)%P%I(I)
00178           IB2 = NDGB2%ADR(N)%P%I(I)
00179           IC1 = NDGA1%ADR(N)%P%I(I+1)
00180           ID1 = NDGB1%ADR(N)%P%I(I+1)
00181           IC2 = NDGA2%ADR(N)%P%I(I+1)
00182           ID2 = NDGB2%ADR(N)%P%I(I+1)
00183 !         FIND THE VALUE OF BOTTOM, WATER LEVEL, TRACER
00184 !           AND ALSO POSITION OF NODES
00185           CALL COLLECT_VALUES(X,Y,ZF,HN,NTRAC,T,
00186      &       IA1,XP_A1,YP_A1,ZF_A1,H_A1,SL_A1,TRAC_A1)
00187           CALL COLLECT_VALUES(X,Y,ZF,HN,NTRAC,T,
00188      &       IB1,XP_B1,YP_B1,ZF_B1,H_B1,SL_B1,TRAC_B1)
00189           CALL COLLECT_VALUES(X,Y,ZF,HN,NTRAC,T,
00190      &       IA2,XP_A2,YP_A2,ZF_A2,H_A2,SL_A2,TRAC_A2)
00191           CALL COLLECT_VALUES(X,Y,ZF,HN,NTRAC,T,
00192      &       IB2,XP_B2,YP_B2,ZF_B2,H_B2,SL_B2,TRAC_B2)
00193           CALL COLLECT_VALUES(X,Y,ZF,HN,NTRAC,T,
00194      &       IC1,XP_C1,YP_C1,ZF_C1,H_C1,SL_C1,TRAC_C1)
00195           CALL COLLECT_VALUES(X,Y,ZF,HN,NTRAC,T,
00196      &       ID1,XP_D1,YP_D1,ZF_D1,H_D1,SL_D1,TRAC_D1)
00197           CALL COLLECT_VALUES(X,Y,ZF,HN,NTRAC,T,
00198      &       IC2,XP_C2,YP_C2,ZF_C2,H_C2,SL_C2,TRAC_C2)
00199           CALL COLLECT_VALUES(X,Y,ZF,HN,NTRAC,T,
00200      &       ID2,XP_D2,YP_D2,ZF_D2,H_D2,SL_D2,TRAC_D2)
00201 !
00202 !         COMPUTE MEAN VALUE
00203 !
00204           SLA = 0.25D0 * (SL_A1 +SL_A2 +SL_C1 +SL_C2 )
00205           SLB = 0.25D0 * (SL_B1 +SL_B2 +SL_D1 +SL_D2 )
00206           ZFA = 0.25D0 * (ZF_A1 +ZF_A2 +ZF_C1 +ZF_C2 )
00207           ZFB = 0.25D0 * (ZF_B1 +ZF_B2 +ZF_D1 +ZF_D2 )
00208           HA  = 0.25D0 * ( H_A1 + H_A2 + H_C1 + H_C2 )
00209           HB  = 0.25D0 * ( H_B1 + H_B2 + H_D1 + H_D2 )
00210           DO ITRAC = 1, NTRAC
00211             TRAC_A(ITRAC) = 0.5D0 * (TRAC_A1(ITRAC)+TRAC_A2(ITRAC))
00212             TRAC_B(ITRAC) = 0.5D0 * (TRAC_B1(ITRAC)+TRAC_B2(ITRAC))
00213             TRAC_C(ITRAC) = 0.5D0 * (TRAC_C1(ITRAC)+TRAC_C2(ITRAC))
00214             TRAC_D(ITRAC) = 0.5D0 * (TRAC_D1(ITRAC)+TRAC_D2(ITRAC))
00215           ENDDO
00216 !
00217 !         CALCULATES THE NORMAL VECTOR, OUTGOING SIDE A, ENTERING SIDE B
00218 !
00219           TXA=XP_C2-XP_A1
00220           TYA=YP_C2-YP_A1
00221           DLA=SQRT(TXA**2+TYA**2)
00222           TXA=TXA/DLA
00223           TYA=TYA/DLA
00224           NXA=-TYA
00225           NYA=TXA
00226 !
00227           TXB=XP_D2-XP_B1
00228           TYB=YP_D2-YP_B1
00229           DLB=SQRT(TXB**2+TYB**2)
00230           TXB=TXB/DLB
00231           TYB=TYB/DLB
00232           NXB=-TYB
00233           NYB=TXB
00234 !
00235 !         COMPUTATION OF THE DISCHARGE
00236 !
00237 !         ADDING A SECURITY ON THE LEVEL OF THE WEIR
00238           YS1 = DMAX1(ZDIG%ADR(N)%P%R(I)  ,ZFA+0.01D0,ZFB+0.01D0)
00239           YS2 = DMAX1(ZDIG%ADR(N)%P%R(I+1),ZFA+0.01D0,ZFB+0.01D0)
00240 !
00241           QELEM = 0.D0
00242 !         UPSTREAM IS ON SIDE A
00243           IF (SLA.GT.SLB) THEN
00244             IF (HA.GT.0.01D0) THEN
00245               CALL LOI_W_INC(SLA,SLB,YS1,YS2,WDIG%ADR(N)%P%R(I),
00246      &                       PHI,QELEM,GRAV)
00247             ELSE
00248               QELEM=0.D0
00249             ENDIF
00250 !         UPSTREAM IS ON SIDE B
00251           ELSE
00252             IF (HB.GT.0.01D0) THEN
00253               CALL LOI_W_INC(SLB,SLA,YS1,YS2,WDIG%ADR(N)%P%R(I),
00254      &                       PHI,-QELEM,GRAV)
00255             ELSE
00256               QELEM=0.D0
00257             ENDIF
00258           ENDIF
00259 !
00260           QELEM = (QELEM*(1D0-RELAX)+QP0%ADR(N)%P%R(I)*RELAX)
00261           QP0%ADR(N)%P%R(I)=QELEM
00262 !
00263 !       DISTRIBUTE THE COMPUTED DISCHARGE OF EACH ELEMENTS OF WEIRS ON NODES
00264 !       QELEM > 0 means the flow is from side A to side B
00265 !
00266           QWA%ADR(N)%P%R(I)   = QWA%ADR(N)%P%R(I  ) - 0.5D0 * QELEM
00267           QWA%ADR(N)%P%R(I+1) = QWA%ADR(N)%P%R(I+1) - 0.5D0 * QELEM
00268           QWB%ADR(N)%P%R(I)   = QWB%ADR(N)%P%R(I  ) + 0.5D0 * QELEM
00269           QWB%ADR(N)%P%R(I+1) = QWB%ADR(N)%P%R(I+1) + 0.5D0 * QELEM
00270 !
00271 ! COMPUTATION OF TRACERS ACCORDING THE COMPUTED DISCHARGE
00272 !
00273           IF(NTRAC.GT.0) THEN
00274             INDIC = (N-1)*MAXNPS + I
00275             DO ITRAC=1,NTRAC
00276               IF(QELEM.GT.0.D0) THEN ! A --> B
00277                 IF(IA1.GT.0) THEN
00278                   TWEIRA%ADR(ITRAC)%P%R(INDIC  ) = TRAC_A(ITRAC) *
00279      &               0.5D0 * QELEM + TWEIRA%ADR(ITRAC)%P%R(INDIC  )
00280                   TWEIRA%ADR(ITRAC)%P%R(INDIC+1) = TRAC_C(ITRAC) *
00281      &               0.5D0 * QELEM + TWEIRA%ADR(ITRAC)%P%R(INDIC+1)
00282                   TWEIRB%ADR(ITRAC)%P%R(INDIC  ) = TRAC_A(ITRAC) *
00283      &               0.5D0 * QELEM + TWEIRB%ADR(ITRAC)%P%R(INDIC  )
00284                   TWEIRB%ADR(ITRAC)%P%R(INDIC+1) = TRAC_C(ITRAC) *
00285      &               0.5D0 * QELEM + TWEIRB%ADR(ITRAC)%P%R(INDIC+1)
00286                 ELSE
00287                   TWEIRA%ADR(ITRAC)%P%R(INDIC  ) = 0.D0 +
00288      &               TWEIRA%ADR(ITRAC)%P%R(INDIC  )
00289                   TWEIRA%ADR(ITRAC)%P%R(INDIC+1) = 0.D0 +
00290      &               TWEIRA%ADR(ITRAC)%P%R(INDIC+1)
00291                   TWEIRB%ADR(ITRAC)%P%R(INDIC  ) = 0.D0 +
00292      &               TWEIRB%ADR(ITRAC)%P%R(INDIC  )
00293                   TWEIRB%ADR(ITRAC)%P%R(INDIC+1) = 0.D0 +
00294      &               TWEIRB%ADR(ITRAC)%P%R(INDIC+1)
00295                 ENDIF
00296               ELSEIF(QELEM.LT.0.D0) THEN ! B --> A
00297                 IF(IB1.GT.0) THEN
00298                   TWEIRA%ADR(ITRAC)%P%R(INDIC  ) = -TRAC_B(ITRAC) *
00299      &               0.5D0 * QELEM + TWEIRA%ADR(ITRAC)%P%R(INDIC  )
00300                   TWEIRA%ADR(ITRAC)%P%R(INDIC+1) = -TRAC_D(ITRAC) *
00301      &               0.5D0 * QELEM + TWEIRA%ADR(ITRAC)%P%R(INDIC+1)
00302                   TWEIRB%ADR(ITRAC)%P%R(INDIC  ) = -TRAC_B(ITRAC) *
00303      &               0.5D0 * QELEM + TWEIRB%ADR(ITRAC)%P%R(INDIC  )
00304                   TWEIRB%ADR(ITRAC)%P%R(INDIC+1) = -TRAC_D(ITRAC) *
00305      &               0.5D0 * QELEM + TWEIRB%ADR(ITRAC)%P%R(INDIC+1)
00306                 ELSE
00307                   TWEIRA%ADR(ITRAC)%P%R(INDIC  ) = 0.D0 +
00308      &               TWEIRA%ADR(ITRAC)%P%R(INDIC  )
00309                   TWEIRA%ADR(ITRAC)%P%R(INDIC+1) = 0.D0 +
00310      &               TWEIRA%ADR(ITRAC)%P%R(INDIC+1)
00311                   TWEIRB%ADR(ITRAC)%P%R(INDIC  ) = 0.D0 +
00312      &               TWEIRB%ADR(ITRAC)%P%R(INDIC  )
00313                   TWEIRB%ADR(ITRAC)%P%R(INDIC+1) = 0.D0 +
00314      &               TWEIRB%ADR(ITRAC)%P%R(INDIC+1)
00315                 ENDIF
00316               ELSE ! No Flow
00317                   TWEIRA%ADR(ITRAC)%P%R(INDIC  ) = 0.D0 +
00318      &               TWEIRA%ADR(ITRAC)%P%R(INDIC  )
00319                   TWEIRA%ADR(ITRAC)%P%R(INDIC+1) = 0.D0 +
00320      &               TWEIRA%ADR(ITRAC)%P%R(INDIC+1)
00321                   TWEIRB%ADR(ITRAC)%P%R(INDIC  ) = 0.D0 +
00322      &               TWEIRB%ADR(ITRAC)%P%R(INDIC  )
00323                   TWEIRB%ADR(ITRAC)%P%R(INDIC+1) = 0.D0 +
00324      &               TWEIRB%ADR(ITRAC)%P%R(INDIC+1)
00325               ENDIF
00326               IF(NCSIZE.GT.1) THEN
00327                 TWEIRA%ADR(ITRAC)%P%R(INDIC)=
00328      &            P_DMAX(MAX( TWEIRA%ADR(ITRAC)%P%R(INDIC)  ,0.D0))
00329      &           -P_DMIN(MAX(-TWEIRA%ADR(ITRAC)%P%R(INDIC)  ,0.D0))
00330                 TWEIRA%ADR(ITRAC)%P%R(INDIC+1)=
00331      &            P_DMAX(MAX( TWEIRA%ADR(ITRAC)%P%R(INDIC+1),0.D0))
00332      &           -P_DMIN(MAX(-TWEIRA%ADR(ITRAC)%P%R(INDIC+1),0.D0))
00333                 TWEIRB%ADR(ITRAC)%P%R(INDIC)=
00334      &            P_DMAX(MAX( TWEIRB%ADR(ITRAC)%P%R(INDIC)  ,0.D0))
00335      &           -P_DMIN(MAX(-TWEIRB%ADR(ITRAC)%P%R(INDIC)  ,0.D0))
00336                 TWEIRB%ADR(ITRAC)%P%R(INDIC+1)=
00337      &            P_DMAX(MAX( TWEIRB%ADR(ITRAC)%P%R(INDIC+1),0.D0))
00338      &           -P_DMIN(MAX(-TWEIRB%ADR(ITRAC)%P%R(INDIC+1),0.D0))
00339               ENDIF
00340             ENDDO
00341           ENDIF
00342 !
00343 ! COMPUTATION OF VELOCITIES
00344 !
00345 !
00346 !         CALCULATES THE TANGENTIAL VELOCITY
00347 !
00348           IF(IOPTAN.EQ.0) THEN
00349             UTANA = 0.D0
00350             UTANB = 0.D0
00351           ELSEIF(IOPTAN.EQ.1) THEN
00352             HSA = MAX(SLA - 0.5D0 * (YS1 + YS2), 0.D0)
00353             HSB = MAX(SLB - 0.5D0 * (YS1 + YS2), 0.D0)
00354             PENTA = (SL_C2 - SL_A1) / DLA
00355             PENTB = (SL_D2 - SL_B1) / DLB
00356             CALL CALCUL_TANG_W2(IA1,NKFROT,CHESTR,HSA,PENTA,KARMAN,
00357      &         UTANA)
00358             CALL CALCUL_TANG_W2(IC2,NKFROT,CHESTR,HSA,PENTA,KARMAN,
00359      &         UTANC)
00360             CALL CALCUL_TANG_W2(IB1,NKFROT,CHESTR,HSB,PENTB,KARMAN,
00361      &         UTANB)
00362             CALL CALCUL_TANG_W2(ID2,NKFROT,CHESTR,HSB,PENTB,KARMAN,
00363      &         UTAND)
00364           ELSE
00365             IF (LNG.EQ.1) THEN
00366               WRITE(LU,*)'CLHUVT : OPTION INCONNUE :',IOPTAN
00367               WRITE(LU,*)'         POUR LES VITESSES TANGENTIELLES'
00368             ELSEIF(LNG.EQ.2) THEN
00369               WRITE(LU,*)'CLHUVT : UNKNOWN OPTION:',IOPTAN
00370               WRITE(LU,*)'         FOR THE TANGENTIAL VELOCITY'
00371             ENDIF
00372             CALL PLANTE(1)
00373             STOP
00374           ENDIF
00375 !
00376 !         ONE CALCULATES VELOCITY COMPONENTS U AND V
00377 !         IN THE ORDINARY COORDINATE SYSTEM (X,Y).
00378 !
00379           IF(ABS(QELEM).GT.0.D0) THEN
00380             UWEIRA%ADR(N)%P%R(I)   = UTANA * TXA + QELEM * NXA / HA +
00381      &         UWEIRA%ADR(N)%P%R(I)
00382             VWEIRA%ADR(N)%P%R(I)   = UTANA * TYA + QELEM * NYA / HA +
00383      &         VWEIRA%ADR(N)%P%R(I)
00384             UWEIRA%ADR(N)%P%R(I+1) = UTANC * TXA + QELEM * NXA / HA +
00385      &         UWEIRA%ADR(N)%P%R(I+1)
00386             VWEIRA%ADR(N)%P%R(I+1) = UTANC * TYA + QELEM * NYA / HA +
00387      &         VWEIRA%ADR(N)%P%R(I+1)
00388             UWEIRB%ADR(N)%P%R(I)   = UTANB * TXB + QELEM * NXB / HB +
00389      &         UWEIRB%ADR(N)%P%R(I)
00390             VWEIRB%ADR(N)%P%R(I)   = UTANB * TYB + QELEM * NYB / HB +
00391      &         VWEIRB%ADR(N)%P%R(I)
00392             UWEIRB%ADR(N)%P%R(I+1) = UTAND * TXB + QELEM * NXB / HB +
00393      &         UWEIRB%ADR(N)%P%R(I+1)
00394             VWEIRB%ADR(N)%P%R(I+1) = UTAND * TYB + QELEM * NYB / HB +
00395      &         VWEIRB%ADR(N)%P%R(I+1)
00396           ELSE
00397             UWEIRA%ADR(N)%P%R(I)   = 0.D0 + UWEIRA%ADR(N)%P%R(I)
00398             VWEIRA%ADR(N)%P%R(I)   = 0.D0 + VWEIRA%ADR(N)%P%R(I)
00399             UWEIRA%ADR(N)%P%R(I+1) = 0.D0 + UWEIRA%ADR(N)%P%R(I+1)
00400             VWEIRA%ADR(N)%P%R(I+1) = 0.D0 + VWEIRA%ADR(N)%P%R(I+1)
00401             UWEIRB%ADR(N)%P%R(I)   = 0.D0 + UWEIRB%ADR(N)%P%R(I)
00402             VWEIRB%ADR(N)%P%R(I)   = 0.D0 + VWEIRB%ADR(N)%P%R(I)
00403             UWEIRB%ADR(N)%P%R(I+1) = 0.D0 + UWEIRB%ADR(N)%P%R(I+1)
00404             VWEIRB%ADR(N)%P%R(I+1) = 0.D0 + VWEIRB%ADR(N)%P%R(I+1)
00405           ENDIF
00406         ENDDO
00407       ENDDO
00408 !
00409 ! THE DISCHARGE IS NOW COMPUTED ON ALL NODES OF WEIRS
00410 ! SO WE COULD COMPUTE AN AVERAGE VALUE OF CONCENTRATION OF TRACERS
00411 !
00412       IF(NTRAC.GT.0) THEN
00413         DO N = 1, NWEIRS
00414           DO I = 1 ,NPSING%I(N)
00415             INDIC = (N-1)*MAXNPS + I
00416             QELEM = ABS(QWA%ADR(N)%P%R(I))
00417             IF(QELEM.GT.0.D0) THEN
00418               DENOM = 1.D0 / QELEM
00419               DO ITRAC = 1, NTRAC
00420                 TWEIRA%ADR(ITRAC)%P%R(INDIC) = DENOM *
00421      &             TWEIRA%ADR(ITRAC)%P%R(INDIC)
00422                 IF(NCSIZE.GT.1) THEN
00423                   TWEIRA%ADR(ITRAC)%P%R(INDIC)=
00424      &              P_DMAX(MAX( TWEIRA%ADR(ITRAC)%P%R(INDIC),0.D0))
00425      &             -P_DMIN(MAX(-TWEIRA%ADR(ITRAC)%P%R(INDIC),0.D0))
00426                 ENDIF
00427               ENDDO
00428             ENDIF
00429             QELEM = ABS(QWB%ADR(N)%P%R(I))
00430             IF(QELEM.GT.0.D0) THEN
00431               DENOM = 1.D0 / QELEM
00432               DO ITRAC = 1, NTRAC
00433                 TWEIRB%ADR(ITRAC)%P%R(INDIC) = DENOM *
00434      &             TWEIRB%ADR(ITRAC)%P%R(INDIC)
00435                 IF(NCSIZE.GT.1) THEN
00436                   TWEIRB%ADR(ITRAC)%P%R(INDIC)=
00437      &              P_DMAX(MAX( TWEIRB%ADR(ITRAC)%P%R(INDIC),0.D0))
00438      &             -P_DMIN(MAX(-TWEIRB%ADR(ITRAC)%P%R(INDIC),0.D0))
00439                 ENDIF
00440               ENDDO
00441             ENDIF
00442           ENDDO
00443         ENDDO
00444       ENDIF
00445 !
00446 ! END OF COMPUTATION OF TRACERS
00447 !
00448       RETURN
00449       END

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