Changeset 5022
- Timestamp:
- Jul 5, 2024, 4:38:48 PM (6 months ago)
- Location:
- LMDZ6/trunk/libf/phylmd
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/fonte_neige_mod.F90
r4523 r5022 36 36 REAL, ALLOCATABLE, DIMENSION(:) :: runofflic_global 37 37 !$OMP THREADPRIVATE(runofflic_global) 38 #ifdef ISO 39 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE :: xtrun_off_ter 40 !$OMP THREADPRIVATE(xtrun_off_ter) 41 REAL, ALLOCATABLE, DIMENSION(:,:) :: xtrun_off_lic 42 !$OMP THREADPRIVATE(xtrun_off_lic) 43 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE :: xtrun_off_lic_0 44 !$OMP THREADPRIVATE(xtrun_off_lic_0) 45 REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE:: fxtfonte_global 46 !$OMP THREADPRIVATE(fxtfonte_global) 47 REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE:: fxtcalving_global 48 !$OMP THREADPRIVATE(fxtcalving_global) 49 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE :: xtrunofflic_global 50 !$OMP THREADPRIVATE(xtrunofflic_global) 51 #endif 38 52 39 53 CONTAINS … … 123 137 124 138 END SUBROUTINE fonte_neige_init 139 140 #ifdef ISO 141 SUBROUTINE fonte_neige_init_iso(xtrestart_runoff) 142 143 ! This subroutine allocates and initialize variables in the module. 144 ! The variable run_off_lic_0 is initialized to the field read from 145 ! restart file. The other variables are initialized to zero. 146 147 USE infotrac_phy, ONLY: niso 148 #ifdef ISOVERIF 149 USE isotopes_mod, ONLY: iso_eau,iso_HDO 150 USE isotopes_verif_mod 151 #endif 152 ! 153 !**************************************************************************************** 154 ! Input argument 155 REAL, DIMENSION(niso,klon), INTENT(IN) :: xtrestart_runoff 156 157 ! Local variables 158 INTEGER :: error 159 CHARACTER (len = 80) :: abort_message 160 CHARACTER (len = 20) :: modname = 'fonte_neige_init' 161 INTEGER :: i 162 163 164 !**************************************************************************************** 165 ! Allocate run-off at landice and initilize with field read from restart 166 ! 167 !**************************************************************************************** 168 169 ALLOCATE(xtrun_off_lic_0(niso,klon), stat = error) 170 IF (error /= 0) THEN 171 abort_message='Pb allocation run_off_lic' 172 CALL abort_gcm(modname,abort_message,1) 173 ENDIF 174 175 xtrun_off_lic_0(:,:) = xtrestart_runoff(:,:) 176 177 #ifdef ISOVERIF 178 IF (iso_eau > 0) THEN 179 CALL iso_verif_egalite_vect1D( & 180 & xtrun_off_lic_0,run_off_lic_0,'fonte_neige 100', & 181 & niso,klon) 182 ENDIF !IF (iso_eau > 0) THEN 183 #endif 184 185 !**************************************************************************************** 186 ! Allocate other variables and initilize to zero 187 ! 188 !**************************************************************************************** 189 190 ALLOCATE(xtrun_off_ter(niso,klon), stat = error) 191 IF (error /= 0) THEN 192 abort_message='Pb allocation xtrun_off_ter' 193 CALL abort_gcm(modname,abort_message,1) 194 ENDIF 195 xtrun_off_ter(:,:) = 0. 196 197 ALLOCATE(xtrun_off_lic(niso,klon), stat = error) 198 IF (error /= 0) THEN 199 abort_message='Pb allocation xtrun_off_lic' 200 CALL abort_gcm(modname,abort_message,1) 201 ENDIF 202 xtrun_off_lic(:,:) = 0. 203 204 ALLOCATE(fxtfonte_global(niso,klon,nbsrf)) 205 IF (error /= 0) THEN 206 abort_message='Pb allocation fxtfonte_global' 207 CALL abort_gcm(modname,abort_message,1) 208 ENDIF 209 fxtfonte_global(:,:,:) = 0.0 210 211 ALLOCATE(fxtcalving_global(niso,klon,nbsrf)) 212 IF (error /= 0) THEN 213 abort_message='Pb allocation fxtcalving_global' 214 CALL abort_gcm(modname,abort_message,1) 215 ENDIF 216 fxtcalving_global(:,:,:) = 0.0 217 218 ALLOCATE(xtrunofflic_global(niso,klon)) 219 IF (error /= 0) THEN 220 abort_message='Pb allocation xtrunofflic_global' 221 CALL abort_gcm(modname,abort_message,1) 222 ENDIF 223 xtrunofflic_global(:,:) = 0.0 224 225 END SUBROUTINE fonte_neige_init_iso 226 #endif 227 125 228 ! 126 229 !**************************************************************************************** … … 128 231 SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, & 129 232 tsurf, precip_rain, precip_snow, & 130 snow, qsol, tsurf_new, evap) 131 132 USE indice_sol_mod 233 snow, qsol, tsurf_new, evap & 234 #ifdef ISO 235 & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag & 236 & ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag & 237 #endif 238 & ) 239 240 USE indice_sol_mod 241 #ifdef ISO 242 USE infotrac_phy, ONLY: niso 243 !use isotopes_mod, ONLY: ridicule_snow,iso_eau,iso_HDO 244 #ifdef ISOVERIF 245 USE isotopes_verif_mod 246 #endif 247 #endif 133 248 134 249 ! Routine de traitement de la fonte de la neige dans le cas du traitement … … 172 287 REAL, DIMENSION(klon), INTENT(INOUT) :: tsurf_new 173 288 REAL, DIMENSION(klon), INTENT(INOUT) :: evap 289 290 #ifdef ISO 291 ! sortie de quelques diagnostiques 292 REAL, DIMENSION(klon), INTENT(OUT) :: fq_fonte_diag 293 REAL, DIMENSION(klon), INTENT(OUT) :: fqfonte_diag 294 REAL, DIMENSION(klon), INTENT(OUT) :: snow_evap_diag 295 REAL, DIMENSION(klon), INTENT(OUT) :: fqcalving_diag 296 REAL, INTENT(OUT) :: max_eau_sol_diag 297 REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag 298 REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_diag 299 REAL, INTENT(OUT) :: coeff_rel_diag 300 #endif 174 301 175 302 ! Local variables … … 193 320 194 321 LOGICAL :: neige_fond 322 323 #ifdef ISO 324 max_eau_sol_diag=max_eau_sol 325 #endif 326 195 327 196 328 !**************************************************************************************** … … 231 363 232 364 bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime 365 #ifdef ISO 366 snow_evap_diag(:) = snow_evap(:) 367 coeff_rel_diag = coeff_rel 368 #endif 369 233 370 234 371 … … 254 391 bil_eau_s(i) = bil_eau_s(i) + fq_fonte 255 392 tsurf_new(i) = tsurf_new(i) - fq_fonte * chasno 393 #ifdef ISO 394 fq_fonte_diag(i) = fq_fonte 395 #endif 396 256 397 257 398 !IM cf JLD OK … … 273 414 snow(i)=MIN(snow(i),snow_max) 274 415 ENDDO 416 #ifdef ISO 417 DO i = 1, knon 418 fqcalving_diag(i) = fqcalving(i) 419 fqfonte_diag(i) = fqfonte(i) 420 ENDDO !DO i = 1, knon 421 #endif 422 275 423 276 424 IF (nisurf == is_ter) THEN … … 278 426 qsol(i) = qsol(i) + bil_eau_s(i) 279 427 run_off_ter(i) = run_off_ter(i) + MAX(qsol(i) - max_eau_sol, 0.0) 428 #ifdef ISO 429 runoff_diag(i) = MAX(qsol(i) - max_eau_sol, 0.0) 430 #endif 280 431 qsol(i) = MIN(qsol(i), max_eau_sol) 281 432 ENDDO … … 290 441 ENDDO 291 442 ENDIF 443 444 #ifdef ISO 445 DO i = 1, klon 446 run_off_lic_diag(i) = run_off_lic(i) 447 ENDDO ! DO i = 1, knon 448 #endif 292 449 293 450 !**************************************************************************************** … … 312 469 !**************************************************************************************** 313 470 ! 314 SUBROUTINE fonte_neige_final(restart_runoff) 471 SUBROUTINE fonte_neige_final(restart_runoff & 472 #ifdef ISO 473 & ,xtrestart_runoff & 474 #endif 475 & ) 315 476 ! 316 477 ! This subroutine returns run_off_lic_0 for later writing to restart file. 317 478 ! 479 #ifdef ISO 480 USE infotrac_phy, ONLY: niso 481 #ifdef ISOVERIF 482 USE isotopes_mod, ONLY: iso_eau 483 USE isotopes_verif_mod 484 #endif 485 #endif 486 ! 318 487 !**************************************************************************************** 319 488 REAL, DIMENSION(klon), INTENT(OUT) :: restart_runoff 489 #ifdef ISO 490 REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrestart_runoff 491 #ifdef ISOVERIF 492 INTEGER :: i 493 #endif 494 #endif 495 496 320 497 321 498 !**************************************************************************************** 322 499 ! Set the output variables 323 500 restart_runoff(:) = run_off_lic_0(:) 501 #ifdef ISO 502 xtrestart_runoff(:,:) = xtrun_off_lic_0(:,:) 503 #ifdef ISOVERIF 504 IF (iso_eau > 0) THEN 505 DO i=1,klon 506 IF (iso_verif_egalite_nostop(run_off_lic_0(i) & 507 & ,xtrun_off_lic_0(iso_eau,i) & 508 & ,'fonte_neige 413') & 509 & == 1) then 510 WRITE(*,*) 'i=',i 511 STOP 512 ENDIF 513 ENDDO !DO i=1,klon 514 ENDIF !IF (iso_eau > 0) then 515 #endif 516 #endif 517 518 324 519 325 520 ! Deallocation of all varaibles in the module … … 334 529 IF (ALLOCATED(fqcalving_global)) DEALLOCATE(fqcalving_global) 335 530 IF (ALLOCATED(runofflic_global)) DEALLOCATE(runofflic_global) 531 #ifdef ISO 532 IF (ALLOCATED(xtrun_off_lic_0)) DEALLOCATE(xtrun_off_lic_0) 533 IF (ALLOCATED(xtrun_off_ter)) DEALLOCATE(xtrun_off_ter) 534 IF (ALLOCATED(xtrun_off_lic)) DEALLOCATE(xtrun_off_lic) 535 IF (ALLOCATED(fxtfonte_global)) DEALLOCATE(fxtfonte_global) 536 IF (ALLOCATED(fxtcalving_global)) DEALLOCATE(fxtcalving_global) 537 IF (ALLOCATED(xtrunofflic_global)) DEALLOCATE(xtrunofflic_global) 538 #endif 539 336 540 337 541 END SUBROUTINE fonte_neige_final … … 340 544 ! 341 545 SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, & 342 fqfonte_out, ffonte_out, run_off_lic_out) 546 fqfonte_out, ffonte_out, run_off_lic_out & 547 #ifdef ISO 548 & ,fxtcalving_out, fxtfonte_out,xtrun_off_lic_out & 549 #endif 550 & ) 343 551 344 552 … … 349 557 !**************************************************************************************** 350 558 351 USE indice_sol_mod 559 USE indice_sol_mod 560 #ifdef ISO 561 USE infotrac_phy, ONLY: niso 562 #endif 352 563 353 564 REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf … … 358 569 REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_out 359 570 571 #ifdef ISO 572 REAL, DIMENSION(niso,klon), INTENT(OUT) :: fxtcalving_out 573 REAL, DIMENSION(niso,klon), INTENT(OUT) :: fxtfonte_out 574 REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrun_off_lic_out 575 INTEGER :: i,ixt 576 #endif 577 360 578 INTEGER :: nisurf 361 579 !**************************************************************************************** … … 364 582 fqfonte_out(:) = 0.0 365 583 fqcalving_out(:) = 0.0 584 #ifdef ISO 585 fxtfonte_out(:,:) = 0.0 586 fxtcalving_out(:,:) = 0.0 587 #endif 366 588 367 589 DO nisurf = 1, nbsrf … … 373 595 run_off_lic_out(:)=runofflic_global(:) 374 596 597 #ifdef ISO 598 DO nisurf = 1, nbsrf 599 DO i=1,klon 600 DO ixt=1,niso 601 fxtfonte_out(ixt,i) = fxtfonte_out(ixt,i) + fxtfonte_global(ixt,i,nisurf)*pctsrf(i,nisurf) 602 fxtcalving_out(ixt,i) = fxtcalving_out(ixt,i) + fxtcalving_global(ixt,i,nisurf)*pctsrf(i,nisurf) 603 ENDDO !DO ixt=1,niso 604 ENDDO !DO i=1,klon 605 ENDDO !DO nisurf = 1, nbsrf 606 xtrun_off_lic_out(:,:) = xtrunofflic_global(:,:) 607 #endif 608 375 609 END SUBROUTINE fonte_neige_get_vars 376 610 ! 377 611 !**************************************************************************************** 378 612 ! 613 !#ifdef ISO 614 ! subroutine fonte_neige_export_xtrun_off_lic_0(knon,xtrun_off_lic_0_diag) 615 ! use infotrac_phy, ONLY: niso 616 ! 617 ! ! inputs 618 ! INTEGER, INTENT(IN) :: knon 619 ! real, INTENT(IN), DIMENSION(niso,klon) :: xtrun_off_lic_0_diag 620 ! 621 ! xtrun_off_lic_0(:,:)=xtrun_off_lic_0_diag(:,:) 622 ! 623 ! end subroutine fonte_neige_export_xtrun_off_lic_0 624 !#endif 625 626 #ifdef ISO 627 SUBROUTINE gestion_neige_besoin_varglob_fonte_neige(klon,knon, & 628 & xtprecip_snow,xtprecip_rain, & 629 & fxtfonte_neige,fxtcalving, & 630 & knindex,nisurf,run_off_lic_diag,coeff_rel_diag) 631 632 ! dans cette routine, on a besoin des variables globales de 633 ! fonte_neige_mod. Il faut donc la mettre dans fonte_neige_mod 634 ! le reste de gestion_neige est dans isotopes_routines_mod car sinon pb 635 ! de dépendance circulaire. 636 637 USE infotrac_phy, ONLY: ntiso,niso 638 USE isotopes_mod, ONLY: iso_eau 639 USE indice_sol_mod 640 #ifdef ISOVERIF 641 USE isotopes_verif_mod 642 #endif 643 IMPLICIT NONE 644 645 ! inputs 646 INTEGER, INTENT(IN) :: klon,knon 647 REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_snow, xtprecip_rain 648 REAL, DIMENSION(niso,klon), INTENT(IN) :: fxtfonte_neige,fxtcalving 649 INTEGER, INTENT(IN) :: nisurf 650 INTEGER, DIMENSION(klon), INTENT(IN) :: knindex 651 REAL, DIMENSION(klon), INTENT(IN) :: run_off_lic_diag 652 REAL, INTENT(IN) :: coeff_rel_diag 653 654 ! locals 655 INTEGER :: i,ixt,j 656 657 #ifdef ISOVERIF 658 IF (nisurf == is_lic) THEN 659 IF (iso_eau > 0) THEN 660 DO i = 1, knon 661 j = knindex(i) 662 CALL iso_verif_egalite(xtrun_off_lic_0(iso_eau,j), & 663 & run_off_lic_0(j),'gestion_neige_besoin_varglob_fonte_neige 625') 664 ENDDO 665 ENDIF 666 ENDIF 667 #endif 668 669 ! calcul de run_off_lic 670 671 IF (nisurf == is_lic) THEN 672 ! coeff_rel = dtime/(tau_calv * rday) 673 674 DO i = 1, knon 675 j = knindex(i) 676 DO ixt = 1, niso 677 xtrun_off_lic(ixt,i) = (coeff_rel_diag * fxtcalving(ixt,i)) & 678 & +(1. - coeff_rel_diag) * xtrun_off_lic_0(ixt,j) 679 xtrun_off_lic_0(ixt,j) = xtrun_off_lic(ixt,i) 680 xtrun_off_lic(ixt,i) = xtrun_off_lic(ixt,i) + fxtfonte_neige(ixt,i) + xtprecip_rain(ixt,i) 681 ENDDO !DO ixt=1,niso 682 #ifdef ISOVERIF 683 IF (iso_eau > 0) THEN 684 IF (iso_verif_egalite_choix_nostop(xtrun_off_lic(iso_eau,i), & 685 & run_off_lic_diag(i),'gestion_neige_besoin_varglob_fonte_neige 1201a', & 686 & errmax,errmaxrel) == 1) THEN 687 WRITE(*,*) 'i,j=',i,j 688 WRITE(*,*) 'coeff_rel_diag=',coeff_rel_diag 689 STOP 690 ENDIF 691 ENDIF 692 #endif 693 ENDDO 694 ENDIF !IF (nisurf == is_lic) THEN 695 696 ! Save ffonte, fqfonte and fqcalving in global arrays for each 697 ! sub-surface separately 698 DO i = 1, knon 699 DO ixt = 1, niso 700 fxtfonte_global(ixt,knindex(i),nisurf) = fxtfonte_neige(ixt,i) 701 fxtcalving_global(ixt,knindex(i),nisurf) = fxtcalving(ixt,i) 702 ENDDO !do ixt=1,niso 703 ENDDO 704 705 IF (nisurf == is_lic) THEN 706 DO i = 1, knon 707 DO ixt = 1, niso 708 xtrunofflic_global(ixt,knindex(i)) = xtrun_off_lic(ixt,i) 709 ENDDO ! DO ixt=1,niso 710 ENDDO 711 ENDIF 712 713 END SUBROUTINE gestion_neige_besoin_varglob_fonte_neige 714 #endif 715 716 379 717 END MODULE fonte_neige_mod -
LMDZ6/trunk/libf/phylmd/ocean_forced_mod.F90
r4523 r5022 22 22 radsol, snow, agesno, & 23 23 qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, & 24 tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa) 24 tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa & 25 #ifdef ISO 26 ,xtprecip_rain, xtprecip_snow, xtspechum,Roce,rlat, & 27 xtsnow,xtevap,h1 & 28 #endif 29 ) 25 30 ! 26 31 ! This subroutine treats the "open ocean", all grid points that are not entierly covered … … 36 41 USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o 37 42 use config_ocean_skin_m, only: activate_ocean_skin 43 #ifdef ISO 44 USE infotrac_phy, ONLY: ntiso,niso 45 USE isotopes_routines_mod, ONLY: calcul_iso_surf_oce_vectall, calcul_iso_surf_sic_vectall 46 #ifdef ISOVERIF 47 USE isotopes_mod, ONLY: iso_eau,ridicule 48 !USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_egalite_choix 49 USE isotopes_verif_mod 50 #endif 51 #endif 38 52 39 53 INCLUDE "YOMCST.h" … … 57 71 real, intent(in):: rhoa(:) ! (knon) density of moist air (kg / m3) 58 72 73 #ifdef ISO 74 REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow 75 REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum 76 REAL, DIMENSION(klon), INTENT(IN) :: rlat 77 #endif 78 59 79 ! In/Output arguments 60 80 !**************************************************************************************** … … 62 82 REAL, DIMENSION(klon), INTENT(INOUT) :: snow 63 83 REAL, DIMENSION(klon), INTENT(INOUT) :: agesno !? put to 0 in ocean 64 84 #ifdef ISO 85 REAL, DIMENSION(niso,klon), INTENT(IN) :: xtsnow 86 REAL, DIMENSION(niso,klon), INTENT(INOUT):: Roce 87 #endif 88 65 89 ! Output arguments 66 90 !**************************************************************************************** … … 72 96 REAL, intent(out):: sens_prec_liq(:) ! (knon) 73 97 98 #ifdef ISO 99 REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap ! isotopes in evaporation flux 100 REAL, DIMENSION(klon), INTENT(OUT) :: h1 ! just a diagnostic, not useful for the simulation 101 #endif 102 74 103 ! Local variables 75 104 !**************************************************************************************** … … 80 109 REAL, DIMENSION(klon) :: u1_lay, v1_lay 81 110 LOGICAL :: check=.FALSE. 82 REAL sens_prec_sol(knon) 83 REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol 111 REAL, DIMENSION(knon) :: sens_prec_sol 112 REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol 113 #ifdef ISO 114 REAL, PARAMETER :: t_coup = 273.15 115 #endif 116 84 117 85 118 !**************************************************************************************** … … 87 120 !**************************************************************************************** 88 121 IF (check) WRITE(*,*)' Entering ocean_forced_noice' 89 122 123 #ifdef ISO 124 #ifdef ISOVERIF 125 DO i = 1, knon 126 IF (iso_eau > 0) THEN 127 CALL iso_verif_egalite_choix(xtspechum(iso_eau,i), & 128 & spechum(i),'ocean_forced_mod 111', & 129 & errmax,errmaxrel) 130 CALL iso_verif_egalite_choix(snow(i), & 131 & xtsnow(iso_eau,i),'ocean_forced_mod 117', & 132 & errmax,errmaxrel) 133 ENDIF !IF (iso_eau > 0) THEN 134 ENDDO !DO i=1,knon 135 #endif 136 #endif 137 90 138 !**************************************************************************************** 91 139 ! 1) … … 103 151 104 152 else ! GCM 105 CALL limit_read_sst(knon,knindex,tsurf_lim) 153 CALL limit_read_sst(knon,knindex,tsurf_lim & 154 #ifdef ISO 155 & ,Roce,rlat & 156 #endif 157 & ) 106 158 endif ! knon 107 159 !sb-- … … 161 213 flux_u1, flux_v1) 162 214 215 #ifdef ISO 216 CALL calcul_iso_surf_oce_vectall(klon, knon,t_coup, & 217 & ps,tsurf_new,spechum,u1_lay, v1_lay, xtspechum, & 218 & evap, Roce,xtevap,h1 & 219 #ifdef ISOTRAC 220 & ,knindex & 221 #endif 222 & ) 223 #endif 224 225 #ifdef ISO 226 #ifdef ISOVERIF 227 ! write(*,*) 'ocean_forced_mod 176: sortie de ocean_forced_noice' 228 IF (iso_eau > 0) THEN 229 DO i = 1, knon 230 CALL iso_verif_egalite_choix(snow(i), & 231 & xtsnow(iso_eau,i),'ocean_forced_mod 180', & 232 & errmax,errmaxrel) 233 ENDDO ! DO j=1,knon 234 ENDIF !IF (iso_eau > 0) THEN 235 #endif 236 #endif 237 163 238 END SUBROUTINE ocean_forced_noice 164 239 ! … … 173 248 radsol, snow, qsol, agesno, tsoil, & 174 249 qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, & 175 tsurf_new, dflux_s, dflux_l, rhoa) 250 tsurf_new, dflux_s, dflux_l, rhoa & 251 #ifdef ISO 252 ,xtprecip_rain, xtprecip_snow, xtspechum,Roce, & 253 xtsnow, xtsol,xtevap,Rland_ice & 254 #endif 255 ) 176 256 ! 177 257 ! This subroutine treats the ocean where there is ice. … … 187 267 USE indice_sol_mod 188 268 USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o 269 #ifdef ISO 270 USE infotrac_phy, ONLY: niso, ntiso 271 USE isotopes_routines_mod, ONLY: calcul_iso_surf_oce_vectall, calcul_iso_surf_sic_vectall 272 #ifdef ISOVERIF 273 USE isotopes_mod, ONLY: iso_eau,ridicule 274 !USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_egalite_choix 275 USE isotopes_verif_mod 276 #endif 277 #endif 189 278 190 279 ! INCLUDE "indicesol.h" … … 209 298 REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness 210 299 real, intent(in):: rhoa(:) ! (knon) density of moist air (kg / m3) 300 #ifdef ISO 301 REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow 302 REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum 303 REAL, DIMENSION(niso,klon), INTENT(IN) :: Roce 304 REAL, DIMENSION(niso,klon), INTENT(IN) :: Rland_ice 305 #endif 211 306 212 307 ! In/Output arguments … … 216 311 REAL, DIMENSION(klon), INTENT(INOUT) :: agesno 217 312 REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil 313 #ifdef ISO 314 REAL, DIMENSION(niso,klon), INTENT(INOUT) :: xtsnow 315 REAL, DIMENSION(niso,klon), INTENT(IN) :: xtsol 316 #endif 218 317 219 318 ! Output arguments … … 226 325 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new 227 326 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l 327 #ifdef ISO 328 REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap 329 #endif 228 330 229 331 ! Local variables … … 238 340 REAL, DIMENSION(klon) :: u0, v0 239 341 REAL, DIMENSION(klon) :: u1_lay, v1_lay 240 REAL sens_prec_liq(knon), sens_prec_sol (knon)342 REAL, DIMENSION(knon) :: sens_prec_liq, sens_prec_sol 241 343 REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol 242 344 345 #ifdef ISO 346 REAL, PARAMETER :: t_coup = 273.15 347 REAL, DIMENSION(klon) :: fq_fonte_diag 348 REAL, DIMENSION(klon) :: fqfonte_diag 349 REAL, DIMENSION(klon) :: snow_evap_diag 350 REAL, DIMENSION(klon) :: fqcalving_diag 351 REAL, DIMENSION(klon) :: run_off_lic_diag 352 REAL :: coeff_rel_diag 353 REAL :: max_eau_sol_diag 354 REAL, DIMENSION(klon) :: runoff_diag 355 INTEGER IXT 356 REAL, DIMENSION(niso,klon) :: xtsnow_prec, xtsol_prec 357 REAL, DIMENSION(klon) :: snow_prec, qsol_prec 358 #endif 243 359 244 360 !**************************************************************************************** … … 307 423 ! 308 424 !**************************************************************************************** 425 #ifdef ISO 426 ! verif 427 #ifdef ISOVERIF 428 DO i = 1, knon 429 IF (iso_eau > 0) THEN 430 IF (snow(i) > ridicule) THEN 431 CALL iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), & 432 & 'interfsurf 964',errmax,errmaxrel) 433 ENDIF !IF ((snow(i) > ridicule)) THEN 434 ENDIF !IF (iso_eau > 0) THEN 435 ENDDO !DO i=1,knon 436 #endif 437 ! end verif 438 439 DO i = 1, knon 440 snow_prec(i) = snow(i) 441 DO ixt = 1, niso 442 xtsnow_prec(ixt,i) = xtsnow(ixt,i) 443 ENDDO !DO ixt=1,niso 444 ! initialisation: 445 fq_fonte_diag(i) = 0.0 446 fqfonte_diag(i) = 0.0 447 snow_evap_diag(i)= 0.0 448 ENDDO !DO i=1,knon 449 #endif 450 451 309 452 CALL fonte_neige( knon, is_sic, knindex, dtime, & 310 453 tsurf_tmp, precip_rain, precip_snow, & 311 snow, qsol, tsurf_new, evap) 454 snow, qsol, tsurf_new, evap & 455 #ifdef ISO 456 & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag & 457 & ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag & 458 #endif 459 & ) 460 461 462 #ifdef ISO 463 ! isotopes: tout est externalisé 464 !#ifdef ISOVERIF 465 ! write(*,*) 'ocean_forced_mod 377: call calcul_iso_surf_sic_vectall' 466 ! write(*,*) 'klon,knon=',klon,knon 467 !#endif 468 CALL calcul_iso_surf_sic_vectall(klon,knon, & 469 & evap,snow_evap_diag,Tsurf_new,Roce,snow, & 470 & fq_fonte_diag,fqfonte_diag,dtime,t_coup, & 471 & precip_snow,xtprecip_snow,xtprecip_rain, snow_prec,xtsnow_prec, & 472 & xtspechum,spechum,ps, & 473 & xtevap,xtsnow,fqcalving_diag, & 474 & knindex,is_sic,run_off_lic_diag,coeff_rel_diag,Rland_ice & 475 & ) 476 #ifdef ISOVERIF 477 !write(*,*) 'ocean_forced_mod 391: sortie calcul_iso_surf_sic_vectall' 478 IF (iso_eau > 0) THEN 479 DO i = 1, knon 480 CALL iso_verif_egalite_choix(snow(i), & 481 & xtsnow(iso_eau,i),'ocean_forced_mod 396', & 482 & errmax,errmaxrel) 483 ENDDO ! DO j=1,knon 484 ENDIF !IF (iso_eau > 0) then 485 #endif 486 !#ifdef ISOVERIF 487 #endif 488 !#ifdef ISO 312 489 313 490 ! Calculation of albedo at snow (alb_neig) and update the age of snow (agesno) -
LMDZ6/trunk/libf/phylmd/pbl_surface_mod.F90
r5015 r5022 33 33 wx_pbl_check, wx_pbl_dts_check, wx_evappot 34 34 use config_ocean_skin_m, only: activate_ocean_skin 35 #ifdef ISO 36 USE infotrac_phy, ONLY: niso,ntraciso=>ntiso 37 #endif 35 38 36 39 IMPLICIT NONE … … 49 52 !$OMP THREADPRIVATE(ydTs0, ydqs0) 50 53 54 #ifdef ISO 55 REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE :: xtsnow ! snow at surface 56 !$OMP THREADPRIVATE(xtsnow) 57 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: Rland_ice ! snow at surface 58 !$OMP THREADPRIVATE(Rland_ice) 59 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: Roce ! snow at surface 60 !$OMP THREADPRIVATE(Roce) 61 #endif 62 51 63 INTEGER, SAVE :: iflag_pbl_surface_t2m_bug 52 64 !$OMP THREADPRIVATE(iflag_pbl_surface_t2m_bug) … … 178 190 179 191 END SUBROUTINE pbl_surface_init 192 193 #ifdef ISO 194 SUBROUTINE pbl_surface_init_iso(xtsnow_rst,Rland_ice_rst) 195 196 ! This routine should be called after the restart file has been read. 197 ! This routine initialize the restart variables and does some validation tests 198 ! for the index of the different surfaces and tests the choice of type of ocean. 199 200 USE indice_sol_mod 201 USE print_control_mod, ONLY: lunout 202 #ifdef ISOVERIF 203 USE isotopes_mod, ONLY: iso_eau,ridicule 204 USE isotopes_verif_mod 205 #endif 206 IMPLICIT NONE 207 208 INCLUDE "dimsoil.h" 209 210 ! Input variables 211 !**************************************************************************************** 212 REAL, DIMENSION(niso,klon, nbsrf), INTENT(IN) :: xtsnow_rst 213 REAL, DIMENSION(niso,klon), INTENT(IN) :: Rland_ice_rst 214 215 ! Local variables 216 !**************************************************************************************** 217 INTEGER :: ierr 218 CHARACTER(len=80) :: abort_message 219 CHARACTER(len = 20) :: modname = 'pbl_surface_init' 220 integer i,ixt 221 222 !**************************************************************************************** 223 ! Allocate and initialize module variables with fields read from restart file. 224 ! 225 !**************************************************************************************** 226 227 ALLOCATE(xtsnow(niso,klon,nbsrf), stat=ierr) 228 IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1) 229 230 ALLOCATE(Rland_ice(niso,klon), stat=ierr) 231 IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1) 232 233 ALLOCATE(Roce(niso,klon), stat=ierr) 234 IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1) 235 236 xtsnow(:,:,:) = xtsnow_rst(:,:,:) 237 Rland_ice(:,:) = Rland_ice_rst(:,:) 238 Roce(:,:) = 0.0 239 240 #ifdef ISOVERIF 241 IF (iso_eau >= 0) THEN 242 CALL iso_verif_egalite_vect2D( & 243 & xtsnow,snow, & 244 & 'pbl_surface_mod 170',niso,klon,nbsrf) 245 DO i=1,klon 246 IF (iso_eau >= 0) THEN 247 CALL iso_verif_egalite(Rland_ice(iso_eau,i),1.0, & 248 & 'pbl_surf_mod 177') 249 ENDIF 250 ENDDO 251 ENDIF 252 #endif 253 254 END SUBROUTINE pbl_surface_init_iso 255 #endif 256 180 257 ! 181 258 !**************************************************************************************** … … 241 318 !FC 242 319 !!! 243 ) 320 #ifdef ISO 321 & ,xtrain_f, xtsnow_f,xt, & 322 & wake_dlxt,zxxtevap,xtevap, & 323 & d_xt,d_xt_w,d_xt_x, & 324 & xtsol,dflux_xt,zxxtsnow,zxfluxxt,flux_xt, & 325 & h1_diag,runoff_diag,xtrunoff_diag & 326 #endif 327 & ) 244 328 !**************************************************************************************** 245 329 ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818 … … 316 400 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid1dto2d_glo 317 401 USE print_control_mod, ONLY : prt_level,lunout 402 #ifdef ISO 403 USE isotopes_mod, ONLY: Rdefault,iso_eau 404 #ifdef ISOVERIF 405 USE isotopes_verif_mod 406 #endif 407 #ifdef ISOTRAC 408 USE isotrac_mod, only: index_iso 409 #endif 410 #endif 318 411 USE ioipsl_getin_p_mod, ONLY : getin_p 319 412 use phys_state_var_mod, only: ds_ns, dt_ns, delta_sst, delta_sal, dter, & … … 368 461 REAL, DIMENSION(klon), INTENT(IN) :: gustiness ! gustiness 369 462 370 REAL, DIMENSION(klon), INTENT(IN) :: cldt ! total cloud fraction 463 REAL, DIMENSION(klon), INTENT(IN) :: cldt ! total cloud 464 465 #ifdef ISO 466 REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: xt ! water vapour (kg/kg) 467 REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtrain_f ! rain fall 468 REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtsnow_f ! snow fall 469 #endif 371 470 372 471 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 … … 381 480 REAL, DIMENSION(klon), INTENT(IN) :: wake_dens 382 481 !!! 383 482 #ifdef ISO 483 REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: wake_dlxt 484 #endif 384 485 ! Input/Output variables 385 486 !**************************************************************************************** … … 450 551 REAL, INTENT(OUT):: zcoefm(:, :, :) ! (klon, klev, nbsrf + 1) 451 552 ! coef for turbulent diffusion of U and V (?), mean for each grid point 553 #ifdef ISO 554 REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: zxxtevap ! water vapour flux at surface, positiv upwards 555 REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT) :: d_xt ! change in water vapour 556 REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag 557 REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrunoff_diag 558 REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt_w 559 REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt_x 560 #endif 561 562 452 563 453 564 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 … … 513 624 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_v ! v wind tension (kg m/s)/(m**2 s) or Pascal 514 625 !FC 515 REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT) :: treedrg ! tree drag (m) 626 REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT) :: treedrg ! tree drag (m) 627 #ifdef ISO 628 REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtsol ! water height in the soil (mm) 629 REAL, DIMENSION(ntraciso,klon, nbsrf) :: xtevap ! evaporation at surface 630 REAL, DIMENSION(klon), INTENT(OUT) :: h1_diag ! just diagnostic, not useful 631 #endif 516 632 517 633 … … 527 643 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_qbs ! blowind snow vertical flux (kg/m**2 528 644 645 #ifdef ISO 646 REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: dflux_xt ! change of water vapour flux 647 REAL, DIMENSION(niso,klon), INTENT(OUT) :: zxxtsnow ! snow at surface, mean for each grid point 648 REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT) :: zxfluxxt ! water vapour flux, mean for each grid point 649 REAL, DIMENSION(ntraciso,klon, klev, nbsrf), INTENT(OUT) :: flux_xt ! water vapour flux(latent flux) (kg/m**2/s) 650 #endif 529 651 530 652 ! Martin … … 575 697 REAL, DIMENSION(klon) :: ysnow, yqsurf, yagesno, yqsol 576 698 REAL, DIMENSION(klon) :: yrain_f, ysnow_f, ybs_f 699 #ifdef ISO 700 REAL, DIMENSION(ntraciso,klon) :: yxt1 701 REAL, DIMENSION(niso,klon) :: yxtsnow, yxtsol 702 REAL, DIMENSION(ntraciso,klon) :: yxtrain_f, yxtsnow_f 703 REAL, DIMENSION(klon) :: yrunoff_diag 704 REAL, DIMENSION(niso,klon) :: yxtrunoff_diag 705 REAL, DIMENSION(niso,klon) :: yRland_ice 706 #endif 577 707 REAL, DIMENSION(klon) :: ysolsw, ysollw 578 708 REAL, DIMENSION(klon) :: yfder … … 583 713 REAL, DIMENSION(klon) :: y_flux_t1, y_flux_q1 584 714 REAL, DIMENSION(klon) :: y_dflux_t, y_dflux_q 715 #ifdef ISO 716 REAL, DIMENSION(ntraciso,klon) :: y_flux_xt1 717 REAL, DIMENSION(ntraciso,klon) :: y_dflux_xt 718 #endif 585 719 REAL, DIMENSION(klon) :: y_flux_u1, y_flux_v1 586 720 REAL, DIMENSION(klon) :: y_flux_bs, y_flux0 … … 610 744 REAL, DIMENSION(klon) :: AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0 611 745 REAL, DIMENSION(klon) :: AcoefH, AcoefQ, BcoefH, BcoefQ 746 #ifdef ISO 747 REAL, DIMENSION(ntraciso,klon) :: AcoefXT, BcoefXT 748 #endif 612 749 REAL, DIMENSION(klon) :: AcoefU, AcoefV, BcoefU, BcoefV 613 750 REAL, DIMENSION(klon) :: AcoefQBS, BcoefQBS … … 628 765 REAL, DIMENSION(klon,klev) :: yu, yv 629 766 REAL, DIMENSION(klon,klev) :: yt, yq, yqbs 767 #ifdef ISO 768 REAL, DIMENSION(ntraciso,klon) :: yxtevap 769 REAL, DIMENSION(ntraciso,klon,klev) :: y_d_xt 770 REAL, DIMENSION(ntraciso,klon,klev) :: y_flux_xt 771 REAL, DIMENSION(ntraciso,klon,klev) :: yxt 772 #endif 630 773 REAL, DIMENSION(klon,klev) :: ypplay, ydelp 631 774 REAL, DIMENSION(klon,klev) :: delp … … 699 842 REAL, DIMENSION(klon,klev) :: Kcoef_hq_w, Kcoef_m_w, gama_h_w, gama_q_w 700 843 REAL, DIMENSION(klon) :: alf_1, alf_2, alf_1_x, alf_2_x, alf_1_w, alf_2_w 844 #ifdef ISO 845 REAL, DIMENSION(ntraciso,klon,klev) :: yxt_x, yxt_w 846 REAL, DIMENSION(ntraciso,klon) :: y_flux_xt1_x , y_flux_xt1_w 847 REAL, DIMENSION(ntraciso,klon,klev) :: y_flux_xt_x,y_d_xt_x,zxfluxxt_x 848 REAL, DIMENSION(ntraciso,klon,klev) :: y_flux_xt_w,y_d_xt_w,zxfluxxt_w 849 REAL, DIMENSION(ntraciso,klon,klev,nbsrf) :: flux_xt_x, flux_xt_w 850 REAL, DIMENSION(ntraciso,klon) :: AcoefXT_x, BcoefXT_x 851 REAL, DIMENSION(ntraciso,klon) :: AcoefXT_w, BcoefXT_w 852 REAL, DIMENSION(ntraciso,klon,klev) :: CcoefXT, DcoefXT 853 REAL, DIMENSION(ntraciso,klon,klev) :: CcoefXT_x, DcoefXT_x 854 REAL, DIMENSION(ntraciso,klon,klev) :: CcoefXT_w, DcoefXT_w 855 REAL, DIMENSION(ntraciso,klon,klev) :: gama_xt,gama_xt_x,gama_xt_w 856 #endif 701 857 !!! 702 858 !!!jyg le 08/02/2012 … … 891 1047 REAL, DIMENSION(klon) :: yrmu0 892 1048 ! Martin 893 REAL, DIMENSIO n(klon) :: yri01049 REAL, DIMENSION(klon) :: yri0 894 1050 895 1051 REAL, DIMENSION(klon):: ydelta_sst, ydelta_sal, yds_ns, ydt_ns, ydter, & … … 898 1054 ! dt_ds, tkt, tks, taur, sss on ocean points 899 1055 REAL :: missing_val 1056 #ifdef ISO 1057 REAL, DIMENSION(klon) :: h1 1058 INTEGER :: ixt 1059 !#ifdef ISOVERIF 1060 ! integer iso_verif_positif_nostop 1061 !#endif 1062 #endif 1063 900 1064 !**************************************************************************************** 901 1065 ! End of declarations … … 925 1089 iflag_split_ref = mod(iflag_pbl_split,10) 926 1090 iflag_split = iflag_split_ref 1091 1092 #ifdef ISO 1093 #ifdef ISOVERIF 1094 DO i=1,klon 1095 DO ixt=1,niso 1096 CALL iso_verif_noNaN(xtsol(ixt,i),'pbl_surface 608') 1097 ENDDO 1098 ENDDO 1099 #endif 1100 #ifdef ISOVERIF 1101 DO i=1,klon 1102 IF (iso_eau >= 0) THEN 1103 CALL iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, & 1104 & 'pbl_surf_mod 585',errmax,errmaxrel) 1105 CALL iso_verif_egalite_choix(xtsnow_f(iso_eau,i),snow_f(i), & 1106 & 'pbl_surf_mod 594',errmax,errmaxrel) 1107 IF (iso_verif_egalite_choix_nostop(xtsol(iso_eau,i),qsol(i), & 1108 & 'pbl_surf_mod 596',errmax,errmaxrel) == 1) THEN 1109 WRITE(*,*) 'i=',i 1110 STOP 1111 ENDIF 1112 DO nsrf=1,nbsrf 1113 CALL iso_verif_egalite_choix(xtsnow(iso_eau,i,nsrf),snow(i,nsrf), & 1114 & 'pbl_surf_mod 598',errmax,errmaxrel) 1115 ENDDO 1116 ENDIF !IF (iso_eau >= 0) THEN 1117 ENDDO !DO i=1,knon 1118 DO k=1,klev 1119 DO i=1,klon 1120 IF (iso_eau >= 0) THEN 1121 CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), & 1122 & 'pbl_surf_mod 595',errmax,errmaxrel) 1123 ENDIF !IF (iso_eau >= 0) THEN 1124 ENDDO !DO i=1,knon 1125 ENDDO !DO k=1,klev 1126 #endif 1127 #endif 1128 927 1129 928 1130 !**************************************************************************************** … … 990 1192 PRINT*,'WARNING : On impose qsol=',qsol0 991 1193 qsol(:)=qsol0 1194 #ifdef ISO 1195 DO ixt=1,niso 1196 xtsol(ixt,:)=qsol0*Rdefault(ixt) 1197 ENDDO 1198 #ifdef ISOTRAC 1199 DO ixt=1+niso,ntraciso 1200 xtsol(ixt,:)=qsol0*Rdefault(index_iso(ixt)) 1201 ENDDO 1202 #endif 1203 #endif 992 1204 ENDIF 993 1205 !**************************************************************************************** … … 1040 1252 qsnow(:)=0. ; snowhgt(:)=0. ; to_ice(:)=0. ; sissnow(:)=0. 1041 1253 runoff(:)=0. 1254 #ifdef ISO 1255 zxxtevap(:,:)=0. 1256 d_xt(:,:,:)=0. 1257 d_xt_x(:,:,:)=0. 1258 d_xt_w(:,:,:)=0. 1259 flux_xt(:,:,:,:)=0. 1260 ! xtsnow(:,:,:)=0.! attention, xtsnow est l'équivalent de snow et non de qsnow 1261 xtevap(:,:,:)=0. 1262 #endif 1042 1263 IF (iflag_pbl<20.or.iflag_pbl>=30) THEN 1043 1264 zcoefh(:,:,:) = 0.0 … … 1129 1350 !FC 1130 1351 1352 #ifdef ISO 1353 yxtrain_f = 0.0 ; yxtsnow_f = 0.0 1354 yxtsnow = 0.0 1355 yxt = 0.0 1356 yxtsol = 0.0 1357 flux_xt = 0.0 1358 yRland_ice = 0.0 1359 ! d_xt = 0.0 1360 y_dflux_xt = 0.0 1361 dflux_xt=0.0 1362 y_d_xt_x=0. ; y_d_xt_w=0. 1363 #endif 1364 1131 1365 ! >> PC 1132 1366 !the yfields_out variable is defined in (klon,nbcf_out) even if it is used on … … 1155 1389 fluxlat_x(:,:)=0. ; fluxlat_w(:,:)=0. 1156 1390 !>jyg 1391 #ifdef ISO 1392 flux_xt_x(:,:,:,:)=0. ; flux_xt_w(:,:,:,:)=0. 1393 #endif 1157 1394 ! 1158 1395 !jyg< … … 1454 1691 yfluxbs(j)=0.0 1455 1692 y_flux_bs(j) = 0.0 1693 !!! 1694 #ifdef ISO 1695 DO ixt=1,ntraciso 1696 yxtrain_f(ixt,j) = xtrain_f(ixt,i) 1697 yxtsnow_f(ixt,j) = xtsnow_f(ixt,i) 1698 ENDDO 1699 DO ixt=1,niso 1700 yxtsnow(ixt,j) = xtsnow(ixt,i,nsrf) 1701 ENDDO 1702 !IF (nsrf == is_lic) THEN 1703 DO ixt=1,niso 1704 yRland_ice(ixt,j)= Rland_ice(ixt,i) 1705 ENDDO 1706 !endif !IF (nsrf == is_lic) THEN 1707 #ifdef ISOVERIF 1708 IF (iso_eau >= 0) THEN 1709 call iso_verif_egalite_choix(ysnow_f(j), & 1710 & yxtsnow_f(iso_eau,j),'pbl_surf_mod 862', & 1711 & errmax,errmaxrel) 1712 call iso_verif_egalite_choix(ysnow(j), & 1713 & yxtsnow(iso_eau,j),'pbl_surf_mod 872', & 1714 & errmax,errmaxrel) 1715 ENDIF 1716 #endif 1717 #ifdef ISOVERIF 1718 DO ixt=1,ntraciso 1719 call iso_verif_noNaN(yxtsnow_f(ixt,j),'pbl_surf_mod 921') 1720 ENDDO 1721 #endif 1722 #endif 1456 1723 ENDDO 1457 1724 ! >> PC … … 1493 1760 yq(j,k) = q(i,k) 1494 1761 yqbs(j,k)=qbs(i,k) 1762 #ifdef ISO 1763 DO ixt=1,ntraciso 1764 yxt(ixt,j,k) = xt(ixt,i,k) 1765 ENDDO !DO ixt=1,ntraciso 1766 #endif 1495 1767 ENDDO 1496 1768 ENDDO … … 1510 1782 yq_w(j,k) = q(i,k)+(1.-wake_s(i))*wake_dlq(i,k) 1511 1783 !!! 1784 #ifdef ISO 1785 DO ixt=1,ntraciso 1786 yxt_x(ixt,j,k) = xt(ixt,i,k)-wake_s(i)*wake_dlxt(ixt,i,k) 1787 yxt_w(ixt,j,k) = xt(ixt,i,k)+(1.-wake_s(i))*wake_dlxt(ixt,i,k) 1788 ENDDO 1789 #endif 1512 1790 ENDDO 1513 1791 ENDDO … … 1565 1843 i = ni(j) 1566 1844 yqsol(j) = qsol(i) 1845 #ifdef ISO 1846 DO ixt=1,niso 1847 yxtsol(ixt,j) = xtsol(ixt,i) 1848 ENDDO 1849 #endif 1567 1850 ENDDO 1568 1851 ENDIF … … 1859 2142 Kcoef_hq, gama_q, gama_h, & 1860 2143 !!! 1861 AcoefH, AcoefQ, BcoefH, BcoefQ) 2144 AcoefH, AcoefQ, BcoefH, BcoefQ & 2145 #ifdef ISO 2146 & ,yxt, CcoefXT, DcoefXT, gama_xt, AcoefXT, BcoefXT & 2147 #endif 2148 & ) 1862 2149 ELSE !(iflag_split .eq.0) 1863 2150 CALL climb_hq_down(knon, ycoefh_x, ypaprs, ypplay, & … … 1867 2154 Kcoef_hq_x, gama_q_x, gama_h_x, & 1868 2155 !!! 1869 AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x) 2156 AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x & 2157 #ifdef ISO 2158 & ,yxt_x, CcoefXT_x, DcoefXT_x, gama_xt_x, AcoefXT_x, BcoefXT_x & 2159 #endif 2160 & ) 1870 2161 !!! 1871 2162 IF (prt_level >=10) THEN … … 1882 2173 Kcoef_hq_w, gama_q_w, gama_h_w, & 1883 2174 !!! 1884 AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w) 2175 AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w & 2176 #ifdef ISO 2177 & ,yxt_w, CcoefXT_w, DcoefXT_w, gama_xt_w, AcoefXT_w, BcoefXT_w & 2178 #endif 2179 & ) 1885 2180 !!! 1886 2181 IF (prt_level >=10) THEN … … 1964 2259 yt1(:) = yt(:,1) 1965 2260 yq1(:) = yq(:,1) 2261 #ifdef ISO 2262 yxt1(:,:) = yxt(:,:,1) 2263 #endif 2264 1966 2265 ELSE IF (iflag_split .ge. 1) THEN 2266 #ifdef ISO 2267 call abort_gcm('pbl_surface_mod 2149','isos pas encore dans iflag_split=1',1) 2268 #endif 2269 1967 2270 ! 1968 2271 ! Cdragq computation … … 2126 2429 yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, & 2127 2430 y_flux_u1, y_flux_v1, & 2128 yveget,ylai,yheight ) 2431 yveget,ylai,yheight & 2432 #ifdef ISO 2433 & ,yxtrain_f, yxtsnow_f,yxt1, & 2434 & yxtsnow,yxtsol,yxtevap,h1, & 2435 & yrunoff_diag,yxtrunoff_diag,yRland_ice & 2436 #endif 2437 & ) 2129 2438 2130 2439 !FC quid qd yveget ylai yheight ne sont pas definit … … 2156 2465 ENDDO 2157 2466 ENDIF 2158 2467 2468 #ifdef ISOVERIF 2469 DO j=1,knon 2470 DO ixt=1,ntraciso 2471 CALL iso_verif_noNaN(yxtevap(ixt,j), & 2472 & 'pbl_surface 1056a: apres surf_land') 2473 ENDDO 2474 DO ixt=1,niso 2475 CALL iso_verif_noNaN(yxtsol(ixt,j), & 2476 & 'pbl_surface 1056b: apres surf_land') 2477 ENDDO 2478 ENDDO 2479 #endif 2480 #ifdef ISOVERIF 2481 ! write(*,*) 'pbl_surface_mod 1038: sortie surf_land' 2482 DO j=1,knon 2483 IF (iso_eau >= 0) THEN 2484 CALL iso_verif_egalite(yxtsnow(iso_eau,j), & 2485 & ysnow(j),'pbl_surf_mod 1043') 2486 ENDIF !if (iso_eau.gt.0) then 2487 ENDDO !DO i=1,klon 2488 #endif 2489 2159 2490 CASE(is_lic) 2160 2491 ! Martin … … 2177 2508 ysnowhgt, yqsnow, ytoice, ysissnow, & 2178 2509 yalb3_new, yrunoff, & 2179 y_flux_u1, y_flux_v1) 2510 y_flux_u1, y_flux_v1 & 2511 #ifdef ISO 2512 & ,yxtrain_f, yxtsnow_f,yxt1,yRland_ice & 2513 & ,yxtsnow,yxtsol,yxtevap & 2514 #endif 2515 & ) 2180 2516 2181 2517 !jyg< … … 2199 2535 ENDDO 2200 2536 ENDIF 2201 2537 2538 #ifdef ISOVERIF 2539 DO j=1,knon 2540 DO ixt=1,ntraciso 2541 CALL iso_verif_noNaN(yxtevap(ixt,j), & 2542 & 'pbl_surface 1095a: apres surf_landice') 2543 ENDDO 2544 do ixt=1,niso 2545 call iso_verif_noNaN(yxtsol(ixt,j), & 2546 & 'pbl_surface 1095b: apres surf_landice') 2547 enddo 2548 enddo 2549 #endif 2550 #ifdef ISOVERIF 2551 !write(*,*) 'pbl_surface_mod 1060: sortie surf_landice' 2552 do j=1,knon 2553 IF (iso_eau >= 0) THEN 2554 CALL iso_verif_egalite(yxtsnow(iso_eau,j), & 2555 & ysnow(j),'pbl_surf_mod 1064') 2556 ENDIF !if (iso_eau >= 0) THEN 2557 ENDDO !DO i=1,klon 2558 #endif 2559 2202 2560 END IF 2203 2561 … … 2216 2574 y_flux_u1, y_flux_v1, ydelta_sst(:knon), ydelta_sal(:knon), & 2217 2575 yds_ns(:knon), ydt_ns(:knon), ydter(:knon), ydser(:knon), & 2218 ydt_ds(:knon), ytkt(:knon), ytks(:knon), ytaur(:knon), ysss) 2576 ydt_ds(:knon), ytkt(:knon), ytks(:knon), ytaur(:knon), ysss & 2577 #ifdef ISO 2578 & ,yxtrain_f, yxtsnow_f,yxt1,Roce, & 2579 & yxtsnow,yxtevap,h1 & 2580 #endif 2581 & ) 2219 2582 IF (prt_level >=10) THEN 2220 2583 print *,'arg de surf_ocean: ycdragh ',ycdragh(1:knon) … … 2257 2620 !albedo SB <<< 2258 2621 ytsurf_new, y_dflux_t, y_dflux_q, & 2259 y_flux_u1, y_flux_v1) 2622 y_flux_u1, y_flux_v1 & 2623 #ifdef ISO 2624 & ,yxtrain_f, yxtsnow_f,yxt1,Roce, & 2625 & yxtsnow,yxtsol,yxtevap,Rland_ice & 2626 #endif 2627 & ) 2260 2628 2261 2629 ! Special DICE MPL 05082013 puis BOMEX MPL 20150410 … … 2265 2633 y_flux_v1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yv(j,1)*ypplay(j,1)/RD/yt(j,1) 2266 2634 ENDDO 2267 ENDIF 2635 ENDIF 2636 2637 #ifdef ISOVERIF 2638 DO j=1,knon 2639 DO ixt=1,ntraciso 2640 CALL iso_verif_noNaN(yxtevap(ixt,j), & 2641 & 'pbl_surface 1165a: apres surf_seaice') 2642 ENDDO 2643 DO ixt=1,niso 2644 CALL iso_verif_noNaN(yxtsol(ixt,j), & 2645 & 'pbl_surface 1165b: apres surf_seaice') 2646 ENDDO 2647 ENDDO 2648 #endif 2649 #ifdef ISOVERIF 2650 !write(*,*) 'pbl_surface_mod 1077: sortie surf_seaice' 2651 DO j=1,knon 2652 IF (iso_eau >= 0) THEN 2653 CALL iso_verif_egalite(yxtsnow(iso_eau,j), & 2654 & ysnow(j),'pbl_surf_mod 1106') 2655 ENDIF !IF (iso_eau >= 0) THEN 2656 ENDDO !DO i=1,klon 2657 #endif 2268 2658 2269 2659 CASE DEFAULT … … 2335 2725 y_flux_t1(j) = yfluxsens(j) 2336 2726 y_flux_q1(j) = -yevap(j) 2727 #ifdef ISO 2728 y_flux_xt1(:,:) = -yxtevap(:,:) 2729 #endif 2337 2730 ENDDO 2338 2731 ENDIF ! (ok_flux_surf) … … 2350 2743 2351 2744 IF (iflag_split .GE. 1) THEN 2745 #ifdef ISO 2746 call abort_gcm('pbl_surface_mod 2607','isos pas encore dans iflag_split=1',1) 2747 #endif 2748 ! 2352 2749 ! 2353 2750 IF (nsrf .ne. is_oce) THEN … … 2567 2964 Kcoef_hq, gama_q, gama_h, & 2568 2965 !!! 2569 y_flux_q(:,:), y_flux_t(:,:), y_d_q(:,:), y_d_t(:,:)) 2966 y_flux_q(:,:), y_flux_t(:,:), y_d_q(:,:), y_d_t(:,:) & 2967 #ifdef ISO 2968 & ,yxt,y_flux_xt1 & 2969 & ,AcoefXT,BcoefXT,CcoefXT,DcoefXT,gama_xt & 2970 & ,y_flux_xt(:,:,:),y_d_xt(:,:,:) & 2971 #endif 2972 & ) 2570 2973 ELSE !(iflag_split .eq.0) 2571 2974 CALL climb_hq_up(knon, dtime, yt_x, yq_x, & … … 2576 2979 Kcoef_hq_x, gama_q_x, gama_h_x, & 2577 2980 !!! 2578 y_flux_q_x(:,:), y_flux_t_x(:,:), y_d_q_x(:,:), y_d_t_x(:,:)) 2981 y_flux_q_x(:,:), y_flux_t_x(:,:), y_d_q_x(:,:), y_d_t_x(:,:) & 2982 #ifdef ISO 2983 & ,yxt_x,y_flux_xt1_x & 2984 & ,AcoefXT_x,BcoefXT_x,CcoefXT_x,DcoefXT_x,gama_xt_x & 2985 & ,y_flux_xt_x(:,:,:),y_d_xt_x(:,:,:) & 2986 #endif 2987 & ) 2579 2988 ! 2580 2989 CALL climb_hq_up(knon, dtime, yt_w, yq_w, & … … 2585 2994 Kcoef_hq_w, gama_q_w, gama_h_w, & 2586 2995 !!! 2587 y_flux_q_w(:,:), y_flux_t_w(:,:), y_d_q_w(:,:), y_d_t_w(:,:)) 2996 y_flux_q_w(:,:), y_flux_t_w(:,:), y_d_q_w(:,:), y_d_t_w(:,:) & 2997 #ifdef ISO 2998 & ,yxt_w,y_flux_xt1_w & 2999 & ,AcoefXT_w,BcoefXT_w,CcoefXT_w,DcoefXT_w,gama_xt_w & 3000 & ,y_flux_xt_w(:,:,:),y_d_xt_w(:,:,:) & 3001 #endif 3002 & ) 2588 3003 !!! 2589 3004 ENDIF ! (iflag_split .eq.0) … … 2703 3118 flux_u(i,k,nsrf) = y_flux_u(j,k) 2704 3119 flux_v(i,k,nsrf) = y_flux_v(j,k) 3120 3121 #ifdef ISO 3122 DO ixt=1,ntraciso 3123 y_d_xt(ixt,j,k) = y_d_xt(ixt,j,k) * ypct(j) 3124 flux_xt(ixt,i,k,nsrf) = y_flux_xt(ixt,j,k) 3125 ENDDO ! DO ixt=1,ntraciso 3126 h1_diag(i)=h1(j) 3127 #endif 3128 2705 3129 ENDDO 2706 3130 ENDDO 3131 3132 #ifdef ISO 3133 #ifdef ISOVERIF 3134 if (iso_eau.gt.0) then 3135 call iso_verif_egalite_vect2D( & 3136 y_d_xt,y_d_q, & 3137 'pbl_surface_mod 2600',ntraciso,klon,klev) 3138 endif 3139 #endif 3140 #endif 2707 3141 2708 3142 ELSE !(iflag_split .eq.0) … … 2722 3156 flux_u_x(i,k,nsrf) = y_flux_u_x(j,k) 2723 3157 flux_v_x(i,k,nsrf) = y_flux_v_x(j,k) 3158 3159 #ifdef ISO 3160 DO ixt=1,ntraciso 3161 y_d_xt_x(ixt,j,k) = y_d_xt_x(ixt,j,k) * ypct(j) 3162 flux_xt_x(ixt,i,k,nsrf) = y_flux_xt_x(ixt,j,k) 3163 ENDDO ! DO ixt=1,ntraciso 3164 #endif 2724 3165 ENDDO 2725 3166 ENDDO … … 2739 3180 flux_u_w(i,k,nsrf) = y_flux_u_w(j,k) 2740 3181 flux_v_w(i,k,nsrf) = y_flux_v_w(j,k) 3182 3183 #ifdef ISO 3184 DO ixt=1,ntraciso 3185 y_d_xt_w(ixt,j,k) = y_d_xt_w(ixt,j,k) * ypct(j) 3186 flux_xt_w(ixt,i,k,nsrf) = y_flux_xt_w(ixt,j,k) 3187 ENDDO ! do ixt=1,ntraciso 3188 #endif 3189 2741 3190 ENDDO 2742 3191 ENDDO … … 2750 3199 flux_u(i,k,nsrf) = flux_u_x(i,k,nsrf)+ywake_s(j)*(flux_u_w(i,k,nsrf)-flux_u_x(i,k,nsrf)) 2751 3200 flux_v(i,k,nsrf) = flux_v_x(i,k,nsrf)+ywake_s(j)*(flux_v_w(i,k,nsrf)-flux_v_x(i,k,nsrf)) 3201 #ifdef ISO 3202 DO ixt=1,ntraciso 3203 flux_xt(ixt,i,k,nsrf) = flux_xt_x(ixt,i,k,nsrf)+ywake_s(j)*(flux_xt_w(ixt,i,k,nsrf)-flux_xt_x(ixt,i,k,nsrf)) 3204 ENDDO ! do ixt=1,ntraciso 3205 #endif 2752 3206 ENDDO 2753 3207 ENDDO … … 2807 3261 dflux_t(i) = dflux_t(i) + y_dflux_t(j)*ypct(j) 2808 3262 dflux_q(i) = dflux_q(i) + y_dflux_q(j)*ypct(j) 3263 #ifdef ISO 3264 DO ixt=1,niso 3265 xtsnow(ixt,i,nsrf) = yxtsnow(ixt,j) 3266 ENDDO 3267 DO ixt=1,ntraciso 3268 xtevap(ixt,i,nsrf) = - flux_xt(ixt,i,1,nsrf) 3269 dflux_xt(ixt,i) = dflux_xt(ixt,i) + y_dflux_xt(ixt,j)*ypct(j) 3270 ENDDO 3271 IF (nsrf == is_lic) THEN 3272 DO ixt=1,niso 3273 Rland_ice(ixt,i) = yRland_ice(ixt,j) 3274 ENDDO 3275 ENDIF !IF (nsrf == is_lic) THEN 3276 #ifdef ISOVERIF 3277 IF (iso_eau.gt.0) THEN 3278 call iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, & 3279 & 'pbl_surf_mod 1230',errmax,errmaxrel) 3280 ENDIF !if (iso_eau.gt.0) then 3281 #endif 3282 #endif 2809 3283 ENDDO 2810 3284 … … 2911 3385 i = ni(j) 2912 3386 qsol(i) = yqsol(j) 3387 #ifdef ISO 3388 runoff_diag(i)=yrunoff_diag(j) 3389 DO ixt=1,niso 3390 xtsol(ixt,i) = yxtsol(ixt,j) 3391 xtrunoff_diag(ixt,i)=yxtrunoff_diag(ixt,j) 3392 ENDDO 3393 #endif 2913 3394 ENDDO 2914 3395 ENDIF … … 2923 3404 ENDDO 2924 3405 ENDDO 2925 3406 3407 #ifdef ISO 3408 #ifdef ISOVERIF 3409 !write(*,*) 'pbl_surface 2858' 3410 DO i = 1, klon 3411 DO ixt=1,niso 3412 call iso_verif_noNaN(xtsol(ixt,i),'pbl_surface 1405') 3413 ENDDO 3414 ENDDO 3415 #endif 3416 #ifdef ISOVERIF 3417 IF (iso_eau.gt.0) THEN 3418 call iso_verif_egalite_vect2D( & 3419 y_d_xt,y_d_q, & 3420 'pbl_surface_mod 1261',ntraciso,klon,klev) 3421 ENDIF !if (iso_eau.gt.0) then 3422 #endif 3423 #endif 2926 3424 !!! jyg le 07/02/2012 2927 3425 IF (iflag_split .ge.1) THEN … … 2942 3440 d_u_w(i,k) = d_u_w(i,k) + y_d_u_w(j,k) 2943 3441 d_v_w(i,k) = d_v_w(i,k) + y_d_v_w(j,k) 3442 #ifdef ISO 3443 DO ixt=1,ntraciso 3444 d_xt_x(ixt,i,k) = d_xt_x(ixt,i,k) + y_d_xt_x(ixt,j,k) 3445 d_xt_w(ixt,i,k) = d_xt_w(ixt,i,k) + y_d_xt_w(ixt,j,k) 3446 ENDDO ! DO ixt=1,ntraciso 3447 #endif 3448 2944 3449 ! 2945 3450 !! d_wake_dlt(i,k) = d_wake_dlt(i,k) + y_d_t_w(i,k)-y_d_t_x(i,k) … … 2957 3462 d_t(i,k) = d_t(i,k) + y_d_t(j,k) 2958 3463 d_q(i,k) = d_q(i,k) + y_d_q(j,k) 3464 #ifdef ISO 3465 DO ixt=1,ntraciso 3466 d_xt(ixt,i,k) = d_xt(ixt,i,k) + y_d_xt(ixt,j,k) 3467 ENDDO !DO ixt=1,ntraciso 3468 #endif 2959 3469 d_u(i,k) = d_u(i,k) + y_d_u(j,k) 2960 3470 d_v(i,k) = d_v(i,k) + y_d_v(j,k) … … 2971 3481 ENDDO 2972 3482 ENDIF 3483 3484 #ifdef ISO 3485 #ifdef ISOVERIF 3486 ! write(*,*) 'd_q,d_xt(iso_eau,554,19)=',d_q(554,19),d_xt(iso_eau,554,19) 3487 ! write(*,*) 'pbl_surface 2929: d_q,d_xt(iso_eau,2,1)=',d_q(2,1),d_xt(iso_eau,2,1) 3488 ! write(*,*) 'y_d_q,y_d_xt(iso_eau,2,1)=',y_d_q(2,1),y_d_xt(iso_eau,2,1) 3489 ! write(*,*) 'iso_eau.gt.0=',iso_eau.gt.0 3490 call iso_verif_noNaN_vect2D( & 3491 & d_xt, & 3492 & 'pbl_surface 1385',ntraciso,klon,klev) 3493 IF (iso_eau >= 0) THEN 3494 call iso_verif_egalite_vect2D( & 3495 y_d_xt,y_d_q, & 3496 'pbl_surface_mod 2945',ntraciso,klon,klev) 3497 call iso_verif_egalite_vect2D( & 3498 d_xt,d_q, & 3499 'pbl_surface_mod 1276',ntraciso,klon,klev) 3500 ENDIF !IF (iso_eau >= 0) THEN 3501 #endif 3502 #endif 2973 3503 2974 3504 ! print*,'Dans pbl OK4' … … 3358 3888 iflag_split=iflag_split_ref 3359 3889 3890 #ifdef ISO 3891 #ifdef ISOVERIF 3892 ! write(*,*) 'pbl_surface tmp 3249: d_q,d_xt(iso_eau,2,1)=',d_q(2,1),d_xt(iso_eau,2,1) 3893 IF (iso_eau >= 0) THEN 3894 call iso_verif_egalite_vect2D( & 3895 d_xt,d_q, & 3896 'pbl_surface_mod 1276',ntraciso,klon,klev) 3897 ENDIF !IF (iso_eau >= 0) THEN 3898 #endif 3899 #endif 3900 3360 3901 !**************************************************************************************** 3361 3902 ! 16) Calculate the mean value over all sub-surfaces for some variables … … 3379 3920 zxfluxt_w(:,:) = 0.0 ; zxfluxq_w(:,:) = 0.0 3380 3921 zxfluxu_w(:,:) = 0.0 ; zxfluxv_w(:,:) = 0.0 3922 #ifdef ISO 3923 zxfluxxt(:,:,:) = 0.0 3924 zxfluxxt_x(:,:,:) = 0.0 3925 zxfluxxt_w(:,:,:) = 0.0 3926 #endif 3927 3381 3928 3382 3929 !!! jyg le 07/02/2012 … … 3397 3944 zxfluxu_w(i,k) = zxfluxu_w(i,k) + flux_u_w(i,k,nsrf) * pctsrf(i,nsrf) 3398 3945 zxfluxv_w(i,k) = zxfluxv_w(i,k) + flux_v_w(i,k,nsrf) * pctsrf(i,nsrf) 3946 #ifdef ISO 3947 DO ixt=1,ntraciso 3948 zxfluxxt_x(ixt,i,k) = zxfluxxt_x(ixt,i,k) + flux_xt_x(ixt,i,k,nsrf) * pctsrf(i,nsrf) 3949 zxfluxxt_w(ixt,i,k) = zxfluxxt_w(ixt,i,k) + flux_xt_w(ixt,i,k,nsrf) * pctsrf(i,nsrf) 3950 ENDDO ! DO ixt=1,ntraciso 3951 #endif 3399 3952 ENDDO 3400 3953 ENDDO … … 3416 3969 zxfluxu(i,k) = zxfluxu(i,k) + flux_u(i,k,nsrf) * pctsrf(i,nsrf) 3417 3970 zxfluxv(i,k) = zxfluxv(i,k) + flux_v(i,k,nsrf) * pctsrf(i,nsrf) 3971 #ifdef ISO 3972 DO ixt=1,niso 3973 zxfluxxt(ixt,i,k) = zxfluxxt(ixt,i,k) + flux_xt(ixt,i,k,nsrf) * pctsrf(i,nsrf) 3974 ENDDO ! DO ixt=1,niso 3975 #endif 3418 3976 ENDDO 3419 3977 ENDDO … … 3440 3998 END DO 3441 3999 endif 4000 4001 #ifdef ISO 4002 DO i = 1, klon 4003 DO ixt=1,ntraciso 4004 zxxtevap(ixt,i) = - zxfluxxt(ixt,i,1) 4005 ENDDO 4006 ENDDO 4007 #endif 3442 4008 3443 4009 !!! … … 3615 4181 zxqsurf(:) = 0.0 3616 4182 zxsnow(:) = 0.0 4183 #ifdef ISO 4184 zxxtsnow(:,:) = 0.0 4185 #endif 4186 3617 4187 DO nsrf = 1, nbsrf 3618 4188 DO i = 1, klon 3619 4189 zxqsurf(i) = zxqsurf(i) + MAX(qsurf(i,nsrf),0.0) * pctsrf(i,nsrf) 3620 4190 zxsnow(i) = zxsnow(i) + snow(i,nsrf) * pctsrf(i,nsrf) 4191 #ifdef ISO 4192 DO ixt=1,niso 4193 zxxtsnow(ixt,i) = zxxtsnow(ixt,i) + xtsnow(ixt,i,nsrf) * pctsrf(i,nsrf) 4194 ENDDO ! DO ixt=1,niso 4195 #endif 3621 4196 ENDDO 3622 4197 ENDDO … … 3630 4205 !**************************************************************************************** 3631 4206 ! 3632 SUBROUTINE pbl_surface_final(fder_rst, snow_rst, qsurf_rst, ftsoil_rst) 4207 SUBROUTINE pbl_surface_final(fder_rst, snow_rst, qsurf_rst, ftsoil_rst & 4208 #ifdef ISO 4209 ,xtsnow_rst,Rland_ice_rst & 4210 #endif 4211 ) 3633 4212 3634 4213 USE indice_sol_mod 4214 #ifdef ISO 4215 #ifdef ISOVERIF 4216 USE isotopes_mod, ONLY: iso_eau,ridicule 4217 USE isotopes_verif_mod, ONLY: errmax,errmaxrel 4218 #endif 4219 #endif 3635 4220 3636 4221 INCLUDE "dimsoil.h" … … 3642 4227 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: qsurf_rst 3643 4228 REAL, DIMENSION(klon, nsoilmx, nbsrf), INTENT(OUT) :: ftsoil_rst 4229 #ifdef ISO 4230 REAL, DIMENSION(niso,klon, nbsrf), INTENT(OUT) :: xtsnow_rst 4231 REAL, DIMENSION(niso,klon), INTENT(OUT) :: Rland_ice_rst 4232 #endif 3644 4233 3645 4234 … … 3652 4241 qsurf_rst(:,:) = qsurf(:,:) 3653 4242 ftsoil_rst(:,:,:) = ftsoil(:,:,:) 4243 #ifdef ISO 4244 xtsnow_rst(:,:,:) = xtsnow(:,:,:) 4245 Rland_ice_rst(:,:) = Rland_ice(:,:) 4246 #endif 3654 4247 3655 4248 !**************************************************************************************** … … 3664 4257 IF (ALLOCATED(ydTs0)) DEALLOCATE(ydTs0) 3665 4258 IF (ALLOCATED(ydqs0)) DEALLOCATE(ydqs0) 4259 #ifdef ISO 4260 IF (ALLOCATED(xtsnow)) DEALLOCATE(xtsnow) 4261 IF (ALLOCATED(Rland_ice)) DEALLOCATE(Rland_ice) 4262 IF (ALLOCATED(Roce)) DEALLOCATE(Roce) 4263 #endif 3666 4264 3667 4265 !jyg< … … 3682 4280 SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, & 3683 4281 evap, z0m, z0h, agesno, & 3684 tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke) 4282 tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke & 4283 #ifdef ISO 4284 ,xtevap & 4285 #endif 4286 & ) 3685 4287 !albedo SB <<< 3686 4288 ! Give default values where new fraction has appread … … 3711 4313 REAL, DIMENSION(klon,nbsrf+1), INTENT(INOUT) :: z0m,z0h 3712 4314 REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(INOUT) :: tke 4315 #ifdef ISO 4316 REAL, DIMENSION(ntraciso,klon,nbsrf), INTENT(INOUT) :: xtevap 4317 #endif 3713 4318 3714 4319 ! Local variables … … 3718 4323 CHARACTER(len=20) :: modname = 'pbl_surface_newfrac' 3719 4324 INTEGER, DIMENSION(nbsrf) :: nfois=0, mfois=0, pfois=0 4325 #ifdef ISO 4326 INTEGER :: ixt 4327 #endif 3720 4328 ! 3721 4329 ! All at once !! … … 3763 4371 u10m(i,nsrf) = u10m(i,nsrf_comp1) 3764 4372 v10m(i,nsrf) = v10m(i,nsrf_comp1) 4373 #ifdef ISO 4374 DO ixt=1,ntraciso 4375 xtevap(ixt,i,nsrf) = xtevap(ixt,i,nsrf_comp1) 4376 ENDDO 4377 #endif 3765 4378 IF (iflag_pbl > 1) THEN 3766 4379 tke(i,:,nsrf) = tke(i,:,nsrf_comp1) … … 3818 4431 u10m(i,nsrf) = u10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + u10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3) 3819 4432 v10m(i,nsrf) = v10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + v10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3) 4433 #ifdef ISO 4434 DO ixt=1,ntraciso 4435 xtevap(ixt,i,nsrf) = xtevap(ixt,i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) & 4436 + xtevap(ixt,i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3) 4437 ENDDO 4438 #endif 3820 4439 IF (iflag_pbl > 1) THEN 3821 4440 tke(i,:,nsrf) = tke(i,:,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + tke(i,:,nsrf_comp3)*pctsrf_old(i,nsrf_comp3) … … 3830 4449 agesno(i,nsrf) = 0. 3831 4450 ftsoil(i,:,nsrf) = tsurf(i,nsrf) 4451 #ifdef ISO 4452 xtsnow(:,i,nsrf) = 0. 4453 #endif 3832 4454 ELSE 3833 4455 pfois(nsrf) = pfois(nsrf)+ 1 -
LMDZ6/trunk/libf/phylmd/phys_output_write_mod.F90
r5007 r5022 207 207 ! Isotopes 208 208 o_xtprecip,o_xtplul,o_xtpluc,o_xtovap,o_xtoliq,o_xtcond, & 209 o_runoff_diag, o_xtrunoff_diag, & 209 210 o_xtevap,o_dxtdyn,o_dxtldyn,o_dxtcon,o_dxtlsc,o_dxteva, & 210 211 o_dxtajs,o_dxtvdf,o_dxtthe, o_dxtch4, & … … 392 393 d_xt_ajs, d_xt_ajsb, & 393 394 d_xt_prod_nucl,d_xt_cosmo,d_xt_decroiss, & 395 runoff_diag, xtrunoff_diag, & 394 396 #endif 395 397 ep, epmax_diag, & ! epmax_cape … … 2799 2801 #ifdef ISO 2800 2802 !write(*,*) 'tmp phys_output_write: ntiso=',ntiso 2803 !! runoff land bucket - ajout S. Nguyen 25 avril 2024 2804 CALL histwrite_phy(o_runoff_diag, runoff_diag) 2805 2801 2806 do ixt=1,ntiso 2802 2807 !write(*,*) 'ixt,o_xtovap(ixt)=',ixt,o_xtovap(ixt) … … 2812 2817 CALL histwrite_phy(o_xtovap(ixt), xt_seri(ixt,:,:)) 2813 2818 CALL histwrite_phy(o_xtoliq(ixt), xtl_seri(ixt,:,:)) 2819 2820 !! runoff land bucket - ajout S. Nguyen 25 avril 2024 2821 CALL histwrite_phy(o_xtrunoff_diag(ixt), xtrunoff_diag(ixt,:)) 2822 2814 2823 2815 2824 DO nsrf = 1, nbsrf ! ajout Camille 8 mai 2023 -
LMDZ6/trunk/libf/phylmd/surf_land_bucket_mod.F90
r3974 r5022 16 16 snow, qsol, agesno, tsoil, & 17 17 qsurf, z0_new, alb1_new, alb2_new, evap, & 18 fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l) 18 fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l & 19 #ifdef ISO 20 ,xtprecip_rain, xtprecip_snow,xtspechum, & 21 xtsnow, xtsol,xtevap,h1, & 22 runoff_diag,xtrunoff_diag,Rland_ice & 23 #endif 24 ) 19 25 20 26 USE limit_read_mod … … 28 34 USE mod_phys_lmdz_para 29 35 USE indice_sol_mod 36 #ifdef ISO 37 use infotrac_phy, ONLY: ntiso,niso 38 USE isotopes_mod, ONLY: iso_eau, iso_HDO, iso_O18, iso_O17, & 39 ridicule_qsol 40 USE isotopes_routines_mod, ONLY: calcul_iso_surf_ter_vectall 41 #ifdef ISOVERIF 42 USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_noNaN, & 43 iso_verif_aberrant_o17,iso_verif_egalite_choix,iso_verif_egalite 44 #endif 45 #endif 30 46 !**************************************************************************************** 31 47 ! Bucket calculations for surface. … … 52 68 REAL, DIMENSION(klon), INTENT(IN) :: rugoro 53 69 REAL, DIMENSION(klon), INTENT(IN) :: swnet, lwnet 70 #ifdef ISO 71 REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow 72 REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum 73 #endif 54 74 55 75 ! In/Output variables … … 58 78 REAL, DIMENSION(klon), INTENT(INOUT) :: agesno 59 79 REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil 80 #ifdef ISO 81 REAL, DIMENSION(niso,klon), INTENT(INOUT) :: xtsnow,xtsol 82 #endif 60 83 61 84 ! Output variables … … 67 90 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new 68 91 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l 92 #ifdef ISO 93 REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap 94 REAL, DIMENSION(klon), INTENT(OUT) :: h1 95 REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrunoff_diag 96 REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag 97 REAL, DIMENSION(niso,klon), INTENT(IN) :: Rland_ice 98 #endif 69 99 70 100 ! Local variables … … 78 108 REAL, DIMENSION(klon) :: dummy_riverflow,dummy_coastalflow 79 109 INTEGER :: i 80 ! 81 !**************************************************************************************** 82 110 #ifdef ISO 111 INTEGER :: ixt 112 REAL, DIMENSION(niso,klon) :: xtsnow_prec,xtsol_prec 113 REAL, DIMENSION(klon) :: snow_prec,qsol_prec 114 REAL, PARAMETER :: t_coup = 273.15 115 REAL, DIMENSION(klon) :: fq_fonte_diag 116 REAL, DIMENSION(klon) :: fqfonte_diag 117 REAL, DIMENSION(klon) :: snow_evap_diag 118 REAL, DIMENSION(klon) :: fqcalving_diag 119 REAL :: max_eau_sol_diag 120 REAL, DIMENSION(klon) :: run_off_lic_diag 121 REAL :: coeff_rel_diag 122 #endif 123 ! 124 !**************************************************************************************** 125 126 #ifdef ISO 127 #ifdef ISOVERIF 128 !write(*,*) 'surf_land_bucket 152' 129 DO i=1,knon 130 IF (iso_eau > 0) THEN 131 CALL iso_verif_egalite_choix(precip_snow(i), & 132 & xtprecip_snow(iso_eau,i),'surf_land_bucket 131', & 133 & errmax,errmaxrel) 134 CALL iso_verif_egalite_choix(qsol(i), & 135 & xtsol(iso_eau,i),'surf_land_bucket 134', & 136 & errmax,errmaxrel) 137 ENDIF 138 ENDDO 139 #endif 140 #ifdef ISOVERIF 141 DO i=1,knon 142 DO ixt=1,niso 143 CALL iso_verif_noNaN(xtsol(ixt,i),'surf_land_mod_bucket 142') 144 ENDDO !do ixt=1,niso 145 ENDDO !do i=1,knon 146 !write(*,*) 'surf_land_bucket 152' 147 #endif 148 #endif 83 149 84 150 ! … … 131 197 tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l) 132 198 199 #ifdef ISO 200 ! verif 201 #ifdef ISOVERIF 202 !write(*,*) 'surf_land_bucket 211' 203 DO i=1,knon 204 IF (iso_eau > 0) THEN 205 CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), & 206 & snow(i),'surf_land_bucket 522', & 207 & errmax,errmaxrel) 208 ENDIF !IF (iso_eau > 0) then 209 ENDDO !DO i=1,knon 210 #endif 211 ! end verif 212 #endif 213 #ifdef ISO 214 DO i=1,knon 215 snow_prec(i)=snow(i) 216 qsol_prec(i)=qsol(i) 217 DO ixt=1,niso 218 xtsnow_prec(ixt,i)=xtsnow(ixt,i) 219 xtsol_prec(ixt,i) =xtsol(ixt,i) 220 ENDDO !DO ixt=1,niso 221 ! initialisation: 222 fqfonte_diag(i) =0.0 223 fq_fonte_diag(i) =0.0 224 snow_evap_diag(i)=0.0 225 ENDDO !DO i=1,knon 226 #ifdef ISOVERIF 227 ! write(*,*) 'surf_land_bucket 235' 228 DO i=1,knon 229 IF (iso_eau > 0) THEN 230 CALL iso_verif_egalite(qsol_prec(i),xtsol_prec(iso_eau,i), & 231 & 'surf_land_bucket 141') 232 ENDIF 233 ENDDO !DO i=1,knon 234 #endif 235 #endif 133 236 ! 134 237 !* Calculate snow height, run_off, age of snow … … 136 239 CALL fonte_neige( knon, is_ter, knindex, dtime, & 137 240 tsurf, precip_rain, precip_snow, & 138 snow, qsol, tsurf_new, evap) 241 snow, qsol, tsurf_new, evap & 242 #ifdef ISO 243 & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag & 244 & ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag & 245 #endif 246 & ) 247 248 #ifdef ISO 249 #ifdef ISOVERIF 250 DO i=1,knon 251 DO ixt=1,niso 252 CALL iso_verif_noNaN(xtsol_prec(ixt,i),'surf_land_burcket 237') 253 ENDDO 254 ENDDO 255 #endif 256 #ifdef ISOVERIF 257 !write(*,*) 'surf_land_bucket 235' 258 DO i=1,knon 259 IF (iso_eau > 0) THEN 260 CALL iso_verif_egalite_choix(qsol_prec(i), & 261 & xtsol_prec(iso_eau,i),'surf_land_bucket 628', & 262 & errmax,errmaxrel) 263 CALL iso_verif_egalite_choix(precip_snow(i), & 264 & xtprecip_snow(iso_eau,i),'surf_land_bucket 227', & 265 & errmax,errmaxrel) 266 ! attention, dans fonte_neige, on modifie snow sans modifier 267 ! xtsnow 268 ! c'est fait plus tard dans gestion_neige 269 ! write(*,*) 'surf_land_bucket 287: i=',i 270 ! write(*,*) 'snow(i)=',snow(i) 271 CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), & 272 & snow_prec(i),'surf_land_bucket 245', & 273 & errmax,errmaxrel) 274 ENDIF 275 IF ((iso_O17 > 0).AND.(iso_O18 > 0)) THEN 276 IF (qsol_prec(i) > ridicule_qsol) THEN 277 CALL iso_verif_aberrant_o17(xtsol_prec(iso_O17,i)/qsol_prec(i) & 278 & ,xtsol_prec(iso_O18,i)/qsol_prec(i) & 279 & ,'surf_land_bucket 642') 280 ENDIF !IF ((qsol_prec(i) > ridicule_qsol) & 281 ENDIF !IF ((iso_O17 > 0).AND.(iso_O18 > 0)) THEN 282 ENDDO !DO i=1,knon 283 !write(*,*) 'surf_land_mod 291' 284 !write(*,*) 'snow_evap_diag(1)=',snow_evap_diag(1) 285 #endif 286 CALL calcul_iso_surf_ter_vectall(klon,knon, & 287 & evap,snow_evap_diag,snow, & 288 & fq_fonte_diag,fqfonte_diag,dtime,precip_rain,xtprecip_rain, & 289 & precip_snow,xtprecip_snow, snow_prec,xtsnow_prec, & 290 & tsurf_new,xtspechum,pref,spechum,t_coup,u1_lay,v1_lay,p1lay, & 291 & qsol,xtsol,qsol_prec,xtsol_prec, & 292 & max_eau_sol_diag, & 293 & xtevap,xtsnow,h1,runoff_diag,xtrunoff_diag,fqcalving_diag, & 294 & knindex,is_ter,run_off_lic_diag,coeff_rel_diag,Rland_ice & 295 & ) 296 !#ifdef ISOVERIF 297 ! write(*,*) 'surf_land_bucket 303' 298 !#endif 299 #endif 300 139 301 ! 140 302 !* Calculate the age of snow -
LMDZ6/trunk/libf/phylmd/surf_land_mod.F90
r4526 r5022 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 !**************************************************************************************** -
LMDZ6/trunk/libf/phylmd/surf_landice_mod.F90
r4947 r5022 23 23 snowhgt, qsnow, to_ice, sissnow, & 24 24 alb3, runoff, & 25 flux_u1, flux_v1) 25 flux_u1, flux_v1 & 26 #ifdef ISO 27 & ,xtprecip_rain, xtprecip_snow,xtspechum,Rland_ice & 28 & ,xtsnow,xtsol,xtevap & 29 #endif 30 & ) 26 31 27 32 USE dimphy … … 33 38 USE phys_local_var_mod, ONLY : zxrhoslic, zxustartlic, zxqsaltlic 34 39 USE phys_output_var_mod, ONLY : snow_o,zfra_o 40 #ifdef ISO 41 USE fonte_neige_mod, ONLY : xtrun_off_lic 42 USE infotrac_phy, ONLY : ntiso,niso 43 USE isotopes_routines_mod, ONLY: calcul_iso_surf_lic_vectall 44 #ifdef ISOVERIF 45 USE isotopes_mod, ONLY: iso_eau,ridicule 46 USE isotopes_verif_mod 47 #endif 48 #endif 49 35 50 !FC 36 51 USE ioipsl_getin_p_mod, ONLY : getin_p … … 68 83 REAL, DIMENSION(klon), INTENT(IN) :: rugoro 69 84 REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf 85 #ifdef ISO 86 REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow 87 REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum 88 #endif 89 70 90 71 91 LOGICAL, INTENT(IN) :: debut !true if first step … … 85 105 REAL, DIMENSION(klon), INTENT(INOUT) :: agesno 86 106 REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil 107 #ifdef ISO 108 REAL, DIMENSION(niso,klon), INTENT(INOUT) :: xtsnow, xtsol 109 REAL, DIMENSION(niso,klon), INTENT(INOUT) :: Rland_ice 110 #endif 111 87 112 88 113 ! Output variables … … 108 133 REAL, DIMENSION(klon), INTENT(OUT) :: sissnow 109 134 REAL, DIMENSION(klon), INTENT(OUT) :: runoff !Land ice runoff 135 #ifdef ISO 136 REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap 137 ! real, DIMENSION(niso,klon) :: xtrun_off_lic_0_diag ! est une variable globale de 138 ! fonte_neige 139 #endif 110 140 111 141 … … 120 150 REAL, DIMENSION(klon) :: fqfonte,ffonte 121 151 REAL, DIMENSION(klon) :: run_off_lic_frac 152 #ifdef ISO 153 REAL, PARAMETER :: t_coup = 273.15 154 REAL, DIMENSION(klon) :: fqfonte_diag 155 REAL, DIMENSION(klon) :: fq_fonte_diag 156 REAL, DIMENSION(klon) :: snow_evap_diag 157 REAL, DIMENSION(klon) :: fqcalving_diag 158 REAL max_eau_sol_diag 159 REAL, DIMENSION(klon) :: runoff_diag 160 REAL, DIMENSION(klon) :: run_off_lic_diag 161 REAL :: coeff_rel_diag 162 INTEGER :: ixt 163 REAL, DIMENSION(niso,klon) :: xtsnow_prec,xtsol_prec 164 REAL, DIMENSION(klon) :: snow_prec,qsol_prec 165 ! real, DIMENSION(klon) :: run_off_lic_0_diag 166 #endif 167 168 122 169 REAL, DIMENSION(klon) :: emis_new !Emissivity 123 170 REAL, DIMENSION(klon) :: swdown,lwdown … … 163 210 !FC firtscall initializations 164 211 !****************************************************************************************** 212 #ifdef ISO 213 #ifdef ISOVERIF 214 ! write(*,*) 'surf_land_ice 1499' 215 DO i=1,knon 216 IF (iso_eau > 0) THEN 217 CALL iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), & 218 & 'surf_land_ice 126',errmax,errmaxrel) 219 ENDIF !IF (iso_eau > 0) THEN 220 ENDDO !DO i=1,knon 221 #endif 222 #endif 223 165 224 IF (firstcall) THEN 166 225 alb_vis_sno_lic=0.77 … … 202 261 !**************************************************************************************** 203 262 #ifdef CPP_INLANDSIS 263 264 #ifdef ISO 265 CALL abort_gcm('surf_landice 235','isotopes pas dans INLANDSIS',1) 266 #endif 204 267 205 268 debut_is=debut … … 322 385 1.,AcoefH, AcoefQ, BcoefH, BcoefQ, & 323 386 tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l) 387 388 #ifdef ISO 389 #ifdef ISOVERIF 390 !write(*,*) 'surf_land_ice 1499' 391 DO i=1,knon 392 IF (iso_eau > 0) THEN 393 IF (snow(i) > ridicule) THEN 394 CALL iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), & 395 & 'surf_land_ice 1151',errmax,errmaxrel) 396 ENDIF !IF ((snow(i) > ridicule)) THEN 397 ENDIF !IF (iso_eau > 0) THEN 398 ENDDO !DO i=1,knon 399 #endif 400 401 DO i=1,knon 402 snow_prec(i)=snow(i) 403 DO ixt=1,niso 404 xtsnow_prec(ixt,i)=xtsnow(ixt,i) 405 ENDDO !DO ixt=1,niso 406 ! initialisation: 407 fq_fonte_diag(i)=0.0 408 fqfonte_diag(i)=0.0 409 snow_evap_diag(i)=0.0 410 ENDDO !DO i=1,knon 411 #endif 324 412 325 413 CALL calcul_flux_wind(knon, dtime, & … … 523 611 524 612 CALL fonte_neige(knon, is_lic, knindex, dtime, & 525 tsurf, precip_rain, precip_totsnow, & 526 snow, qsol, tsurf_new, evap_totsnow) 613 tsurf, precip_rain, precip_totsnow, & 614 snow, qsol, tsurf_new, evap_totsnow & 615 #ifdef ISO 616 & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag & 617 & ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag & 618 #endif 619 & ) 620 621 622 #ifdef ISO 623 #ifdef ISOVERIF 624 DO i=1,knon 625 IF (iso_eau > 0) THEN 626 CALL iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, & 627 & 'surf_landice_mod 217',errmax,errmaxrel) 628 ENDIF !IF (iso_eau > 0) THEN 629 ENDDO !DO i=1,knon 630 #endif 631 632 CALL calcul_iso_surf_lic_vectall(klon,knon, & 633 & evap,snow_evap_diag,Tsurf_new,snow, & 634 & fq_fonte_diag,fqfonte_diag,dtime,t_coup, & 635 & precip_snow,xtprecip_snow,precip_rain,xtprecip_rain, snow_prec,xtsnow_prec, & 636 & xtspechum,spechum,ps,Rland_ice, & 637 & xtevap,xtsnow,fqcalving_diag, & 638 & knindex,is_lic,run_off_lic_diag,coeff_rel_diag & 639 & ) 640 641 ! call fonte_neige_export_xtrun_off_lic_0(knon,xtrun_off_lic_0_diag) 642 643 #endif 527 644 528 529 645 WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0. 530 646 zfra(1:knon) = MAX(0.0,MIN(1.0,snow(1:knon)/(snow(1:knon)+10.0))) -
LMDZ6/trunk/libf/phylmd/surf_ocean_mod.F90
r4526 r5022 21 21 tsurf_new, dflux_s, dflux_l, lmt_bils, & 22 22 flux_u1, flux_v1, delta_sst, delta_sal, ds_ns, dt_ns, dter, dser, & 23 dt_ds, tkt, tks, taur, sss) 23 dt_ds, tkt, tks, taur, sss & 24 #ifdef ISO 25 & ,xtprecip_rain, xtprecip_snow,xtspechum,Roce, & 26 & xtsnow,xtevap,h1 & 27 #endif 28 & ) 24 29 25 30 use albedo, only: alboc, alboc_cd … … 31 36 USE ocean_cpl_mod, ONLY : ocean_cpl_noice 32 37 USE indice_sol_mod, ONLY : nbsrf, is_oce 38 #ifdef ISO 39 USE infotrac_phy, ONLY : ntraciso=>ntiso,niso 40 #ifdef ISOVERIF 41 USE isotopes_mod, ONLY: iso_eau,ridicule 42 USE isotopes_verif_mod 43 #endif 44 #endif 33 45 USE limit_read_mod 34 use config_ocean_skin_m, only: activate_ocean_skin46 USE config_ocean_skin_m, ONLY: activate_ocean_skin 35 47 ! 36 48 ! This subroutine will make a call to ocean_XXX_noice according to the ocean mode (force, … … 68 80 REAL, DIMENSION(klon), INTENT(IN) :: rugoro 69 81 REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf 82 #ifdef ISO 83 REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow 84 REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtspechum 85 #endif 70 86 71 87 ! In/Output variables … … 75 91 REAL, DIMENSION(klon), INTENT(INOUT) :: agesno 76 92 REAL, DIMENSION(klon), INTENT(inOUT) :: z0h 93 #ifdef ISO 94 REAL, DIMENSION(niso,klon), INTENT(IN) :: xtsnow 95 REAL, DIMENSION(niso,klon), INTENT(INOUT):: Roce 96 #endif 77 97 78 98 REAL, intent(inout):: delta_sst(:) ! (knon) … … 136 156 ! size klon because of the coupling machinery.) 137 157 158 #ifdef ISO 159 REAL, DIMENSION(ntraciso,klon), INTENT(out) :: xtevap ! isotopes in surface evaporation flux 160 REAL, DIMENSION(klon), INTENT(out) :: h1 ! just a diagnostic, not useful for the simulation 161 #endif 162 138 163 ! Local variables 139 164 !************************************************************************* … … 146 171 REAL, DIMENSION(klon) :: precip_totsnow 147 172 CHARACTER(len=20),PARAMETER :: modname="surf_ocean" 148 realrhoa(knon) ! density of moist air (kg / m3)173 REAL rhoa(knon) ! density of moist air (kg / m3) 149 174 REAL sens_prec_liq(knon) 150 175 151 176 REAL t_int(knon) ! ocean-air interface temperature, in K 152 reals_int(knon) ! ocean-air interface salinity, in ppt177 REAL s_int(knon) ! ocean-air interface salinity, in ppt 153 178 154 179 !************************************************************************** 155 180 181 #ifdef ISO 182 #ifdef ISOVERIF 183 DO i = 1, knon 184 IF (iso_eau > 0) THEN 185 CALL iso_verif_egalite_choix(xtspechum(iso_eau,i), & 186 & spechum(i),'surf_ocean_mod 117', & 187 & errmax,errmaxrel) 188 CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), & 189 & snow(i),'surf_ocean_mod 127', & 190 & errmax,errmaxrel) 191 ENDIF !IF (iso_eau > 0) then 192 ENDDO !DO i=1,klon 193 #endif 194 #endif 156 195 157 196 !****************************************************************************** … … 230 269 radsol, snow, agesno, & 231 270 qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, & 232 tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa) 271 tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa & 272 #ifdef ISO 273 ,xtprecip_rain, xtprecip_snow, xtspechum,Roce,rlat, & 274 xtsnow,xtevap,h1 & 275 #endif 276 ) 233 277 END SELECT 234 278 -
LMDZ6/trunk/libf/phylmd/surf_seaice_mod.F90
r3815 r5022 21 21 z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, & 22 22 tsurf_new, dflux_s, dflux_l, & 23 flux_u1, flux_v1) 23 flux_u1, flux_v1 & 24 #ifdef ISO 25 & ,xtprecip_rain, xtprecip_snow,xtspechum,Roce, & 26 & xtsnow,xtsol,xtevap,Rland_ice & 27 #endif 28 & ) 24 29 25 30 USE dimphy … … 29 34 USE ocean_slab_mod, ONLY : ocean_slab_ice 30 35 USE indice_sol_mod 36 #ifdef ISO 37 USE infotrac_phy, ONLY : ntiso,niso 38 #endif 31 39 32 40 ! … … 62 70 REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness 63 71 REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf 72 #ifdef ISO 73 REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow 74 REAL, DIMENSION(klon), INTENT(IN) :: xtspechum 75 REAL, DIMENSION(niso,klon), INTENT(IN) :: Roce 76 REAL, DIMENSION(niso,klon), INTENT(IN) :: Rland_ice 77 #endif 64 78 65 79 ! In/Output arguments … … 68 82 REAL, DIMENSION(klon), INTENT(INOUT) :: agesno 69 83 REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil 84 #ifdef ISO 85 REAL, DIMENSION(niso,klon), INTENT(INOUT) :: xtsnow 86 REAL, DIMENSION(niso,klon), INTENT(IN) :: xtsol 87 #endif 70 88 71 89 ! Output arguments … … 82 100 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l 83 101 REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1 102 #ifdef ISO 103 REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap 104 #endif 84 105 85 106 ! Local arguments 86 107 !**************************************************************************************** 87 108 REAL, DIMENSION(klon) :: radsol 109 #ifdef ISO 110 #ifdef ISOVERIF 111 INTEGER :: j 112 #endif 113 #endif 88 114 89 115 !albedo SB >>> … … 145 171 radsol, snow, qsol, agesno, tsoil, & 146 172 qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, & 147 tsurf_new, dflux_s, dflux_l, rhoa) 173 tsurf_new, dflux_s, dflux_l, rhoa & 174 #ifdef ISO 175 ,xtprecip_rain, xtprecip_snow, xtspechum,Roce, & 176 xtsnow, xtsol,xtevap,Rland_ice & 177 #endif 178 ) 148 179 149 180 END IF
Note: See TracChangeset
for help on using the changeset viewer.