|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE FLOOD_UPDATE (PTAB_F,PTAB_H,PTAB_VF,PAREA,PFLOOD_STO, & 00003 PHFLOOD,PFFLOOD,PFLOOD_LEN,PWFLOOD ) 00004 ! ########################################################################## 00005 ! 00006 !!**** *FLOOD_UPDATE* 00007 !! 00008 !! PURPOSE 00009 !! ------- 00010 ! 00011 ! Compute HFLOOD, FFLOOD, LFLOOD, WFLOOD. 00012 ! 00013 !!** METHOD 00014 !! ------ 00015 ! 00016 ! Direct calculation 00017 ! 00018 !! EXTERNAL 00019 !! -------- 00020 ! 00021 ! None 00022 !! 00023 !! IMPLICIT ARGUMENTS 00024 !! ------------------ 00025 !! 00026 !! 00027 !! REFERENCE 00028 !! --------- 00029 !! 00030 !! AUTHOR 00031 !! ------ 00032 !! B. Decharme 00033 !! 00034 !! MODIFICATIONS 00035 !! ------------- 00036 !! Original 01/11/06 00037 !------------------------------------------------------------------------------- 00038 ! 00039 !* 0. DECLARATIONS 00040 ! ------------ 00041 ! 00042 USE MODD_TRIP_PAR, ONLY : XTRIP_UNDEF, XRHOLW_T 00043 USE MODD_TRIP_n, ONLY : XRATMED 00044 ! 00045 ! 00046 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00047 USE PARKIND1 ,ONLY : JPRB 00048 ! 00049 IMPLICIT NONE 00050 ! 00051 !* 0.1 declarations of arguments 00052 ! 00053 REAL,DIMENSION(:), INTENT(IN) :: PTAB_F ! Flood fraction array 00054 REAL,DIMENSION(:), INTENT(IN) :: PTAB_H ! Topo height array 00055 REAL,DIMENSION(:), INTENT(IN) :: PTAB_VF ! Flood volume array 00056 REAL, INTENT(IN) :: PAREA ! grid area [mē] 00057 REAL, INTENT(IN) :: PFLOOD_STO ! Floodplain water mass [kg] 00058 ! 00059 REAL, INTENT(OUT) :: PHFLOOD ! Floodplain fraction [-] 00060 REAL, INTENT(OUT) :: PFFLOOD ! Floodplain water depth [m] 00061 REAL, INTENT(OUT) :: PFLOOD_LEN ! Floodplain lenght [m] 00062 REAL, INTENT(OUT) :: PWFLOOD ! Floodplain width [m] 00063 ! 00064 !* 0.2 declarations of local variables 00065 ! 00066 REAL, DIMENSION(:), ALLOCATABLE :: ZCOMP 00067 ! 00068 REAL :: ZF_UP, ZF_DOWN, ZV_UP, ZV_DOWN, ZH_UP, ZH_DOWN, ZSLOPE 00069 ! 00070 INTEGER, DIMENSION(:), ALLOCATABLE ::IUP, IDOWN 00071 ! 00072 INTEGER :: I, IPAS 00073 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00074 ! 00075 !------------------------------------------------------------------------------- 00076 ! Initialize and allocate local variable 00077 !------------------------------------------------------------------------------- 00078 ! 00079 IF (LHOOK) CALL DR_HOOK('FLOOD_UPDATE',0,ZHOOK_HANDLE) 00080 PHFLOOD = 0.0 00081 PFFLOOD = 0.0 00082 PWFLOOD = 0.0 00083 PFLOOD_LEN = 0.0 00084 ! 00085 IF(PFLOOD_STO<=0 .AND. LHOOK) CALL DR_HOOK('FLOOD_UPDATE',1,ZHOOK_HANDLE) 00086 IF(PFLOOD_STO<=0)RETURN 00087 ! 00088 IPAS=SIZE(PTAB_VF(:)) 00089 ! 00090 ALLOCATE(ZCOMP(IPAS)) 00091 ALLOCATE(IUP (1)) 00092 ALLOCATE(IDOWN(1)) 00093 ! 00094 !------------------------------------------------------------------------------- 00095 !compare arrays 00096 ! 00097 ZCOMP(:) = PTAB_VF(:)-PFLOOD_STO 00098 ! 00099 !------------------------------------------------------------------------------- 00100 !calculate array index 00101 ! 00102 IF(ALL(ZCOMP(:)<0.0))THEN 00103 IUP (1) = IPAS 00104 IDOWN(1) = IPAS 00105 ELSE 00106 IUP (:) = MINLOC(ZCOMP(:),ZCOMP(:)>=0.0) 00107 IDOWN(:) = MAXLOC(ZCOMP(:),ZCOMP(:)<=0.0) 00108 ENDIF 00109 ! 00110 !------------------------------------------------------------------------------- 00111 !new born 00112 ! 00113 ZF_UP = PTAB_F (IUP (1)) 00114 ZF_DOWN = PTAB_F (IDOWN(1)) 00115 ZV_UP = PTAB_VF(IUP (1)) 00116 ZV_DOWN = PTAB_VF(IDOWN(1)) 00117 ZH_UP = PTAB_H (IUP (1)) 00118 ZH_DOWN = PTAB_H (IDOWN(1)) 00119 ! 00120 !------------------------------------------------------------------------------- 00121 !Calculate new Fflood 00122 ! 00123 ZSLOPE = 0.0 00124 IF(IUP(1)/=IDOWN(1)) ZSLOPE = (ZF_UP-ZF_DOWN)/(ZV_UP-ZV_DOWN) 00125 ! 00126 PFFLOOD = ZF_DOWN + (PFLOOD_STO-ZV_DOWN) * ZSLOPE 00127 ! 00128 !------------------------------------------------------------------------------- 00129 !Calculate new Hflood 00130 ! 00131 ZSLOPE = 0.0 00132 IF(IUP(1)/=IDOWN(1)) ZSLOPE = (ZH_UP-ZH_DOWN)/(ZV_UP-ZV_DOWN) 00133 ! 00134 PHFLOOD = ZH_DOWN + (PFLOOD_STO-ZV_DOWN) * ZSLOPE 00135 ! 00136 !------------------------------------------------------------------------------- 00137 !Calculate special case 00138 ! 00139 IF(PFFLOOD>=1.0)THEN 00140 PFFLOOD=1.0 00141 PHFLOOD= ZH_DOWN + (PFLOOD_STO-ZV_DOWN)/(XRHOLW_T*PAREA) 00142 ENDIF 00143 ! 00144 !------------------------------------------------------------------------------- 00145 !Calculate new Wflood, Lflood 00146 ! 00147 PFLOOD_LEN = XRATMED*SQRT(PFFLOOD*PAREA) 00148 PWFLOOD = PAREA*PFFLOOD/PFLOOD_LEN 00149 ! 00150 !------------------------------------------------------------------------------- 00151 ! Deallocate local variable 00152 !------------------------------------------------------------------------------- 00153 ! 00154 DEALLOCATE(ZCOMP) 00155 DEALLOCATE(IUP ) 00156 DEALLOCATE(IDOWN) 00157 IF (LHOOK) CALL DR_HOOK('FLOOD_UPDATE',1,ZHOOK_HANDLE) 00158 ! 00159 !------------------------------------------------------------------------------- 00160 END SUBROUTINE FLOOD_UPDATE
1.8.0
