Changeset 105 for LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90
- Timestamp:
- Jul 21, 2000, 10:28:19 AM (24 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90
r101 r105 38 38 ! run_off ruissellement total 39 39 real, allocatable, dimension(:),save :: run_off 40 #include "YOMCST.inc" 40 41 41 42 … … 52 53 & fder, taux, tauy, & 53 54 & albedo, snow, qsol, & 54 & tsurf, p1lay, coef1lay,ps, radsol, &55 & ocean, &55 & tsurf, p1lay, ps, radsol, & 56 & ocean, zmasq, & 56 57 & evap, fluxsens, fluxlat, dflux_l, dflux_s, & 57 & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new , zmasq)58 & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new) 58 59 59 60 … … 103 104 ! tsurf temperature de surface 104 105 ! p1lay pression 1er niveau (milieu de couche) 105 ! coef1lay coefficient d'echange106 106 ! ps pression au sol 107 107 ! radsol rayonnement net aus sol (LW + SW) … … 109 109 ! fder derivee des flux (pour le couplage) 110 110 ! taux, tauy tension de vents 111 ! zmasq masque terre/ocean 111 112 ! 112 113 ! output: … … 120 121 ! z0_new surface roughness 121 122 ! pctsrf_new nouvelle repartition des surfaces 122 ! zmasq masque terre/ocean123 123 124 124 include 'indicesol.h' … … 144 144 real, dimension(knon), intent(IN) :: precip_rain, precip_snow 145 145 real, dimension(knon), intent(IN) :: lwdown, swnet, swdown, ps, albedo 146 real, dimension(knon), intent(IN) :: tsurf, p1lay , coef1lay146 real, dimension(knon), intent(IN) :: tsurf, p1lay 147 147 real, dimension(knon), intent(IN) :: radsol 148 148 real, dimension(klon), intent(IN) :: zmasq … … 169 169 integer :: nexca !pas de temps couplage 170 170 real, dimension(knon):: alb_ice 171 real, dimension(knon):: tsurf_temp 171 172 172 173 #include "YOMCST.inc" … … 191 192 call abort_gcm(modname,abort_message,1) 192 193 endif 194 if ( is_oce > is_sic ) then 195 write(*,*)' *** Warning ***' 196 write(*,*)' Pour des raisons de sequencement dans le code' 197 write(*,*)' l''ocean doit etre traite avant la banquise' 198 write(*,*)' or is_oce = ',is_oce, '> is_sic = ',is_sic 199 abort_message='voir ci-dessus' 200 call abort_gcm(modname,abort_message,1) 193 201 endif 194 202 first_call = .false. … … 228 236 cal = RCPD * capsol 229 237 call calcul_fluxs( knon, nisurf, dtime, & 230 & tsurf, p1lay, cal, beta, coef1lay, ps, &238 & tsurf, p1lay, cal, beta, tq_cdrag, ps, & 231 239 & precip_rain, precip_snow, snow, qsol, & 232 240 & radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, & … … 247 255 & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, & 248 256 & precip_rain, precip_snow, lwdown, swnet, swdown, & 249 & tsurf, p1lay, coef1lay,ps, radsol, &257 & tsurf, p1lay, ps, radsol, & 250 258 & evap, fluxsens, fluxlat, & 251 259 & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, dflux_l, dflux_s) … … 271 279 & ocean, nexca, debut, lafin, & 272 280 & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, & 273 & fder, albedo, taux, tauy, &281 & fder, albedo, taux, tauy, zmasq, & 274 282 & tsurf_new, alb_new, alb_ice, pctsrf_new) 283 284 tsurf_temp = tsurf_new 275 285 276 286 ! else if (ocean == 'slab ') then … … 281 291 ! & debut, & 282 292 ! & tsurf_new, alb_new, z0_new, pctsrf_new) 293 ! 283 294 endif 284 ! 295 285 296 cal = 0. 286 297 beta = 1. 287 298 dif_grnd = 0. 288 299 300 endif 289 301 call calcul_fluxs( knon, nisurf, dtime, & 290 & tsurf , p1lay, cal, beta, coef1lay, ps, &302 & tsurf_temp, p1lay, cal, beta, tq_cdrag, ps, & 291 303 & precip_rain, precip_snow, snow, qsol, & 292 304 & radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, & … … 307 319 ! Surface "glace de mer" appel a l'interface avec l'ocean 308 320 ! 309 ! call interfoce(nisurf, ocean) 310 ! 311 312 cal = calice 313 where (snow > 0.0) cal = calsno 314 beta = 1.0 315 dif_grnd = 1.0 / tau_gl 321 ! 322 if (ocean == 'couple') then 323 nexca = 0 324 325 call interfoce(itime, dtime, & 326 & klon, iim, jjm, nisurf, pctsrf, knon, knindex, rlon, rlat, & 327 & ocean, nexca, debut, lafin, & 328 & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, & 329 & fder, albedo, taux, tauy, zmasq, & 330 & tsurf_new, alb_new, alb_ice, pctsrf_new) 331 332 tsurf_temp = tsurf_new 333 cal = 0. 334 dif_grnd = 0. 335 336 ! else if (ocean == 'slab ') then 337 ! call interfoce(nisurf) 338 else ! lecture conditions limites 339 ! call interfoce(itime, dtime, jour, & 340 ! & klon, nisurf, knon, knindex, & 341 ! & debut, & 342 ! & tsurf_new, alb_new, z0_new, pctsrf_new)endif 343 344 cal = calice 345 where (snow > 0.0) cal = calsno 346 beta = 1.0 347 dif_grnd = 1.0 / tau_gl 348 tsurf_temp = tsurf 349 endif 316 350 317 351 call calcul_fluxs( knon, nisurf, dtime, & 318 & tsurf , p1lay, cal, beta, coef1lay, ps, &352 & tsurf_temp, p1lay, cal, beta, tq_cdrag, ps, & 319 353 & precip_rain, precip_snow, snow, qsol, & 320 354 & radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, & … … 338 372 339 373 call calcul_fluxs( knon, nisurf, dtime, & 340 & tsurf, p1lay, cal, beta, coef1lay, ps, &374 & tsurf, p1lay, cal, beta, tq_cdrag, ps, & 341 375 & precip_rain, precip_snow, snow, qsol, & 342 376 & radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, & … … 386 420 & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, & 387 421 & precip_rain, precip_snow, lwdown, swnet, swdown, & 388 & tsurf, p1lay, coef1lay,ps, radsol, &422 & tsurf, p1lay, ps, radsol, & 389 423 & evap, fluxsens, fluxlat, & 390 424 & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, dflux_l, dflux_s) … … 427 461 ! tsurf temperature de surface 428 462 ! p1lay pression 1er niveau (milieu de couche) 429 ! coef1lay coefficient d'echange430 463 ! ps pression au sol 431 464 ! radsol rayonnement net aus sol (LW + SW) … … 463 496 real, dimension(knon), intent(IN) :: precip_rain, precip_snow 464 497 real, dimension(knon), intent(IN) :: lwdown, swnet, swdown, ps 465 real, dimension(knon), intent(IN) :: tsurf, p1lay , coef1lay498 real, dimension(knon), intent(IN) :: tsurf, p1lay 466 499 real, dimension(knon), intent(IN) :: radsol 467 500 ! Parametres de sortie … … 569 602 & ocean, nexca, debut, lafin, & 570 603 & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, & 571 & fder, albsol, taux, tauy, &604 & fder, albsol, taux, tauy, zmasq, & 572 605 & tsurf_new, alb_new, alb_ice, pctsrf_new) 573 574 575 606 576 607 ! Cette routine sert d'interface entre le modele atmospherique et un 577 608 ! coupleur avec un modele d'ocean 'complet' derriere 609 ! 610 ! Le modele de glace qu'il est prevu d'utiliser etant couple directement a 611 ! l'ocean presentement, on va passer deux fois dans cette routine par pas de 612 ! temps physique, une fois avec les points oceans et l'autre avec les points 613 ! glace. A chaque pas de temps de couplage, la lecture des champs provenant 614 ! du coupleur se fera "dans" l'ocean et l'ecriture des champs a envoyer 615 ! au coupleur "dans" la glace. Il faut donc des tableaux de travail "tampons" 616 ! dimensionnes sur toute la grille qui remplissent les champs sur les 617 ! domaines ocean/glace quand il le faut. Il est aussi necessaire que l'index 618 ! ocean soit traiter avant l'index glace (sinon tout intervertir) 619 ! 578 620 ! 579 621 ! L. Fairhead 02/2000 … … 605 647 ! tauy tension de vent en y 606 648 ! nexca frequence de couplage 649 ! zmasq masque terre/ocean 607 650 ! 608 651 ! … … 632 675 real, dimension(knon), intent(IN) :: tsurf, fder, albsol, taux, tauy 633 676 integer :: nexca 677 real, dimension(klon), intent(IN) :: zmasq 634 678 635 679 real, dimension(knon), intent(INOUT) :: evap … … 646 690 logical :: check = .true. 647 691 ! variables pour moyenner les variables de couplage 648 real, allocatable, dimension(:),save :: cpl_sols, cpl_nsol, cpl_rain 649 real, allocatable, dimension(:),save :: cpl_snow, cpl_evap, cpl_tsol 650 real, allocatable, dimension(:),save :: cpl_fder, cpl_albe, cpl_taux 651 real, allocatable, dimension(:),save :: cpl_tauy, cpl_ruis 692 real, allocatable, dimension(:,:),save :: cpl_sols, cpl_nsol, cpl_rain 693 real, allocatable, dimension(:,:),save :: cpl_snow, cpl_evap, cpl_tsol 694 real, allocatable, dimension(:,:),save :: cpl_fder, cpl_albe, cpl_taux 695 real, allocatable, dimension(:,:),save :: cpl_tauy, cpl_rriv, cpl_rcoa 696 ! variables tampons avant le passage au coupleur 697 real, allocatable, dimension(:,:,:),save :: tmp_sols, tmp_nsol, tmp_rain 698 real, allocatable, dimension(:,:,:),save :: tmp_snow, tmp_evap, tmp_tsol 699 real, allocatable, dimension(:,:,:),save :: tmp_fder, tmp_albe, tmp_taux 700 real, allocatable, dimension(:,:,:),save :: tmp_tauy, tmp_rriv, tmp_rcoa 652 701 ! variables a passer au coupleur 653 real, dimension(iim, jjm+1) :: wri_sols, wri_nsol, wri_rain 654 real, dimension(iim, jjm+1) :: wri_snow, wri_evap, wri_tsol 655 real, dimension(iim, jjm+1) :: wri_fder, wri_albe, wri_taux 656 real, dimension(iim, jjm+1) :: wri_tauy, wri_ruis 702 real, dimension(iim, jjm+1) :: wri_sol_ice, wri_sol_sea, wri_nsol_ice 703 real, dimension(iim, jjm+1) :: wri_nsol_sea, wri_fder_ice, wri_evap_ice 704 real, dimension(iim, jjm+1) :: wri_evap_sea 705 real, dimension(iim, jjm+1) :: wri_rain, wri_snow, wri_taux 706 real, dimension(iim, jjm+1) :: wri_tauy, wri_rriv, wri_rcoa 657 707 ! variables relues par le coupleur 658 real, dimension(iim, jjm+1) :: read_sst, read_sic 659 real, dimension(iim, jjm+1) :: read_alb_sst, read_alb_sic 708 ! read_sic = fraction de glace 709 ! read_sit = temperature de glace 710 real, allocatable, dimension(:,:),save :: read_sst, read_sic, read_sit 711 real, allocatable, dimension(:,:),save :: read_alb_sic 660 712 ! variable tampon 661 713 real, dimension(klon) :: tamp 662 714 real, dimension(knon) :: tamp_sic 663 664 715 real, dimension(iim, jjm+1, 2) :: tamp_srf 716 integer, allocatable, dimension(:), save :: tamp_ind 717 real, allocatable, dimension(:,:),save :: tamp_zmasq 718 real, dimension(iim, jjm+1) :: deno 665 719 ! 666 720 ! Initialisation … … 668 722 if (debut) then 669 723 sum_error = 0 670 allocate(cpl_sols(knon), stat = error) 671 sum_error = sum_error + error 672 allocate(cpl_nsol(knon), stat = error) 673 sum_error = sum_error + error 674 allocate(cpl_rain(knon), stat = error) 675 sum_error = sum_error + error 676 allocate(cpl_snow(knon), stat = error) 677 sum_error = sum_error + error 678 allocate(cpl_evap(knon), stat = error) 679 sum_error = sum_error + error 680 allocate(cpl_tsol(knon), stat = error) 681 sum_error = sum_error + error 682 allocate(cpl_fder(knon), stat = error) 683 sum_error = sum_error + error 684 allocate(cpl_albe(knon), stat = error) 685 sum_error = sum_error + error 686 allocate(cpl_taux(knon), stat = error) 687 sum_error = sum_error + error 688 allocate(cpl_tauy(knon), stat = error) 689 sum_error = sum_error + error 690 allocate(cpl_ruis(knon), stat = error) 691 sum_error = sum_error + error 724 allocate(cpl_sols(knon,2), stat = error); sum_error = sum_error + error 725 allocate(cpl_nsol(knon,2), stat = error); sum_error = sum_error + error 726 allocate(cpl_rain(knon,2), stat = error); sum_error = sum_error + error 727 allocate(cpl_snow(knon,2), stat = error); sum_error = sum_error + error 728 allocate(cpl_evap(knon,2), stat = error); sum_error = sum_error + error 729 allocate(cpl_tsol(knon,2), stat = error); sum_error = sum_error + error 730 allocate(cpl_fder(knon,2), stat = error); sum_error = sum_error + error 731 allocate(cpl_albe(knon,2), stat = error); sum_error = sum_error + error 732 allocate(cpl_taux(knon,2), stat = error); sum_error = sum_error + error 733 allocate(cpl_tauy(knon,2), stat = error); sum_error = sum_error + error 734 allocate(cpl_rcoa(knon,2), stat = error); sum_error = sum_error + error 735 allocate(cpl_rriv(knon,2), stat = error); sum_error = sum_error + error 736 allocate(read_sst(iim, jjm+1), stat = error); sum_error = sum_error + error 737 allocate(read_sic(iim, jjm+1), stat = error); sum_error = sum_error + error 738 allocate(read_sit(iim, jjm+1), stat = error); sum_error = sum_error + error 739 allocate(read_sit(iim, jjm+1), stat = error); sum_error = sum_error + error 740 allocate(read_alb_sic(iim, jjm+1), stat = error); sum_error = sum_error + error 741 692 742 if (sum_error /= 0) then 693 743 abort_message='Pb allocation variables couplees' 694 744 call abort_gcm(modname,abort_message,1) 695 745 endif 696 cpl_sols = 0. 697 cpl_ nsol= 0.698 cpl_ rain= 0.699 cpl_snow = 0. 700 cpl_evap = 0.701 cpl_tsol = 0.702 cpl_fder = 0.703 cpl_albe = 0.704 cpl_taux = 0.705 cpl_tauy = 0.706 c pl_ruis = 0.746 cpl_sols = 0.; cpl_nsol = 0.; cpl_rain = 0.; cpl_snow = 0. 747 cpl_evap = 0.; cpl_tsol = 0.; cpl_fder = 0.; cpl_albe = 0. 748 cpl_taux = 0.; cpl_tauy = 0.; cpl_rriv = 0.; cpl_rcoa = 0. 749 750 sum_error = 0 751 allocate(tamp_ind(klon), stat = error); sum_error = sum_error + error 752 allocate(tamp_zmasq(iim, jjm+1), stat = error); sum_error = sum_error + error 753 do ig = 1, klon 754 tamp_ind(ig) = ig 755 enddo 756 call gath2cpl(zmasq, tamp_zmasq, klon, klon, iim, jjm, tamp_ind) 707 757 ! 708 758 ! initialisation couplage … … 712 762 ! 1ere lecture champs ocean 713 763 ! 714 call fromcpl(itime,(jjm+1)*iim, & 715 & read_sst, read_sic, read_alb_sst, read_alb_sic) 764 if (nisurf == is_oce) then 765 call fromcpl(itime,(jjm+1)*iim, & 766 & read_sst, read_sic, read_sit, read_alb_sic) 767 ! 768 ! je voulais utiliser des where mais ca ne voulait pas compiler dans un 769 ! if construct sur sun 770 ! 771 do j = 1, jjm + 1 772 do ig = 1, iim 773 if (abs(1. - read_sic(ig,j)) < 0.00001) then 774 read_sst(ig,j) = RTT - 1.8 775 read_sit(ig,j) = read_sit(ig,j) / read_sic(ig,j) 776 read_alb_sic(ig,j) = read_alb_sic(ig,j) / read_sic(ig,j) 777 else if (abs(read_sic(ig,j)) < 0.00001) then 778 read_sst(ig,j) = read_sst(ig,j) / (1. - read_sic(ig,j)) 779 read_sit(ig,j) = read_sst(ig,j) 780 read_alb_sic(ig,j) = 0.6 781 else 782 read_sst(ig,j) = read_sst(ig,j) / (1. - read_sic(ig,j)) 783 read_sit(ig,j) = read_sit(ig,j) / read_sic(ig,j) 784 read_alb_sic(ig,j) = read_alb_sic(ig,j) / read_sic(ig,j) 785 endif 786 enddo 787 enddo 788 endif 789 790 endif ! fin if (debut) 791 792 ! fichier restart et fichiers histoires 793 794 ! calcul des fluxs a passer 795 796 cpl_sols(:,nisurf) = cpl_sols(:,nisurf) + swdown / FLOAT(nexca) 797 cpl_nsol(:,nisurf) = cpl_nsol(:,nisurf) + lwdown / FLOAT(nexca) 798 cpl_rain(:,nisurf) = cpl_rain(:,nisurf) + precip_rain / FLOAT(nexca) 799 cpl_snow(:,nisurf) = cpl_snow(:,nisurf) + precip_snow / FLOAT(nexca) 800 cpl_evap(:,nisurf) = cpl_evap(:,nisurf) + evap / FLOAT(nexca) 801 cpl_tsol(:,nisurf) = cpl_tsol(:,nisurf) + tsurf / FLOAT(nexca) 802 cpl_fder(:,nisurf) = cpl_fder(:,nisurf) + fder / FLOAT(nexca) 803 cpl_albe(:,nisurf) = cpl_albe(:,nisurf) + albsol / FLOAT(nexca) 804 cpl_taux(:,nisurf) = cpl_taux(:,nisurf) + taux / FLOAT(nexca) 805 cpl_tauy(:,nisurf) = cpl_tauy(:,nisurf) + tauy / FLOAT(nexca) 806 cpl_rriv(:,nisurf) = cpl_rriv(:,nisurf) + run_off / FLOAT(nexca)/dtime 807 cpl_rcoa(:,nisurf) = cpl_rcoa(:,nisurf) + run_off / FLOAT(nexca)/dtime 808 809 if (mod(itime, nexca) == 0) then 810 ! 811 ! Mise sur la bonne grille des champs a passer au coupleur 812 ! 813 ! allocation memoire 814 sum_error = 0 815 allocate(tmp_sols(iim,jjm+1,2), stat=error); sum_error = sum_error + error 816 allocate(tmp_nsol(iim,jjm+1,2), stat=error); sum_error = sum_error + error 817 allocate(tmp_rain(iim,jjm+1,2), stat=error); sum_error = sum_error + error 818 allocate(tmp_snow(iim,jjm+1,2), stat=error); sum_error = sum_error + error 819 allocate(tmp_evap(iim,jjm+1,2), stat=error); sum_error = sum_error + error 820 allocate(tmp_tsol(iim,jjm+1,2), stat=error); sum_error = sum_error + error 821 allocate(tmp_fder(iim,jjm+1,2), stat=error); sum_error = sum_error + error 822 allocate(tmp_albe(iim,jjm+1,2), stat=error); sum_error = sum_error + error 823 allocate(tmp_taux(iim,jjm+1,2), stat=error); sum_error = sum_error + error 824 allocate(tmp_tauy(iim,jjm+1,2), stat=error); sum_error = sum_error + error 825 allocate(tmp_rriv(iim,jjm+1,2), stat=error); sum_error = sum_error + error 826 allocate(tmp_rcoa(iim,jjm+1,2), stat=error); sum_error = sum_error + error 827 if (sum_error /= 0) then 828 abort_message='Pb allocation variables couplees' 829 call abort_gcm(modname,abort_message,1) 830 endif 831 832 call gath2cpl(cpl_sols(1,nisurf), tmp_sols(1,1,nisurf), klon, knon,iim,jjm, knindex) 833 call gath2cpl(cpl_nsol(1,nisurf), tmp_nsol(1,1,nisurf), klon, knon,iim,jjm, knindex) 834 call gath2cpl(cpl_rain(1,nisurf), tmp_rain(1,1,nisurf), klon, knon,iim,jjm, knindex) 835 call gath2cpl(cpl_snow(1,nisurf), tmp_snow(1,1,nisurf), klon, knon,iim,jjm, knindex) 836 call gath2cpl(cpl_evap(1,nisurf), tmp_evap(1,1,nisurf), klon, knon,iim,jjm, knindex) 837 call gath2cpl(cpl_tsol(1,nisurf), tmp_tsol(1,1,nisurf), klon, knon,iim,jjm, knindex) 838 call gath2cpl(cpl_fder(1,nisurf), tmp_fder(1,1,nisurf), klon, knon,iim,jjm, knindex) 839 call gath2cpl(cpl_albe(1,nisurf), tmp_albe(1,1,nisurf), klon, knon,iim,jjm, knindex) 840 call gath2cpl(cpl_taux(1,nisurf), tmp_taux(1,1,nisurf), klon, knon,iim,jjm, knindex) 841 call gath2cpl(cpl_tauy(1,nisurf), tmp_tauy(1,1,nisurf), klon, knon,iim,jjm, knindex) 842 call gath2cpl(cpl_rriv(1,nisurf), tmp_rriv(1,1,nisurf), klon, knon,iim,jjm, knindex) 843 call gath2cpl(cpl_rcoa(1,nisurf), tmp_rcoa(1,1,nisurf), klon, knon,iim,jjm, knindex) 844 ! 845 ! Passage des champs au/du coupleur 846 ! 847 ! Si le domaine considere est l'ocean, on lit les champs venant du coupleur 848 ! 849 if (nisurf == is_oce) then 850 call fromcpl(itime,(jjm+1)*iim, & 851 & read_sst, read_sic, read_sit, read_alb_sic) 852 do j = 1, jjm + 1 853 do ig = 1, iim 854 if (abs(1. - read_sic(ig,j)) < 0.00001) then 855 read_sst(ig,j) = RTT - 1.8 856 read_sit(ig,j) = read_sit(ig,j) / read_sic(ig,j) 857 read_alb_sic(ig,j) = read_alb_sic(ig,j) / read_sic(ig,j) 858 else if (abs(read_sic(ig,j)) < 0.00001) then 859 read_sst(ig,j) = read_sst(ig,j) / (1. - read_sic(ig,j)) 860 read_sit(ig,j) = read_sst(ig,j) 861 read_alb_sic(ig,j) = 0.6 862 else 863 read_sst(ig,j) = read_sst(ig,j) / (1. - read_sic(ig,j)) 864 read_sit(ig,j) = read_sit(ig,j) / read_sic(ig,j) 865 read_alb_sic(ig,j) = read_alb_sic(ig,j) / read_sic(ig,j) 866 endif 867 enddo 868 enddo 869 endif 870 ! 871 ! Si le domaine considere est la banquise, on envoie les champs au coupleur 872 ! 873 if (nisurf == is_sic) then 874 wri_rain = 0.; wri_snow = 0.; wri_rcoa = 0.; wri_rriv = 0. 875 wri_taux = 0.; wri_tauy = 0. 876 call gath2cpl(pctsrf(1,is_oce), tamp_srf(1,1,1), klon, klon, iim, jjm, tamp_ind) 877 call gath2cpl(pctsrf(1,is_sic), tamp_srf(1,1,2), klon, klon, iim, jjm, tamp_ind) 878 879 wri_sol_ice = tmp_sols(:,:,2) 880 wri_sol_sea = tmp_sols(:,:,1) 881 wri_nsol_ice = tmp_nsol(:,:,2) 882 wri_nsol_sea = tmp_nsol(:,:,1) 883 wri_fder_ice = tmp_fder(:,:,2) 884 wri_evap_ice = tmp_evap(:,:,2) 885 wri_evap_sea = tmp_evap(:,:,1) 886 where (tamp_zmasq /= 1.) 887 deno = tamp_srf(:,:,1) + tamp_srf(:,:,2) 888 wri_rain = tmp_rain(:,:,1) * tamp_srf(:,:,1) / deno + & 889 & tmp_rain(:,:,2) * tamp_srf(:,:,2) / deno 890 wri_snow = tmp_snow(:,:,1) * tamp_srf(:,:,1) / deno + & 891 & tmp_snow(:,:,2) * tamp_srf(:,:,2) / deno 892 wri_rriv = tmp_rriv(:,:,1) * tamp_srf(:,:,1) / deno + & 893 & tmp_rriv(:,:,2) * tamp_srf(:,:,2) / deno 894 wri_rcoa = tmp_rcoa(:,:,1) * tamp_srf(:,:,1) / deno + & 895 & tmp_rcoa(:,:,2) * tamp_srf(:,:,2) / deno 896 wri_taux = tmp_taux(:,:,1) * tamp_srf(:,:,1) / deno + & 897 & tmp_taux(:,:,2) * tamp_srf(:,:,2) / deno 898 wri_tauy = tmp_tauy(:,:,1) * tamp_srf(:,:,1) / deno + & 899 & tmp_tauy(:,:,2) * tamp_srf(:,:,2) / deno 900 endwhere 901 902 call intocpl(itime, (jjm+1)*iim, wri_sol_ice, wri_sol_sea, wri_nsol_ice,& 903 & wri_nsol_sea, wri_fder_ice, wri_evap_ice, wri_evap_sea, wri_rain, & 904 & wri_snow, wri_rcoa, wri_rriv, wri_taux, wri_tauy, wri_taux, wri_tauy, & 905 & lafin ) 906 cpl_sols = 0.; cpl_nsol = 0.; cpl_rain = 0.; cpl_snow = 0. 907 cpl_evap = 0.; cpl_tsol = 0.; cpl_fder = 0.; cpl_albe = 0. 908 cpl_taux = 0.; cpl_tauy = 0.; cpl_rriv = 0.; cpl_rcoa = 0. 909 ! 910 ! deallocation memoire variables temporaires 911 ! 912 sum_error = 0 913 deallocate(tmp_sols, stat=error); sum_error = sum_error + error 914 deallocate(tmp_nsol, stat=error); sum_error = sum_error + error 915 deallocate(tmp_rain, stat=error); sum_error = sum_error + error 916 deallocate(tmp_snow, stat=error); sum_error = sum_error + error 917 deallocate(tmp_evap, stat=error); sum_error = sum_error + error 918 deallocate(tmp_fder, stat=error); sum_error = sum_error + error 919 deallocate(tmp_tsol, stat=error); sum_error = sum_error + error 920 deallocate(tmp_albe, stat=error); sum_error = sum_error + error 921 deallocate(tmp_taux, stat=error); sum_error = sum_error + error 922 deallocate(tmp_tauy, stat=error); sum_error = sum_error + error 923 deallocate(tmp_rriv, stat=error); sum_error = sum_error + error 924 deallocate(tmp_rcoa, stat=error); sum_error = sum_error + error 925 if (sum_error /= 0) then 926 abort_message='Pb deallocation variables couplees' 927 call abort_gcm(modname,abort_message,1) 928 endif 929 930 endif 931 932 endif ! fin nexca 933 ! 934 ! on range les variables lues/sauvegardees dans les bonnes variables de sortie 935 ! 936 if (nisurf == is_oce) then 716 937 call cpl2gath(read_sst, tsurf_new, klon, knon,iim,jjm, knindex) 717 938 call cpl2gath(read_sic, tamp_sic , klon, knon,iim,jjm, knindex) 718 call cpl2gath(read_alb_sst, alb_new, klon, knon,iim,jjm, knindex)719 call cpl2gath(read_alb_sic, alb_ice, klon, knon,iim,jjm, knindex)720 939 ! 721 940 ! transformer tamp_sic en pctsrf_new … … 729 948 endif 730 949 enddo 731 732 endif ! fin if (debut) 733 734 ! fichier restart et fichiers histoires 735 736 ! calcul des fluxs a passer 737 738 cpl_sols = cpl_sols + swdown / FLOAT(nexca) 739 cpl_nsol = cpl_nsol + lwdown / FLOAT(nexca) 740 cpl_rain = cpl_rain + precip_rain / FLOAT(nexca) 741 cpl_snow = cpl_snow + precip_snow / FLOAT(nexca) 742 cpl_evap = cpl_evap + evap / FLOAT(nexca) 743 cpl_tsol = cpl_tsol + tsurf / FLOAT(nexca) 744 cpl_fder = cpl_fder + fder / FLOAT(nexca) 745 cpl_albe = cpl_albe + albsol / FLOAT(nexca) 746 cpl_taux = cpl_taux + taux / FLOAT(nexca) 747 cpl_tauy = cpl_tauy + tauy / FLOAT(nexca) 748 cpl_ruis = cpl_ruis + run_off / FLOAT(nexca)/dtime 749 750 if (mod(itime, nexca) == 0) then 751 ! 752 ! Mise sur la bonne grille des champs a passer au coupleur 753 call gath2cpl(cpl_sols, wri_sols, klon, knon,iim,jjm, knindex) 754 call gath2cpl(cpl_nsol, wri_nsol, klon, knon,iim,jjm, knindex) 755 call gath2cpl(cpl_rain, wri_rain, klon, knon,iim,jjm, knindex) 756 call gath2cpl(cpl_snow, wri_snow, klon, knon,iim,jjm, knindex) 757 call gath2cpl(cpl_evap, wri_evap, klon, knon,iim,jjm, knindex) 758 call gath2cpl(cpl_tsol, wri_tsol, klon, knon,iim,jjm, knindex) 759 call gath2cpl(cpl_fder, wri_fder, klon, knon,iim,jjm, knindex) 760 call gath2cpl(cpl_albe, wri_albe, klon, knon,iim,jjm, knindex) 761 call gath2cpl(cpl_taux, wri_taux, klon, knon,iim,jjm, knindex) 762 call gath2cpl(cpl_tauy, wri_tauy, klon, knon,iim,jjm, knindex) 763 call gath2cpl(cpl_ruis, wri_ruis, klon, knon,iim,jjm, knindex) 764 ! 765 ! Passage des champs au coupleur 766 ! 767 call intocpl(itime, iim, jjm , wri_sols, wri_nsol, wri_rain, wri_snow, & 768 & wri_evap, wri_tsol, wri_fder, wri_albe, wri_taux, wri_tauy, & 769 & wri_ruis ) 770 cpl_sols = 0. 771 cpl_nsol = 0. 772 cpl_rain = 0. 773 cpl_snow = 0. 774 cpl_evap = 0. 775 cpl_tsol = 0. 776 cpl_fder = 0. 777 cpl_albe = 0. 778 cpl_taux = 0. 779 cpl_tauy = 0. 780 cpl_ruis = 0. 781 782 call fromcpl(itime,(jjm+1)*iim, & 783 & read_sst, read_sic, read_alb_sst, read_alb_sic) 784 call cpl2gath(read_sst, tsurf_new, klon, knon,iim,jjm, knindex) 785 call cpl2gath(read_sic, tamp_sic , klon, knon,iim,jjm, knindex) 786 call cpl2gath(read_alb_sst, alb_new, klon, knon,iim,jjm, knindex) 787 call cpl2gath(read_alb_sic, alb_ice, klon, knon,iim,jjm, knindex) 788 ! transformer tamp_sic en pctsrf_new 789 790 do ig = 1, klon 791 IF (pctsrf(ig,is_oce) > epsfra .OR. & 792 & pctsrf(ig,is_sic) > epsfra) THEN 793 pctsrf_new(ig,is_oce) = pctsrf(ig,is_oce) & 794 & - (tamp_sic(ig)-pctsrf(ig,is_sic)) 795 pctsrf_new(ig,is_sic) = tamp_sic(ig) 796 endif 797 enddo 950 else if (nisurf == is_sic) then 951 call cpl2gath(read_sit, tsurf_new, klon, knon,iim,jjm, knindex) 952 call cpl2gath(read_alb_sic, alb_new, klon, knon,iim,jjm, knindex) 798 953 endif 799 954 … … 1278 1433 ! 1279 1434 fonte_neige = (nisurf /= is_oce) .AND. & 1280 & (snow(i) > 0..OR. nisurf == is_sic .OR. nisurf == is_lic) &1435 & (snow(i) > epsfra .OR. nisurf == is_sic .OR. nisurf == is_lic) & 1281 1436 & .AND. (tsurf_new(i) >= RTT) 1282 1437 if (fonte_neige) tsurf_new(i) = RTT … … 1453 1608 real, dimension(klon) :: tamp 1454 1609 1610 tamp = 0. 1455 1611 do i = 1, knon 1456 1612 ig = knindex(i)
Note: See TracChangeset
for help on using the changeset viewer.
