SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/TRIP/mode_trip

Go to the documentation of this file.
00001 !########################
00002 MODULE MODE_TRIP_FUNCTION
00003 !########################
00004 !
00005 !!****  *MODE_TRIP_FUNCTION*
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !    
00010 !      The purpose of this routine is to store here all functions 
00011 !      used by MODE_TRIP_INIT.
00012 !
00013 !!
00014 !!**  IMPLICIT ARGUMENTS
00015 !!    ------------------
00016 !!       NONE          
00017 !!
00018 !!    REFERENCE
00019 !!    ---------
00020 !!
00021 !!
00022 !!    AUTHOR
00023 !!    ------
00024 !!      B. Decharme       * Meteo France *
00025 !!
00026 !!    MODIFICATIONS
00027 !!    -------------
00028 !!      Original    15/04/08
00029 !--------------------------------------------------------------------------------
00030 !
00031 !*       0.    DECLARATIONS
00032 !              ------------
00033 !
00034 !
00035 !-------------------------------------------------------------------------------
00036 !
00037 !
00038 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00039 USE PARKIND1  ,ONLY : JPRB
00040 !
00041 CONTAINS
00042 !-------------------------------------------------------------------------------
00043 !
00044 !     ###############################################
00045       FUNCTION IRNXTX(IX,NX,IRIV) RESULT(KNEXTX)
00046 !     ###############################################
00047 !
00048 IMPLICIT NONE
00049 !
00050 INTEGER, INTENT(IN)  :: IX,NX,IRIV 
00051 INTEGER              :: KNEXTX
00052 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00053 !
00054 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:IRNXTX',0,ZHOOK_HANDLE)
00055 IF(IRIV==1.OR.IRIV==5)THEN
00056   KNEXTX = IX 
00057 ELSEIF(IRIV==8.OR.IRIV==7.OR.IRIV==6)THEN
00058   IF(IX==1)THEN
00059     KNEXTX = NX
00060   ELSE
00061     KNEXTX = IX-1
00062   ENDIF
00063 ELSEIF(IRIV==2.OR.IRIV==3.OR.IRIV==4)THEN
00064   IF(IX==NX)THEN
00065     KNEXTX = 1
00066   ELSE
00067     KNEXTX = IX+1
00068   ENDIF
00069 ELSE
00070     KNEXTX = 0
00071 ENDIF
00072 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:IRNXTX',1,ZHOOK_HANDLE)
00073 !
00074 END FUNCTION IRNXTX
00075 !
00076 !-------------------------------------------------------------------------------
00077 !
00078 !     ###############################################
00079       FUNCTION IRNXTY(IY,NY,IRIV) RESULT(KNEXTY)
00080 !     ###############################################
00081 !
00082 IMPLICIT NONE
00083 !
00084 INTEGER, INTENT(IN)  :: IY,NY,IRIV 
00085 INTEGER              :: KNEXTY
00086 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00087 !
00088 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:IRNXTY',0,ZHOOK_HANDLE)
00089 IF(IRIV==7.OR.IRIV==3)THEN
00090   KNEXTY = IY 
00091 ELSEIF(IRIV==6.OR.IRIV==5.OR.IRIV==4)THEN
00092   KNEXTY = IY-1
00093 ELSEIF(IRIV==8.OR.IRIV==1.OR.IRIV==2)THEN
00094   IF(IY==NY)THEN
00095     KNEXTY = 0
00096   ELSE
00097     KNEXTY = IY+1
00098   ENDIF
00099 ELSE
00100   KNEXTY = 0
00101 ENDIF
00102 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:IRNXTY',1,ZHOOK_HANDLE)
00103 !
00104 END FUNCTION IRNXTY
00105 !
00106 !-------------------------------------------------------------------------------
00107 !
00108 !     ###############################################
00109       FUNCTION GETLON(IX,NX) RESULT(PLON0)
00110 !     ###############################################
00111 !
00112 IMPLICIT NONE
00113 !
00114 INTEGER, INTENT(IN)  :: IX,NX 
00115 REAL                 :: PLON0
00116 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00117 !
00118 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:GETLON',0,ZHOOK_HANDLE)
00119 PLON0 = 360.0 * (REAL(IX)-0.5) / REAL(NX) - 180.0
00120 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:GETLON',1,ZHOOK_HANDLE)
00121 !
00122 END FUNCTION GETLON
00123 !
00124 !-------------------------------------------------------------------------------
00125 !
00126 !     ###############################################
00127       FUNCTION GETLAT(IY,NY) RESULT(PLAT0)
00128 !     ###############################################
00129 !
00130 IMPLICIT NONE
00131 !
00132 INTEGER, INTENT(IN)  :: IY,NY 
00133 REAL                 :: PLAT0
00134 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00135 !
00136 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:GETLAT',0,ZHOOK_HANDLE)
00137 PLAT0 = 180.0 * (REAL(IY)-0.5) / REAL(NY) - 90.0
00138 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:GETLAT',1,ZHOOK_HANDLE)
00139 !
00140 END FUNCTION GETLAT
00141 !
00142 !-------------------------------------------------------------------------------
00143 !
00144 !     ###############################################
00145       FUNCTION GIVELON(ZY) RESULT(PDLON)
00146 !     ###############################################
00147 !
00148 USE MODD_TRIP_PAR, ONLY : XPI_T, XRAD_T
00149 !
00150 IMPLICIT NONE
00151 !
00152 REAL, INTENT(IN)  :: ZY
00153 REAL              :: PDLON
00154 !
00155 REAL, PARAMETER   :: ZE2 = 0.006694470
00156 REAL :: ZR, ZY_RAD, ZRA
00157 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00158 !
00159 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:GIVELON',0,ZHOOK_HANDLE)
00160 ZRA = XRAD_T/1000.0
00161 !
00162 ZY_RAD = ZY * XPI_T / 180.
00163 !
00164 PDLON = XPI_T / 180.0 * ZRA * COS(ZY_RAD) / SQRT(1.0 - ZE2 * SIN(ZY_RAD) * SIN(ZY_RAD))
00165 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:GIVELON',1,ZHOOK_HANDLE)
00166 !
00167 END FUNCTION GIVELON
00168 !
00169 !-------------------------------------------------------------------------------
00170 !
00171 !     ###############################################
00172       FUNCTION GIVELAT(ZY) RESULT(PDLAT)
00173 !     ###############################################
00174 !
00175 USE MODD_TRIP_PAR, ONLY : XPI_T, XRAD_T
00176 !
00177 IMPLICIT NONE
00178 !
00179 REAL, INTENT(IN)  :: ZY
00180 REAL              :: PDLAT
00181 !
00182 REAL, PARAMETER   :: ZE2 = 0.006694470
00183 REAL :: ZR, ZY_RAD, ZRA
00184 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00185 !
00186 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:GIVELAT',0,ZHOOK_HANDLE)
00187 ZRA = XRAD_T/1000.0
00188 !
00189 ZY_RAD = ZY * XPI_T / 180.
00190 !
00191 PDLAT = XPI_T / 180.0 * ZRA * (1.0-ZE2) / SQRT( (1.0 - ZE2 * SIN(ZY_RAD) * SIN(ZY_RAD))**3. )
00192 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:GIVELAT',1,ZHOOK_HANDLE)
00193 !
00194 END FUNCTION GIVELAT
00195 !
00196 !-------------------------------------------------------------------------------
00197 !
00198 !     ###############################################
00199       FUNCTION GIVERAD(ZY) RESULT(PRAD)
00200 !     ###############################################
00201 !
00202 USE MODD_TRIP_PAR, ONLY : XRAD_T, XPI_T
00203 !
00204 IMPLICIT NONE
00205 !
00206 REAL, INTENT(IN)  :: ZY
00207 REAL              :: PRAD
00208 !
00209 REAL, PARAMETER   :: ZE2 = 0.006694470
00210 REAL :: ZR, ZY_RAD, ZRN, ZRA
00211 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00212 !
00213 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:GIVERAD',0,ZHOOK_HANDLE)
00214 ZRA = XRAD_T/1000.0
00215 !
00216 ZY_RAD = ZY * XPI_T / 180.
00217 !
00218 ZRN = ZRA / SQRT(1.0 - ZE2 *  SIN(ZY_RAD) * SIN(ZY_RAD) )
00219 !
00220 PRAD = ZRN * SQRT( 1.0 - ZE2 * SIN(ZY_RAD) + ZE2 * ZE2 * SIN(ZY_RAD) * SIN(ZY_RAD) )
00221 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:GIVERAD',1,ZHOOK_HANDLE)
00222 !
00223 END FUNCTION GIVERAD
00224 !
00225 !-------------------------------------------------------------------------------
00226 !
00227 !     ###############################################
00228       FUNCTION GIVELEN(ZX,ZY,ZX_N,ZY_N) RESULT(PLEN0)
00229 !     ###############################################
00230 !
00231 IMPLICIT NONE
00232 !
00233 REAL, INTENT(IN)  :: ZX,ZY,ZX_N,ZY_N
00234 REAL              :: PLEN0
00235 !
00236 REAL :: ZLAT, ZDX, ZDY, ZRAD, ZDLON, ZDLAT
00237 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00238 !
00239 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:GIVELEN',0,ZHOOK_HANDLE)
00240 ZDLON = ABS(ZX-ZX_N)
00241 ZDLAT = ABS(ZY-ZY_N)
00242 !
00243 IF(ZDLON>=180.0)ZDLON = ABS(360.0 - ZDLON)
00244 !
00245 PLEN0 = 0.0
00246 !
00247 IF(ZX==ZX_N)THEN
00248   ZLAT  = (ZY+ZY_N) / 2.0
00249   PLEN0 = GIVELAT(ZLAT) * ZDLAT
00250 ELSEIF(ZY==ZY_N)THEN
00251   ZLAT  = ZY
00252   PLEN0 = GIVELON(ZLAT) * ZDLON
00253 ELSE
00254   ZLAT  = (ZY+ZY_N) / 2.0
00255   ZRAD  = GIVERAD(ZLAT)
00256   ZDX   = GIVELON(ZLAT) * ZDLON / ZRAD
00257   ZDY   = GIVELAT(ZLAT) * ZDLAT / ZRAD
00258   PLEN0 = ACOS(COS(ZDX)*COS(ZDY)) * ZRAD
00259 ENDIF
00260 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:GIVELEN',1,ZHOOK_HANDLE)
00261 !
00262 END FUNCTION GIVELEN
00263 !
00264 !-------------------------------------------------------------------------------
00265 !
00266 !     ##############################################
00267       FUNCTION FUNCVEL(PRC,PL,PW,PX,PSIN) RESULT(PY)
00268 !     ##############################################
00269 !
00270 USE MODD_TRIP_PAR, ONLY : XM_EXP, XRHOLW_T
00271 !
00272 IMPLICIT NONE
00273 !
00274 REAL, INTENT(IN)  :: PRC,PL,PW,PX,PSIN
00275 !
00276 REAL              :: PY
00277 REAL              :: ZHS,ZRADIUS,ZVEL
00278 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00279 !
00280 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:FUNCVEL',0,ZHOOK_HANDLE)
00281 ZHS=0.0
00282 IF(PRC>0.0)THEN
00283    ZHS=PX/(XRHOLW_T*PL*PW)
00284 ENDIF
00285 !
00286 ZVEL=DIAGVEL(PRC,PL,PW,ZHS)
00287 !
00288 PY= PSIN-ZVEL*PX/PL
00289 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:FUNCVEL',1,ZHOOK_HANDLE)
00290 !
00291 END FUNCTION FUNCVEL
00292 !
00293 !-------------------------------------------------------------------------------
00294 !
00295 !     ##############################################
00296       FUNCTION DIAGVEL(PRC,PL,PW,PX) RESULT(PY)
00297 !     ##############################################
00298 !
00299 USE MODD_TRIP_n,   ONLY : XTRIP_TSTEP,XCVEL
00300 USE MODD_TRIP_PAR, ONLY : XM_EXP,XRHOLW_T
00301 !
00302 IMPLICIT NONE
00303 !
00304 REAL, INTENT(IN)  :: PRC,PL,PW,PX
00305 !
00306 REAL              :: PY
00307 REAL              :: ZRADIUS, ZVV
00308 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00309 !
00310 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:DIAGVEL',0,ZHOOK_HANDLE)
00311 !
00312 IF(PRC>0.0)THEN
00313   ZRADIUS=PW*PX/(PW+2.0*PX)
00314   ZVV=MIN(PRC*(ZRADIUS**XM_EXP),PL/XTRIP_TSTEP)
00315   PY=MAX(0.1,ZVV)
00316 ELSE
00317   PY=XCVEL
00318 ENDIF
00319 !
00320 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:DIAGVEL',1,ZHOOK_HANDLE)
00321 !
00322 END FUNCTION DIAGVEL
00323 !
00324 !-------------------------------------------------------------------------------
00325 !
00326 !     ##################################################################
00327       FUNCTION FUNCFLOOD(PX,PF,PHF,PLF,PWF,PHC,PNF,PW,PL,PD,PFF) RESULT(PY)
00328 !     ##################################################################
00329 !
00330 USE MODD_TRIP_PAR, ONLY : XRHOLW_T
00331 !
00332 IMPLICIT NONE
00333 !
00334 REAL, INTENT(IN)  :: PX,PF,PHF,PHC,PNF,PLF,PWF,PW,PL,PD,PFF
00335 REAL              :: PY
00336 REAL              :: ZMEX,ZMDEF,ZHT,ZVIN,ZVOUT,ZHS
00337 REAL              :: ZQIN,ZQOUT,ZFL,ZHIN,ZHOUT,ZHLIM
00338 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00339 !
00340 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:FUNCFLOOD',0,ZHOOK_HANDLE)
00341 PY=0.0
00342 IF(PHC==0.0.OR.PD==1.0 .AND. LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:FUNCFLOOD',1,ZHOOK_HANDLE)
00343 IF(PHC==0.0.OR.PD==1.0)RETURN
00344 !
00345 ZHS=PX/(XRHOLW_T*PL*PW)
00346 !
00347 ZFL=MAX(1.E-3,PLF)
00348 !
00349 ! * water mass exchanged
00350 !
00351 ZHIN =MAX(0.0,ZHS-PHC-PHF)
00352 ZHOUT=MAX(0.0,PHF+PHC-ZHS)
00353 !
00354 ZMEX =ZFL*ZHIN *PW*XRHOLW_T 
00355 ZMDEF=ZFL*ZHOUT*PW*XRHOLW_T
00356 !
00357 ZMDEF=MIN(ZMDEF,PF)
00358 !
00359 ! * water velocity
00360 !
00361  CALL VELFLOOD(ZHS,PFF,PHF,PLF,PWF,PHC,PNF,PW,PD,ZVIN,ZVOUT)
00362 !
00363 ! * inflow or outflow water flux
00364 !
00365 ZQIN =ZVIN *ZMEX /(PW+PWF)
00366 ZQOUT=ZVOUT*ZMDEF/(PW+PWF)
00367 !
00368 ! * total water flux
00369 !
00370 PY=ZQIN-ZQOUT
00371 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:FUNCFLOOD',1,ZHOOK_HANDLE)
00372 !
00373 END FUNCTION FUNCFLOOD
00374 !
00375 !-------------------------------------------------------------------------------
00376 !
00377 !     ##############################################
00378       SUBROUTINE VELFLOOD(PHS,PFF,PHF,PLF,PWF,PHC, &
00379                             PNF,PW,PD,PVIN,PVOUT )  
00380 !     ##############################################
00381 !
00382 USE MODD_TRIP_n,   ONLY : XTRIP_TSTEP
00383 USE MODD_TRIP_PAR, ONLY : XM_EXP
00384 !
00385 IMPLICIT NONE
00386 !
00387 REAL, INTENT(IN)  :: PHS,PHF,PLF,PWF,PHC,PNF,PW,PD,PFF
00388 REAL, INTENT(OUT) :: PVIN,PVOUT
00389 !
00390 REAL              :: ZSLOPE_IN,ZSLOPE_OUT,ZFL, 
00391                        ZRADIN,ZRADOUT,ZHEX  
00392 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00393 !
00394 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:VELFLOOD',0,ZHOOK_HANDLE)
00395 PVIN =0.0
00396 PVOUT=0.0
00397 !
00398 IF(PHC==0.0.OR.PD==1.0 .AND. LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:VELFLOOD',1,ZHOOK_HANDLE)
00399 IF(PHC==0.0.OR.PD==1.0)RETURN
00400 !
00401 ZFL=MAX(1.E-3,PLF)
00402 !
00403 ! * water slope
00404 !
00405 ZSLOPE_IN =2.0*MAX(0.0,PHS-PHC-PHF)/(PW+PWF)
00406 ZSLOPE_OUT=2.0*MAX(0.0,PHF+PHC-PHS)/(PW+PWF)
00407 !
00408 ! * manning velocity
00409 !
00410 ZHEX =MAX(0.0,PHS-PHC)
00411 !
00412 ZRADIN  = ZHEX*ZFL/(ZFL+2.0*ZHEX)
00413 ZRADOUT = PHF *ZFL/(ZFL+2.0*PHF)
00414 !
00415 IF(PFF<1.0)THEN
00416    PVIN =(ZRADIN **XM_EXP)*SQRT(ZSLOPE_IN )/PNF
00417 ENDIF
00418 !
00419 PVOUT=(ZRADOUT**XM_EXP)*SQRT(ZSLOPE_OUT)/PNF
00420 !
00421 IF(PVIN >0.0)PVIN =MAX(0.001,PVIN)
00422 IF(PVOUT>0.0)PVOUT=MAX(0.001,PVOUT)
00423 !
00424 PVIN =MIN(PVIN, (PW+PWF)/XTRIP_TSTEP)
00425 PVOUT=MIN(PVOUT,(PW+PWF)/XTRIP_TSTEP)
00426 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:VELFLOOD',1,ZHOOK_HANDLE)
00427 !
00428 END SUBROUTINE VELFLOOD
00429 !
00430 !-------------------------------------------------------------------------------
00431 !
00432 !     ###########################################################
00433       FUNCTION DELTA_FLOOD(PX,PF,PHF,PLF,PWF,PHC,PW,PL) RESULT(PY)
00434 !     ###########################################################
00435 !
00436 USE MODD_TRIP_PAR, ONLY : XRHOLW_T
00437 !
00438 IMPLICIT NONE
00439 !
00440 REAL, INTENT(IN)  :: PX,PF,PHF,PLF,PWF,PHC,PW,PL
00441 REAL              :: PY
00442 REAL              :: ZMDEF,ZHDEF,ZHS,ZFL
00443 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00444 !
00445 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:DELTA_FLOOD',0,ZHOOK_HANDLE)
00446 PY=0.0
00447 IF(PHC==0.0 .AND. LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:DELTA_FLOOD',1,ZHOOK_HANDLE)
00448 IF(PHC==0.0)RETURN
00449 !
00450 ZHS=PX/(XRHOLW_T*PL*PW)
00451 !
00452 ZFL=MAX(1.E-3,PLF)
00453 !
00454 IF(PHF==0.0)THEN
00455   ZHDEF=0.0
00456 ELSE
00457   ZHDEF=MAX(0.0,PHF+PHC-ZHS)
00458 ENDIF
00459 !
00460 ZMDEF=ZHDEF*XRHOLW_T*PW*ZFL
00461 IF(PF<ZMDEF)THEN
00462   PY=1.0
00463 ELSE
00464   PY=0.0
00465 ENDIF
00466 IF (LHOOK) CALL DR_HOOK('MODE_TRIP_FUNCTION:DELTA_FLOOD',1,ZHOOK_HANDLE)
00467 !
00468 END FUNCTION DELTA_FLOOD
00469 !
00470 !-------------------------------------------------------------------------------
00471 !
00472 END MODULE MODE_TRIP_FUNCTION