cvsp_compress_clean.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\cvsp_compress_clean.f
00002 !
00061                      SUBROUTINE CVSP_COMPRESS_CLEAN
00062 !                    ******************************
00063 !
00064      &(J)
00065 !
00066 !***********************************************************************
00067 ! SISYPHE   V6P3                                   14/03/2013
00068 !***********************************************************************
00069 !
00070 !
00071 !
00072 !
00073 !
00074 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00075 !| J              |<--| INDEX OF A POINT IN MESH
00076 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00077 !
00078       USE DECLARATIONS_SISYPHE
00079 !
00080       IMPLICIT NONE
00081       INTEGER,           INTENT(IN) :: J
00082 !
00083 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00084 !
00085       INTEGER  I,K, MARKERMAX, MARKERCNT,  TTT, JG
00086       INTEGER MARKER(PRO_MAX_MAX)
00087 !
00088 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00089 !
00090 ! STORES THE FRACTION ERRORS THAT WILL OCCURE IF THE POINT IS ELEMINATED FROM CURRENT PROFILE
00091 !
00092       DOUBLE PRECISION SUMFERR
00093 !
00094 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00095 !
00096 ! STORES THE MAXIMUM DISTANCE OF ANY NODE IN THE CURRENT LOOP
00097 !
00098       DOUBLE PRECISION  DIST, SUMF
00099       LOGICAL DB
00100 !
00101 !-----------------------------------------------------------------------
00102 ! LOCAL -> GLOBAL / PARALLEL STUFF
00103 !-----------------------------------------------------------------------
00104 !
00105       JG = J
00106       IF (NCSIZE.GT.1) JG = MESH%KNOLG%I(J)
00107 !
00108 !-----------------------------------------------------------------------
00109 ! INITIAL DEBUGGING OUTPUT ...
00110 !-----------------------------------------------------------------------
00111 !
00112       IF (DB(JG,0).EQV..TRUE.) CALL CVSP_P('./','V_W',JG)
00113 !
00114 !--------------------------------------------------------------------------
00115 ! INIT
00116 !-----------------------------------------------------------------------
00117 !
00118       IF(PRO_MAX(J) <= 2) RETURN
00119 !                                FIRST AND LAST POINT WILL ALWAYS BE KEPT
00120       MARKERMAX = 2             !MAXIMUM USED INDEX IN MARKER ARRAY
00121       MARKER(1) = 1             !FIRST WILL ALWAYS BE KEPT
00122       MARKERCNT = 1             !MAXIMUM USED INDEX IN MARKERTEMP ARRAY
00123 !
00124 !--------------------------------------------------------------------------
00125 ! TOP TO BOTTOM
00126 !-----------------------------------------------------------------------
00127 !
00128       DO TTT = 2,PRO_MAX(J)
00129         SUMF = 0.D0
00130         SUMFERR = 0.D0
00131         DO I = 1, NSICLA
00132           SUMF = PRO_F(J,TTT, I) + SUMF
00133           SUMFERR = ABS((PRO_F(J,TTT,I)-PRO_F(J,MARKER(MARKERCNT),I)))
00134      &         + SUMFERR
00135         ENDDO
00136 !
00137         IF (TTT > 1) THEN
00138           DIST = ABS((PRO_D(J,TTT,1)-PRO_D(J,MARKER(MARKERCNT),1)))
00139           IF ((DIST.GT.ZERO).OR.(SUMFERR.GT.0.D0)) THEN
00140             MARKERCNT = MARKERCNT + 1
00141             MARKER(MARKERCNT) = TTT
00142           ENDIF
00143         ENDIF
00144       ENDDO                     !TTT
00145 !
00146       MARKERMAX = MARKERCNT
00147 !
00148 !--------------------------------------------------------------------------
00149 ! RECREATE THE SORTING PROFILE WITH LESSER NUMBER OF NODES=LAYERS
00150 !-----------------------------------------------------------------------
00151 !
00152       DO K = 1, NSICLA
00153         DO I = 1, MARKERMAX
00154           PRO_F(J,I,K) = PRO_F(J,MARKER(I),K)
00155           PRO_D(J,I,K) = PRO_D(J,MARKER(I),K)
00156         ENDDO                  !I
00157       ENDDO                     !K
00158       PRO_MAX(J) = MARKERMAX
00159 !
00160 !--------------------------------------------------------------------------
00161 ! BRUTFORCE COMPRESSION IN CASE OF EXCEPTIONAL FRAGMENTATION
00162 !-----------------------------------------------------------------------
00163 !
00164       IF (PRO_MAX(J) > PRO_MAX_MAX-8*NSICLA) THEN
00165         CALL CVSP_COMPRESS_DP(J, 1.D-5)
00166       ENDIF
00167       IF (PRO_MAX(J) < 4) THEN
00168         CALL CVSP_COMPRESS_BRUT(J)
00169       ENDIF
00170 !
00171 !--------------------------------------------------------------------------
00172 ! FINAL DEBUGGING OUTPUT ...
00173 !-----------------------------------------------------------------------
00174 !
00175       IF(DB(JG,0)) CALL CVSP_P('./','V_V',JG)
00176 !
00177 !-----------------------------------------------------------------------
00178 !
00179       RETURN
00180       END SUBROUTINE CVSP_COMPRESS_CLEAN

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