cvsp_main.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\cvsp_main.f
00002 !
00063                      SUBROUTINE CVSP_MAIN
00064 !                    ********************
00065 !
00066      &(ZFCL_W,NLAYER,ZR,ZF,ESTRAT,ELAY,MASBAS,ACLADM,NSICLA,NPOIN,
00067      & ELAY0,VOLTOT,ES,AVAIL,CONST_ALAYER,DTS,ESTRATNEW,NLAYNEW)
00068 !
00069 !***********************************************************************
00070 ! SISYPHE   V6P3                                   14/03/2013
00071 !***********************************************************************
00072 !
00073 !BRIEF    CONTINOUS VERTICAL SORTING MODEL
00074 !+        COMPUTES FRACTIONS FOR EACH CLASS AND EACH SECTION OF A C-VSM;
00075 !+
00076 !
00077 !HISTORY  U.MERKEL (BAW), R.KOPMANN (BAW)
00078 !+        01/06/2012
00079 !+        V6P2
00080 !+
00081 !
00082 !
00083 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00084 !| ACLADM         |---| CALCULATED GEOMETRICAL MEAN DIAMETER OF ACT LAY
00085 !| AVAIL          |<--| SEDIMENT FRACTION FOR EACH LAYER, CLASS, POINT
00086 !| CONST_ALAYER   |---|
00087 !| DTS            |---| TIMESTEP LENGTH IN [S]
00088 !| ELAY           |<--| ACTIVE LAYER THICKNESS FOR EACH POINT
00089 !| ELAY0          |---| WANTED ACTIVE LAYER THICKNESS
00090 !| ES             |---| LAYER THICKNESS
00091 !| ESTRAT         |<--| ACTIVE STRATUM THICKNESS FOR EACH POINT
00092 !| ESTRATNEW      |---| TEMPORARY ACTIVE STRATUM THICKNESS
00093 !| MASBAS         |---| AREA AROUND NODE
00094 !| NLAYER         |<--| NUMBER OF LAYER FOR EACH POINT
00095 !| NLAYNEW        |---| TEMPORARY NUMBER OF LAYER FOR EACH POINT
00096 !| NPOIN          |---| NUMBER OF MESH POINTS
00097 !| NSICLA         |---| NUMBER OF GRAIN CLASSES (FRACTIONS)
00098 !| VOLTOT         |---| TOTAL VOLUME AROUND ONE POINT
00099 !| ZF             |---| BOTTOM ELEVATION
00100 !| ZFCL_W         |-->| EVOLUTION FOR EACH SEDIMENT CLASS
00101 !| ZR             |---| RIGID BED
00102 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00103 !
00104       USE BIEF
00105       USE DECLARATIONS_SISYPHE, ONLY: CVSMOUTPUT,CVSM_OUT,CVSM_OUT_FULL,
00106      &                                PRO_D,PRO_MAX,PRO_MAX_MAX,PERCOU,
00107      &                                HN,LT,DT,MESH,Z
00108 !
00109       IMPLICIT NONE
00110       INTEGER LNG,LU
00111       COMMON/INFO/LNG,LU
00112 !
00113 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00114 !
00115       INTEGER IAMCASE, ISICLA, JG
00116 !
00117 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00118 !
00119       TYPE (BIEF_OBJ),  INTENT(IN)    :: ZFCL_W,ZR,ZF
00120       TYPE (BIEF_OBJ),  INTENT(IN)    :: MASBAS,ACLADM
00121       INTEGER,          INTENT(IN)    :: NSICLA,NPOIN
00122       DOUBLE PRECISION, INTENT(IN)    :: DTS
00123       LOGICAL,          INTENT(IN)    :: CONST_ALAYER
00124       TYPE (BIEF_OBJ),  INTENT(INOUT) :: NLAYER,ESTRAT,ELAY
00125       DOUBLE PRECISION, INTENT(INOUT) :: ELAY0
00126       DOUBLE PRECISION, INTENT(INOUT) :: ES(NPOIN,10)
00127       DOUBLE PRECISION, INTENT(INOUT) :: AVAIL(NPOIN,10,NSICLA)
00128       DOUBLE PRECISION, INTENT(INOUT) :: VOLTOT(10),ESTRATNEW(NPOIN)
00129       INTEGER         , INTENT(INOUT) :: NLAYNEW(NPOIN)
00130 !
00131 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00132 !
00133       DOUBLE PRECISION P_DSUM
00134       EXTERNAL         P_DSUM
00135       INTEGER  P_ISUM
00136       EXTERNAL P_ISUM
00137 !
00138 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00139 !
00140       LOGICAL CVSP_CHECK_F, DB, RET
00141       INTEGER I,J,K,ARRET,ARRET2
00142       DOUBLE PRECISION DZFCL,EVL,AT,DELTA
00143       INTEGER KK
00144 !
00145 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00146 !
00147       ARRET=0
00148       AT = DT*LT/PERCOU
00149 !
00150 !-----------------------------------------------------------------------
00151 !     CHECK FOR RIGID BED ERRORS
00152 !-----------------------------------------------------------------------
00153 !
00154       DO J=1,NPOIN
00155         IF(Z%R(J)-ZF%R(J).LT.0.D0) THEN
00156            WRITE(LU,*) 'UHM_Z.LT.ZF_BEF ',AT,Z%R(J),ZF%R(J),HN%R(J),
00157      &                 (Z%R(J)-ZF%R(J))-HN%R(J)
00158            CALL CVSP_P('./','Z_', J)
00159         ENDIF
00160       ENDDO
00161 !
00162 !-----------------------------------------------------------------------
00163 !     FOR ALL POINTS AND FOR ALL CLASSES
00164 !-----------------------------------------------------------------------
00165 !
00166       DO J=1,NPOIN
00167         JG = J
00168         IF (NCSIZE.GT.1) JG = MESH%KNOLG%I(J)
00169         EVL = 0.D0
00170         DO ISICLA = 1,NSICLA
00171           EVL = ZFCL_W%ADR(ISICLA)%P%R(J) + EVL
00172         END DO
00173 !
00174 ! DEBUG INFO
00175         IAMCASE = 0
00176         IF (DB(JG,0)) CALL CVSP_P('./','V_A',JG)
00177 ! DEBUG INFO
00178 !
00179 !-----------------------------------------------------------------------
00180 ! DEPOSITION IN SUM OVER ALL CASES
00181 !-----------------------------------------------------------------------
00182 !
00183         IF(EVL.GT.0) THEN
00184           CALL CVSP_ADD_SECTION(J)
00185         ENDIF
00186 !
00187         DO I=1,NSICLA
00188           DZFCL = ZFCL_W%ADR(I)%P%R(J)
00189           IF (EVL.GT.0D0) THEN
00190             IF (DZFCL.GT.0.D0) THEN
00191               CALL CVSP_ADD_FRACTION(J,I,DZFCL,EVL)
00192               IAMCASE = 1 + IAMCASE !DEBUG INFO
00193             ELSEIF( DZFCL.LT.0.D0) THEN
00194               CALL CVSP_RM_FRACTION(J,I,DZFCL,EVL)
00195               IAMCASE = 10 + IAMCASE !DEBUG INFO
00196             ENDIF
00197           ENDIF
00198 !
00199 !-----------------------------------------------------------------------
00200 ! END DEPOSITION
00201 !-----------------------------------------------------------------------
00202 !
00203 !-----------------------------------------------------------------------
00204 ! START EROSION IN SUM OVER ALL CASES
00205 !-----------------------------------------------------------------------
00206 !
00207           IF(EVL.LT.0.D0) THEN
00208             IF (DZFCL.GT.0.D0) THEN
00209               CALL CVSP_ADD_FRACTION(J,I,DZFCL,EVL)
00210               IAMCASE = 100 + IAMCASE !DEBUG INFO
00211             ELSEIF(DZFCL.LT.0.D0) THEN
00212               CALL CVSP_RM_FRACTION(J,I,DZFCL,EVL)
00213               IAMCASE = 1000 + IAMCASE !DEBUG INFO
00214             ENDIF                      ! DZFCL
00215           ENDIF                        ! EVL < 0
00216 !
00217 !-----------------------------------------------------------------------
00218 ! END EROSION
00219 !-----------------------------------------------------------------------
00220 !
00221         ENDDO
00222 !
00223 !-----------------------------------------------------------------------
00224 ! END FOR ALL CLASSES
00225 !-----------------------------------------------------------------------
00226 !
00227 !-----------------------------------------------------------------------
00228 ! WE ARE RUNNING OUT OF SECTION MEMORY! COMPRESS NOW!
00229 !-----------------------------------------------------------------------
00230 !
00231         IF ((PRO_MAX(J).GT.PRO_MAX_MAX/4*3).OR.
00232      &       (PRO_MAX_MAX-PRO_MAX(J).LT.8*NSICLA)) THEN
00233            CALL CVSP_COMPRESS_DP(J, 1.0D-5)
00234         ENDIF
00235 !
00236 !-----------------------------------------------------------------------
00237 ! SYNCHRONICE VSP WITH LAYER (FOR DEBUGGING ...)
00238 !-----------------------------------------------------------------------
00239 !
00240         DELTA = ZF%R(J) - PRO_D(J, PRO_MAX(J), 1)
00241 !
00242         IF (DELTA.NE.0.D0) THEN
00243           DO I = 1 , NSICLA
00244             DO K = 1, PRO_MAX(J)
00245               PRO_D(J, K, I) = PRO_D(J, K, I) + DELTA
00246             ENDDO
00247           ENDDO
00248         ENDIF
00249 !
00250 !-----------------------------------------------------------------------
00251 !FINAL CHECK ON NEW FRACTIONS AND STEADY STADE
00252 !-----------------------------------------------------------------------
00253 !
00254         DO K = 1, PRO_MAX(J)
00255 !         REMOVES NUMERIC INSTABILITIES
00256           RET =  CVSP_CHECK_F(J,K,' FINAL:   ')
00257         ENDDO
00258         CALL CVSP_CHECK_STEADY(J)
00259 !
00260 ! END FOR ALL POINTS
00261       ENDDO
00262 !
00263 !-----------------------------------------------------------------------
00264 ! PRINT OUT SORTING PROFILE FOR SELECTED GLOBAL POINT NUMBERS!INSERT
00265 !-----------------------------------------------------------------------
00266 !
00267       IF((CVSM_OUT).OR.(DB(-1,-1).EQV..TRUE.)) THEN
00268 ! WRITES THE FULL VSP AS SERAFIN
00269         IF (CVSM_OUT_FULL) CALL CVSP_WRITE_PROFILE()
00270 ! WRITES THE VSP FOR SINGLE POINTS
00271         DO KK = 1, 100
00272           IF (CVSMOUTPUT(KK).GT.0) THEN
00273             CALL CVSP_P('./','V_', CVSMOUTPUT(KK))
00274           ENDIF
00275         ENDDO
00276       END IF
00277 !
00278 !-----------------------------------------------------------------------
00279 ! GENERATE NEW LAYERS FROM SORTING PROFILE
00280 !-----------------------------------------------------------------------
00281 !
00282       CALL CVSP_MAKE_ACTLAY()
00283 !
00284 !-----------------------------------------------------------------------
00285 ! CHECK FOR RIGID BED ERRORS
00286 !-----------------------------------------------------------------------
00287 !
00288       DO J=1,NPOIN
00289         IF (Z%R(J)-ZF%R(J).LT.0.D0) THEN
00290           WRITE(LU,*) 'UHM_Z.LT.ZF ', I,AT,Z%R(J),ZF%R(J),HN%R(J),
00291      &         (Z%R(J)-ZF%R(J))-HN%R(J)
00292           CALL CVSP_P('./','Z_', J)
00293         END IF
00294       ENDDO
00295 !
00296 !-----------------------------------------------------------------------
00297 ! PRINT OUT NEW LAYERS FOR SELECTED GLOBAL POINT NUMBERS
00298 !-----------------------------------------------------------------------
00299 !
00300       IF((CVSM_OUT).OR.(DB(-1,-1).EQV..TRUE.)) THEN
00301         DO KK = 1,100
00302           IF (CVSMOUTPUT(KK).GT.0) THEN
00303             CALL LAYERS_P('./VSP_', CVSMOUTPUT(KK))
00304           ENDIF
00305         ENDDO
00306       END IF
00307 !
00308 !-----------------------------------------------------------------------
00309 !     CLEAN STOP FOR ALL PROCESSORS IF PROBLEM
00310 !-----------------------------------------------------------------------
00311 !
00312       ARRET2=ARRET
00313       IF(NCSIZE.GT.1) ARRET2=P_ISUM(ARRET)
00314       IF(ARRET2.GT.0) THEN
00315         IF(LNG.EQ.1) WRITE(LU,*) 'ARRET APRES ERREUR DANS LAYER'
00316         IF(LNG.EQ.2) WRITE(LU,*) 'STOP AFTER AN ERROR IN LAYER'
00317         IF(ARRET.EQ.0) THEN
00318           IF(LNG.EQ.1) WRITE(LU,*) 'DANS ',ARRET2,' PROCESSEUR(S)'
00319           IF(LNG.EQ.2) WRITE(LU,*) 'IN ',ARRET2,' PROCESSOR(S)'
00320         ENDIF
00321         CALL PLANTE(1)
00322         STOP
00323       ENDIF
00324 !
00325 !-----------------------------------------------------------------------
00326 !
00327       RETURN
00328       END SUBROUTINE

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