|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE CANOPY_EVOL_FIELD(KI, KLVL, PTSTEP, KIMPL, PK, PDKDDVDZ, & 00003 PSFLUX_F, PFORC_F, PDFORC_FDF, PDZ, PDZF, & 00004 PEXT, PDEXTDV, PF, PWF, PALFA, PBETA ) 00005 ! ######################################### 00006 ! 00007 !!**** *CANOPY_EVOL_FIELD* - evolution of wind in canopy 00008 !! 00009 !! 00010 !! PURPOSE 00011 !! ------- 00012 !! 00013 !!** METHOD 00014 !! ------ 00015 !! 00016 !! EXTERNAL 00017 !! -------- 00018 !! 00019 !! 00020 !! IMPLICIT ARGUMENTS 00021 !! ------------------ 00022 !! 00023 !! REFERENCE 00024 !! --------- 00025 !! 00026 !! 00027 !! AUTHOR 00028 !! ------ 00029 !! V. Masson *Meteo France* 00030 !! 00031 !! MODIFICATIONS 00032 !! ------------- 00033 !! Original 07/2006 00034 !------------------------------------------------------------------------------- 00035 ! 00036 !* 0. DECLARATIONS 00037 ! ------------ 00038 ! 00039 USE MODI_TRIDIAG_SURF 00040 ! 00041 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00042 USE PARKIND1 ,ONLY : JPRB 00043 ! 00044 IMPLICIT NONE 00045 ! 00046 !* 0.1 Declarations of arguments 00047 ! ------------------------- 00048 ! 00049 INTEGER, INTENT(IN) :: KI ! number of horizontal points 00050 INTEGER, INTENT(IN) :: KLVL ! number of levels in canopy 00051 REAL, INTENT(IN) :: PTSTEP ! time-step (s) 00052 INTEGER, INTENT(IN) :: KIMPL ! implicitation code: 00053 ! ! 1 : computes only alfa and beta coupling 00054 ! ! coefficients for all variables 00055 ! ! 2 : computes temporal evolution of the 00056 ! ! variables 00057 REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PK ! mixing exchange coefficient (m2/s) 00058 REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDKDDVDZ ! derivative of mixing coefficient as a 00059 ! ! function of vertical gradient of wind 00060 ! ! (at mid levels) (m2) 00061 REAL, DIMENSION(KI), INTENT(IN) :: PSFLUX_F ! surface flux w'Th' (mK/s) 00062 REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PFORC_F ! tendency of wind due to canopy drag (K/s) 00063 REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDFORC_FDF! formal derivative of the tendency of 00064 ! ! wind due to canopy drag (1/s) 00065 REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDZ ! deltaZ between canopy half levels, 00066 ! ! located at full levels (m) 00067 REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDZF ! deltaZ between canopy (full) levels, 00068 ! ! located at half levels (m) 00069 REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PEXT ! external forcing at full levels 00070 REAL, DIMENSION(KI,KLVL), INTENT(IN) :: PDEXTDV ! derivative of external forcing as a 00071 ! ! function of vertical variable 00072 ! ! (at full levels) 00073 REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PF ! pot. temp. at canopy levels (K) 00074 REAL, DIMENSION(KI,KLVL), INTENT(OUT) :: PWF ! turbulent flux (at half levels) (mK/s) 00075 REAL, DIMENSION(KI), OPTIONAL, INTENT(OUT) :: PALFA ! V+(1) = alfa F(1) + beta 00076 REAL, DIMENSION(KI), OPTIONAL, INTENT(OUT) :: PBETA ! V+(1) = alfa F(1) + beta 00077 ! 00078 ! 00079 !* 0.2 Declarations of local variables 00080 ! ------------------------------- 00081 ! 00082 INTEGER :: JLAYER ! loop counter on layers 00083 ! 00084 REAL, DIMENSION(KI,KLVL) :: ZDFDZ ! dTh/dz at mid levels 00085 REAL, DIMENSION(KI,KLVL) :: ZWORK ! work variable : wind at futur instant 00086 ! ! (or past at the end of the routine) 00087 REAL, DIMENSION(KI,KLVL) :: ZF ! turbulent flux at mid levels 00088 REAL, DIMENSION(KI,KLVL) :: ZDFDDVDZ ! derivative of turbulent flux as a 00089 ! ! function of vertical gradient of wind variable 00090 ! ! (at mid levels) 00091 REAL, DIMENSION(KI) :: ZDFADT ! dTHa/dt at forcing level 00092 REAL, DIMENSION(KI) :: ZDWFDZ ! dw'Th'/dz at forcing level 00093 REAL, DIMENSION(KI) :: ZALFA, ZBETA 00094 LOGICAL :: LIMPL 00095 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00096 ! 00097 !------------------------------------------------------------------------------- 00098 ! 00099 ! 00100 !* 1. initializations 00101 ! --------------- 00102 ! 00103 !* external forces 00104 ! 00105 IF (LHOOK) CALL DR_HOOK('CANOPY_EVOL_FIELD',0,ZHOOK_HANDLE) 00106 ! 00107 !------------------------------------------------------------------------------- 00108 ! 00109 !* 2. pot. temp. vertical derivative (at half levels below full levels) 00110 ! ------------------------------ 00111 ! 00112 ZDFDZ(:,:) = -999. 00113 DO JLAYER=2,KLVL 00114 ZDFDZ(:,JLAYER) = (PF(:,JLAYER) - PF(:,JLAYER-1)) / PDZF(:,JLAYER) 00115 END DO 00116 ! 00117 !------------------------------------------------------------------------------- 00118 ! 00119 !* 3. turbulent flux (at half levels below full levels) 00120 ! -------------- 00121 ! 00122 ZWORK = -999. 00123 ! 00124 !* surface flux 00125 ZWORK(:,1) = PSFLUX_F(:) 00126 ! 00127 !* flux at other levels 00128 DO JLAYER=2,KLVL 00129 ZWORK(:,JLAYER) = -PK (:,JLAYER) * ZDFDZ(:,JLAYER) 00130 END DO 00131 ! 00132 !------------------------------------------------------------------------------- 00133 ! 00134 !* 4. formal derivative of turbulent flux for variable X=(dU/dz) 00135 ! ---------------------------------------------------------- 00136 ! 00137 !* no implicitation of surface flux 00138 ! 00139 ZDFDDVDZ(:,:) = 0. 00140 ! 00141 !* other levels (at half levels below full levels) 00142 ! 00143 ZDFDDVDZ(:,2:KLVL) = - PK(:,2:KLVL) - PDKDDVDZ(:,2:KLVL) * ZDFDZ(:,2:KLVL) 00144 ! 00145 !------------------------------------------------------------------------------- 00146 ! 00147 !* 7. adds Forces & divergence of turbulent flux to dU/dt (at full levels) 00148 ! --------------------------------------------------- 00149 ! 00150 LIMPL=(KIMPL==1) 00151 CALL TRIDIAG_SURF(PF, ZWORK, ZDFDDVDZ, PEXT, PDEXTDV, PTSTEP, & 00152 PDZF, PDZ, ZF, LIMPL, ZALFA, ZBETA ) 00153 ! 00154 IF (PRESENT(PALFA)) PALFA = ZALFA 00155 IF (PRESENT(PBETA)) PBETA = ZBETA 00156 ! 00157 !------------------------------------------------------------------------------- 00158 ! 00159 !* 8. updated turbulent flux (at half levels below full levels) 00160 ! ---------------------- 00161 ! 00162 PWF(:,:) = -999. 00163 PWF(:,1) = PSFLUX_F(:) 00164 ! 00165 DO JLAYER=2,KLVL 00166 PWF(:,JLAYER) = PWF(:,JLAYER-1) & 00167 + ( PFORC_F(:,JLAYER-1) + PDFORC_FDF(:,JLAYER-1) * (ZF(:,JLAYER-1)-PF(:,JLAYER-1)) ) & 00168 * PDZ(:,JLAYER-1) 00169 END DO 00170 ! 00171 !------------------------------------------------------------------------------- 00172 ! 00173 !* 8. New value of potential temperature (at full levels) 00174 ! ---------------------------------- 00175 ! 00176 PF(:,:) = ZF(:,:) 00177 ! 00178 IF (LHOOK) CALL DR_HOOK('CANOPY_EVOL_FIELD',1,ZHOOK_HANDLE) 00179 !---------------------------------------------------------------- 00180 ! 00181 END SUBROUTINE CANOPY_EVOL_FIELD
1.8.0
