oi_fctveg.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
SUBROUTINE oi_fctveg(KH,PVEG,&
   pvgat1,pvgat2,pvgat3,pvgbt1,pvgbt2,pvgbt3,pvgct1,pvgct2, &
   pvgah1,pvgah2,pvgah3,pvgbh1,pvgbh2,pvgbh3,pvgch1,pvgch2, &
   psigt2mp,psighp2,pg1,pg2,pg3,pg4,&
   pvgst,pvgsh,pvgpt1,pvgph1,pvgpt2,pvgph2)  
!
!****-------------------------------------------------------------------
!
USE modd_assim, ONLY : xsighp1, xsigt2mr, xsigh2mr, xsigt2mo, xsigh2mo 
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
INTEGER :: j
INTEGER, INTENT(IN) :: kh
!
REAL, DIMENSION(24), INTENT(IN) :: pvgat1,pvgat2,pvgat3
REAL, DIMENSION(24), INTENT(IN) :: pvgbt1,pvgbt2,pvgbt3
REAL, DIMENSION(24), INTENT(IN) :: pvgct1,pvgct2
REAL, DIMENSION(24), INTENT(IN) :: pvgah1,pvgah2,pvgah3
REAL, DIMENSION(24), INTENT(IN) :: pvgbh1,pvgbh2,pvgbh3
REAL, DIMENSION(24), INTENT(IN) :: pvgch1,pvgch2
REAL, DIMENSION(24), INTENT(IN) :: psigt2mp,psighp2
!
REAL, INTENT(IN) :: pveg
!
REAL, INTENT(OUT) :: pg1,pg2,pg3,pg4
REAL, INTENT(OUT) :: pvgst,pvgsh,pvgpt1,pvgph1,pvgpt2,pvgph2
!
REAL :: zsigh2mp
REAL :: zx1,zy1,zx2,zy2,zx3,zy3,zx4,zy4
!
REAL(KIND=JPRB) :: zhook_handle
!
!**---------------------------------------------------------------------
!**  1. Initialisation des polynomes bruts et des champs de reference.
!**     -------------------------------------------------------------
!
! fonction definissant la dependance par rapport aux erreurs d'observation
!REAL :: G
!REAL :: PX,PY
!G ( PX,PY ) = PX**2 / (PX**2 + PY**2 + (PX*PY)**2)
!
! ecart-type d'erreurs de prevision sur H2m
!
IF (lhook) CALL dr_hook('OI_FCTVEG',0,zhook_handle)
zsigh2mp  = xsighp1 + psighp2(kh)*pveg
!
!G1 = G(SIGH2MO/SIGH2MP(KH,PVEG),SIGT2MO/SIGT2MP(KH))
zx1 = xsigh2mo/zsigh2mp
zy1 = xsigt2mo/psigt2mp(kh)
pg1  = zx1**2 / (zx1**2 + zy1**2 + (zx1*zy1)**2)
!
!G2= G(SIGH2MR/SIGH2MP(KH,PVEG),SIGT2MR/SIGT2MP(KH))
zx2 = xsigh2mr/zsigh2mp
zy2 = xsigt2mr/psigt2mp(kh)          
pg2  = zx2**2 / (zx2**2 + zy2**2 + (zx2*zy2)**2)
!
!G3= G(SIGT2MO/SIGT2MP(KH),SIGH2MO/SIGH2MP(KH,PVEG))
zx3 = xsigt2mo/psigt2mp(kh)
zy3 = xsigh2mo/zsigh2mp
pg3  = zx3**2 / (zx3**2 + zy3**2 + (zx3*zy3)**2)
!
!G4= G(SIGT2MR/SIGT2MP(KH),SIGH2MR/SIGH2MP(KH,PVEG))
zx4 = xsigt2mr/psigt2mp(kh)
zy4 = xsigh2mr/zsigh2mp          
pg4  = zx4**2 / (zx4**2 + zy4**2 + (zx4*zy4)**2)
!
! polynomes de base pour la dependance par rapport a l'indice de vegetation
!
pvgst  = (1.0 - pveg)*(pvgat1(kh) + pvgat2(kh)*pveg + pvgat3(kh)*pveg**2)
pvgsh  = (1.0 - pveg)*(pvgah1(kh) + pvgah2(kh)*pveg + pvgah3(kh)*pveg**2)
pvgpt1 = (1.0 - pveg)*(pvgbt1(kh) + pvgbt2(kh)*pveg + pvgbt3(kh)*pveg**2)
pvgph1 = (1.0 - pveg)*(pvgbh1(kh) + pvgbh2(kh)*pveg + pvgbh3(kh)*pveg**2)
pvgpt2 = pveg*(pvgct1(kh) + pvgct2(kh)*pveg)
pvgph2 = pveg*(pvgch1(kh) + pvgch2(kh)*pveg)
IF (lhook) CALL dr_hook('OI_FCTVEG',1,zhook_handle)
!
!**---------------------------------------------------------------------
END SUBROUTINE oi_fctveg