Changeset 5202 for LMDZ6/branches/cirrus/libf/phylmd/surf_land_mod.F90
- Timestamp:
- Sep 20, 2024, 12:32:04 PM (7 weeks ago)
- Location:
- LMDZ6/branches/cirrus
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/surf_land_mod.F90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/cirrus
- Property svn:mergeinfo changed
-
LMDZ6/branches/cirrus/libf/phylmd/surf_land_mod.F90
r4526 r5202 20 20 qsurf, tsurf_new, dflux_s, dflux_l, & 21 21 flux_u1, flux_v1 , & 22 veget,lai,height) 22 veget,lai,height & 23 #ifdef ISO 24 ,xtprecip_rain, xtprecip_snow,xtspechum, & 25 xtsnow, xtsol,xtevap,h1, & 26 runoff_diag,xtrunoff_diag,Rland_ice & 27 #endif 28 ) 23 29 24 30 USE dimphy … … 59 65 USE calcul_fluxs_mod 60 66 USE indice_sol_mod 67 #ifdef ISO 68 use infotrac_phy, ONLY: ntiso,niso 69 use isotopes_mod, ONLY: nudge_qsol, iso_eau 70 #ifdef ISOVERIF 71 use isotopes_verif_mod 72 #endif 73 #endif 74 61 75 USE print_control_mod, ONLY: lunout 62 76 … … 92 106 ! corresponds to previous sollwdown 93 107 REAL, DIMENSION(klon), INTENT(IN) :: q2m, t2m 94 108 #ifdef ISO 109 REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow 110 REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum 111 #endif 95 112 ! In/Output variables 96 113 !**************************************************************************************** … … 98 115 REAL, DIMENSION(klon), INTENT(INOUT) :: agesno 99 116 REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil 117 #ifdef ISO 118 REAL, DIMENSION(niso,klon), INTENT(INOUT) :: xtsnow, xtsol 119 #endif 100 120 101 121 ! Output variables … … 116 136 REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: veget,lai 117 137 REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height 138 #ifdef ISO 139 REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap 140 REAL, DIMENSION(klon), INTENT(OUT) :: h1 141 REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrunoff_diag 142 REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag 143 REAL, DIMENSION(niso,klon), INTENT(IN) :: Rland_ice 144 #endif 118 145 119 146 ! Local variables … … 132 159 !albedo SB <<< 133 160 134 161 #ifdef ISO 162 real, parameter :: t_coup = 273.15 163 real, dimension(klon) :: fqfonte_diag 164 real, dimension(klon) :: snow_evap_diag 165 real, dimension(klon) :: fqcalving_diag 166 integer :: ixt 167 #endif 135 168 !**************************************************************************************** 136 169 !Total solid precip … … 142 175 ENDIF 143 176 !**************************************************************************************** 177 #ifdef ISO 178 #ifdef ISOVERIF 179 ! write(*,*) 'surf_land_mod 162' 180 do i=1,knon 181 if (iso_eau.gt.0) then 182 call iso_verif_egalite_choix(precip_snow(i), & 183 & xtprecip_snow(iso_eau,i),'surf_land_mod 129', & 184 & errmax,errmaxrel) 185 call iso_verif_egalite_choix(qsol(i), & 186 & xtsol(iso_eau,i),'surf_land_mod 139', & 187 & errmax,errmaxrel) 188 endif 189 enddo 190 #endif 191 #ifdef ISOVERIF 192 ! write(*,*) 'surf_land 169: ok_veget=',ok_veget 193 do i=1,knon 194 do ixt=1,ntiso 195 call iso_verif_noNaN(xtprecip_snow(ixt,i),'surf_land 146') 196 enddo 197 enddo 198 #endif 199 #endif 144 200 145 201 … … 172 228 END DO 173 229 230 #ifdef ISO 231 CALL abort_gcm('surf_land_mod 220','isos pas prevus dans orchidee',1) 232 #endif 174 233 ! temporary for keeping same results using lwdown_m instead of lwdown 175 234 CALL surf_land_orchidee(itime, dtime, date0, knon, & … … 183 242 tsol_rad, tsurf_new, alb1_new, alb2_new, & 184 243 emis_new, z0m, z0h, qsurf, & 185 veget, lai, height) 244 veget, lai, height & 245 !#ifdef ISO 246 ! , xtprecip_rain, xtprecip_snow, xtspechum, xtevap & 247 !#endif 248 ) 249 250 #ifdef ISO 251 #ifdef ISOVERIF 252 write(*,*) 'surf_land 193: apres surf_land_orchidee' 253 do i=1,knon 254 if (iso_eau.gt.0) then 255 call iso_verif_egalite_choix(xtevap(iso_eau,i),evap(i), & 256 & 'surf_land 197',errmax,errmaxrel) 257 endif !if (iso_eau.gt.0) then 258 enddo !do i=1,knon 259 #endif 260 #endif 186 261 ! 187 262 !* Add contribution of relief to surface roughness … … 196 271 ! 197 272 !**************************************************************************************** 273 #ifdef ISO 274 #ifdef ISOVERIF 275 ! write(*,*) 'surf_land 247' 276 call iso_verif_egalite_vect1D( & 277 & xtsnow,snow,'surf_land_mod 207',niso,klon) 278 #endif 279 #endif 280 281 #ifdef ISO 282 if (nudge_qsol.eq.1) then 283 call surf_land_nudge_qsol(knon,rlat,rlon,qsol,xtsol,knindex) 284 endif 285 !write(*,*) 'surf_land 258' 286 #endif 198 287 CALL surf_land_bucket(itime, jour, knon, knindex, debut, dtime,& 199 288 tsurf, p1lay, cdragh, precip_rain, precip_totsnow, temp_air, & … … 202 291 snow, qsol, agesno, tsoil, & 203 292 qsurf, z0m, alb1_new, alb2_new, evap, & 204 fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l) 293 fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l & 294 #ifdef ISO 295 ,xtprecip_rain, xtprecip_snow,xtspechum, & 296 xtsnow, xtsol,xtevap,h1, & 297 & runoff_diag, xtrunoff_diag,Rland_ice & 298 #endif 299 & ) 205 300 z0h(1:knon)=z0m(1:knon) ! En attendant mieux 206 301 … … 224 319 p1lay, temp_air, & 225 320 flux_u1, flux_v1) 321 322 #ifdef ISO 323 #ifdef ISOVERIF 324 ! write(*,*) 'surf_land 237: sortie' 325 DO i=1,knon 326 IF (iso_eau >= 0) THEN 327 call iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), & 328 & 'surf_land 241',errmax,errmaxrel) 329 ENDIF !if (iso_eau.gt.0) then 330 ENDDO !do i=1,knon 331 #endif 332 #endif 226 333 227 334 !albedo SB >>> … … 248 355 249 356 END SUBROUTINE surf_land 357 358 359 #ifdef ISO 360 SUBROUTINE surf_land_nudge_qsol(knon,rlat,rlon,qsol,xtsol,knindex) 361 362 USE dimphy 363 USE infotrac_phy, ONLY: niso 364 USE isotopes_mod, ONLY: region_nudge_qsol 365 INTEGER, INTENT(IN) :: knon 366 REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat 367 REAL, DIMENSION(klon), INTENT(INOUT) :: qsol 368 INTEGER, DIMENSION(klon), INTENT(IN) :: knindex 369 REAL, DIMENSION(niso,klon), INTENT(INOUT) :: xtsol 370 REAL :: lat_min_nudge_qsol,lat_max_nudge_qsol 371 REAL :: lon_min_nudge_qsol,lon_max_nudge_qsol 372 INTEGER :: i,ixt 373 REAL :: qsol_new 374 375 IF (region_nudge_qsol == 1) THEN 376 ! Aamzonie du Sud 377 lat_min_nudge_qsol=-15.0 378 lat_max_nudge_qsol=-5.0 379 lon_min_nudge_qsol=-70.0 380 lon_max_nudge_qsol=-50.0 381 ELSE IF (region_nudge_qsol == 2) THEN 382 ! Aamzonie du Nord 383 lat_min_nudge_qsol=-5.0 384 lat_max_nudge_qsol=5.0 385 lon_min_nudge_qsol=-70.0 386 lon_max_nudge_qsol=-50.0 387 ELSE 388 WRITE(*,*) 'surf_land 298: cas pas prevu' 389 WRITE(*,*) 'region_nudge_qsol=',region_nudge_qsol 390 stop 391 ENDIF 392 393 ! write(*,*) 'surf_land 314: knon=',knon 394 ! write(*,*) 'rlat=',rlat 395 ! write(*,*) 'rlon=',rlon 396 ! write(*,*) 'region_nudge_qsol=',region_nudge_qsol 397 398 DO i=1,knon 399 IF ((rlat(knindex(i)) >= lat_min_nudge_qsol).and. & 400 & (rlat(knindex(i)) <= lat_max_nudge_qsol).and. & 401 & (rlon(knindex(i)) >= lon_min_nudge_qsol).and. & 402 & (rlon(knindex(i)) <= lon_max_nudge_qsol)) THEN 403 ! write(*,*) 'surf_land 324: bon domaine: rlat,rlon,qsol=', & 404 ! & rlat(knindex(i)),rlon(knindex(i)),qsol(knindex(i)) 405 qsol_new=qsol(i) 406 IF (region_nudge_qsol == 1) THEN 407 qsol_new=max(qsol(i),50.0) 408 ELSE IF (region_nudge_qsol == 2) THEN 409 qsol_new=max(qsol(i),120.0) 410 ELSE !if (region_nudge_qsol.eq.1) then 411 WRITE(*,*) 'surf_land 317: cas pas prevu' 412 WRITE(*,*) 'region_nudge_qsol=',region_nudge_qsol 413 STOP 414 ENDIF !if (region_nudge_qsol.eq.1) then 415 IF (qsol(i) > 0.0) THEN 416 DO ixt=1,niso 417 xtsol(ixt,i)=xtsol(ixt,i)*qsol_new/qsol(i) 418 ENDDO 419 ELSE !IF (qsol(i) > 0.0) THEN 420 DO ixt=1,niso 421 xtsol(ixt,i)=0.0 422 ENDDO 423 ENDIF !IF (qsol(i) > 0.0) THEN 424 qsol(i)=qsol_new 425 WRITE(*,*) 'surf_land 346: qsol_new=',qsol(i) 426 ENDIF ! if ((rlat(i).ge.lat_min_nudge_qsol).and. 427 ENDDO !DO i=1,knon 428 429 END SUBROUTINE surf_land_nudge_qsol 430 #endif 431 250 432 ! 251 433 !****************************************************************************************
Note: See TracChangeset
for help on using the changeset viewer.
