cvsp_add_fraction.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\cvsp_add_fraction.f
00002 !
00051                      SUBROUTINE CVSP_ADD_FRACTION
00052 !                    ****************************
00053 !
00054      &(J, I, DZFCL, EVL)
00055 !
00056 !***********************************************************************
00057 ! SISYPHE   V6P3                                   12/03/2013
00058 !***********************************************************************
00059 !
00060 !
00061 !
00062 !
00063 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00064 !| J              |<--| INDEX OF A POINT IN MESH
00065 !| I              |<--| INDEX OF A FRACTION
00066 !| DZFCL          |<--| EVOLUTION OF FRACTION I [M]
00067 !| EVL            |<--| EVOLUTION OF ALL FRACTIONS [M]
00068 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00069 !
00070       USE DECLARATIONS_SISYPHE
00071 !
00072       IMPLICIT NONE
00073 !
00074 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00075 !
00076       INTEGER,          INTENT(IN) :: J
00077       INTEGER,          INTENT(IN) :: I
00078       DOUBLE PRECISION, INTENT(IN) :: DZFCL
00079       DOUBLE PRECISION, INTENT(IN) :: EVL
00080 !
00081 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00082 !
00083       DOUBLE PRECISION STR_OLD, STR_NEW, TEMP1, TEMP2, AT
00084       INTEGER II
00085       LOGICAL RET, CVSP_CHECK_F
00086 !
00087 !-----------------------------------------------------------------------
00088 !
00089       AT = DT*LT/PERCOU
00090 !
00091 !-----------------------------------------------------------------------
00092 !     MAKES SURE THAT THERE IS NO INFLUENCE ON THE PROFILE POINTS BELOW
00093 !     BY INSERTING A SECTION WITH 0 STRENGTH IF IT DOESN'T EXIST ALREADY
00094 !
00095 !     CHECKS FOR BREAKPOINT (= 0 STRENGTH)
00096 !-----------------------------------------------------------------------
00097 !
00098       IF (PRO_MAX(J).GT.2) THEN
00099         IF (PRO_D(J,PRO_MAX(J)-1,1).GT.PRO_D(J,PRO_MAX(J)-2,1)) THEN
00100 !
00101 !-----------------------------------------------------------------------
00102 !INSERT
00103 !-----------------------------------------------------------------------
00104 !
00105           PRO_MAX(J) = PRO_MAX(J) + 1
00106 !
00107 !-----------------------------------------------------------------------
00108 !SHIFTS BREAKPOINT
00109 !-----------------------------------------------------------------------
00110 !
00111           DO II=1,NSICLA
00112             PRO_F(J,PRO_MAX(J),II) = PRO_F(J,PRO_MAX(J)-1,II)
00113             PRO_F(J,PRO_MAX(J)-1,II) = PRO_F(J,PRO_MAX(J)-2,II)
00114             PRO_D(J,PRO_MAX(J),II) = PRO_D(J,PRO_MAX(J)-1,II)
00115             PRO_D(J,PRO_MAX(J)-1,II) = PRO_D(J,PRO_MAX(J)-2,II)
00116           ENDDO
00117 
00118         ENDIF
00119       ENDIF
00120 !
00121 !-----------------------------------------------------------------------
00122 ! ADDS MATERIAL
00123 !-----------------------------------------------------------------------
00124 !
00125 !
00126 !-----------------------------------------------------------------------
00127 !STRENGTH OF FRACTION
00128 !-----------------------------------------------------------------------
00129 !
00130       STR_OLD = (PRO_D(J,PRO_MAX(J),I)-PRO_D(J,PRO_MAX(J)-1,I))
00131       STR_NEW = DZFCL + STR_OLD
00132 !
00133 !-----------------------------------------------------------------------
00134 !NEW FRACTIONS
00135 !TOP
00136 !-----------------------------------------------------------------------
00137 !
00138       PRO_F(J,PRO_MAX(J),I) =
00139      &     (DZFCL + PRO_F(J,PRO_MAX(J),I) * STR_OLD) / (STR_NEW)
00140 !
00141 !-----------------------------------------------------------------------
00142 !BOTTOM
00143 !-----------------------------------------------------------------------
00144 !
00145       PRO_F(J,PRO_MAX(J)-1,I) =
00146      &     (DZFCL + PRO_F(J,PRO_MAX(J)-1,I) * STR_OLD) / (STR_NEW)
00147 !
00148 !-----------------------------------------------------------------------
00149 !NEW DEPTH=Z OF FRACTION
00150 !-----------------------------------------------------------------------
00151 !
00152       PRO_D(J,PRO_MAX(J),I) = DZFCL + PRO_D(J,PRO_MAX(J),I)
00153 !
00154 !-----------------------------------------------------------------------
00155 !SHIFTING PERCENTAGE FOR THE OTHER FRACTIONS
00156 !-----------------------------------------------------------------------
00157 !
00158       DO II=1,NSICLA
00159         IF (I /= II) THEN
00160 !
00161 !-----------------------------------------------------------------------
00162 ! SUM OF FRACTIONS AFTER SEDIMENTATION /= I
00163 !-----------------------------------------------------------------------
00164 !
00165           TEMP1 = PRO_F(J,PRO_MAX(J),II) * STR_OLD / STR_NEW
00166           TEMP2 = PRO_F(J,PRO_MAX(J)-1,II) * STR_OLD / STR_NEW
00167 !
00168 !-----------------------------------------------------------------------
00169 ! ASSIGN NEW THICKNESS & CORRECTED FRACTIONS
00170 !-----------------------------------------------------------------------
00171 !
00172           PRO_F(J,PRO_MAX(J),II) = TEMP1
00173           PRO_D(J,PRO_MAX(J),II) = DZFCL + PRO_D(J,PRO_MAX(J),II)
00174           PRO_F(J,PRO_MAX(J)-1,II) = TEMP2
00175         ENDIF
00176       ENDDO
00177 !
00178 !-----------------------------------------------------------------------
00179 ! REMOVES FLOATING POINT TRUCATIONS
00180 !-----------------------------------------------------------------------
00181 !
00182       RET = CVSP_CHECK_F(J,PRO_MAX(J),'ADF: MAX  ')
00183       RET = CVSP_CHECK_F(J,PRO_MAX(J)-1,'ADF: MAX+1')
00184       IF (PRO_MAX(J).GT.2) THEN
00185         RET =  CVSP_CHECK_F(J,PRO_MAX(J)-2,'ADF: MAX+2')
00186       ENDIF
00187       IF (PRO_MAX(J).GT.3) THEN
00188         RET = CVSP_CHECK_F(J,PRO_MAX(J)-3,'ADF: MAX+3')
00189       ENDIF
00190 !
00191 !-----------------------------------------------------------------------
00192 !
00193       RETURN
00194       END SUBROUTINE CVSP_ADD_FRACTION

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