collect_values.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\collect_values.f
00002 !
00052                         SUBROUTINE COLLECT_VALUES
00053 !                       *************************
00054 !
00055      &(X,Y,ZF,HN,NTRAC,T,IP,XP,YP,ZFP,HP,SLP,TRP)
00056 !
00057 !***********************************************************************
00058 ! TELEMAC2D   V6P3                                   09/07/2013
00059 !***********************************************************************
00060 !
00061 !
00062 !+
00063 !
00064 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00065 !| HN             |-->| DEPTH AT TIME T(N)
00066 !| HP             |-->| DEPTH OF NODE IP
00067 !| IP             |-->| INDEX OF THE INTERESTING NODE
00068 !| NTRAC          |-->| NUMBER OF TRACERS
00069 !| SLP            |<--| FREE SURFACE LEVEL OF NODE IP
00070 !| T              |-->| BLOCK OF TRACERS
00071 !| TRP            |<--| ARRAY OF TRACERS VALUES ON NODE IP
00072 !| X              |-->| ABSCISSAE OF NODES
00073 !| XP             |<--| ABSCISSAE OF NODE IP
00074 !| Y              |-->| ORDINATES OF NODES
00075 !| YP             |<--| ORDINATES OF NODE IP
00076 !| ZF             |-->| BOTTOM
00077 !| ZFP            |<--| BOTTOM LEVEL OF NODE IP
00078 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00079 !
00080       USE BIEF
00081 !
00082       IMPLICIT NONE
00083       INTEGER LNG,LU
00084       COMMON/INFO/LNG,LU
00085 !
00086       INTEGER, INTENT(IN)           :: NTRAC, IP
00087       DOUBLE PRECISION, INTENT(IN)  :: X(*),Y(*),ZF(*),HN(*)
00088       TYPE(BIEF_OBJ)  , INTENT(IN)  :: T
00089       DOUBLE PRECISION, INTENT(OUT) :: XP,YP,ZFP,HP,SLP
00090       DOUBLE PRECISION, INTENT(OUT) :: TRP(NTRAC)
00091 !
00092       INTEGER ITRAC
00093 !
00094       DOUBLE PRECISION P_DMAX,P_DMIN
00095       EXTERNAL         P_DMAX,P_DMIN
00096 !
00097 !-----------------------------------------------------------------------
00098 !
00099       IF(IP.GT.0) THEN
00100         ZFP = ZF(IP)
00101         HP  = HN(IP)
00102         SLP = HP + ZFP
00103         DO ITRAC = 1, NTRAC
00104           TRP(ITRAC) = T%ADR(ITRAC)%P%R(IP)
00105         ENDDO
00106         XP = X(IP)
00107         YP = Y(IP)
00108       ELSE
00109         ZFP = 0.D0
00110         HP  = 0.D0
00111         SLP = 0.D0
00112         DO ITRAC = 1, NTRAC
00113           TRP(ITRAC) = 0.D0
00114         ENDDO
00115         XP = 0.D0
00116         YP = 0.D0
00117       ENDIF
00118 !
00119       IF(NCSIZE.GT.1) THEN
00120         ZFP=P_DMAX(MAX(ZFP,0.D0))-P_DMIN(MAX(-ZFP,0.D0))
00121         HP =P_DMAX(MAX(HP ,0.D0))-P_DMIN(MAX(-HP ,0.D0))
00122         SLP=P_DMAX(MAX(SLP,0.D0))-P_DMIN(MAX(-SLP,0.D0))
00123         XP =P_DMAX(MAX(XP ,0.D0))-P_DMIN(MAX(-XP ,0.D0))
00124         YP =P_DMAX(MAX(YP ,0.D0))-P_DMIN(MAX(-YP ,0.D0))
00125         DO ITRAC = 1, NTRAC
00126            TRP(ITRAC) = P_DMAX(MAX( TRP(ITRAC),0.D0))
00127      &                - P_DMIN(MAX(-TRP(ITRAC),0.D0))
00128         ENDDO
00129       ENDIF
00130 !
00131       RETURN
00132       END

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