|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 !option! -O nomove 00002 !****--------------------------------------------------------------------------- 00003 !**** CACSTS : INITIALISE LES CHAMPS DE SURFACE 00004 !**** ------ 00005 !**** Auteurs : CB 01/91, BU 05/92, VC 05/93, DG 03/94, PA 09/95, DG 05/96 00006 !**** Mod : E. Bazile 01/97 Soustraction du biais moyen de temperature 00007 !**** et/ou d'humidite pour les increments utilises 00008 !**** pour l'analyse de l'eau du sol 00009 !**** Mod : D. Giard 03/99 ACSOL -> ACSOLW 00010 !**** E. Bazile , F. Bouyssel : Remplacement du logique LLLACW par 00011 !**** une fonction continue ZDACW (LSOLV). 00012 !**** Mod : F. Taillefer 09/02 : mise a jour constantes surface selon SST 00013 !**** Mod : F. Bouyssel 02/04 : Seuil utilisant l'angle zenithal solaire 00014 !**** Mod : E. Bazile 01/2007 : Parametre pour la correction PSNS et WPI 00015 ! A.Trojakova 27-Jun-2007 bugfixing ZV10M (surface pointers) 00016 ! F. Bouyssel 27-Mar-2011 Use of REPS2 instead of REPS3 for ZNEIG 00017 !****--------------------------------------------------------------------------- 00018 ! 00019 SUBROUTINE OI_CACSTS(KNBPT,PT2INC,PH2INC,PWGINC,PWS_O, & 00020 IDAT,NSSSSS, & 00021 PTP,PWP,PTL,PSNS,PTS,PWS, & 00022 PTCLS,PHCLS,PUCLS,PVCLS,PSSTC,PWPINC1,PWPINC2,PWPINC3, & 00023 PT2MBIAS,PH2MBIAS, & 00024 PRRCL,PRRSL,PRRCN,PRRSN,PATMNEB,PEVAP,PEVAPTR, & 00025 PITM,PVEG,PALBF,PEMISF,PZ0F, & 00026 PIVEG,PARG,PD2,PSAB,PLAI,PRSMIN,PZ0H, & 00027 PTSC,PTPC,PWSC,PWPC,PSNC,PGELAT,PGELAM,PGEMU) 00028 ! 00029 !****--------------------------------------------------------------------------- 00030 !** BUT : INITIALISE LES CHAMPS DE SURFACE PROGNOSTIQUES 00031 !** --- 00032 !** SEQUENCE D'APPEL : 00033 !** ---------------- 00034 !** CALL CACSTS(....) 00035 00036 !** ARGUMENTS D'ENTREE : 00037 !** ------------------ 00038 !** 00039 !** - EXPLICITE - 00040 !** KNBPT : nombre reel de points traites 00041 !** PT2INC : increment d'analyse de T2m 00042 !** PH2INC : increment d'analyse de Hu2m 00043 !** PSP_SB,PSP_SG,PSP_RR,PSD_VF,PSD_VV,PSD_VX,PSP_CI,PSP_X2 : 00044 !** buffer des champs pdg de l'analyse 00045 !** PGELAM, PGELAT, PGEMU : coordonnees geographiques 00046 00047 !** ARGUMENTS DE SORTIE : 00048 !** ------------------- 00049 !** EXTERNES : CAVEGI (FCTVEG) - ACSOLW - TSL 00050 !** -------- 00051 00052 !** ALGORITHME : - INITIALISE LA TEMPERATURE DE SURFACE. 00053 !** ---------- - INITIALISE LA TEMPERATURE PROFONDE. 00054 !** - INITIALISE LE RESERVOIR DE SURFACE. 00055 !** - INITIALISE LE RESERVOIR PROFOND. 00056 !** - CORRIGE LA QUANTITE DE NEIGE. 00057 !***----------------------------------------------------------------- 00058 ! 00059 USE MODD_CSTS, ONLY : XG, XTT, XRHOLW, XDAY 00060 USE MODD_SURF_PAR, ONLY : XUNDEF 00061 USE MODD_ASSIM 00062 ! 00063 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00064 USE PARKIND1 ,ONLY : JPRB 00065 ! 00066 USE MODI_OI_CAVEGI 00067 USE MODI_OI_ACSOLW 00068 USE MODI_OI_JACOBIANS 00069 USE MODI_OI_TSL 00070 USE MODI_OI_FCTVEG 00071 USE MODI_OI_KALMAN_GAIN 00072 ! 00073 IMPLICIT NONE 00074 ! 00075 INTEGER,INTENT(IN) :: KNBPT, IDAT, NSSSSS 00076 ! 00077 REAL ,INTENT(IN) :: PT2INC(KNBPT) 00078 REAL ,INTENT(IN) :: PH2INC(KNBPT) 00079 REAL ,INTENT(IN) :: PWGINC(KNBPT) 00080 REAL ,INTENT(IN) :: PWS_O(KNBPT) 00081 REAL ,INTENT(INOUT) :: PTP(KNBPT) 00082 REAL ,INTENT(INOUT) :: PWP(KNBPT) 00083 REAL ,INTENT(INOUT) :: PTL(KNBPT) 00084 REAL ,INTENT(INOUT) :: PSNS(KNBPT) 00085 REAL ,INTENT(INOUT) :: PTS(KNBPT) 00086 REAL ,INTENT(INOUT) :: PWS(KNBPT) 00087 REAL ,INTENT(INOUT) :: PTCLS(KNBPT) 00088 REAL ,INTENT(INOUT) :: PHCLS(KNBPT) 00089 REAL ,INTENT(INOUT) :: PUCLS(KNBPT) 00090 REAL ,INTENT(INOUT) :: PVCLS(KNBPT) 00091 REAL ,INTENT(INOUT) :: PSSTC(KNBPT) 00092 REAL ,INTENT(INOUT) :: PWPINC1(KNBPT) 00093 REAL ,INTENT(INOUT) :: PWPINC2(KNBPT) 00094 REAL ,INTENT(INOUT) :: PWPINC3(KNBPT) 00095 REAL ,INTENT(INOUT) :: PT2MBIAS(KNBPT) 00096 REAL ,INTENT(INOUT) :: PH2MBIAS(KNBPT) 00097 REAL ,INTENT(IN) :: PRRCL(KNBPT) 00098 REAL ,INTENT(IN) :: PRRSL(KNBPT) 00099 REAL ,INTENT(IN) :: PRRCN(KNBPT) 00100 REAL ,INTENT(IN) :: PRRSN(KNBPT) 00101 REAL ,INTENT(IN) :: PATMNEB(KNBPT) 00102 REAL ,INTENT(IN) :: PEVAP(KNBPT) 00103 REAL ,INTENT(IN) :: PEVAPTR(KNBPT) 00104 REAL ,INTENT(IN) :: PITM(KNBPT) 00105 REAL ,INTENT(INOUT) :: PVEG(KNBPT) 00106 REAL ,INTENT(INOUT) :: PALBF(KNBPT) 00107 REAL ,INTENT(INOUT) :: PEMISF(KNBPT) 00108 REAL ,INTENT(INOUT) :: PZ0F(KNBPT) 00109 REAL ,INTENT(INOUT) :: PIVEG(KNBPT) 00110 REAL ,INTENT(INOUT) :: PARG(KNBPT) 00111 REAL ,INTENT(INOUT) :: PD2(KNBPT) 00112 REAL ,INTENT(INOUT) :: PSAB(KNBPT) 00113 REAL ,INTENT(INOUT) :: PLAI(KNBPT) 00114 REAL ,INTENT(INOUT) :: PRSMIN(KNBPT) 00115 REAL ,INTENT(INOUT) :: PZ0H(KNBPT) 00116 REAL ,INTENT(IN) :: PTSC(KNBPT) 00117 REAL ,INTENT(IN) :: PTPC(KNBPT) 00118 REAL ,INTENT(IN) :: PWSC(KNBPT) 00119 REAL ,INTENT(IN) :: PWPC(KNBPT) 00120 REAL ,INTENT(IN) :: PSNC(KNBPT) 00121 REAL ,INTENT(IN) :: PGELAT(KNBPT) 00122 REAL ,INTENT(IN) :: PGELAM(KNBPT) 00123 REAL ,INTENT(IN) :: PGEMU(KNBPT) 00124 ! 00125 REAL :: VGAT1(24),VGAT2(24),VGAT3(24) 00126 REAL :: VGBT1(24),VGBT2(24),VGBT3(24) 00127 REAL :: VGCT1(24),VGCT2(24) 00128 REAL :: VGAH1(24),VGAH2(24),VGAH3(24) 00129 REAL :: VGBH1(24),VGBH2(24),VGBH3(24) 00130 REAL :: VGCH1(24),VGCH2(24) 00131 REAL :: SIGT2MP(24),SIGHP2(24) 00132 ! 00133 REAL :: VGST,VGSH,VGPT1,VGPH1,VGPT2,VGPH2,G1,G2,G3,G4 00134 ! 00135 REAL :: ZITS(KNBPT), ZITP(KNBPT), ZIWS(KNBPT), ZIWP(KNBPT) 00136 REAL :: ZIVEG(KNBPT), ZWFC(KNBPT), ZWWILT(KNBPT) 00137 REAL :: ZWSMX(KNBPT), ZWPMX(KNBPT), ZWPI(KNBPT), ZWSAT(KNBPT) 00138 REAL :: ZISN(KNBPT) 00139 REAL :: ZDWG_DWG(KNBPT), ZDWG_DW2(KNBPT) 00140 ! 00141 REAL :: ZCLIM, ZCLIMCA, ZCOEF, ZCWPH, ZCWPT, ZCWSH, 00142 ZCWST, ZDW, ZECHGU, ZEVAP, ZGEL, 00143 ZH2D, ZHEFF, ZHSA, ZHSP, ZLAISRS, ZMSN, ZNEIG, 00144 ZPDN, ZPDS, ZPDT, ZPRECIP, ZSNA, ZSNC, ZT2D, 00145 ZTEFF, ZTINER, ZTPC, ZTSC, ZV10M, ZVEG, ZWP, 00146 ZWPA, ZWPC, ZWPD, ZWPD1, ZWPD2, ZWPDX, ZWPMIN, 00147 ZWPR, ZWSA, ZWSC, ZWSD, ZWSD1, ZWSD2, ZWSMSPI, 00148 ZWSR, ZZH, ZZT, ZDACW, ZMU0, ZMU0M, ZPDM, ZPDV, 00149 ZK1, ZK2, ZDACW2, ZPR_EVA, ZWSMIN, ZZVEG 00150 ! 00151 INTEGER :: IH, JROF 00152 LOGICAL :: LSGOBS 00153 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00154 ! 00155 !-------------------------------------------------------------------- 00156 IF (LHOOK) CALL DR_HOOK('OI_CACSTS',0,ZHOOK_HANDLE) 00157 ZECHGU = REAL(NECHGU) * 3600. 00158 ! 00159 !** 1. Initialisation des polynomes bruts et des champs de reference. 00160 ! 00161 CALL OI_CAVEGI(VGAT1,VGAT2,VGAT3,VGBT1,VGBT2,VGBT3,VGCT1,VGCT2, & 00162 VGAH1,VGAH2,VGAH3,VGBH1,VGBH2,VGBH3,VGCH1,VGCH2, & 00163 SIGT2MP,SIGHP2,LSGOBS) 00164 ! 00165 ! 00166 !* Seuil d'evaporation min. pour analyse de W (SEVAP en mm/jour) 00167 00168 ZEVAP = -SEVAP / XDAY 00169 00170 !* 1.2 Initialisation des variables intermediaires 00171 ! 00172 00173 DO JROF = 1 , KNBPT 00174 ZIVEG(JROF) = ANINT(PIVEG(JROF)) 00175 IF (LFGEL) THEN 00176 ZWPI(JROF) = PTL(JROF) 00177 ELSE 00178 ZWPI (JROF) = 0.0 00179 ENDIF 00180 ENDDO 00181 ! 00182 CALL OI_ACSOLW (1,KNBPT, & 00183 PARG,PD2,PWS,ZIVEG,PSAB, & 00184 LLDHMT, & 00185 ZWFC, ZWPMX, ZWSAT, ZWSMX, ZWWILT) 00186 ! 00187 ! Analytical Jacobians for WG assimilation 00188 ! 00189 CALL OI_JACOBIANS (KNBPT,PWS_O,PSAB,PARG,PD2,PWP,ZDWG_DWG,ZDWG_DW2) 00190 ! 00191 !**--------------------------------------------------------------------- 00192 !** - 2 - Calcul des champs analyses. 00193 00194 DO JROF = 1 , KNBPT 00195 00196 ! stockage des champs prevus 00197 00198 ZITS(JROF) = PTS(JROF) 00199 ZITP(JROF) = PTP(JROF) 00200 ZIWS(JROF) = PWS(JROF) 00201 ZIWP(JROF) = PWP(JROF) 00202 ZVEG = PVEG(JROF) 00203 ZISN(JROF) = PSNS(JROF) 00204 ZNEIG = MAX(0.0,PSNS(JROF)/(PSNS(JROF)+WCRIN)) 00205 ! 00206 ! analyse de surface ou rappel vers la climatologie, sur terre 00207 00208 ! IF (PITM(JROF) > 0.5.AND.(RCLIMCA >= 0.0).AND.PWS(JROF)/=XUNDEF) THEN 00209 IF (PWS(JROF)/=XUNDEF) THEN 00210 00211 ! analyse de surface 00212 00213 !* 2.O Initialisations pour l'analyse de surface 00214 00215 ! conditions locales d'analyse effective des champs de surface 00216 ! calcul du temps solaire local utile 00217 ! 00218 ZV10M=SQRT(PUCLS(JROF)**2+PVCLS(JROF)**2) 00219 ZPRECIP = MAX(0.,PRRCL(JROF))+ MAX(0.,PRRSL(JROF)) & 00220 + MAX(0.,PRRCN(JROF))+ MAX(0.,PRRSN(JROF)) 00221 ! 00222 ! Surface water forcing to the superficial reservoir 00223 ! 00224 ZPR_EVA = ZPRECIP + ABS(PEVAP(JROF)) 00225 ! 00226 CALL OI_TSL(IDAT,NSSSSS,PGELAT(JROF),PGELAM(JROF),ZMU0,ZMU0M,IH) 00227 ZMU0 = ZMU0M 00228 ! 00229 ZDACW = MIN(1.0,MAX(0.0,ABS(REAL(NINT(ZIVEG(JROF))-NTVGLA)))) 00230 * MIN(1.0,MAX(0.0,REAL(IH))) 00231 * MIN(1.0,MAX(0.0,REAL(IDJ)/REAL(MINDJ))) 00232 * MIN(1.0,MAX(0.0,1.0-ZV10M/(V10MX+REPS3))) 00233 * MIN(1.0,MAX(0.0,1.0-ZPRECIP/(SPRECIP+REPS3))) 00234 * MIN(1.0,MAX(0.0,1.0-ZWPI(JROF)/SICE)) 00235 ! 00236 ZDACW2 = MIN(1.0,MAX(0.0,1.0-ZPR_EVA/(SPRECIP2+REPS3))) & 00237 * MIN(1.0,MAX(0.0,1.0-ZWPI(JROF)/SICE)) 00238 ! 00239 ! coefficients : dependance par rapport a l'angle zenithal solaire 00240 ! 00241 IF ( SMU0 > REPS3 ) THEN 00242 ZPDM=0.5*(1.0+TANH(SMU0*(ZMU0-0.5))) 00243 ELSE 00244 ZPDM=1.0 00245 ENDIF 00246 ZDACW = ZDACW * ZPDM 00247 ! 00248 ! coefficients : dependance par rapport a l'evaporation de surface 00249 ! 00250 IF ( SEVAP > REPS3 ) THEN 00251 ZPDV=MIN(1.0,MAX(0.0,PEVAP(JROF)/ZEVAP)) 00252 ELSE 00253 ZPDV=1.0 00254 ENDIF 00255 ZDACW = ZDACW * ZPDV 00256 ! 00257 ! coefficients : dependance par rapport a la nebulosite 00258 ! 00259 IF ( ANEBUL > REPS3 ) THEN 00260 ZPDN=1.0-ANEBUL*(PATMNEB(JROF)/ZECHGU)**NNEBUL 00261 ELSE 00262 ZPDN=1.0 00263 ENDIF 00264 ZDACW = ZDACW * ZPDN 00265 ! 00266 ! increments de temperature et d'humidite relative a 2m utiles 00267 ! 00268 ZT2D = PT2INC(JROF) 00269 ZH2D = PH2INC(JROF) 00270 ! 00271 !* 2.1 Analyse de temperature 00272 ! 00273 ! report de l'increment de temperature a 2m sur Ts et Tp avec amortissement 00274 ! 00275 ! 00276 ZTINER = SODELX(1)/SODELX(0) 00277 IF (NNEIGT <= 0.OR. ZNEIG < REPS2) THEN 00278 ZPDT= 1.0 00279 ELSEIF (SNEIGT < REPS3) THEN 00280 ZPDT= 0.0 00281 ELSE 00282 ZPDT= (1.0- MIN(ZNEIG,SNEIGT)/SNEIGT)**NNEIGT 00283 ENDIF 00284 00285 PTS(JROF) = PTS(JROF) + ZT2D*ZPDT 00286 PTP(JROF) = PTP(JROF) + ZT2D*ZPDT/ZTINER 00287 00288 !* 2.2 Analyse d'humidite par interpolation optimale pour ISBA 00289 00290 00291 ! coefficients : dependance principale par rapport a la vegetation 00292 ! 00293 ! fctveg.h 00294 !****------------------------------------------------------------------- 00295 ! 00296 CALL OI_FCTVEG(IH,ZVEG, & 00297 VGAT1,VGAT2,VGAT3,VGBT1,VGBT2,VGBT3,VGCT1,VGCT2, & 00298 VGAH1,VGAH2,VGAH3,VGBH1,VGBH2,VGBH3,VGCH1,VGCH2, & 00299 SIGT2MP,SIGHP2, & 00300 G1,G2,G3,G4, & 00301 VGST,VGSH,VGPT1,VGPH1,VGPT2,VGPH2) 00302 ! 00303 ZLAISRS = PLAI(JROF)/MAX(1.0,PRSMIN(JROF)) 00304 ZCWST = VGST 00305 ZCWSH = VGSH 00306 ZCWPT = VGPT1 + ZLAISRS*VGPT2 00307 ZCWPH = VGPH1 + ZLAISRS*VGPH2 00308 00309 ! coefficients : dependance par rapport a la texture 00310 00311 ZDW = (ZWFC(JROF)-ZWWILT(JROF))/ADWR 00312 00313 ! coefficients : dependance par rapport aux erreurs d'observation 00314 ! nb - in our case LSGOBS=.F. 00315 00316 IF ( LSGOBS ) THEN 00317 ZZT = G1 / G2 00318 ZZH = G3 / G4 00319 ELSE 00320 ZZT = 1.0 00321 ZZH = 1.0 00322 ENDIF 00323 00324 ! coefficients : dependance par rapport a la couverture neigeuse 00325 00326 IF (NNEIGW <= 0.OR. ZNEIG < REPS2) THEN 00327 ZPDS= 1.0 00328 ELSEIF (SNEIGW < REPS3) THEN 00329 ZPDS= 0.0 00330 ELSE 00331 ZPDS= (1.0- MIN(ZNEIG,SNEIGW)/SNEIGW)**NNEIGW 00332 ENDIF 00333 ZDACW = ZDACW * ZPDS 00334 ! 00335 ZDACW2 = ZDACW2 * ZPDS 00336 00337 ! calcul des increments bruts pour ws=Ws/ds/ro, wp=Wp/dp/ro 00338 ! coefficients finaux 00339 00340 ZCWST = ZCWST * ZDW * ZZT * ZDACW 00341 ZCWSH = ZCWSH * ZDW * ZZH * ZDACW 00342 ZCWPT = ZCWPT * ZDW * ZZT * ZDACW 00343 ZCWPH = ZCWPH * ZDW * ZZH * ZDACW 00344 00345 ! limitation eventuelle des increments de T2m et H2m 00346 ! limitation de la valeur absolue des increments 00347 00348 IF (SIGT2MO < 0.0) ZT2D=MAX(SIGT2MO,MIN(-SIGT2MO,ZT2D)) 00349 IF (SIGH2MO < 0.0) ZH2D=MAX(SIGH2MO,MIN(-SIGH2MO,ZH2D)) 00350 00351 ! retrait du biais moyen 00352 ! soustraction du biais moyen si SCOEF(T/H) <> 1 00353 00354 PT2MBIAS(JROF)= PT2MBIAS(JROF)*(1.0-SCOEFT)+ZT2D*SCOEFT 00355 PH2MBIAS(JROF)= PH2MBIAS(JROF)*(1.0-SCOEFH)+ZH2D*SCOEFH 00356 ZTEFF = ZT2D - PT2MBIAS(JROF) 00357 ZHEFF = ZH2D - PH2MBIAS(JROF) 00358 00359 ! si le biais courant est inferieur au biais moyen on le met a zero 00360 ! IF (ABS(ZT2D).LT.ABS(PSP_CI(JROF,YSP_CI%YCI(12)%MP0)) ZTEFF = 0. 00361 ! IF (ABS(ZH2D).LT.ABS(PSP_CI(JROF,YSP_CI%YCI(13)%MP0)) ZHEFF = 0. 00362 ! si le biais courant est inferieur au biais effectif on le garde 00363 00364 IF ( (SCOEFT /= 0.0) .OR. (SCOEFH /= 0.0) ) THEN 00365 IF (ABS(ZT2D) < ABS(ZTEFF)) ZTEFF = ZT2D 00366 IF (ABS(ZH2D) < ABS(ZHEFF)) ZHEFF = ZH2D 00367 ZT2D = ZTEFF 00368 ZH2D = ZHEFF 00369 ENDIF 00370 00371 ! increments bruts 00372 00373 IF (LOBSWG) THEN 00374 CALL OI_KALMAN_GAIN(ZDWG_DWG(JROF),ZDWG_DW2(JROF),PD2(JROF),ZK1,ZK2) 00375 ZWSD = ZK1*ZDACW2*PWGINC(JROF) 00376 ZWPD = ZK2*ZDACW2*PWGINC(JROF) 00377 IF (LOBS2M) THEN 00378 IF (PWGINC(JROF) == 0.0) THEN 00379 ZWSD = RSCALDW*(ZCWST*ZT2D + ZCWSH*ZH2D) 00380 ZWPD = RSCALDW*(ZCWPT*ZT2D + ZCWPH*ZH2D) 00381 ENDIF 00382 ENDIF 00383 ELSEIF (LOBS2M) THEN 00384 ZWSD = RSCALDW*(ZCWST*ZT2D + ZCWSH*ZH2D) 00385 ZWPD = RSCALDW*(ZCWPT*ZT2D + ZCWPH*ZH2D) 00386 ELSE 00387 ZWSD = 0.0 00388 ZWPD = 0.0 00389 ENDIF 00390 00391 ! limitations sur les corrections 00392 ! pas d'analyse de ws si pas d'evaporation sur sol nu 00393 00394 IF (PEVAP(JROF)-PEVAPTR(JROF) >= 0.0 .AND. .NOT.LOBSWG)THEN 00395 ZWSD = 0.0 00396 ENDIF 00397 00398 ZZVEG = ZVEG 00399 !=============================================================== 00400 ! Lower limit for Wp set to Wwilt instead of veg*Wwilt 00401 !=============================================================== 00402 ! ZZVEG = 1.0 00403 !=============================================================== 00404 00405 ! analyse de wp limitee pour assurer veg*wwilt <= wp <= SWFC*wfc 00406 00407 IF ( LIMVEG ) THEN 00408 00409 ZWPR = ZIWP(JROF)/(PD2(JROF)*XRHOLW) 00410 IF ( ZWPR > ZWFC(JROF)*SWFC ) THEN 00411 IF ( LHUMID ) THEN 00412 ZWPD = MIN(0.0,ZWPD) 00413 ELSE 00414 ZWPD = 0.0 00415 ENDIF 00416 ELSEIF ( ZWPR < ZWWILT(JROF)*ZZVEG ) THEN 00417 IF ( LHUMID ) THEN 00418 ZWPD = MAX(0.0,ZWPD) 00419 ELSE 00420 ZWPD = 0.0 00421 ENDIF 00422 ELSE 00423 ZWPD1 = ZWWILT(JROF)*ZZVEG -ZWPR 00424 ZWPD2 = ZWFC(JROF)*SWFC -ZWPR 00425 ZWPD = MAX(ZWPD1,MIN(ZWPD2,ZWPD)) 00426 ENDIF 00427 00428 ! analyse de ws limitee pour assurer veg*wwilt <= ws <= SWFC*wfc 00429 00430 ZWSR = ZIWS(JROF)/(RD1*XRHOLW) 00431 IF ( ZWSR > ZWFC(JROF)*SWFC ) THEN 00432 IF ( LHUMID ) THEN 00433 ZWSD = MIN(0.0,ZWSD) 00434 ELSE 00435 ZWSD = 0.0 00436 ENDIF 00437 ELSEIF ( ZWSR < ZWWILT(JROF)*ZVEG) THEN 00438 IF (LHUMID) THEN 00439 ZWSD = MAX(0.0,ZWSD) 00440 ELSE 00441 ZWSD = 0.0 00442 ENDIF 00443 ELSE 00444 ZWSD1 = ZWWILT(JROF)*ZVEG -ZWSR 00445 ZWSD2 = ZWFC(JROF)*SWFC -ZWSR 00446 ZWSD = MAX(ZWSD1,MIN(ZWSD2,ZWSD)) 00447 ENDIF 00448 ENDIF 00449 00450 ! lissage des increments d'analyse de wp 00451 00452 IF ( LISSEW ) THEN 00453 ZWPDX = ZWPD 00454 IF ( NLISSEW >= 3 ) THEN 00455 ZWPD =.25*(PWPINC3(JROF)+PWPINC2(JROF)+PWPINC1(JROF)+ZWPDX) 00456 ELSE 00457 ZWPD = 0.0 00458 ENDIF 00459 IF ( NLISSEW >= 2 ) THEN 00460 PWPINC3(JROF)=PWPINC2(JROF) 00461 ENDIF 00462 IF ( NLISSEW >= 1 ) THEN 00463 PWPINC2(JROF)=PWPINC1(JROF) 00464 ENDIF 00465 PWPINC1(JROF)=ZWPDX 00466 ENDIF 00467 00468 ! report des increments sur Ws, Wp 00469 00470 ZWSA = PWS(JROF) + ZWSD*RD1*XRHOLW 00471 ZWPA = PWP(JROF) + ZWPD*PD2(JROF)*XRHOLW 00472 ZWSMIN = REPS1*RD1*XRHOLW 00473 PWS(JROF) = MAX(ZWSMIN,MIN(ZWSMX(JROF),ZWSA)) 00474 00475 ! contenu en eau total minimum 00476 00477 ZWPMIN = MAX(PWS(JROF),REPS1*PD2(JROF)*XRHOLW) 00478 PWP(JROF) = MAX(ZWPMIN,MIN(ZWPMX(JROF),ZWPA)) 00479 00480 !* 2.4 Rappel vers la climatologie 00481 00482 00483 ! mise a jour des champs climatologiques 00484 00485 IF ( .NOT. LCLIM ) THEN 00486 ZTSC = ZITS(JROF) 00487 ZTPC = ZITP(JROF) 00488 ZWSC = ZIWS(JROF) 00489 ZWPC = ZIWP(JROF) 00490 ZSNC = PSNS(JROF) 00491 ELSE 00492 ZTSC = PTSC(JROF) 00493 ZTPC = PTPC(JROF) 00494 ZWSC = PWSC(JROF) * ZWSMX(JROF) 00495 ZWPC = PWPC(JROF) * ZWPMX(JROF) 00496 ZSNC = PSNC(JROF) 00497 ENDIF 00498 00499 ZCLIM = RCLIMCA /(1.0+RCLIMN*ZNEIG) 00500 00501 ! Rappel de Ts 00502 ZCLIMCA = RCLIMTS * ZCLIM 00503 PTS(JROF) = (1.0-ZCLIMCA)*PTS(JROF)+ ZCLIMCA *ZTSC 00504 ! Rappel de Tp 00505 ZCLIMCA = RCLIMTP * RCLIMCA 00506 PTP(JROF) = (1.0-ZCLIMCA)*PTP(JROF)+ ZCLIMCA *ZTPC 00507 ! Rappel de Ws 00508 ZCLIMCA = RCLIMWS * ZCLIM 00509 ZCLIMCA = ZCLIMCA* ZVEG + MIN(1.0,RCLIMV*ZCLIMCA)* (1.0-ZVEG) 00510 PWS(JROF) = (1.0-ZCLIMCA)*PWS(JROF)+ ZCLIMCA *ZWSC 00511 ! Rappel de Wp 00512 ZCLIMCA = RCLIMWP * ZCLIM 00513 ZCLIMCA = ZCLIMCA* ZVEG + MIN(1.0,RCLIMV*ZCLIMCA)* (1.0-ZVEG) 00514 IF ( LFGEL ) THEN 00515 ZWP = PWP(JROF) 00516 ZGEL = ZWPI(JROF) / MAX(ZWP+ZWPI(JROF),REPS3) 00517 ZWPC = ZWPC * (1.0 - MAX(0.0,MIN(1.0,ZGEL))) 00518 ZWPC = MAX(ZWPMIN,ZWPC) 00519 ENDIF 00520 PWP(JROF) = (1.0-ZCLIMCA)*PWP(JROF) + ZCLIMCA*ZWPC 00521 00522 ! rappel de Sn avec correction eventuelle pour fonte 00523 00524 ZSNA = (1.0-RCLIMCA)*PSNS(JROF) + RCLIMCA*ZSNC 00525 ZCOEF= RSNSA/21600. * ZECHGU 00526 ZMSN = MAX (0.0, ZCOEF*(PTCLS(JROF)-XTT))**RSNSB 00527 PSNS(JROF) = MAX (ZSNA-ZMSN ,0.0) 00528 00529 IF (LFGEL) THEN 00530 ZCOEF= RWPIA/21600. * ZECHGU 00531 ZMSN = MAX (0.0, ZCOEF*(PTCLS(JROF)-XTT))**RWPIB 00532 PTL(JROF)=MAX (ZWPI(JROF)-ZMSN ,0.0) 00533 PWP(JROF)=PWP(JROF)-PTL(JROF)+ZWPI(JROF) 00534 ENDIF 00535 00536 !* 2.5 Rappel de SST, sur mer 00537 00538 ! ELSEIF ( PITM(JROF) <= 0.5 .AND. RCLISST /= 0. .AND. LCLIM ) THEN 00539 ! PTS(JROF) = (1.0-RCLISST)*PTS(JROF) + RCLISST *PSSTC(JROF) 00540 ! PTP(JROF) = PTS(JROF) 00541 ! PWS(JROF) = XUNDEF 00542 ! PWP(JROF) = XUNDEF 00543 ! PTL(JROF) = 0.0 00544 ENDIF 00545 00546 00547 !* 2.6 Mise a jour des constantes de surface sur mer, 00548 !* en fonction de la banquise 00549 00550 IF ( PITM(JROF) <= 0.5 ) THEN 00551 IF ( PTS(JROF) <= TMERGL ) THEN 00552 PALBF(JROF) = SALBB 00553 PEMISF(JROF) = SEMIB 00554 PZ0F(JROF) = SZZ0B*XG 00555 PZ0H(JROF) = RZHZ0G*SZZ0B*XG 00556 ELSE 00557 PALBF(JROF) = SALBM 00558 PEMISF(JROF) = SEMIM 00559 ENDIF 00560 ENDIF 00561 00562 ENDDO 00563 IF (LHOOK) CALL DR_HOOK('OI_CACSTS',1,ZHOOK_HANDLE) 00564 ! 00565 !**--------------------------------------------------------------------- 00566 END SUBROUTINE OI_CACSTS
1.8.0
