Changeset 782 for LMDZ4


Ignore:
Timestamp:
Jun 11, 2007, 4:50:43 PM (17 years ago)
Author:
Laurent Fairhead
Message:

Adaptation du code a la nouvelle interface avec les surface de Josefine
LF

Location:
LMDZ4/trunk/libf/phylmd
Files:
13 added
10 deleted
10 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/trunk/libf/phylmd/coefkzmin.F

    r766 r782  
    88      IMPLICIT NONE
    99
    10 cym#include "dimensions.h"
    11 cym#include "dimphy.h"
    12 #include "YOMCST.h"
     10      include "YOMCST.h"
    1311
    1412c.......................................................................
    … …  
    5654      REAL km(klon,klev+1)
    5755      REAL kn(klon,klev+1)
    58       integer l_mix,ngrid
     56      integer ngrid
    5957
    6058
    6159      integer nlay,nlev
    62 cym      PARAMETER (nlay=klev)
    63 cym      PARAMETER (nlev=klev+1)
    64 
    6560      integer ig,k
    6661
    6762      real,parameter :: kap=0.4
    68 
    69       real frif,falpha,fsm
    70       real fl,zzz,zl0,zq2,zn2
    7163
    7264      nlay=klev

  • LMDZ4/trunk/libf/phylmd/ini_histrac.h

    r776 r782  
    2323
    2424         zsto = pdtphys
    25          zout = pdtphys * FLOAT(ecrit_tra)
     25         zout = pdtphys * ecrit_tra
    2626c
    2727         CALL histdef(nid_tra, "phis", "Surface geop. height", "-",

  • LMDZ4/trunk/libf/phylmd/phyetat0.F

    r779 r782  
    55c
    66      SUBROUTINE phyetat0 (fichnom,dtime,co2_ppm_etat0,solaire_etat0,
    7      .            rlat_p,rlon_p, pctsrf_p, tsol_p,tsoil_p,
    8 cIM "slab" ocean
    9      .           ocean, tslab_p,seaice_p,
    10      .           qsurf_p,qsol_p,snow_p,albe_p, alblw_p, evap_p,
     7     .           rlat_p, rlon_p, pctsrf_p, tsol_p,
     8     .           ocean_in, ok_veget_in,
     9     .           albe_p, alblw_p,
    1110     .           rain_fall_p, snow_fall_p,solsw_p, sollw_p,
    12      .           fder_p,radsol_p,frugs_p,agesno_p,clesphy0,
     11     .           radsol_p,clesphy0,
    1312     .           zmea_p,zstd_p,zsig_p,zgam_p,zthe_p,zpic_p,zval_p,
    1413     .           rugsrel_p,tabcntr0,
    1514     .           t_ancien_p,q_ancien_p,ancien_ok_p, rnebcon_p, ratqs_p,
    16      .           clwcon_p,run_off_lic_0_p)
     15     .           clwcon_p)
     16
    1717      USE dimphy
    1818      USE mod_grid_phy_lmdz
    1919      USE mod_phys_lmdz_para
    2020      USE iophy
     21      USE ocean_slab_mod,   ONLY : ocean_slab_init
     22      USE ocean_cpl_mod,    ONLY : ocean_cpl_init
     23      USE ocean_forced_mod, ONLY : ocean_forced_init
     24      USE fonte_neige_mod,  ONLY : fonte_neige_init
     25      USE pbl_surface_mod,  ONLY : pbl_surface_init
     26      USE surface_data,     ONLY : ocean, ok_veget
     27
    2128      IMPLICIT none
    2229c======================================================================
    … …  
    2532c======================================================================
    2633#include "dimensions.h"
    27 cym#include "dimphy.h"
    2834#include "netcdf.inc"
    2935#include "indicesol.h"
    … …  
    111117      real ratqs(klon_glo,klev)
    112118
    113       CHARACTER*6 ocean
     119      CHARACTER*6 ocean_in
     120      LOGICAL ok_veget_in
    114121
    115122      INTEGER        longcles
    … …  
    515522c Lecture de tslab (pour slab ocean seulement):     
    516523c
    517       IF (ocean .eq. 'slab  ') then
     524      IF (ocean_in .eq. 'slab  ') then
    518525        ierr = NF_INQ_VARID (nid, "TSLAB", nvarid)
    519526        IF (ierr.NE.NF_NOERR) THEN
    … …  
    15431550      call Scatter( zmasq_glo,zmasq)
    15441551
     1552c
     1553c Initilalize variables in module surface_data
     1554c
     1555      ok_veget = ok_veget_in
     1556      ocean    = ocean_in
     1557c
     1558c Initialize module pbl_surface_mod
     1559c
     1560      CALL pbl_surface_init(qsol_p, fder_p, snow_p, qsurf_p,
     1561     $     evap_p, frugs_p, agesno_p, tsoil_p)
     1562
     1563c Initialize ocean module according to ocean type
     1564      IF ( ocean == 'slab' ) THEN
     1565c        initilalize module ocean_slab_init
     1566         CALL ocean_slab_init(dtime, tslab_p, seaice_p, pctsrf_p)
     1567      ELSEIF ( ocean == 'couple' ) THEN
     1568c        initilalize module ocean_cpl_init
     1569         CALL ocean_cpl_init(dtime, rlon_p, rlat_p)
     1570      ELSE
     1571c        initilalize module ocean_forced_init
     1572         CALL ocean_forced_init
     1573      ENDIF
     1574c
     1575c Initilialize module fonte_neige_mod     
     1576c
     1577      CALL fonte_neige_init(run_off_lic_0_p)
     1578
     1579
    15451580      RETURN
    15461581      END

  • LMDZ4/trunk/libf/phylmd/phyredem.F

    r776 r782  
    33!
    44c
    5       SUBROUTINE phyredem (fichnom,dtime,radpas,
    6      .           rlat_p,rlon_p, pctsrf_p,tsol_p,tsoil_p,
    7 cIM "slab" ocean
    8      .           tslab,seaice,
    9      .           qsurf_p,qsol_p,snow_p,albedo_p, alblw_p, evap_p,
    10      .           rain_fall_p, snow_fall_p,solsw_p, sollw_p,fder_p,
    11      .           radsol_p,frugs_p,agesno_p,zmea_p,zstd_p,zsig_p,
     5      SUBROUTINE phyredem (fichnom,dtime,radpas,ocean,
     6     .           rlat_p,rlon_p, pctsrf_p,tsol_p,
     7     .           albedo_p, alblw_p,
     8     .           rain_fall_p, snow_fall_p,solsw_p, sollw_p,
     9     .           radsol_p,zmea_p,zstd_p,zsig_p,
    1210     .           zgam_p,zthe_p,zpic_p,zval_p,rugsrel_p,
    13      .           t_ancien_p, q_ancien_p, rnebcon_p, ratqs_p, clwcon_p,
    14      .           run_off_lic_0_p)
     11     .           t_ancien_p, q_ancien_p, rnebcon_p, ratqs_p, clwcon_p)
     12
    1513      USE dimphy
    1614      USE mod_grid_phy_lmdz
    1715      USE mod_phys_lmdz_para
     16      USE ocean_slab_mod,   ONLY : ocean_slab_final
     17      USE fonte_neige_mod,  ONLY : fonte_neige_final
     18      USE pbl_surface_mod,  ONLY : pbl_surface_final
     19
    1820      IMPLICIT none
    1921c======================================================================
    … …  
    2123c Objet: Ecriture de l'etat de redemarrage pour la physique
    2224c======================================================================
    23 cym#include "dimensions.h"
    24 cym#include "dimphy.h"
    2525#include "netcdf.inc"
    2626#include "indicesol.h"
    … …  
    3636      REAL tsol_p(klon,nbsrf)
    3737      REAL tsoil_p(klon,nsoilmx,nbsrf)
     38      CHARACTER*6 ocean
    3839cIM "slab" ocean
    3940      REAL tslab_p(klon), seaice_p(klon)
    … …  
    110111      CHARACTER*7 str7
    111112      CHARACTER*2 str2
    112 c
     113
     114c======================================================================
     115c
     116c Get variables which will be written to restart file from module
     117c pbl_surface_mod
     118      CALL pbl_surface_final(qsol_p, fder_p, snow_p, qsurf_p,
     119     $     evap_p, frugs_p, agesno_p, tsoil_p)
     120
     121c Get a variable calculated in module fonte_neige_mod
     122      CALL fonte_neige_final(run_off_lic_0_p)
     123
     124c If slab ocean then get 2 varaibles from module ocean_slab_mod
     125      IF ( ocean == 'slab' ) THEN
     126         CALL ocean_slab_final(tslab_p, seaice_p)
     127      ELSE
     128         tslab_p(:)  = 0.0
     129         seaice_p(:) = 0.0
     130      ENDIF     
     131
     132c======================================================================
     133
    113134      call Gather( rlat_p,rlat)
    114135      call Gather( rlon_p,rlon)

  • LMDZ4/trunk/libf/phylmd/physiq.F

    r776 r782  
    2626      USE misc_mod, mydebug=>debug
    2727      USE vampir
     28      USE pbl_surface_mod, ONLY : pbl_surface
     29
     30#ifdef INCA
     31cym      USE chemshut
     32      USE species_names
     33#ifdef INCA_CH4
     34!      USE obs_pos
     35#endif
     36#endif
     37
     38      USE ocean_slab_mod, ONLY   : ocean_slab_get_vars
     39      USE ocean_cpl_mod, ONLY    : ocean_cpl_get_vars
     40      USE ocean_forced_mod, ONLY : ocean_forced_get_vars
     41      USE fonte_neige_mod, ONLY  : fonte_neige_get_vars
     42
    2843      IMPLICIT none
    2944c======================================================================
    … …  
    7085c d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s)
    7186c omega---input-R-vitesse verticale en Pa/s
    72 cIM comgeomphy.h BEG
    73 c cuphy----input-R-resolution des mailles en x (m)
    74 c cvphy----input-R-resolution des mailles en y (m)
    75 cIM comgeomphy.h END
    7687c d_u-----output-R-tendance physique de "u" (m/s/s)
    7788c d_v-----output-R-tendance physique de "v" (m/s/s)
    … …  
    8798      integer iip1
    8899      parameter (iip1=iim+1)
    89 cym#include "dimphy.h"
     100
    90101#include "regdim.h"
    91102#include "indicesol.h"
    … …  
    110121      PARAMETER (ok_stratus=.FALSE.)
    111122c======================================================================
    112 c Parametres lies au coupleur OASIS:
    113 #include "oasis.h"
    114       INTEGER,SAVE :: npas, nexca
    115 c$OMP THREADPRIVATE(npas, nexca)
    116123      logical rnpb
    117124#ifdef INCA
    … …  
    124131      SAVE ocean
    125132c$OMP THREADPRIVATE(ocean)
    126 c      parameter (ocean = 'force ')
    127 c     parameter (ocean = 'couple')
    128       logical ok_ocean
    129       SAVE ok_ocean
    130 c$OMP THREADPRIVATE(ok_ocean)
    131 c
     133
    132134cIM "slab" ocean
    133135      REAL tslab(klon)    !Temperature du slab-ocean
    … …  
    167169      save ok_journe
    168170c$OMP THREADPRIVATE(ok_journe)
    169 c      PARAMETER (ok_journe=.true.)
    170171c
    171172      LOGICAL ok_mensuel ! sortir le fichier mensuel
    172173      save ok_mensuel
    173174c$OMP THREADPRIVATE(ok_mensuel)
    174 c      PARAMETER (ok_mensuel=.true.)
    175175c
    176176      LOGICAL ok_instan ! sortir le fichier instantane
    177177      save ok_instan
    178178c$OMP THREADPRIVATE(ok_instan)
    179 c      PARAMETER (ok_instan=.true.)
    180179c
    181180      LOGICAL ok_region ! sortir le fichier regional
    … …  
    185184      REAL fm_therm(klon,klev+1)
    186185      REAL entr_therm(klon,klev)
    187       real,allocatable,save :: q2(:,:,:)
    188 c$OMP THREADPRIVATE(q2)
    189 cym      save q2
    190186c======================================================================
    191187c
    … …  
    212208      REAL presnivs(klev)
    213209      REAL znivsig(klev)
    214       REAL zsurf(nbsrf)
    215       INTEGER kinv
    216210      real pir
    217211
    … …  
    223217      REAL,allocatable,save :: t_ancien(:,:), q_ancien(:,:)
    224218c$OMP THREADPRIVATE(t_ancien, q_ancien)
    225 cym      SAVE t_ancien, q_ancien
    226219      LOGICAL ancien_ok
    227220      SAVE ancien_ok
    … …  
    268261      REAL,allocatable,save :: swup0(:,:), swup(:,:)
    269262c$OMP THREADPRIVATE(swdn0 , swdn, swup0, swup)
    270 cym      SAVE swdn0 , swdn, swup0, swup
    271263c
    272264      REAL,allocatable,save :: SWdn200clr(:), SWdn200(:)
    273265      REAL,allocatable,save :: SWup200clr(:), SWup200(:)
    274266c$OMP THREADPRIVATE(SWdn200clr, SWdn200, SWup200clr, SWup200)
    275 cym      SAVE SWdn200clr, SWdn200, SWup200clr, SWup200
    276267c
    277268      REAL,allocatable,save :: lwdn0(:,:), lwdn(:,:)
    278269      REAL,allocatable,save :: lwup0(:,:), lwup(:,:)
    279270c$OMP THREADPRIVATE(lwdn0 , lwdn, lwup0, lwup)
    280 cym      SAVE lwdn0 , lwdn, lwup0, lwup
    281271c
    282272      REAL,allocatable,save :: LWdn200clr(:), LWdn200(:)
    283273      REAL,allocatable,save :: LWup200clr(:), LWup200(:)
    284274c$OMP THREADPRIVATE(LWdn200clr, LWdn200, LWup200clr, LWup200)
    285 cym      SAVE LWdn200clr, LWdn200, LWup200clr, LWup200
    286275c
    287276      REAL,allocatable,save :: LWdnTOA(:), LWdnTOAclr(:)
    288277c$OMP THREADPRIVATE(LWdnTOA, LWdnTOAclr)
    289 cym      SAVE LWdnTOA, LWdnTOAclr
    290278c
    291279cIM Amip2
    … …  
    323311      REAL,SAVE,ALLOCATABLE :: wsumSTD(:,:,:), phisumSTD(:,:,:)
    324312      REAL,SAVE,ALLOCATABLE :: qsumSTD(:,:,:), rhsumSTD(:,:,:)
    325 c
    326 cym      SAVE tsumSTD, usumSTD, vsumSTD, wsumSTD, phisumSTD,
    327 cym     .     qsumSTD, rhsumSTD
    328313c$OMP THREADPRIVATE(tsumSTD, usumSTD, vsumSTD, wsumSTD, phisumSTD)
    329314c$OMP THREADPRIVATE(qsumSTD, rhsumSTD)
    … …  
    332317      real,SAVE,ALLOCATABLE :: tnondef(:,:,:)
    333318c$OMP THREADPRIVATE(tnondef)
    334 cym      save tnondef
    335319c
    336320c les produits uvSTD, vqSTD, .., T2STD sont calcules
    … …  
    360344      real,save,allocatable :: T2sumSTD(:,:,:)
    361345c
    362 cym      SAVE uvsumSTD, vqsumSTD, vTsumSTD, wqsumSTD
    363 cym      SAVE vphisumSTD, wTsumSTD, u2sumSTD, v2sumSTD, T2sumSTD
    364346c$OMP THREADPRIVATE(uvsumSTD, vqsumSTD, vTsumSTD, wqsumSTD)
    365347c$OMP THREADPRIVATE(vphisumSTD, wTsumSTD, u2sumSTD, v2sumSTD, T2sumSTD)
    … …  
    433415      REAL seed_re(klon,napisccp)
    434416      INTEGER,ALLOCATABLE,SAVE :: seed_old(:,:)
    435 cym      SAVE seed_old
    436417c$OMP THREADPRIVATE(seed_old)
    437418cym !!!! A voir plus tard
    … …  
    511492      PARAMETER(nbregdyn=5)
    512493
    513       INTEGER linv
    514494      INTEGER,ALLOCATABLE,SAVE :: pct_ocean(:,:)
    515495c$OMP THREADPRIVATE(pct_ocean)
    … …  
    683663
    684664      REAL,allocatable,save :: ftsol(:,:)
    685 c$OMP THREADPRIVATE(ftsol)
    686 cym      SAVE ftsol                  ! temperature du sol
     665c$OMP THREADPRIVATE(ftsol)       ! temperature du sol
    687666
    688667cIM
    … …  
    691670cym     SAVE newsst
    692671c
    693       REAL,allocatable,save :: ftsoil(:,:,:)
    694 c$OMP THREADPRIVATE(ftsoil)
    695 cym      SAVE ftsoil                 ! temperature dans le sol
    696 c
    697       REAL,allocatable,save :: fevap(:,:)
    698 c$OMP THREADPRIVATE(fevap)
    699 cym      SAVE fevap                 ! evaporation
    700       REAL,allocatable,save :: fluxlat(:,:)
    701 c$OMP THREADPRIVATE(fluxlat)
    702 cym      SAVE fluxlat
     672      REAL fevap(klon,nbsrf)
     673      REAL fluxlat(klon,nbsrf)
    703674c
    704675      REAL,allocatable,save :: deltat(:)
    … …  
    706677cym      SAVE deltat                 ! ecart avec la SST de reference
    707678c
    708       REAL,allocatable,save :: fqsurf(:,:)
    709 c$OMP THREADPRIVATE(fqsurf)
    710 cym      SAVE fqsurf                 ! humidite de l'air au contact de la surface
    711 c
    712       REAL,allocatable,save :: qsol(:)
    713 c$OMP THREADPRIVATE(qsol)
    714 cym      SAVE qsol                  ! hauteur d'eau dans le sol
    715 c
    716       REAL,allocatable,save :: fsnow(:,:)
    717 c$OMP THREADPRIVATE(fsnow)
    718 cym      SAVE fsnow                  ! epaisseur neigeuse
     679      REAL qsol(klon)
    719680c
    720681      REAL,allocatable,save :: falbe(:,:)
    721 c$OMP THREADPRIVATE(falbe)
    722 cym      SAVE falbe                  ! albedo par type de surface
     682c$OMP THREADPRIVATE(falbe)       ! albedo par type de surface
     683c
    723684      REAL,allocatable,save :: falblw(:,:)
    724 c$OMP THREADPRIVATE(falblw)     
    725 cym      SAVE falblw                 ! albedo par type de surface
     685c$OMP THREADPRIVATE(falblw)       ! albedo par type de surface
    726686
    727687c
    … …  
    770730      INTEGER igwd,idx(klon),itest(klon)
    771731c
    772       REAL,allocatable,save :: agesno(:,:)
    773 c$OMP THREADPRIVATE(agesno)
    774 cym      SAVE agesno                 ! age de la neige
     732      REAL agesno(klon,nbsrf)
    775733c
    776734      REAL,allocatable,save :: alb_neig(:)
    … …  
    778736cym      SAVE alb_neig               ! albedo de la neige
    779737c
    780       REAL,allocatable,save :: run_off_lic_0(:)
    781 c$OMP THREADPRIVATE(run_off_lic_0)
     738c      REAL,allocatable,save :: run_off_lic_0(:)
     739cc$OMP THREADPRIVATE(run_off_lic_0)
    782740cym      SAVE run_off_lic_0
    783741cKE43
    … …  
    836794      REAL yu1(klon)            ! vents dans la premiere couche U
    837795      REAL yv1(klon)            ! vents dans la premiere couche V
    838       REAL,SAVE,ALLOCATABLE :: ffonte(:,:)    !Flux thermique utilise pour fondre la neige
    839 c$OMP THREADPRIVATE(ffonte)
    840       REAL,SAVE,ALLOCATABLE :: fqcalving(:,:) !Flux d'eau "perdu" par la surface
    841 c$OMP THREADPRIVATE(fqcalving)
    842       REAL,SAVE,ALLOCATABLE :: fqfonte(:,:)  !Quantite d'eau de fonte des glaciers
    843 c$OMP THREADPRIVATE(fqfonte)
    844 c                               !et necessaire pour limiter la
    845 c                               !hauteur de neige, en kg/m2/s
     796
    846797      REAL zxffonte(klon), zxfqcalving(klon),zxfqfonte(klon)
    847798
    … …  
    882833      REAL evap(klon), devap(klon) ! evaporation et sa derivee
    883834      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
    884       REAL,allocatable,save :: dlw(:)    ! derivee infra rouge
    885 c$OMP THREADPRIVATE(dlw)
    886 cym
    887 cym      SAVE dlw
    888 cym
     835
    889836      REAL bils(klon) ! bilan de chaleur au sol
    890837      REAL wfbilo(klon,nbsrf) ! bilan d'eau, pour chaque
    … …  
    892839      REAL wfbils(klon,nbsrf) ! bilan de chaleur au sol, pour chaque
    893840C                             ! type de sous-surface et pondere par la fraction
    894       REAL,allocatable,save :: fder(:) ! Derive de flux (sensible et latente)
    895 c$OMP THREADPRIVATE(fder)
    896 cym      save fder
     841      REAL fder(klon)         
    897842      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
    898843      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
    … …  
    900845      REAL uq(klon) ! integr. verticale du transport zonal de l'eau
    901846c
    902       REAL,allocatable,save :: frugs(:,:) ! longueur de rugosite
    903 c$OMP THREADPRIVATE(frugs)
    904 cym      save frugs
     847      REAL frugs(klon,nbsrf)
    905848      REAL zxrugs(klon) ! longueur de rugosite
    906849c
    … …  
    944887      EXTERNAL alboc     ! calculer l'albedo sur ocean
    945888      EXTERNAL ajsec     ! ajustement sec
    946       EXTERNAL clmain    ! couche limite
    947889      EXTERNAL conlmd    ! convection (schema LMD)
    948890cKE43
    … …  
    1047989c
    1048990      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)
     991      REAL zxsnow_dummy(klon)
    1049992c
    1050993      REAL dist, rmu0(klon), fract(klon)
    … …  
    10701013cym      REAL zx_aire(iim,jjmp1)
    10711014c
    1072 cIM cf. AM Variables locales pour la CLA (hbtm2)
    1073 c
    1074       REAL,SAVE,ALLOCATABLE :: pblh(:, :)           ! Hauteur de couche limite
    1075 c$OMP THREADPRIVATE(pblh)
    1076       REAL,SAVE,ALLOCATABLE :: plcl(:, :)           ! Niveau de condensation de la CLA
    1077 c$OMP THREADPRIVATE(plcl)
    1078       REAL,SAVE,ALLOCATABLE :: capCL(:, :)          ! CAPE de couche limite
    1079 c$OMP THREADPRIVATE(capCL)
    1080       REAL,SAVE,ALLOCATABLE :: oliqCL(:, :)          ! eau_liqu integree de couche limite
    1081 c$OMP THREADPRIVATE(oliqCL)
    1082       REAL,SAVE,ALLOCATABLE :: cteiCL(:, :)          ! cloud top instab. crit. couche limite
    1083 c$OMP THREADPRIVATE(cteiCL)
    1084       REAL,SAVE,ALLOCATABLE :: pblt(:, :)          ! T a la Hauteur de couche limite
    1085 c$OMP THREADPRIVATE(pblt)
    1086       REAL,SAVE,ALLOCATABLE :: therm(:, :)
    1087 c$OMP THREADPRIVATE(therm)
    1088       REAL,SAVE,ALLOCATABLE :: trmb1(:, :)          ! deep_cape
    1089 c$OMP THREADPRIVATE(trmb1)
    1090       REAL,SAVE,ALLOCATABLE :: trmb2(:, :)          ! inhibition
    1091 c$OMP THREADPRIVATE(trmb2)
    1092       REAL,SAVE,ALLOCATABLE :: trmb3(:, :)          ! Point Omega
    1093 c$OMP THREADPRIVATE(trmb3)
    1094 c Grdeurs de sorties
     1015c Grandeurs de sorties
    10951016      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
    10961017      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
    … …  
    12461167cIM RH a 2m (la surface)
    12471168      REAL rh2m(klon), qsat2m(klon)
    1248       REAL zx_rh2m(klon,nbsrf), zx_qsat2m(klon,nbsrf)
    1249       REAL zx_qs1(klon,nbsrf), zx_t1(klon,nbsrf), zdelta1(klon,nbsrf)
    1250       REAL zcor1(klon,nbsrf)
    12511169      REAL tpot(klon), tpote(klon)
    12521170      REAL Lheat
    … …  
    13701288      REAL ZRCPD
    13711289c-jld ec_conser
     1290      REAL t2m(klon,nbsrf)  ! temperature a 2m
     1291      REAL q2m(klon,nbsrf)  ! humidite a 2m
     1292
    13721293cIM: t2m, q2m, u10m, v10m et t2mincels, t2maxcels
    1373       REAL,SAVE,ALLOCATABLE :: t2m(:,:), q2m(:,:)   !temperature, humidite a 2m
    1374 c$OMP THREADPRIVATE(t2m,q2m)
    13751294      REAL,SAVE,ALLOCATABLE :: u10m(:,:), v10m(:,:) !vents a 10m
    13761295c$OMP THREADPRIVATE(u10m,v10m)
    … …  
    14201339c Declaration des constantes et des fonctions thermodynamiques
    14211340c
    1422       REAL Field_tmp(klon_glo,klevp1)
    14231341      LOGICAL,SAVE :: first=.true.
    14241342c$OMP THREADPRIVATE(first)
    … …  
    14431361      aam=0.
    14441362      torsfc=0.
    1445 cym => pour le couple ocean => revoir dans clmain/intersurf
    1446       fluxg(:)=0.
    1447       fluxo(:)=0.     
    14481363
    14491364      if (first) then
    14501365     
    14511366      allocate( t_ancien(klon,klev), q_ancien(klon,klev))
    1452       allocate( q2(klon,klev+1,nbsrf))
    14531367      allocate( swdn0(klon,klevp1), swdn(klon,klevp1))
    14541368      allocate( swup0(klon,klevp1), swup(klon,klevp1))
    … …  
    14641378      allocate( rlon(klon))
    14651379      allocate( ftsol(klon,nbsrf))
    1466       allocate( ftsoil(klon,nsoilmx,nbsrf))
    1467       allocate( fevap(klon,nbsrf))
    1468       allocate( fluxlat(klon,nbsrf))
    14691380      allocate( deltat(klon))
    1470       allocate( fqsurf(klon,nbsrf))
    1471       allocate( qsol(klon))
    1472       allocate( fsnow(klon,nbsrf))
    14731381      allocate( falbe(klon,nbsrf))
    14741382      allocate( falblw(klon,nbsrf))
    … …  
    14821390      allocate( rugoro(klon))
    14831391      allocate( zuthe(klon),zvthe(klon))
    1484       allocate( agesno(klon,nbsrf))
    14851392      allocate( alb_neig(klon))
    1486       allocate( run_off_lic_0(klon))
    14871393      allocate( ema_workcbmf(klon))   
    14881394      allocate( ema_cbmf(klon))
    … …  
    14991405      allocate( snow_fall(klon) )
    15001406      allocate( total_rain(klon), nday_rain(klon))
    1501       allocate( dlw(klon)   )
    1502       allocate( fder(klon) )
    1503       allocate( frugs(klon,nbsrf) )
    15041407      allocate( pctsrf(klon,nbsrf))
    15051408      allocate( albsol(klon))
    … …  
    15461449      allocate( newsst(klon))
    15471450      allocate( zqasc(klon,klev))
    1548       allocate( therm(klon, nbsrf))
    15491451      allocate( rain_con(klon))
    1550       allocate( pblt(klon, nbsrf))
    1551       allocate( t2m(klon,nbsrf), q2m(klon,nbsrf) ) 
    15521452      allocate( u10m(klon,nbsrf), v10m(klon,nbsrf))
    15531453      allocate( topswad(klon), solswad(klon))
    15541454      allocate( topswai(klon), solswai(klon) )
    1555       allocate( ffonte(klon,nbsrf))
    1556       allocate( fqcalving(klon,nbsrf))
    1557       allocate( fqfonte(klon,nbsrf))
    1558       allocate( pblh(klon, nbsrf))
    1559       allocate( plcl(klon, nbsrf)) 
    1560       allocate( capCL(klon, nbsrf))   
    1561       allocate( oliqCL(klon, nbsrf))       
    1562       allocate( cteiCL(klon, nbsrf))       
    1563       allocate( trmb1(klon, nbsrf))   
    1564       allocate( trmb2(klon, nbsrf))     
    1565       allocate( trmb3(klon, nbsrf))
    15661455      allocate( clwcon0(klon,klev),rnebcon0(klon,klev))
    15671456      allocate( tau_ae(klon,klev,2), piz_ae(klon,klev,2))
    … …  
    15761465        rnebcon(:,:)=0.
    15771466        ratqs(:,:)=0.
    1578         run_off_lic_0(:)=0.
    15791467        sollw(:)=0.
    15801468        ema_work1(:,:)=0.
    … …  
    16151503         u10m(:,:)=0.
    16161504         v10m(:,:)=0.
    1617          t2m(:,:)=0.
    1618          q2m(:,:)=0.
    1619          ffonte(:,:)=0.
    1620          fqcalving(:,:)=0.
    1621          fqfonte(:,:)=0.
    16221505         piz_ae(:,:,:)=0.
    16231506         tau_ae(:,:,:)=0.
    … …  
    16431526c        histoW(:,:,:,:) = 0.0
    16441527! fin anne
    1645 ! Anne 12/09/2005
    1646 
    1647          pblh(:,:)   =0.        ! Hauteur de couche limite
    1648          plcl(:,:)   =0.        ! Niveau de condensation de la CLA
    1649          capCL(:,:)  =0.        ! CAPE de couche limite
    1650          oliqCL(:,:) =0.        ! eau_liqu integree de couche limite
    1651          cteiCL(:,:) =0.        ! cloud top instab. crit. couche limite
    1652          pblt(:,:)   =0.        ! T a la Hauteur de couche limite
    1653          therm(:,:)  =0.
    1654          trmb1(:,:)  =0.        ! deep_cape
    1655          trmb2(:,:)  =0.        ! inhibition
    1656          trmb3(:,:)  =0.        ! Point Omega
    1657 ! fin Anne
    1658 
    1659 cym
    1660          wfbils(:,:)=0
    1661 cym     
     1528
    16621529cIM     
    16631530         IF (ip_ebil_phy.ge.1) d_h_vcol_phy=0.
    … …  
    16771544c Initialiser les compteurs:
    16781545c
    1679 
    1680          frugs = 0.
    16811546         itap    = 0
    16821547         itaprad = 0
     1548
    16831549         CALL phyetat0 ("startphy.nc",dtime,co2_ppm_etat0,solaire_etat0,
    1684      .       rlat,rlon,pctsrf, ftsol,ftsoil,
    1685 cIM "slab" ocean
    1686      .       ocean, tslab,seaice,
    1687      .       fqsurf,qsol,fsnow,
    1688 cIM 220306  .       falbe, falblw, fevap, rain_fall,snow_fall,solsw, sollwdown,
    1689      .       falbe, falblw, fevap, rain_fall,snow_fall,solsw, sollw,
    1690      .       dlw,radsol,frugs,agesno,clesphy0,
     1550     .       rlat,rlon,pctsrf, ftsol,
     1551     .       ocean, ok_veget,
     1552     .       falbe, falblw, rain_fall,snow_fall,
     1553     .       solsw, sollw,
     1554     .       radsol,clesphy0,
    16911555     .       zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,tabcntr0,
    1692      .       t_ancien, q_ancien, ancien_ok, rnebcon, ratqs,clwcon,
    1693      .       run_off_lic_0)
     1556     .       t_ancien, q_ancien, ancien_ok, rnebcon, ratqs,clwcon)
    16941557
    16951558       DO i=1,klon
    … …  
    16971560     $       pctsrf(i, is_oce) + pctsrf(i, is_sic)  - 1.) .GT. EPSFRA)
    16981561     $       THEN
    1699              WRITE(*,*) 'physiq : pb sous surface au point ', i,
    1700      $           pctsrf(i, 1 : nbsrf)
     1562            WRITE(*,*)
     1563     $   'physiq apres lecture de restart: pb sous surface au point ',
     1564     $   i, pctsrf(i, 1 : nbsrf)
    17011565         ENDIF
    17021566      ENDDO
    1703  
    1704 c   ATTENTION : il faudra a terme relire q2 dans l'etat initial
    1705          q2(:,:,:)=1.e-8
    1706 c
     1567
    17071568         radpas = NINT( 86400./dtime/nbapp_rad)
    17081569c
    … …  
    17171578cIM cf. AM 081204 END
    17181579c
    1719          IF(ocean.NE.'force ') THEN
    1720           ok_ocean=.TRUE.
    1721          ENDIF
    1722 c
    1723          CALL printflag( tabcntr0,radpas,ok_ocean,ok_oasis ,ok_journe,
     1580         CALL printflag( tabcntr0,radpas,ok_journe,
    17241581     ,                    ok_instan, ok_region )
    17251582c
    … …  
    17801637c34EK
    17811638         IF (ok_orodr) THEN
    1782          DO i=1,klon
    1783          rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
    1784          ENDDO
    1785          CALL SUGWD(klon,klev,paprs,pplay)
    1786          DO i=1,klon
    1787          zuthe(i)=0.
    1788          zvthe(i)=0.
    1789          if(zstd(i).gt.10.)then
    1790            zuthe(i)=(1.-zgam(i))*cos(zthe(i))
    1791            zvthe(i)=(1.-zgam(i))*sin(zthe(i))
    1792          endif
    1793          ENDDO
     1639           DO i=1,klon
     1640             rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
     1641           ENDDO
     1642           CALL SUGWD(klon,klev,paprs,pplay)
     1643           DO i=1,klon
     1644             zuthe(i)=0.
     1645             zvthe(i)=0.
     1646             if(zstd(i).gt.10.)then
     1647               zuthe(i)=(1.-zgam(i))*cos(zthe(i))
     1648               zvthe(i)=(1.-zgam(i))*sin(zthe(i))
     1649             endif
     1650           ENDDO
    17941651         ENDIF
    17951652c
    … …  
    18511708         ecrit_tra = ecrit_tra * un_jour
    18521709cIM 030306 END
    1853 c
    1854 c Initialiser le couplage si necessaire
    1855 c
    1856       npas = 0
    1857       nexca = 0
    1858       if (ocean == 'couple') then
    1859         npas = itaufin/ iphysiq
    1860         nexca = 86400 / dtime
    1861         write(lunout,*)' ##### Ocean couple #####'
    1862         write(lunout,*)' Valeurs des pas de temps'
    1863         write(lunout,*)' npas = ', npas
    1864         write(lunout,*)' nexca = ', nexca
    1865       endif       
    1866 c
     1710
    18671711      capemaxcels = 't_max(X)'
    18681712      t2mincels = 't_min(X)'
    … …  
    21421986C
    21431987      END IF
    2144 C
    2145 c
    2146 c Appeler la diffusion verticale (programme de couche limite)
    2147 c
    2148       DO i = 1, klon
    2149 c       if (.not. ok_veget) then
    2150 c          frugs(i,is_ter) = SQRT(frugs(i,is_ter)**2+rugoro(i)**2)
    2151 c       endif
    2152 c         frugs(i,is_lic) = rugoro(i)
    2153 c         frugs(i,is_oce) = rugmer(i)
    2154 c         frugs(i,is_sic) = 0.001
    2155          zxrugs(i) = 0.0
    2156       ENDDO
    2157       DO nsrf = 1, nbsrf
    2158       DO i = 1, klon
    2159 c         frugs(i,nsrf) = MAX(frugs(i,nsrf),0.001)
    2160         frugs(i,nsrf) = MAX(frugs(i,nsrf),0.000015)
    2161       ENDDO
    2162       ENDDO
    2163       DO nsrf = 1, nbsrf
    2164       DO i = 1, klon
    2165             zxrugs(i) = zxrugs(i) + frugs(i,nsrf)*pctsrf(i,nsrf)
    2166       ENDDO
    2167       ENDDO
     1988
    21681989c
    21691990C calculs necessaires au calcul de l'albedo dans l'interface
    … …  
    21761997        rmu0 = -999.999
    21771998      ENDIF
    2178 c
    2179 C     Calcul de l'abedo moyen par maille
    2180       albsol(:)=0.
    2181       albsollw(:)=0.
    2182       DO nsrf = 1, nbsrf
    2183       DO i = 1, klon
    2184          albsol(i) = albsol(i) + falbe(i,nsrf) * pctsrf(i,nsrf)
    2185          albsollw(i) = albsollw(i) + falblw(i,nsrf) * pctsrf(i,nsrf)
    2186       ENDDO
    2187       ENDDO
    2188 C
    2189 C     Repartition sous maille des flux LW et SW
    2190 C Modif OM+PASB+JLD
    2191 C Repartition du longwave par sous-surface linearisee
    2192 Cn
    2193 
    2194        DO nsrf = 1, nbsrf
    2195        DO i = 1, klon
    2196 c@$$        fsollw(i,nsrf) = sollwdown(i) - RSIGMA*ftsol(i,nsrf)**4
    2197 c@$$        fsollw(i,nsrf) = sollw(i)
    2198          fsollw(i,nsrf) = sollw(i)
    2199      $      + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ftsol(i,nsrf))
    2200          fsolsw(i,nsrf) = solsw(i)*(1.-falbe(i,nsrf))/(1.-albsol(i))
    2201        ENDDO
    2202        ENDDO
    2203      
    2204 cYM   !!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2205 cYM         Attention verrue
    2206 cYM    ---> A supprimer plus tard       
    2207 cYM         pour etre integre dans
    2208 cYM         ORCHIDEE       
    2209       DO i = 1, klon
    2210         sollwdown(i)=sollw(i)+RSIGMA*ztsol(i)**4
    2211       ENDDO
    2212 cYM  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!     
    2213      
    2214       fder = dlw
    22151999
    22162000      if (mydebug) then
    … …  
    22202004        call writefield_phy('q_seri',q_seri,llm)
    22212005      endif
    2222  
    2223       IF (check) THEN
    2224        amn=MIN(tslab(1),1000.)
    2225        amx=MAX(tslab(1),-1000.)
    2226        DO i=2, klon
    2227         amn=MIN(tslab(i),amn)
    2228         amx=MAX(tslab(i),amx)
    2229        ENDDO
    2230 c
    2231        PRINT*,' debut avant clqh min max tslab',amn,amx
    2232       ENDIF !(check) THEN
    2233 c
    2234       CALL clmain(dtime,itap,date0,pctsrf,pctsrf_new,
    2235      e            t_seri,q_seri,u_seri,v_seri,
    2236      e            julien, rmu0, co2_ppm,
    2237      e            ok_veget, ocean, npas, nexca, ftsol,
    2238      $            soil_model,cdmmax, cdhmax,
    2239      $            ksta, ksta_ter, ok_kzmin, ftsoil, qsol,
    2240 cIM BAD    $            paprs,pplay,radsol, fsnow,fqsurf,fevap,falbe,falblw,
    2241      $            paprs,pplay, fsnow,fqsurf,fevap,falbe,falblw,
    2242      $            fluxlat,
    2243      e            rain_fall, snow_fall,
    2244      e            fsolsw, fsollw, sollwdown, fder,
    2245      e            rlon, rlat, cuphy, cvphy, frugs,
    2246      e            debut, lafin, agesno,rugoro ,
    2247      s            d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_ts,
    2248      s            fluxt,fluxq,fluxu,fluxv,cdragh,cdragm,
    2249      s            q2,
    2250      s            dsens, devap,
    2251      s            ycoefh,yu1,yv1, t2m, q2m, u10m, v10m,
    2252      s            pblh,capCL,oliqCL,cteiCL,pblT,
    2253      s            therm,trmb1,trmb2,trmb3,plcl,
    2254      s            fqcalving, fqfonte,ffonte, run_off_lic_0,
    2255 cIM "slab" ocean
    2256      s            fluxo, fluxg, tslab, seaice)
    2257 c
    2258 CXXX PB
    2259 CXXX Incrementation des flux
    2260 CXXX
    2261 
    2262       zxfluxt=0.
    2263       zxfluxq=0.
    2264       zxfluxu=0.
    2265       zxfluxv=0.
    2266       DO nsrf = 1, nbsrf
    2267         DO k = 1, klev
    2268           DO i = 1, klon
    2269             zxfluxt(i,k) = zxfluxt(i,k) +
    2270      $          fluxt(i,k,nsrf) * pctsrf( i, nsrf)
    2271             zxfluxq(i,k) = zxfluxq(i,k) +
    2272      $          fluxq(i,k,nsrf) * pctsrf( i, nsrf)
    2273             zxfluxu(i,k) = zxfluxu(i,k) +
    2274      $          fluxu(i,k,nsrf) * pctsrf( i, nsrf)
    2275             zxfluxv(i,k) = zxfluxv(i,k) +
    2276      $          fluxv(i,k,nsrf) * pctsrf( i, nsrf)
    2277           END DO
    2278         END DO
    2279       END DO
    2280       DO i = 1, klon
    2281          sens(i) = - zxfluxt(i,1) ! flux de chaleur sensible au sol
    2282 c         evap(i) = - fluxq(i,1) ! flux d'evaporation au sol
    2283          evap(i) = - zxfluxq(i,1) ! flux d'evaporation au sol
    2284          fder(i) = dlw(i) + dsens(i) + devap(i)
    2285       ENDDO
    2286 
    2287 
     2006
     2007ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
     2008c Appel au pbl_surface : Planetary Boudary Layer et Surface
     2009c Cela implique tous les interactions des sous-surfaces et la partie diffusion
     2010c turbulent du couche limit.
     2011c
     2012c Certains varibales de sorties de pbl_surface sont utiliser que pour
     2013c ecriture des fihiers hist_XXXX.nc, ces sont :
     2014c   qsol,      zq2m,      s_pblh,  s_lcl,
     2015c   s_capCL,   s_oliqCL,  s_cteiCL,s_pblT,
     2016c   s_therm,   s_trmb1,   s_trmb2, s_trmb3,
     2017c   zxrugs,    zu10m,     zv10m,   fder,
     2018c   zxqsurf,   rh2m,      zxfluxu, zxfluxv,
     2019c   frugs,     agesno,    fsollw,  fsolsw,
     2020c   d_ts,      fevap,     fluxlat, t2m,
     2021c   wfbils,    wfbilo,    fluxt,   fluxu, fluxv,
     2022c
     2023c Certains ne sont pas utiliser du tout :
     2024c   dsens, devap, zxsnow, zxfluxt, zxfluxq, q2m, fluxq
     2025c
     2026      CALL pbl_surface(
     2027     e     dtime,     date0,     itap,    julien,
     2028     e     debut,     lafin,
     2029     e     rlon,      rlat,      rugoro,  rmu0,     
     2030     e     rain_fall, snow_fall, solsw,   sollw,   
     2031     e     t_seri,    q_seri,    u_seri,  v_seri,   
     2032     e     pplay,     paprs,     pctsrf,           
     2033     +     ftsol,     falbe,     falblw,  u10m,   v10m,
     2034     s     sollwdown, cdragh,    cdragm,  yu1,    yv1,
     2035     s     albsol,    albsollw,  sens,    evap, 
     2036     s     zxtsol,    zxfluxlat, zt2m,    qsat2m,
     2037     s     d_t_vdf,   d_q_vdf,   d_u_vdf, d_v_vdf,
     2038     s     ycoefh,    pctsrf_new,               
     2039     d     qsol,      zq2m,      s_pblh,  s_lcl,
     2040     d     s_capCL,   s_oliqCL,  s_cteiCL,s_pblT,
     2041     d     s_therm,   s_trmb1,   s_trmb2, s_trmb3,
     2042     d     zxrugs,    zu10m,     zv10m,   fder,
     2043     d     zxqsurf,   rh2m,      zxfluxu, zxfluxv,
     2044     d     frugs,     agesno,    fsollw,  fsolsw,
     2045     d     d_ts,      fevap,     fluxlat, t2m,
     2046     d     wfbils,    wfbilo,    fluxt,   fluxu,  fluxv,
     2047     -     dsens,     devap,     zxsnow,
     2048     -     zxfluxt,   zxfluxq,   q2m,     fluxq )
     2049c
     2050c
     2051ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
     2052
     2053      pctsrf(:,:) = pctsrf_new(:,:)
     2054     
    22882055      DO k = 1, klev
    22892056      DO i = 1, klon
    … …  
    23032070
    23042071
    2305 cIM
    23062072      IF (ip_ebil_phy.ge.2) THEN
    2307         ztit='after clmain'
     2073        ztit='after surface_main'
    23082074        CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime
    23092075     e      , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay
    … …  
    23152081     s      , fs_bound, fq_bound )
    23162082      END IF
    2317 C
    2318 c
    2319 c Incrementer la temperature du sol
    2320 c
    2321       DO i = 1, klon
    2322          zxtsol(i) = 0.0
    2323          zxfluxlat(i) = 0.0
    2324 c
    2325          zt2m(i) = 0.0
    2326          zq2m(i) = 0.0
    2327          zu10m(i) = 0.0
    2328          zv10m(i) = 0.0
    2329 cIM cf JLD ??
    2330          zxffonte(i) = 0.0
    2331          zxfqcalving(i) = 0.0
    2332          zxfqfonte(i) = 0.0
    2333 cIM cf. AM 081204 BEG
    2334 c
    2335          s_pblh(i) = 0.0
    2336          s_lcl(i) = 0.0
    2337          s_capCL(i) = 0.0
    2338          s_oliqCL(i) = 0.0
    2339          s_cteiCL(i) = 0.0
    2340          s_pblT(i) = 0.0
    2341          s_therm(i) = 0.0
    2342          s_trmb1(i) = 0.0
    2343          s_trmb2(i) = 0.0
    2344          s_trmb3(i) = 0.0
    2345 c
    2346          IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +
    2347      $       pctsrf(i, is_oce) + pctsrf(i, is_sic)  - 1.) .GT. EPSFRA)
    2348      $       THEN
    2349              WRITE(*,*) 'physiq : pb sous surface au point ', i,
    2350      $           pctsrf(i, 1 : nbsrf)
    2351          ENDIF
    2352       ENDDO
    2353       DO nsrf = 1, nbsrf
    2354         DO i = 1, klon
    2355 c        IF (pctsrf(i,nsrf) .GE. EPSFRA) THEN
    2356             ftsol(i,nsrf) = ftsol(i,nsrf) + d_ts(i,nsrf)
    2357 cIM cf. JLD
    2358             wfbils(i,nsrf) = ( fsolsw(i,nsrf) + fsollw(i,nsrf)
    2359      $         + fluxt(i,1,nsrf) + fluxlat(i,nsrf) ) * pctsrf(i,nsrf)
    2360 cIM
    2361             wfbilo(i,nsrf) = ( fevap(i,nsrf) -
    2362      $      (rain_fall(i) + snow_fall(i)) ) * pctsrf(i,nsrf)
    2363             zxtsol(i) = zxtsol(i) + ftsol(i,nsrf)*pctsrf(i,nsrf)
    2364             zxfluxlat(i) = zxfluxlat(i) + fluxlat(i,nsrf)*pctsrf(i,nsrf)
    2365 cccIM
    2366             zt2m(i) = zt2m(i) + t2m(i,nsrf)*pctsrf(i,nsrf)
    2367             zq2m(i) = zq2m(i) + q2m(i,nsrf)*pctsrf(i,nsrf)
    2368             zu10m(i) = zu10m(i) + u10m(i,nsrf)*pctsrf(i,nsrf)
    2369             zv10m(i) = zv10m(i) + v10m(i,nsrf)*pctsrf(i,nsrf)
    2370 cIM cf JLD ??
    2371             zxffonte(i) = zxffonte(i) + ffonte(i,nsrf)*pctsrf(i,nsrf)
    2372             zxfqcalving(i) = zxfqcalving(i) +
    2373      .                      fqcalving(i,nsrf)*pctsrf(i,nsrf)
    2374             zxfqfonte(i) = zxfqfonte(i) +
    2375      .                      fqfonte(i,nsrf)*pctsrf(i,nsrf)
    2376 cIM cf. AM 081204 BEG
    2377             s_pblh(i) = s_pblh(i) + pblh(i,nsrf)*pctsrf(i,nsrf)
    2378             s_lcl(i) = s_lcl(i) + plcl(i,nsrf)*pctsrf(i,nsrf)
    2379             s_capCL(i) = s_capCL(i) + capCL(i,nsrf) *pctsrf(i,nsrf)
    2380             s_oliqCL(i) = s_oliqCL(i) + oliqCL(i,nsrf) *pctsrf(i,nsrf)
    2381             s_cteiCL(i) = s_cteiCL(i) + cteiCL(i,nsrf) *pctsrf(i,nsrf)
    2382             s_pblT(i) = s_pblT(i) + pblT(i,nsrf) *pctsrf(i,nsrf)
    2383             s_therm(i) = s_therm(i) + therm(i,nsrf) *pctsrf(i,nsrf)
    2384             s_trmb1(i) = s_trmb1(i) + trmb1(i,nsrf) *pctsrf(i,nsrf)
    2385             s_trmb2(i) = s_trmb2(i) + trmb2(i,nsrf) *pctsrf(i,nsrf)
    2386             s_trmb3(i) = s_trmb3(i) + trmb3(i,nsrf) *pctsrf(i,nsrf)
    2387 c        ENDIF
    2388         ENDDO
    2389       ENDDO
    2390 
    2391       IF (check) THEN
    2392        amn=MIN(ftsol(1,is_ter),1000.)
    2393        amx=MAX(ftsol(1,is_ter),-1000.)
    2394        DO i=2, klon
    2395         amn=MIN(ftsol(i,is_ter),amn)
    2396         amx=MAX(ftsol(i,is_ter),amx)
    2397        ENDDO
    2398 c
    2399        PRINT*,' debut apres d_ts min max ftsol',itap,amn,amx
    2400       ENDIF !(check) THEN
    2401 c
    2402 c Si une sous-fraction n'existe pas, elle prend la temp. moyenne
    2403 c
    2404       DO nsrf = 1, nbsrf
    2405         DO i = 1, klon
    2406           IF (pctsrf(i,nsrf) .LT. epsfra.OR.t2m(i,nsrf).EQ.0.) THEN
    2407            ftsol(i,nsrf) = zxtsol(i)
    2408            t2m(i,nsrf) = zt2m(i)
    2409            q2m(i,nsrf) = zq2m(i)
    2410            u10m(i,nsrf) = zu10m(i)
    2411            v10m(i,nsrf) = zv10m(i)
    2412            ffonte(i,nsrf) = zxffonte(i)
    2413            fqcalving(i,nsrf) = zxfqcalving(i)
    2414            fqfonte(i,nsrf) = zxfqfonte(i)
    2415            pblh(i,nsrf)=s_pblh(i)
    2416            plcl(i,nsrf)=s_lcl(i)
    2417            capCL(i,nsrf)=s_capCL(i)
    2418            oliqCL(i,nsrf)=s_oliqCL(i)
    2419            cteiCL(i,nsrf)=s_cteiCL(i)
    2420            pblT(i,nsrf)=s_pblT(i)
    2421            therm(i,nsrf)=s_therm(i)
    2422            trmb1(i,nsrf)=s_trmb1(i)
    2423            trmb2(i,nsrf)=s_trmb2(i)
    2424            trmb3(i,nsrf)=s_trmb3(i)
    2425           ENDIF
    2426         ENDDO
    2427       ENDDO
    2428 c
    2429 c Calculer la derive du flux infrarouge
    2430 c
    2431 cXXX      DO nsrf = 1, nbsrf
    2432       DO i = 1, klon
    2433 cXXX        IF (pctsrf(i,nsrf) .GE. EPSFRA) THEN
    2434             dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3
    2435 cXXX     .          *(ftsol(i,nsrf)-zxtsol(i))
    2436 cXXX     .          *pctsrf(i,nsrf)
    2437 cXXX        ENDIF
    2438 cXXX      ENDDO
    2439       ENDDO
     2083
    24402084c
    24412085c Appeler la convection (au choix)
    … …  
    24732117      ELSE IF (iflag_con.EQ.2) THEN
    24742118      CALL conflx(dtime, paprs, pplay, t_seri, q_seri,
    2475      e            conv_t, conv_q, zxfluxq(1,1), omega,
     2119     e            conv_t, conv_q, -evap, omega,
    24762120     s            d_t_con, d_q_con, rain_con, snow_con,
    24772121     s            pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
    … …  
    29562600      ENDDO
    29572601      ENDDO
    2958 c
    2959 cIM Calculer l'humidite relative a 2m (rh2m) pour diagnostique
    2960 cIM ajout dependance type surface
    2961       DO i = 1, klon
    2962        rh2m(i)=0.
    2963        qsat2m(i)=0.
    2964       DO nsrf=1, nbsrf
    2965          zx_t1(i,nsrf) = t2m(i,nsrf)
    2966          IF (thermcep) THEN
    2967             zdelta1(i,nsrf) = MAX(0.,SIGN(1.,rtt-zx_t1(i,nsrf)))
    2968             zx_qs1(i,nsrf)  = r2es *
    2969      $      FOEEW(zx_t1(i,nsrf),zdelta1(i,nsrf))/paprs(i,1)
    2970             zx_qs1(i,nsrf)  = MIN(0.5,zx_qs1(i,nsrf))
    2971             zcor1(i,nsrf)   = 1./(1.-retv*zx_qs1(i,nsrf))
    2972             zx_qs1(i,nsrf)  = zx_qs1(i,nsrf)*zcor1(i,nsrf)
    2973          ELSE
    2974 c
    2975            IF (zx_t.LT.RTT) THEN
    2976               zx_qs = qsats(zx_t)/paprs(i,1)
    2977            ELSE
    2978               zx_qs = qsatl(zx_t)/paprs(i,1)
    2979            ENDIF
    2980          ENDIF
    2981        zx_rh2m(i,nsrf) = q2m(i,nsrf)/zx_qs1(i,nsrf)
    2982        zx_qsat2m(i,nsrf)=zx_qs1(i,nsrf)
    2983        rh2m(i) = rh2m(i)+zx_rh2m(i,nsrf)*pctsrf(i,nsrf)
    2984        qsat2m(i)=qsat2m(i)+zx_qsat2m(i,nsrf)*pctsrf(i,nsrf)
    2985       ENDDO !nsrf
    2986       ENDDO
    2987 c
     2602
    29882603cIM Calcul temp.potentielle a 2m (tpot) et temp. potentielle
    29892604c   equivalente a 2m (tpote) pour diagnostique
    … …  
    30232638#endif
    30242639
     2640           zxsnow_dummy(:) = 0.0
     2641
    30252642           CALL chemhook_begin (calday,
    30262643#if defined(INCA) && !defined(INCA_CH4) && !defined(INCA_NMHC) && !defined(INCA_AER)
    … …  
    30422659     $                          q_seri,
    30432660     $                          zxtsol,
    3044      $                          zxsnow,
     2661     $                          zxsnow_dummy,
    30452662     $                          solsw,
    30462663     $                          albsol,
    … …  
    30992716c
    31002717      IF (MOD(itaprad,radpas).EQ.0) THEN
     2718
    31012719      DO i = 1, klon
    31022720         albsol(i) = falbe(i,is_oce) * pctsrf(i,is_oce)
    … …  
    31722790c     .            agesno, ftsol,fqsurf,fsnow, ruis)
    31732791c
    3174       DO i = 1, klon
    3175          zxqsurf(i) = 0.0
    3176          zxsnow(i) = 0.0
    3177       ENDDO
    3178       DO nsrf = 1, nbsrf
    3179       DO i = 1, klon
    3180          zxqsurf(i) = zxqsurf(i) + fqsurf(i,nsrf)*pctsrf(i,nsrf)
    3181          zxsnow(i) = zxsnow(i) + fsnow(i,nsrf)*pctsrf(i,nsrf)
    3182       ENDDO
    3183       ENDDO
    3184 c
    3185 c Si une sous-fraction n'existe pas, elle prend la valeur moyenne
    3186 c
    3187 cXXX      DO nsrf = 1, nbsrf
    3188 cXXX      DO i = 1, klon
    3189 cXXX         IF (pctsrf(i,nsrf).LT.epsfra) THEN
    3190 cXXX            fqsurf(i,nsrf) = zxqsurf(i)
    3191 cXXX            fsnow(i,nsrf) = zxsnow(i)
    3192 cXXX         ENDIF
    3193 cXXX      ENDDO
    3194 cXXX      ENDDO
     2792
    31952793c
    31962794c Calculer le bilan du sol et la derive de temperature (couplage)
    … …  
    34933091     $                        annee_ref,
    34943092     $                        day_ini,
    3495      $                        airephy,     
    34963093#ifdef INCA_AER
    34973094     $                        xjour,
    … …  
    35583155c=============================================================
    35593156#ifdef CPP_IOIPSL
     3157 
     3158c Recupere des varibles calcule dans differents modules
     3159c pour ecriture dans histxxx.nc
     3160
     3161      ! Get some variables from module mod_fonte_neige
     3162      CALL fonte_neige_get_vars(pctsrf,
     3163     .     zxfqcalving, zxfqfonte, zxffonte)
     3164
     3165      IF (ocean == 'slab') THEN
     3166         ! Get some variables from module oceanslab
     3167         CALL ocean_slab_get_vars(tslab, seaice, fluxo, fluxg)
     3168      ELSEIF (ocean == 'couple') THEN
     3169         ! Get some variables from module oceancpl
     3170         CALL ocean_cpl_get_vars(fluxo, fluxg)
     3171      ELSE
     3172         ! Get some variables from module oceanforced
     3173         CALL ocean_forced_get_vars(fluxo, fluxg)
     3174      ENDIF
    35603175
    35613176#ifdef histhf
    … …  
    35953210c====================================================================
    35963211c
     3212     
     3213
    35973214      IF (lafin) THEN
    35983215         itau_phy = itau_phy + itap
    3599 ccc         IF (ok_oasis) CALL quitcpl
    3600          CALL phyredem ("restartphy.nc",dtime,radpas,
    3601      .      rlat, rlon, pctsrf, ftsol, ftsoil,
    3602 cIM "slab" ocean
    3603      .      tslab, seaice,
    3604      .      fqsurf, qsol,
    3605      .      fsnow, falbe,falblw, fevap, rain_fall, snow_fall,
    3606 cIM  .      solsw, sollwdown,dlw,
    3607      .      solsw, sollw,dlw,
    3608      .      radsol,frugs,agesno,
     3216         CALL phyredem ("restartphy.nc",dtime,radpas,ocean,
     3217     .      rlat, rlon, pctsrf, ftsol,
     3218     .      falbe,falblw, rain_fall,
     3219     .      snow_fall,
     3220     .      solsw, sollw,
     3221     .      radsol,
    36093222     .      zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,
    3610      .      t_ancien, q_ancien, rnebcon, ratqs, clwcon,run_off_lic_0)
     3223     .      t_ancien, q_ancien, rnebcon, ratqs, clwcon)
    36113224      ENDIF
    36123225     

  • LMDZ4/trunk/libf/phylmd/phytrac.F

    r776 r782  
    415415
    416416
    417           ecrit_tra = NINT(86400./pdtphys *ecritphy)
     417c jg: c'est ca qu'on veut?????           
     418          ecrit_tra = FLOAT(NINT(86400./pdtphys *ecritphy))
    418419          print*,'dans phytrac ',pdtphys,ecritphy,ecrit_tra
    419420

  • LMDZ4/trunk/libf/phylmd/printflag.F

    r524 r782  
    22! $Header$
    33!
    4        SUBROUTINE  printflag( tabcntr0, radpas, ok_ocean,ok_oasis,
     4       SUBROUTINE  printflag( tabcntr0, radpas,
    55     ,                        ok_journe,ok_instan,ok_region        )
    66c
    … …  
    1414       LOGICAL cycle_diurn0,soil_model0,new_oliq0,ok_orodr0
    1515       LOGICAL ok_orolf0,ok_limitvr0
    16        LOGICAL ok_ocean,ok_oasis,ok_journe,ok_instan,ok_region
     16       LOGICAL ok_journe,ok_instan,ok_region
    1717       INTEGER radpas , radpas0
    1818c
    … …  
    5353
    5454       PRINT 8, radpas
    55        PRINT 100
    56 
    57        PRINT 5,  ok_ocean,ok_oasis
    5855       PRINT 100
    5956
    … …  
    138135     , l3,3x,',ok_region = ',l3,3x,5(1H*) )
    139136
    140  5    FORMAT(2x,5(1H*),'      ok_ocean = ',l3,6x,' , ok_oasis = ',
    141      , l3,14x,5(1H*) )
    142 
    143 
    144137 7     FORMAT(2x,5(1H*),15x,'      ok_limitvrai   = ',l3,16x,5(1h*) )
    145138

  • LMDZ4/trunk/libf/phylmd/readsulfate.F

    r776 r782  
    4141c Input:
    4242c ------
    43       REAL*8  r_day                   ! Day of integration
     43      REAL  r_day                   ! Day of integration
    4444      LOGICAL first                 ! First timestep
    4545                                    ! (and therefore initialization necessary)
    … …  
    4747c Output:     
    4848c -------     
    49       REAL*8  sulfate_p(klon_omp,klev)
    50       REAL*8  sulfate (klon, klev)  ! Mass of sulfate (monthly mean data,
     49      REAL  sulfate_p(klon_omp,klev)
     50      REAL  sulfate (klon, klev)  ! Mass of sulfate (monthly mean data,
    5151                                  !  from file) [ug SO4/m3]
    52       REAL*8,SAVE,ALLOCATABLE :: sulfate_mpi(:,:)
    5352c     
    5453c Local Variables:
    … …  
    5857      parameter (ny=jjm+1)
    5958     
    60       INTEGER ismaller
    6159CJLD      INTEGER idec1, idec2 ! The two decadal data read ini
    6260      CHARACTER*4 cyear
    6361     
    6462      INTEGER im, day1, day2, im2
    65       REAL*8 so4_1(iim, jjm+1, klev, 12)
    66       REAL*8 so4_2(iim, jjm+1, klev, 12)   ! The sulfate distributions
    67      
    68 cym      REAL*8 so4(klon, klev, 12)  ! SO4 in right dimension
    69 cym      SAVE so4
    70 cym      REAL*8 so4_out(klon, klev)
    71 cym      SAVE so4_out
    72 
    73       REAL*8,allocatable,save :: so4(:, :, :)  ! SO4 in right dimension
    74       REAL*8,allocatable,save :: so4_out(:, :)
     63      REAL so4_1(iim, jjm+1, klev, 12)
     64      REAL so4_2(iim, jjm+1, klev, 12)   ! The sulfate distributions
     65     
     66      REAL, allocatable,save :: so4(:, :, :)  ! SO4 in right dimension
     67      REAL, allocatable,save :: so4_out(:, :)
    7568c$OMP THREADPRIVATE(so4,so4_out)
    7669     
    … …  
    290283     
    291284c$OMP END MASTER
    292       call Scatter(real(sulfate),real(sulfate_p))           
     285      call Scatter(sulfate,sulfate_p)           
    293286
    294287      RETURN
    … …  
    333326#include "chem.h"     
    334327#include "dimensions.h"     
    335 cym#include "dimphy.h"     
    336328#include "temps.h"     
    337329c
    338330c Input:
    339331c ------
    340       REAL*8  r_day                   ! Day of integration
     332      REAL  r_day                   ! Day of integration
    341333      LOGICAL first                 ! First timestep
    342334                                    ! (and therefore initialization necessary)
    … …  
    344336c Output:     
    345337c -------     
    346       REAL*8  pi_sulfate_p (klon_omp, klev) 
     338      REAL  pi_sulfate_p (klon_omp, klev) 
    347339                                 
    348       REAL*8  pi_sulfate (klon, klev)  ! Number conc. sulfate (monthly mean data,
     340      REAL  pi_sulfate (klon, klev)  ! Number conc. sulfate (monthly mean data,
    349341                                  !  from fil
    350342c     
    … …  
    355347      parameter (ny=jjm+1)
    356348     
    357       INTEGER im, day1, day2, im2, ismaller
    358       REAL*8 pi_so4_1(iim, jjm+1, klev, 12)
    359 
    360 cym      REAL*8 pi_so4(klon, klev, 12)  ! SO4 in right dimension
    361 cym      SAVE pi_so4
    362 cym      REAL*8 pi_so4_out(klon, klev)
    363 cym      SAVE pi_so4_out
    364 
    365       REAL*8,allocatable,save :: pi_so4(:, :, :)  ! SO4 in right dimension
    366       REAL*8,allocatable,save :: pi_so4_out(:, :)
     349      INTEGER im, day1, day2, im2
     350      REAL pi_so4_1(iim, jjm+1, klev, 12)
     351
     352      REAL, allocatable,save :: pi_so4(:, :, :)  ! SO4 in right dimension
     353      REAL, allocatable,save :: pi_so4_out(:, :)
    367354c$OMP THREADPRIVATE(pi_so4,pi_so4_out)           
    368355     
    … …  
    530517     
    531518c$OMP END MASTER
    532       call Scatter(real(pi_sulfate),real(pi_sulfate_p))           
     519      call Scatter(pi_sulfate,pi_sulfate_p)           
    533520
    534521      RETURN
    … …  
    563550     
    564551           
    565       REAL*8 so4mth(iim, ny, klev)
    566 c      REAL*8 so4mth(klev, ny, iim)
    567       REAL*8 so4(iim, ny, klev, 12)
     552      REAL so4mth(iim, ny, klev)
     553      REAL so4(iim, ny, klev, 12)
    568554
    569555 
    … …  
    609595         STATUS = NF_INQ_VARID (NCID, cvar, VARID)
    610596         write (*,*) ncid,imth,cvar, varid
    611 c         STATUS = NF_INQ_VARID (NCID, VARMONTHS(i), VARID(i))
     597
    612598         IF (STATUS .NE. NF_NOERR) write (*,*) 'err in read ',status     
    613          STATUS = NF_GET_VARA_DOUBLE
    614      .    (NCID, VARID, START,COUNT, so4mth)
     599
     600#ifdef NC_DOUBLE
     601         status = NF_GET_VAR_DOUBLE(NCID, VARID, START, COUNT, so4mth)
     602#else
     603         status = NF_GET_VAR_REAL(NCID, VARID, START, COUNT, so4mth)
     604#endif
    615605         IF (STATUS .NE. NF_NOERR) write (*,*) 'err in read data',status
    616606         
    … …  
    623613                  endif
    624614                  so4(i,j,k,imth)=so4mth(i,j,k)
    625 c                  so4(i,j,k,imth)=so4mth(k,j,i)
    626615               ENDDO
    627616            ENDDO
    … …  
    630619     
    631620      STATUS = NF_CLOSE(NCID)
     621      IF (STATUS .NE. NF_NOERR) write (*,*) 'err in closing file',status
     622
     623
    632624      END ! subroutine getso4fromfile
    633625     

  • LMDZ4/trunk/libf/phylmd/write_histday.h

    r766 r782  
    548548c
    549549      DO i=1, klon
    550        zx_tmp_2d(i)=MIN(100.,rh2m(i)*100.)
     550       zx_tmp_fi2d(i)=MIN(100.,rh2m(i)*100.)
    551551      ENDDO
    552552c
    553553cym      CALL gr_fi_ecrit(1,klon,iim,jjmp1, zx_tmp_2d,zx_tmp_2d)
    554       CALL histwrite_phy(nid_day,"rh2m",itau_w,zx_tmp_2d)
     554      CALL histwrite_phy(nid_day,"rh2m",itau_w,zx_tmp_fi2d)
    555555c
    556556cym      CALL gr_fi_ecrit(1,klon,iim,jjmp1, qsat2m,zx_tmp_2d)

  • LMDZ4/trunk/libf/phylmd/write_histhf.h

    r776 r782  
    332332cym      CALL gr_fi_ecrit(nbteta,klon,iim,jjmp1,PVteta,zx_tmp_3dte)
    333333      DO k=1, nbteta
     334       zx_tmp_fi2d(1:klon) = PVteta(1:klon,k)
    334335       CALL histwrite_phy(nid_hf,"PV"//ctetaSTD(k),
    335      .      itau_w,PVteta)
     336     .      itau_w,zx_tmp_fi2d)
    336337      ENDDO !k=1, nbteta
    337338      ENDIF
Note: See TracChangeset for help on using the changeset viewer.