Changeset 634 for LMDZ4/branches/LMDZ4_par_0/libf/phylmd/physiq.F
- Timestamp:
- May 4, 2005, 5:11:29 PM (19 years ago)
- File:
-
- 1 edited
-
LMDZ4/branches/LMDZ4_par_0/libf/phylmd/physiq.F (modified) (40 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/LMDZ4_par_0/libf/phylmd/physiq.F
r633 r634 15 15 USE ioipsl 16 16 USE histcom 17 USE comgeomphy 18 USE write_field 19 USE write_field_p 20 USE dimphy 21 USE iophy 22 c$$$ USE misc_mod, mydebug=>debug 23 #ifdef CPP_PARALLEL 24 USE vampir 25 #endif 17 26 #ifdef INCA 18 27 USE chemshut … … 35 44 c CLEFS CPP POUR LES IO 36 45 c ===================== 37 #define histhf46 c#define histhf 38 47 #define histday 39 48 #define histmth 40 #define histins49 c#define histins 41 50 c#define histISCCP 42 #define histREGDYN43 #define histmthNMC51 c#define histREGDYN 52 c#define histmthNMC 44 53 c====================================================================== 45 54 c modif ( P. Le Van , 12/10/98 ) … … 77 86 integer jjmp1 78 87 parameter (jjmp1=jjm+1-1/jjm) 79 #include "dimphy.h" 88 integer iip1 89 parameter (iip1=iim+1) 90 cym#include "dimphy.h" 80 91 #include "regdim.h" 81 92 #include "indicesol.h" … … 85 96 #include "logic.h" 86 97 #include "temps.h" 87 #include "comgeomphy.h"98 cym#include "comgeomphy.h" 88 99 #include "advtrac.h" 89 100 #include "iniprint.h" … … 161 172 REAL fm_therm(klon,klev+1) 162 173 REAL entr_therm(klon,klev) 163 real q2(klon,klev+1,nbsrf)164 save q2174 real,allocatable,save :: q2(:,:,:) 175 cym save q2 165 176 c====================================================================== 166 177 c … … 194 205 REAL qx(klon,klev,nqmax) 195 206 196 REAL t_ancien(klon,klev), q_ancien(klon,klev)197 SAVE t_ancien, q_ancien207 REAL,allocatable,save :: t_ancien(:,:), q_ancien(:,:) 208 cym SAVE t_ancien, q_ancien 198 209 LOGICAL ancien_ok 199 210 SAVE ancien_ok … … 214 225 real da(klon,klev),phi(klon,klev,klev),mp(klon,klev) 215 226 216 INTEGER klevp1, klevm1217 PARAMETER(klevp1=klev+1,klevm1=klev-1)218 #include "raddim.h"227 cym INTEGER klevp1, klevm1 228 cym PARAMETER(klevp1=klev+1,klevm1=klev-1) 229 cym#include "raddim.h" 219 230 c 220 231 cIM 080304 REAL swdn0(klon,2), swdn(klon,2), swup0(klon,2), swup(klon,2) 221 REAL swdn0(klon,klevp1), swdn(klon,klevp1)222 REAL swup0(klon,klevp1), swup(klon,klevp1)223 SAVE swdn0 , swdn, swup0, swup224 c 225 REAL SWdn200clr(klon), SWdn200(klon)226 REAL SWup200clr(klon), SWup200(klon)227 SAVE SWdn200clr, SWdn200, SWup200clr, SWup200228 c 229 REAL lwdn0(klon,klevp1), lwdn(klon,klevp1)230 REAL lwup0(klon,klevp1), lwup(klon,klevp1)231 SAVE lwdn0 , lwdn, lwup0, lwup232 c 233 REAL LWdn200clr(klon), LWdn200(klon)234 REAL LWup200clr(klon), LWup200(klon)235 SAVE LWdn200clr, LWdn200, LWup200clr, LWup200236 c 237 REAL LWdnTOA(klon), LWdnTOAclr(klon)238 SAVE LWdnTOA, LWdnTOAclr232 REAL,allocatable,save :: swdn0(:,:), swdn(:,:) 233 REAL,allocatable,save :: swup0(:,:), swup(:,:) 234 cym SAVE swdn0 , swdn, swup0, swup 235 c 236 REAL,allocatable,save :: SWdn200clr(:), SWdn200(:) 237 REAL,allocatable,save :: SWup200clr(:), SWup200(:) 238 cym SAVE SWdn200clr, SWdn200, SWup200clr, SWup200 239 c 240 REAL,allocatable,save :: lwdn0(:,:), lwdn(:,:) 241 REAL,allocatable,save :: lwup0(:,:), lwup(:,:) 242 cym SAVE lwdn0 , lwdn, lwup0, lwup 243 c 244 REAL,allocatable,save :: LWdn200clr(:), LWdn200(:) 245 REAL,allocatable,save :: LWup200clr(:), LWup200(:) 246 cym SAVE LWdn200clr, LWdn200, LWup200clr, LWup200 247 c 248 REAL,allocatable,save :: LWdnTOA(:), LWdnTOAclr(:) 249 cym SAVE LWdnTOA, LWdnTOAclr 239 250 c 240 251 c vents meridien et zonal a un niveau de pression … … 296 307 cv3.4 297 308 INTEGER debug, debugcol 298 INTEGER npoints299 PARAMETER(npoints=klon)309 cym INTEGER npoints 310 cym PARAMETER(npoints=klon) 300 311 c 301 312 INTEGER sunlit(klon) !sunlit=1 if day; sunlit=0 if night … … 457 468 SAVE radpas ! frequence d'appel rayonnement 458 469 c 459 REAL radsol(klon)460 SAVE radsol ! bilan radiatif au sol calcule par code radiatif461 c 462 REAL rlat(klon)463 SAVE rlat ! latitude pour chaque point464 c 465 REAL rlon(klon)466 SAVE rlon ! longitude pour chaque point470 REAL,allocatable,save :: radsol(:) 471 cym SAVE radsol ! bilan radiatif au sol calcule par code radiatif 472 c 473 REAL,allocatable,save :: rlat(:) 474 cym SAVE rlat ! latitude pour chaque point 475 c 476 REAL,allocatable,save :: rlon(:) 477 cym SAVE rlon ! longitude pour chaque point 467 478 c 468 479 cc INTEGER iflag_con … … 478 489 real slp(klon) ! sea level pressure 479 490 480 REAL ftsol(klon,nbsrf)481 SAVE ftsol ! temperature du sol482 c 483 REAL ftsoil(klon,nsoilmx,nbsrf)484 SAVE ftsoil ! temperature dans le sol485 c 486 REAL fevap(klon,nbsrf)487 SAVE fevap ! evaporation488 REAL fluxlat(klon,nbsrf)489 SAVE fluxlat490 c 491 REAL deltat(klon)492 SAVE deltat ! ecart avec la SST de reference493 c 494 REAL fqsurf(klon,nbsrf)495 SAVE fqsurf ! humidite de l'air au contact de la surface496 c 497 REAL qsol(klon)498 SAVE qsol ! hauteur d'eau dans le sol499 c 500 REAL fsnow(klon,nbsrf)501 SAVE fsnow ! epaisseur neigeuse502 c 503 REAL falbe(klon,nbsrf)504 SAVE falbe ! albedo par type de surface505 REAL falblw(klon,nbsrf)506 SAVE falblw ! albedo par type de surface491 REAL,allocatable,save :: ftsol(:,:) 492 cym SAVE ftsol ! temperature du sol 493 c 494 REAL,allocatable,save :: ftsoil(:,:,:) 495 cym SAVE ftsoil ! temperature dans le sol 496 c 497 REAL,allocatable,save :: fevap(:,:) 498 cym SAVE fevap ! evaporation 499 REAL,allocatable,save :: fluxlat(:,:) 500 cym SAVE fluxlat 501 c 502 REAL,allocatable,save :: deltat(:) 503 cym SAVE deltat ! ecart avec la SST de reference 504 c 505 REAL,allocatable,save :: fqsurf(:,:) 506 cym SAVE fqsurf ! humidite de l'air au contact de la surface 507 c 508 REAL,allocatable,save :: qsol(:) 509 cym SAVE qsol ! hauteur d'eau dans le sol 510 c 511 REAL,allocatable,save :: fsnow(:,:) 512 cym SAVE fsnow ! epaisseur neigeuse 513 c 514 REAL,allocatable,save :: falbe(:,:) 515 cym SAVE falbe ! albedo par type de surface 516 REAL,allocatable,save :: falblw(:,:) 517 cym SAVE falblw ! albedo par type de surface 507 518 508 519 c … … 510 521 c Parametres de l'Orographie a l'Echelle Sous-Maille (OESM): 511 522 c 512 REAL zmea(klon)513 SAVE zmea ! orographie moyenne514 c 515 REAL zstd(klon)516 SAVE zstd ! deviation standard de l'OESM517 c 518 REAL zsig(klon)519 SAVE zsig ! pente de l'OESM520 c 521 REAL zgam(klon)522 save zgam ! anisotropie de l'OESM523 c 524 REAL zthe(klon)525 SAVE zthe ! orientation de l'OESM526 c 527 REAL zpic(klon)528 SAVE zpic ! Maximum de l'OESM529 c 530 REAL zval(klon)531 SAVE zval ! Minimum de l'OESM532 c 533 REAL rugoro(klon)534 SAVE rugoro ! longueur de rugosite de l'OESM523 REAL,allocatable,save :: zmea(:) 524 cym SAVE zmea ! orographie moyenne 525 c 526 REAL,allocatable,save :: zstd(:) 527 cym SAVE zstd ! deviation standard de l'OESM 528 c 529 REAL,allocatable,save :: zsig(:) 530 cym SAVE zsig ! pente de l'OESM 531 c 532 REAL,allocatable,save :: zgam(:) 533 cym save zgam ! anisotropie de l'OESM 534 c 535 REAL,allocatable,save :: zthe(:) 536 cym SAVE zthe ! orientation de l'OESM 537 c 538 REAL,allocatable,save :: zpic(:) 539 cym SAVE zpic ! Maximum de l'OESM 540 c 541 REAL,allocatable,save :: zval(:) 542 cym SAVE zval ! Minimum de l'OESM 543 c 544 REAL,allocatable,save :: rugoro(:) 545 cym SAVE rugoro ! longueur de rugosite de l'OESM 535 546 c 536 547 REAL zulow(klon),zvlow(klon),zustr(klon), zvstr(klon) 537 548 c 538 REAL zuthe(klon),zvthe(klon)539 SAVE zuthe540 SAVE zvthe549 REAL,allocatable,save :: zuthe(:),zvthe(:) 550 cym SAVE zuthe 551 cym SAVE zvthe 541 552 INTEGER igwd,idx(klon),itest(klon) 542 553 c 543 REAL agesno(klon,nbsrf)544 SAVE agesno ! age de la neige545 c 546 REAL alb_neig(klon)547 SAVE alb_neig ! albedo de la neige548 c 549 REAL run_off_lic_0(klon)550 SAVE run_off_lic_0554 REAL,allocatable,save :: agesno(:,:) 555 cym SAVE agesno ! age de la neige 556 c 557 REAL,allocatable,save :: alb_neig(:) 558 cym SAVE alb_neig ! albedo de la neige 559 c 560 REAL,allocatable,save :: run_off_lic_0(:) 561 cym SAVE run_off_lic_0 551 562 cKE43 552 563 c Variables liees a la convection de K. Emanuel (sb): 553 564 c 554 REAL ema_workcbmf(klon) ! cloud base mass flux555 SAVE ema_workcbmf556 557 REAL ema_cbmf(klon) ! cloud base mass flux558 SAVE ema_cbmf559 560 REAL ema_pcb(klon) ! cloud base pressure561 SAVE ema_pcb562 563 REAL ema_pct(klon) ! cloud top pressure564 SAVE ema_pct565 REAL,allocatable,save :: ema_workcbmf(:) ! cloud base mass flux 566 cym SAVE ema_workcbmf 567 568 REAL,allocatable,save :: ema_cbmf(:) ! cloud base mass flux 569 cym SAVE ema_cbmf 570 571 REAL,allocatable,save :: ema_pcb(:) ! cloud base pressure 572 cym SAVE ema_pcb 573 574 REAL,allocatable,save :: ema_pct(:) ! cloud top pressure 575 cym SAVE ema_pct 565 576 566 577 REAL bas, top ! cloud base and top levels … … 568 579 SAVE top 569 580 570 REAL Ma(klon,klev) ! undilute upward mass flux571 SAVE Ma572 REAL qcondc(klon,klev) ! in-cld water content from convect573 SAVE qcondc574 REAL ema_work1(klon, klev), ema_work2(klon, klev)575 SAVE ema_work1, ema_work2581 REAL,allocatable,save :: Ma(:,:) ! undilute upward mass flux 582 cym SAVE Ma 583 REAL,allocatable,save :: qcondc(:,:) ! in-cld water content from convect 584 cym SAVE qcondc 585 REAL,allocatable,save :: ema_work1(:, :), ema_work2(:, :) 586 cym SAVE ema_work1, ema_work2 576 587 REAL wdn(klon), tdn(klon), qdn(klon) 577 588 578 REAL wd(klon) ! sb579 SAVE wd ! sb589 REAL,allocatable,save :: wd(:) ! sb 590 cym SAVE wd ! sb 580 591 581 592 c Variables locales pour la couche limite (al1): … … 604 615 c$$$ PARAMETER (offline=.false.) 605 616 c$$$ INTEGER physid 606 REAL pfrac_impa(klon,klev)! Produits des coefs lessivage impaction607 save pfrac_impa608 REAL pfrac_nucl(klon,klev)! Produits des coefs lessivage nucleation609 save pfrac_nucl610 REAL pfrac_1nucl(klon,klev)! Produits des coefs lessi nucl (alpha = 1)611 save pfrac_1nucl617 REAL,allocatable,save :: pfrac_impa(:,:)! Produits des coefs lessivage impaction 618 cym save pfrac_impa 619 REAL,allocatable,save :: pfrac_nucl(:,:)! Produits des coefs lessivage nucleation 620 cym save pfrac_nucl 621 REAL,allocatable,save :: pfrac_1nucl(:,:)! Produits des coefs lessi nucl (alpha = 1) 622 cym save pfrac_1nucl 612 623 REAL frac_impa(klon,klev) ! fractions d'aerosols lessivees (impaction) 613 624 REAL frac_nucl(klon,klev) ! idem (nucleation) … … 618 629 619 630 cAA 620 REAL rain_fall(klon) ! pluie621 REAL snow_fall(klon) ! neige622 save snow_fall, rain_fall631 REAL,allocatable,save :: rain_fall(:) ! pluie 632 REAL,allocatable,save :: snow_fall(:) ! neige 633 cym save snow_fall, rain_fall 623 634 cIM 050204 BEG 624 REAL total_rain(klon), nday_rain(klon)625 save total_rain, nday_rain635 REAL,allocatable,save :: total_rain(:), nday_rain(:) 636 cym save total_rain, nday_rain 626 637 cIM 050204 END 627 638 REAL evap(klon), devap(klon) ! evaporation et sa derivee 628 639 REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee 629 REAL dlw(klon) ! derivee infra rouge640 REAL,allocatable,save :: dlw(:) ! derivee infra rouge 630 641 cym 631 SAVE dlw642 cym SAVE dlw 632 643 cym 633 644 REAL bils(klon) ! bilan de chaleur au sol 634 645 REAL wfbils(klon,nbsrf) ! bilan de chaleur au sol, pour chaque 635 646 C ! type de sous-surface et pondere par la fraction 636 REAL fder(klon) ! Derive de flux (sensible et latente)637 save fder647 REAL,allocatable,save :: fder(:) ! Derive de flux (sensible et latente) 648 cym save fder 638 649 REAL ve(klon) ! integr. verticale du transport meri. de l'energie 639 650 REAL vq(klon) ! integr. verticale du transport meri. de l'eau … … 641 652 REAL uq(klon) ! integr. verticale du transport zonal de l'eau 642 653 c 643 REAL frugs(klon,nbsrf) ! longueur de rugosite644 save frugs654 REAL,allocatable,save :: frugs(:,:) ! longueur de rugosite 655 cym save frugs 645 656 REAL zxrugs(klon) ! longueur de rugosite 646 657 c 647 658 c Conditions aux limites 648 659 c 660 INTEGER :: iii 649 661 INTEGER julien 650 662 c 651 663 INTEGER lmt_pas 652 664 SAVE lmt_pas ! frequence de mise a jour 653 REAL pctsrf(klon,nbsrf)665 REAL,allocatable,save :: pctsrf(:,:) 654 666 cIM 655 667 REAL pctsrf_new(klon,nbsrf) !pourcentage surfaces issus d'ORCHIDEE 656 REAL paire_ter(klon) !surfaces terre 668 cym REAL paire_ter(klon) !surfaces terre 669 REAL,allocatable,save :: paire_ter(:) !surfaces terre 670 657 671 cIM 658 SAVE pctsrf ! sous-fraction du sol659 REAL albsol(klon)660 SAVE albsol ! albedo du sol total661 REAL albsollw(klon)662 SAVE albsollw ! albedo du sol total663 664 REAL wo(klon,klev)665 672 cym SAVE pctsrf ! sous-fraction du sol 673 REAL,allocatable,save :: albsol(:) 674 cym SAVE albsol ! albedo du sol total 675 REAL,allocatable,save :: albsollw(:) 676 cym SAVE albsollw ! albedo du sol total 677 678 REAL,allocatable,save :: wo(:,:) 679 cym SAVE wo ! ozone 666 680 c====================================================================== 667 681 c … … 702 716 c Variables locales 703 717 c 704 real clwcon(klon,klev),rnebcon(klon,klev)718 real,allocatable,save :: clwcon(:,:),rnebcon(:,:) 705 719 real clwcon0(klon,klev),rnebcon0(klon,klev) 706 save rnebcon, clwcon720 cym save rnebcon, clwcon 707 721 708 722 REAL rhcl(klon,klev) ! humiditi relative ciel clair … … 725 739 REAL zxfluxv(klon, klev) 726 740 CXXX 727 REAL heat(klon,klev) ! chauffage solaire728 REAL heat0(klon,klev) ! chauffage solaire ciel clair729 REAL cool(klon,klev) ! refroidissement infrarouge730 REAL cool0(klon,klev) ! refroidissement infrarouge ciel clair731 REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)732 real sollwdown(klon) ! downward LW flux at surface741 REAL,allocatable,save :: heat(:,:) ! chauffage solaire 742 REAL,allocatable,save :: heat0(:,:) ! chauffage solaire ciel clair 743 REAL,allocatable,save :: cool(:,:) ! refroidissement infrarouge 744 REAL,allocatable,save :: cool0(:,:) ! refroidissement infrarouge ciel clair 745 REAL,allocatable,save :: topsw(:), toplw(:), solsw(:), sollw(:) 746 real,allocatable,save :: sollwdown(:) ! downward LW flux at surface 733 747 cIM BEG 734 real sollwdownclr(klon) ! downward CS LW flux at surface735 real toplwdown(klon) ! downward CS LW flux at TOA736 real toplwdownclr(klon) ! downward CS LW flux at TOA748 real,allocatable,save :: sollwdownclr(:) ! downward CS LW flux at surface 749 real,allocatable,save :: toplwdown(:) ! downward CS LW flux at TOA 750 real,allocatable,save :: toplwdownclr(:) ! downward CS LW flux at TOA 737 751 cIM END 738 REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)739 REAL albpla(klon)752 REAL,allocatable,save :: topsw0(:),toplw0(:),solsw0(:),sollw0(:) 753 REAL,allocatable,save :: albpla(:) 740 754 REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface 741 755 REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface 742 756 c Le rayonnement n'est pas calcule tous les pas, il faut donc 743 757 c sauvegarder les sorties du rayonnement 744 SAVE heat,cool,albpla,topsw,toplw,solsw,sollw,sollwdown745 SAVE sollwdownclr, toplwdown, toplwdownclr746 SAVE topsw0,toplw0,solsw0,sollw0, heat0, cool0758 cym SAVE heat,cool,albpla,topsw,toplw,solsw,sollw,sollwdown 759 cym SAVE sollwdownclr, toplwdown, toplwdownclr 760 cym SAVE topsw0,toplw0,solsw0,sollw0, heat0, cool0 747 761 c 748 762 INTEGER itaprad … … 785 799 REAL dnwd0(klon,klev) ! unsaturated downdraft mass flux 786 800 REAL tvp(klon,klev) ! virtual temp of lifted parcel 787 REAL cape(klon) ! CAPE788 SAVE cape801 REAL,allocatable,save :: cape(:) ! CAPE 802 cym SAVE cape 789 803 CHARACTER*40 capemaxcels !max(CAPE) 790 804 791 REAL pbase(klon) ! cloud base pressure792 SAVE pbase793 REAL bbase(klon) ! cloud base buoyancy794 SAVE bbase805 REAL,allocatable,save :: pbase(:) ! cloud base pressure 806 cym SAVE pbase 807 REAL,allocatable,save :: bbase(:) ! cloud base buoyancy 808 cym SAVE bbase 795 809 REAL rflag(klon) ! flag fonctionnement de convect 796 810 INTEGER iflagctrl(klon) ! flag fonctionnement de convect … … 829 843 REAL prfl(klon,klev+1), psfl(klon,klev+1) 830 844 c 831 INTEGER ibas_con(klon), itop_con(klon)845 INTEGER,allocatable,save :: ibas_con(:), itop_con(:) 832 846 cym 833 SAVE ibas_con,itop_con847 cym SAVE ibas_con,itop_con 834 848 cym 835 849 REAL rain_con(klon), rain_lsc(klon) … … 846 860 REAL d_u_oli(klon,klev), d_v_oli(klon,klev) !tendances dues a oro et lif 847 861 848 REAL ratqs(klon,klev),ratqss(klon,klev),ratqsc(klon,klev) 862 REAL,allocatable,save :: ratqs(:,:) 863 REAL ratqss(klon,klev),ratqsc(klon,klev) 849 864 real ratqsbas,ratqshaut 850 save ratqsbas,ratqshaut, ratqs 865 cym save ratqsbas,ratqshaut, ratqs 866 save ratqsbas,ratqshaut 851 867 real zpt_conv(klon,klev) 852 868 … … 956 972 cjq Aerosol effects (Johannes Quaas, 27/11/2003) 957 973 REAL sulfate(klon, klev) ! SO4 aerosol concentration [ug/m3] 958 REAL sulfate_pi(klon, klev) ! SO4 aerosol concentration [ug/m3] (pre-industrial value)959 SAVE sulfate_pi974 REAL,allocatable,save :: sulfate_pi(:,:) ! SO4 aerosol concentration [ug/m3] (pre-industrial value) 975 cym SAVE sulfate_pi 960 976 961 977 REAL cldtaupi(klon,klev) ! Cloud optical thickness for pre-industrial (pi) aerosols … … 990 1006 c Declaration des constantes et des fonctions thermodynamiques 991 1007 c 1008 LOGICAL :: first=.true. 992 1009 #include "YOMCST.h" 993 1010 #include "YOETHF.h" 994 1011 #include "FCTTRE.h" 1012 1013 REAL Field_tmp(klon2,klevp1) 1014 1015 if (first) then 1016 1017 allocate( t_ancien(klon,klev), q_ancien(klon,klev)) 1018 allocate( q2(klon,klev+1,nbsrf)) 1019 allocate( swdn0(klon,klevp1), swdn(klon,klevp1)) 1020 allocate( swup0(klon,klevp1), swup(klon,klevp1)) 1021 allocate( SWdn200clr(klon), SWdn200(klon)) 1022 allocate( SWup200clr(klon), SWup200(klon)) 1023 allocate( lwdn0(klon,klevp1), lwdn(klon,klevp1)) 1024 allocate( lwup0(klon,klevp1), lwup(klon,klevp1)) 1025 allocate( LWdn200clr(klon), LWdn200(klon)) 1026 allocate( LWup200clr(klon), LWup200(klon)) 1027 allocate( LWdnTOA(klon), LWdnTOAclr(klon)) 1028 allocate( radsol(klon)) 1029 allocate( rlat(klon)) 1030 allocate( rlon(klon)) 1031 allocate( ftsol(klon,nbsrf)) 1032 allocate( ftsoil(klon,nsoilmx,nbsrf)) 1033 allocate( fevap(klon,nbsrf)) 1034 allocate( fluxlat(klon,nbsrf)) 1035 allocate( deltat(klon)) 1036 allocate( fqsurf(klon,nbsrf)) 1037 allocate( qsol(klon)) 1038 allocate( fsnow(klon,nbsrf)) 1039 allocate( falbe(klon,nbsrf)) 1040 allocate( falblw(klon,nbsrf)) 1041 allocate( zmea(klon)) 1042 allocate( zstd(klon)) 1043 allocate( zsig(klon)) 1044 allocate( zgam(klon)) 1045 allocate( zthe(klon)) 1046 allocate( zpic(klon)) 1047 allocate( zval(klon)) 1048 allocate( rugoro(klon)) 1049 allocate( zuthe(klon),zvthe(klon)) 1050 allocate( agesno(klon,nbsrf)) 1051 allocate( alb_neig(klon)) 1052 allocate( run_off_lic_0(klon)) 1053 allocate( ema_workcbmf(klon)) 1054 allocate( ema_cbmf(klon)) 1055 allocate( ema_pcb(klon)) 1056 allocate( ema_pct(klon)) 1057 allocate( Ma(klon,klev) ) 1058 allocate( qcondc(klon,klev)) 1059 allocate( ema_work1(klon, klev), ema_work2(klon, klev)) 1060 allocate( wd(klon) ) 1061 allocate( pfrac_impa(klon,klev)) 1062 allocate( pfrac_nucl(klon,klev)) 1063 allocate( pfrac_1nucl(klon,klev)) 1064 allocate( rain_fall(klon) ) 1065 allocate( snow_fall(klon) ) 1066 allocate( total_rain(klon), nday_rain(klon)) 1067 allocate( dlw(klon) ) 1068 allocate( fder(klon) ) 1069 allocate( frugs(klon,nbsrf) ) 1070 allocate( pctsrf(klon,nbsrf)) 1071 allocate( albsol(klon)) 1072 allocate( albsollw(klon)) 1073 allocate( wo(klon,klev)) 1074 allocate( clwcon(klon,klev),rnebcon(klon,klev)) 1075 allocate( heat(klon,klev) ) 1076 allocate( heat0(klon,klev) ) 1077 allocate( cool(klon,klev) ) 1078 allocate( cool0(klon,klev) ) 1079 allocate( topsw(klon), toplw(klon), solsw(klon), sollw(klon)) 1080 allocate( sollwdown(klon) ) 1081 allocate( sollwdownclr(klon) ) 1082 allocate( toplwdown(klon) ) 1083 allocate( toplwdownclr(klon) ) 1084 allocate( topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)) 1085 allocate( albpla(klon)) 1086 allocate( cape(klon) ) 1087 allocate( pbase(klon) ) 1088 allocate( bbase(klon) ) 1089 allocate( ibas_con(klon), itop_con(klon)) 1090 allocate( ratqs(klon,klev)) 1091 allocate( sulfate_pi(klon, klev)) 1092 allocate( paire_ter(klon)) 1093 1094 paire_ter(:)=0. 1095 clwcon(:,:)=0. 1096 rnebcon(:,:)=0. 1097 ratqs(:,:)=0. 1098 run_off_lic_0(:)=0. 1099 sollw(:)=0. 1100 ema_work1(:,:)=0. 1101 ema_work2(:,:)=0. 1102 1103 first=.false. 1104 endif 995 1105 c====================================================================== 996 1106 !rv … … 1164 1274 DO i = 1, klon 1165 1275 ibas_con(i) = 1 1166 itop_con(i) = 11276 itop_con(i) = klev+1 1167 1277 ENDDO 1168 1278 cIM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>END … … 1292 1402 c 1293 1403 #ifdef INCA 1404 call VTe(VTphysiq) 1405 call VTb(VTinca) 1294 1406 iii = MOD(NINT(xjour),360) 1295 1407 calday = FLOAT(iii) + gmtime … … 1314 1426 WRITE(lunout,*) 'OK.' 1315 1427 #endif 1428 call VTe(VTinca) 1429 call VTb(VTphysiq) 1316 1430 #endif 1317 1431 c … … 1538 1652 fder = dlw 1539 1653 1540 1654 c$$$ if (mydebug) then 1655 c$$$ call WriteField_phy_p('u_seri',u_seri,llm) 1656 c$$$ call WriteField_phy_p('v_seri',v_seri,llm) 1657 c$$$ call WriteField_phy_p('t_seri',t_seri,llm) 1658 c$$$ call WriteField_phy_p('q_seri',q_seri,llm) 1659 c$$$ endif 1660 1541 1661 CALL clmain(dtime,itap,date0,pctsrf,pctsrf_new, 1542 1662 e t_seri,q_seri,u_seri,v_seri, … … 1596 1716 ENDDO 1597 1717 ENDDO 1718 1719 c$$$ if (mydebug) then 1720 c$$$ call WriteField_phy_p('u_seri',u_seri,llm) 1721 c$$$ call WriteField_phy_p('v_seri',v_seri,llm) 1722 c$$$ call WriteField_phy_p('t_seri',t_seri,llm) 1723 c$$$ call WriteField_phy_p('q_seri',q_seri,llm) 1724 c$$$ endif 1725 1598 1726 c 1599 1727 IF (if_ebil.ge.2) THEN … … 1833 1961 ENDDO 1834 1962 ENDDO 1963 1964 c$$$ if (mydebug) then 1965 c$$$ call WriteField_phy_p('u_seri',u_seri,llm) 1966 c$$$ call WriteField_phy_p('v_seri',v_seri,llm) 1967 c$$$ call WriteField_phy_p('t_seri',t_seri,llm) 1968 c$$$ call WriteField_phy_p('q_seri',q_seri,llm) 1969 c$$$ endif 1835 1970 c 1836 1971 IF (if_ebil.ge.2) THEN … … 2033 2168 s , fs_bound, fq_bound ) 2034 2169 END IF 2170 2171 c$$$ if (mydebug) then 2172 c$$$ call WriteField_phy_p('u_seri',u_seri,llm) 2173 c$$$ call WriteField_phy_p('v_seri',v_seri,llm) 2174 c$$$ call WriteField_phy_p('t_seri',t_seri,llm) 2175 c$$$ call WriteField_phy_p('q_seri',q_seri,llm) 2176 c$$$ endif 2177 2035 2178 c 2036 2179 c------------------------------------------------------------------- … … 2252 2395 & boxptop) 2253 2396 2254 2397 2398 if (monocpu) then 2399 2255 2400 c passage de la grille (klon,7,7) a (iim,jjmp1,7,7) 2256 2401 DO l=1, lmaxm1 … … 2301 2446 ENDDO 2302 2447 ENDDO 2448 2449 endif ! monocpu 2303 2450 c 2304 2451 ENDIF !ok_isccp … … 2380 2527 2381 2528 #ifdef INCA 2529 call VTe(VTphysiq) 2530 call VTb(VTinca) 2382 2531 calday = FLOAT(julien) + gmtime 2383 2532 … … 2433 2582 WRITE(lunout,*)'OK.' 2434 2583 #endif 2584 call VTe(VTinca) 2585 call VTb(VTphysiq) 2435 2586 #endif 2436 2587 c … … 2471 2622 . + falblw(i,is_sic) * pctsrf(i,is_sic) 2472 2623 ENDDO 2624 2625 c$$$ if (mydebug) then 2626 c$$$ call WriteField_phy_p('u_seri',u_seri,llm) 2627 c$$$ call WriteField_phy_p('v_seri',v_seri,llm) 2628 c$$$ call WriteField_phy_p('t_seri',t_seri,llm) 2629 c$$$ call WriteField_phy_p('q_seri',q_seri,llm) 2630 c$$$ endif 2631 2473 2632 CALL radlwsw ! nouveau rayonnement (compatible Arpege-IFS) 2474 2633 e (dist, rmu0, fract, … … 2500 2659 ENDDO 2501 2660 c 2661 c$$$ if (mydebug) then 2662 c$$$ call WriteField_phy_p('u_seri',u_seri,llm) 2663 c$$$ call WriteField_phy_p('v_seri',v_seri,llm) 2664 c$$$ call WriteField_phy_p('t_seri',t_seri,llm) 2665 c$$$ call WriteField_phy_p('q_seri',q_seri,llm) 2666 c$$$ endif 2667 2502 2668 IF (if_ebil.ge.2) THEN 2503 2669 ztit='after rad' … … 2585 2751 ENDIF ! fin de test sur ok_orodr 2586 2752 c 2753 c$$$ if (mydebug) then 2754 c$$$ call WriteField_phy_p('u_seri',u_seri,llm) 2755 c$$$ call WriteField_phy_p('v_seri',v_seri,llm) 2756 c$$$ call WriteField_phy_p('t_seri',t_seri,llm) 2757 c$$$ call WriteField_phy_p('q_seri',q_seri,llm) 2758 c$$$ endif 2759 2587 2760 IF (ok_orolf) THEN 2588 2761 c … … 2617 2790 ENDIF ! fin de test sur ok_orolf 2618 2791 c 2792 2793 c$$$ if (mydebug) then 2794 c$$$ call WriteField_phy_p('u_seri',u_seri,llm) 2795 c$$$ call WriteField_phy_p('v_seri',v_seri,llm) 2796 c$$$ call WriteField_phy_p('t_seri',t_seri,llm) 2797 c$$$ call WriteField_phy_p('q_seri',q_seri,llm) 2798 c$$$ endif 2799 2619 2800 IF (if_ebil.ge.2) THEN 2620 2801 ztit='after orography' … … 2852 3033 c Convertir les incrementations en tendances 2853 3034 c 3035 c$$$ if (mydebug) then 3036 c$$$ call WriteField_phy_p('u_seri',u_seri,llm) 3037 c$$$ call WriteField_phy_p('v_seri',v_seri,llm) 3038 c$$$ call WriteField_phy_p('t_seri',t_seri,llm) 3039 c$$$ call WriteField_phy_p('q_seri',q_seri,llm) 3040 c$$$ endif 3041 2854 3042 DO k = 1, klev 2855 3043 DO i = 1, klon … … 2918 3106 2919 3107 #ifdef INCA 3108 call VTe(VTphysiq) 3109 call VTb(VTinca) 2920 3110 #ifdef INCAINFO 2921 3111 WRITE(lunout,*)'Appel CHEMHOOK_END ...' … … 2945 3135 WRITE(lunout,*)'OK.' 2946 3136 #endif 3137 call VTe(VTinca) 3138 call VTb(VTphysiq) 2947 3139 #endif 2948 3140
Note: See TracChangeset
for help on using the changeset viewer.
