cvsp_compress_brut.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\cvsp_compress_brut.f
00002 !
00074                     SUBROUTINE CVSP_COMPRESS_BRUT(J)
00075 !                   ********************************
00076 !
00077 !
00078 !***********************************************************************
00079 ! SISYPHE   V6P3                                   12/03/2013
00080 !***********************************************************************
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00087 !| J              |<--| INDEX OF A POINT IN MESH
00088 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00089 !
00090       USE DECLARATIONS_SISYPHE
00091 !
00092       IMPLICIT NONE
00093       INTEGER LNG,LU
00094       COMMON/INFO/LNG,LU
00095 !
00096 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00097 !
00098       INTEGER, INTENT(IN) :: J
00099       DOUBLE PRECISION Z_LOW ,Z_HIGH, SECHIGHT
00100 !
00101 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00102 !
00103 ! USING T1 INSTEAD, ASSUMING THAT NUMBER OF NODES ALWAYS BIGGER THAN NUMBER OF GRAIN SIZE CLASSES
00104 !
00105       INTEGER NEWPRO_MAX, K, I, JG
00106       LOGICAL DB,RET
00107       LOGICAL, EXTERNAL          :: CVSP_CHECK_F
00108       DOUBLE PRECISION, EXTERNAL :: CVSP_INTEGRATE_VOLUME
00109 !
00110 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00111 !
00112 !TEMPORARY VERTICAL SORTING PROFILE: FRACTION FOR EACH LAYER, CLASS, POINT
00113 !
00114       DOUBLE PRECISION,DIMENSION(:,:),TARGET,ALLOCATABLE::PRO_FNEW
00115 !
00116 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00117 !
00118 !TEMPORARY VERTICAL SORTING PROFILE: DEPTH FOR EACH LAYER, CLASS, POINT
00119 !
00120       DOUBLE PRECISION,DIMENSION(:,:),TARGET,ALLOCATABLE::PRO_DNEW
00121 !
00122 !-----------------------------------------------------------------------
00123 !
00124       ALLOCATE(PRO_DNEW(PRO_MAX_MAX,NSICLA))
00125       ALLOCATE(PRO_FNEW(PRO_MAX_MAX,NSICLA))
00126 
00127       JG = J
00128       IF(NCSIZE.GT.1) JG = MESH%KNOLG%I(J)
00129       IF(DB(JG,0)) CALL CVSP_P('./','BRUA',JG)
00130 !
00131 !-----------------------------------------------------------------------
00132 ! WORKS LIKE THE MAKE_ACT LAYER ROUTINE BUT FOR VSP
00133 !-----------------------------------------------------------------------
00134 !
00135       NEWPRO_MAX=INT(MAX(8.D0,(DBLE(PRO_MAX_MAX - 4 * NSICLA)*0.7D0)))
00136 !
00137 !-----------------------------------------------------------------------
00138 ! NEW VSP SECTION HEIGHT
00139 !-----------------------------------------------------------------------
00140 !
00141       SECHIGHT = (PRO_D(J,PRO_MAX(J),1)-PRO_D(J,1,1)) / (NEWPRO_MAX - 1)
00142 !
00143       DO K = 1, NEWPRO_MAX
00144         DO I = 1, NSICLA
00145           PRO_DNEW(K,I) = (K-1)*SECHIGHT + PRO_D(J,1,1)
00146           Z_LOW  = PRO_DNEW(K,1) - 0.5D0*SECHIGHT
00147           Z_HIGH = PRO_DNEW(K,1) + 0.5D0*SECHIGHT
00148           IF(K.EQ.1) Z_LOW = PRO_D(J,1,1)
00149           IF(K.EQ.NEWPRO_MAX) Z_HIGH = PRO_D(J,PRO_MAX(J),1)
00150           PRO_FNEW(K,I)=CVSP_INTEGRATE_VOLUME(J,I, Z_HIGH, Z_LOW,T1%R)
00151      &         / SECHIGHT
00152           IF(K.EQ.1) PRO_FNEW(K,I) = PRO_FNEW(K,I) * 2.0D0
00153           IF(K.EQ.NEWPRO_MAX) PRO_FNEW(K,I) = PRO_FNEW(K,I) * 2.0D0
00154         ENDDO
00155       ENDDO
00156 !
00157 !-----------------------------------------------------------------------
00158 ! RESUBSTITUTE
00159 !-----------------------------------------------------------------------
00160 !
00161       DO I = 1, NSICLA
00162         DO K = 1, NEWPRO_MAX
00163           PRO_D(J,K,I) = PRO_DNEW(K,I)
00164           PRO_F(J,K,I) = PRO_FNEW(K,I)
00165         ENDDO
00166       ENDDO
00167 !
00168       PRO_MAX(J) = NEWPRO_MAX
00169 !
00170       IF(PRO_MAX(J).LE.2) THEN
00171         WRITE(LU,*) ' COMPRESSBRUT: NOT ENOUGH PRO_MAX '
00172         CALL PLANTE(1)
00173         STOP
00174       ENDIF
00175 !
00176       IF(DB(JG,0)) CALL CVSP_P('./','BRUE',JG)
00177 !
00178 !-----------------------------------------------------------------------
00179 !
00180       DEALLOCATE(PRO_DNEW)
00181       DEALLOCATE(PRO_FNEW)
00182 !
00183 !-----------------------------------------------------------------------
00184 ! REMOVES NUMERIC INSTABILITIES
00185 !-----------------------------------------------------------------------
00186 !
00187       DO K = 1, PRO_MAX(J)
00188         RET = CVSP_CHECK_F(J,K,'AFTERBRUT:   ')
00189       ENDDO
00190       CALL CVSP_CHECK_STEADY(J)
00191 !
00192 !-----------------------------------------------------------------------
00193 !
00194       RETURN
00195       END SUBROUTINE CVSP_COMPRESS_BRUT

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