cvsp_check_f.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\cvsp_check_f.f
00002 !
00058                      LOGICAL FUNCTION CVSP_CHECK_F
00059 !                    *****************************
00060 !
00061      &(J,K, SOMETEXT)
00062 !
00063 !***********************************************************************
00064 ! SISYPHE   V6P3                                   14/03/2013
00065 !***********************************************************************
00066 !
00067 !
00068 !
00069 !
00070 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00071 !| J              |<--| INDEX OF A POINT IN MESH
00072 !| K              |<--| INDEX OF A SECTION IN VERTICAL SORTING PROFILE
00073 !| SOMETEXT       |<--| DEBUGING TEXT FOR LOG-OUTPUT
00074 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00075 !
00076       USE BIEF_DEF, ONLY: IPID, NCSIZE
00077       USE BIEF
00078       USE DECLARATIONS_SISYPHE
00079 !
00080       IMPLICIT NONE
00081       INTEGER LNG,LU
00082       COMMON/INFO/LNG,LU
00083 !
00084 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00085 !
00086       INTEGER,          INTENT(IN)    :: J
00087       INTEGER,          INTENT(IN)    :: K
00088       CHARACTER*10,     INTENT(IN)    :: SOMETEXT
00089 !
00090 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00091 !
00092       DOUBLE PRECISION TEMP, AT
00093       INTEGER I, JG
00094 !
00095 !-----------------------------------------------------------------------
00096 !
00097       AT = DT*LT/PERCOU
00098       JG = J
00099       IF (NCSIZE > 1) JG = MESH%KNOLG%I(J)
00100 !
00101       CVSP_CHECK_F = .TRUE.
00102       TEMP = 0.D0
00103 !
00104 !-----------------------------------------------------------------------
00105 !SUM UP AND SLIGHT CORRECTION
00106 !-----------------------------------------------------------------------
00107 !
00108       DO I=1,NSICLA
00109         IF (PRO_F(J,K,I).LT.0.D0) THEN
00110           IF(PRO_F(J,K,I).GE.-1.D-8) THEN
00111             PRO_F(J,K,I) = 0.D0
00112           ELSE
00113             WRITE(LU,*) 'CF:,PRO_F <0: BAD !!'
00114      &                  ,SOMETEXT,JG,K,I,PRO_F(J,K,I)
00115           ENDIF
00116         ENDIF
00117 !
00118         TEMP = TEMP + PRO_F(J,K,I)
00119       ENDDO
00120 !
00121 !-----------------------------------------------------------------------
00122 ! CORRECT DEVIATIONS
00123 !-----------------------------------------------------------------------
00124 !
00125       IF(ABS(TEMP-1.D0).GT.0.D0) THEN
00126         IF(ABS(TEMP-1.D0).GT.1.D-6) THEN
00127 !         STRONG DIFFERENCES ARE CORRECTED BY NORMALIZING ALL FRACTIONS
00128           CVSP_CHECK_F = .FALSE.
00129           DO I=1,NSICLA
00130             IF(PRO_F(J,K,I).GT.0.D0) THEN
00131               PRO_F(J,K,I) = PRO_F(J,K,I) / TEMP
00132               EXIT
00133             ENDIF
00134           ENDDO
00135         ELSE
00136 !         SLIGHT DIFFERENCES TO 0 ARE CORRECTED BY CHANGING ONLY
00137 !         THE FIRST FRACTION BIG ENOUGH
00138           DO I=1,NSICLA
00139             IF(PRO_F(J,K,I).GT.ZERO) THEN
00140               PRO_F(J,K,I) = 1.D0-(TEMP-PRO_F(J,K,I))
00141               EXIT
00142             ENDIF
00143           ENDDO
00144         ENDIF
00145       ENDIF
00146 !
00147 !-----------------------------------------------------------------------
00148 !
00149       RETURN
00150       END FUNCTION CVSP_CHECK_F

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